diff options
Diffstat (limited to 'tests/regexpComp.test')
| -rw-r--r-- | tests/regexpComp.test | 138 |
1 files changed, 63 insertions, 75 deletions
diff --git a/tests/regexpComp.test b/tests/regexpComp.test index 42f1b3b..e927ca2 100644 --- a/tests/regexpComp.test +++ b/tests/regexpComp.test @@ -4,35 +4,32 @@ # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # -# Copyright © 1991-1993 The Regents of the University of California. -# Copyright © 1998 Sun Microsystems, Inc. -# Copyright © 1998-1999 Scriptics Corporation. +# Copyright (c) 1991-1993 The Regents of the University of California. +# Copyright (c) 1998 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {"::tcltest" ni [namespace children]} { - package require tcltest 2.5 +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest 2 namespace import -force ::tcltest::* } -source [file join [file dirname [info script]] tcltests.tcl] - # Procedure to evaluate a script within a proc, to test compilation # functionality proc evalInProc { script } { proc testProc {} $script set status [catch { - testProc + testProc } result] rename testProc {} return $result #return [list $status $result] } -unset -nocomplain foo - +catch {unset foo} test regexpComp-1.1 {basic regexp operation} { evalInProc { regexp ab*c abbbc @@ -64,8 +61,8 @@ test regexpComp-1.6 {basic regexp operation} { test regexpComp-1.7 {regexp utf compliance} { # if not UTF-8 aware, result is "0 1" evalInProc { - set foo "乎b q" - regexp "乎b q" "a乎b qw幎N wq" bar + set foo "\u4e4eb q" + regexp "\u4e4eb q" "a\u4e4eb qw\u5e4e\x4e wq" bar list [string compare $foo $bar] [regexp 4 $bar] } } {0 0} @@ -261,7 +258,7 @@ test regexpComp-4.4 {case conversion in regexp} { list [regexp -nocase $::x $::x foo] $foo } } "1 $x" -unset -nocomplain ::x +catch {unset ::x} test regexpComp-5.1 {exercise cache of compiled expressions} { evalInProc { @@ -318,17 +315,17 @@ test regexpComp-6.1 {regexp errors} { evalInProc { list [catch {regexp a} msg] $msg } -} {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}} +} {1 {wrong # args: should be "regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"}} test regexpComp-6.2 {regexp errors} { evalInProc { list [catch {regexp -nocase a} msg] $msg } -} {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}} +} {1 {wrong # args: should be "regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"}} test regexpComp-6.3 {regexp errors} { evalInProc { list [catch {regexp -gorp a} msg] $msg } -} {1 {bad option "-gorp": must be -all, -about, -indices, -inline, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}} +} {1 {bad switch "-gorp": must be -all, -about, -indices, -inline, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}} test regexpComp-6.4 {regexp errors} { evalInProc { list [catch {regexp a( b} msg] $msg @@ -351,11 +348,11 @@ test regexpComp-6.7 {regexp errors} { } {0 0} test regexpComp-6.8 {regexp errors} { evalInProc { - unset -nocomplain f1 + catch {unset f1} set f1 44 list [catch {regexp abc abc f1(f2)} msg] $msg } -} {1 {can't set "f1(f2)": variable isn't array}} +} {1 {couldn't set variable "f1(f2)"}} test regexpComp-6.9 {regexp errors, -start bad int check} { evalInProc { list [catch {regexp -start bogus {^$} {}} msg] $msg @@ -449,8 +446,8 @@ test regexpComp-7.16 {basic regsub operation} { test regexpComp-7.17 {regsub utf compliance} { evalInProc { # if not UTF-8 aware, result is "0 1" - set foo "xyz555ijka乎bpqr" - regsub a乎b xyza乎bijka乎bpqr 555 bar + set foo "xyz555ijka\u4e4ebpqr" + regsub a\u4e4eb xyza\u4e4ebijka\u4e4ebpqr 555 bar list [string compare $foo $bar] [regexp 4 $bar] } } {0 0} @@ -528,11 +525,6 @@ test regexpComp-9.6 {-all option to regsub} { list [regsub -all ^ xxx 123 foo] $foo } } {1 123xxx} -test regexpComp-9.7 {Bug 84af1192f5: -all option to regsub} { - evalInProc { - regsub -all {\(.*} 123(qwe) "" - } -} 123 test regexpComp-10.1 {expanded syntax in regsub} { evalInProc { @@ -569,27 +561,27 @@ test regexpComp-11.1 {regsub errors} { evalInProc { list [catch {regsub a b} msg] $msg } -} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} +} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}} test regexpComp-11.2 {regsub errors} { evalInProc { list [catch {regsub -nocase a b} msg] $msg } -} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} +} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}} test regexpComp-11.3 {regsub errors} { evalInProc { list [catch {regsub -nocase -all a b} msg] $msg } -} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} +} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}} test regexpComp-11.4 {regsub errors} { evalInProc { list [catch {regsub a b c d e f} msg] $msg } -} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} +} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}} test regexpComp-11.5 {regsub errors} { evalInProc { list [catch {regsub -gorp a b c} msg] $msg } -} {1 {bad option "-gorp": must be -all, -command, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}} +} {1 {bad switch "-gorp": must be -all, -nocase, -expanded, -line, -linestop, -lineanchor, -start, or --}} test regexpComp-11.6 {regsub errors} { evalInProc { list [catch {regsub -nocase a( b c d} msg] $msg @@ -597,11 +589,11 @@ test regexpComp-11.6 {regsub errors} { } {1 {couldn't compile regular expression pattern: parentheses () not balanced}} test regexpComp-11.7 {regsub errors} { evalInProc { - unset -nocomplain f1 + catch {unset f1} set f1 44 list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg } -} {1 {can't set "f1(f2)": variable isn't array}} +} {1 {couldn't set variable "f1(f2)"}} test regexpComp-11.8 {regsub errors, -start bad int check} { evalInProc { list [catch {regsub -start bogus pattern string rep var} msg] $msg @@ -609,7 +601,7 @@ test regexpComp-11.8 {regsub errors, -start bad int check} { } {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} # This test crashes on the Mac unless you increase the Stack Space to about 1 -# Meg. This is probably bigger than most users want... +# Meg. This is probably bigger than most users want... # 8.2.3 regexp reduced stack space requirements, but this should be # tested again test regexpComp-12.1 {Tcl_RegExpExec: large number of subexpressions} {macCrash} { @@ -667,54 +659,54 @@ test regexpComp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} removeFile junk.tcl } -result 1 -test regexpComp-15.1 {regexp -start} -body { - unset -nocomplain x +test regexpComp-15.1 {regexp -start} { + catch {unset x} list [regexp -start -10 {\d} 1abc2de3 x] $x -} -result {1 1} -test regexpComp-15.2 {regexp -start} -body { - unset -nocomplain x +} {1 1} +test regexpComp-15.2 {regexp -start} { + catch {unset x} list [regexp -start 2 {\d} 1abc2de3 x] $x -} -result {1 2} -test regexpComp-15.3 {regexp -start} -body { - unset -nocomplain x +} {1 2} +test regexpComp-15.3 {regexp -start} { + catch {unset x} list [regexp -start 4 {\d} 1abc2de3 x] $x -} -result {1 2} -test regexpComp-15.4 {regexp -start} -body { - unset -nocomplain x +} {1 2} +test regexpComp-15.4 {regexp -start} { + catch {unset x} list [regexp -start 5 {\d} 1abc2de3 x] $x -} -result {1 3} -test regexpComp-15.5 {regexp -start, over end of string} -body { - unset -nocomplain x +} {1 3} +test regexpComp-15.5 {regexp -start, over end of string} { + catch {unset x} list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x] -} -result {0 0} -test regexpComp-15.6 {regexp -start, loss of ^$ behavior} -body { +} {0 0} +test regexpComp-15.6 {regexp -start, loss of ^$ behavior} { list [regexp -start 2 {^$} {}] -} -result {0} +} {0} -test regexpComp-16.1 {regsub -start} -body { - unset -nocomplain x +test regexpComp-16.1 {regsub -start} { + catch {unset x} list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x -} -result {4 a1b/2c/3d/4e/5} -test regexpComp-16.2 {regsub -start} -body { - unset -nocomplain x +} {4 a1b/2c/3d/4e/5} +test regexpComp-16.2 {regsub -start} { + catch {unset x} list [regsub -all -start -25 {z} hello {/&} x] $x -} -result {0 hello} -test regexpComp-16.3 {regsub -start} -body { - unset -nocomplain x +} {0 hello} +test regexpComp-16.3 {regsub -start} { + catch {unset x} list [regsub -all -start 3 {z} hello {/&} x] $x -} -result {0 hello} -test regexpComp-16.4 {regsub -start, \A behavior} -body { +} {0 hello} +test regexpComp-16.4 {regsub -start, \A behavior} { set out {} lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x -} -result {5 /a/b/c/d/e 3 ab/c/d/e} +} {5 /a/b/c/d/e 3 ab/c/d/e} -test regexpComp-17.1 {regexp -inline} -body { +test regexpComp-17.1 {regexp -inline} { regexp -inline b ababa -} -result {b} -test regexpComp-17.2 {regexp -inline} -body { +} {b} +test regexpComp-17.2 {regexp -inline} { regexp -inline (b) ababa -} -result {b b} +} {b b} test regexpComp-17.3 {regexp -inline -indices} { regexp -inline -indices (b) ababa } {{1 1} {1 1}} @@ -793,13 +785,13 @@ test regexpComp-19.1 {regsub null replacement} { } } "\0a\0hel\0a\0lo\0a\0 14" -test regexpComp-20.1 {regsub shared object shimmering} deprecated { +test regexpComp-20.1 {regsub shared object shimmering} { evalInProc { # Bug #461322 - set a abcdefghijklmnopqurstuvwxyz - set b $a - set c abcdefghijklmnopqurstuvwxyz0123456789 - regsub $a $c $b d + set a abcdefghijklmnopqurstuvwxyz + set b $a + set c abcdefghijklmnopqurstuvwxyz0123456789 + regsub $a $c $b d list $d [string length $d] [string bytelength $d] } } [list abcdefghijklmnopqurstuvwxyz0123456789 37 37] @@ -989,11 +981,7 @@ test regexpComp-24.11 {regexp command compiling tests} { regexp -- $re $text } } 1 - + # cleanup ::tcltest::cleanupTests return - -# Local Variables: -# mode: tcl -# End: |