diff options
| author | hobbs <hobbs> | 2006-11-03 00:34:51 (GMT) |
|---|---|---|
| committer | hobbs <hobbs> | 2006-11-03 00:34:51 (GMT) |
| commit | c399e676c8dbdec3ce1fe4b694d7c269f9b1f675 (patch) | |
| tree | 13086bc5f8998596d202f1bdeaa9df4ed46bc3cd /tests | |
| parent | ee75480f2f9483654c8f665acd984569f3234ca8 (diff) | |
| download | tcl-c399e676c8dbdec3ce1fe4b694d7c269f9b1f675.zip tcl-c399e676c8dbdec3ce1fe4b694d7c269f9b1f675.tar.gz tcl-c399e676c8dbdec3ce1fe4b694d7c269f9b1f675.tar.bz2 | |
* doc/ParseCmd.3, doc/Tcl.n, doc/eval.n, doc/exec.n:
* doc/fconfigure.n, doc/interp.n, doc/unknown.n:
* library/auto.tcl, library/init.tcl, library/package.tcl:
* library/safe.tcl, library/tm.tcl, library/msgcat/msgcat.tcl:
* tests/all.tcl, tests/basic.test, tests/cmdInfo.test:
* tests/compile.test, tests/encoding.test, tests/execute.test:
* tests/fCmd.test, tests/http.test, tests/init.test:
* tests/interp.test, tests/io.test, tests/ioUtil.test:
* tests/iogt.test, tests/namespace-old.test, tests/namespace.test:
* tests/parse.test, tests/pkg.test, tests/pkgMkIndex.test:
* tests/proc.test, tests/reg.test, tests/trace.test:
* tests/upvar.test, tests/winConsole.test, tests/winFCmd.test:
* tools/tclZIC.tcl:
* generic/tclParse.c (Tcl_ParseCommand): Replace {expand} with {*}
officially (TIP #293). Leave -DALLOW_EXPAND=0|1 option to keep
{expand} syntax for transition users. [Bug 1589629]
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/all.tcl | 4 | ||||
| -rw-r--r-- | tests/basic.test | 144 | ||||
| -rw-r--r-- | tests/cmdInfo.test | 8 | ||||
| -rw-r--r-- | tests/compile.test | 44 | ||||
| -rw-r--r-- | tests/encoding.test | 4 | ||||
| -rw-r--r-- | tests/execute.test | 14 | ||||
| -rw-r--r-- | tests/fCmd.test | 8 | ||||
| -rw-r--r-- | tests/http.test | 4 | ||||
| -rw-r--r-- | tests/init.test | 4 | ||||
| -rw-r--r-- | tests/interp.test | 4 | ||||
| -rw-r--r-- | tests/io.test | 4 | ||||
| -rw-r--r-- | tests/ioUtil.test | 4 | ||||
| -rw-r--r-- | tests/iogt.test | 4 | ||||
| -rw-r--r-- | tests/namespace-old.test | 6 | ||||
| -rw-r--r-- | tests/namespace.test | 86 | ||||
| -rw-r--r-- | tests/parse.test | 76 | ||||
| -rw-r--r-- | tests/pkg.test | 4 | ||||
| -rw-r--r-- | tests/pkgMkIndex.test | 14 | ||||
| -rw-r--r-- | tests/proc.test | 34 | ||||
| -rw-r--r-- | tests/reg.test | 28 | ||||
| -rw-r--r-- | tests/trace.test | 6 | ||||
| -rw-r--r-- | tests/upvar.test | 6 | ||||
| -rw-r--r-- | tests/winConsole.test | 4 | ||||
| -rw-r--r-- | tests/winFCmd.test | 4 |
24 files changed, 259 insertions, 259 deletions
diff --git a/tests/all.tcl b/tests/all.tcl index f83536d..75650a1 100644 --- a/tests/all.tcl +++ b/tests/all.tcl @@ -10,10 +10,10 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: all.tcl,v 1.18 2004/10/30 02:16:52 dgp Exp $ +# RCS: @(#) $Id: all.tcl,v 1.19 2006/11/03 00:34:52 hobbs Exp $ package require Tcl 8.5 package require tcltest 2.2 namespace import tcltest::* -configure {expand}$argv -testdir [file dir [info script]] +configure {*}$argv -testdir [file dir [info script]] runAllTests diff --git a/tests/basic.test b/tests/basic.test index 7322eb0..e8a9e75 100644 --- a/tests/basic.test +++ b/tests/basic.test @@ -15,7 +15,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: basic.test,v 1.42 2006/10/09 19:15:44 msofer Exp $ +# RCS: @(#) $Id: basic.test,v 1.43 2006/11/03 00:34:52 hobbs Exp $ # package require tcltest 2 @@ -202,13 +202,13 @@ test basic-13.2 {Tcl_ExposeCommand, invalidate cached refs to cmd now being expo } {42 {} {} Hello {} {} 42} test basic-14.1 {Tcl_CreateCommand, new cmd goes into a namespace specified in its name, if any} {testcreatecommand} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} list [testcreatecommand create] \ [test_ns_basic::createdcommand] \ [testcreatecommand delete] } {{} {CreatedCommandProc in ::test_ns_basic} {}} test basic-14.2 {Tcl_CreateCommand, namespace code ignore single ":"s in middle or end of names} {testcreatecommand} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename value:at: ""} list [testcreatecommand create2] \ [value:at:] \ @@ -216,7 +216,7 @@ test basic-14.2 {Tcl_CreateCommand, namespace code ignore single ":"s in middle } {{} {CreatedCommandProc2 in ::} {}} test basic-15.1 {Tcl_CreateObjCommand, new cmd goes into a namespace specified in its name, if any} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_basic {} proc test_ns_basic::cmd {} { ;# proc requires that ns already exist return [namespace current] @@ -232,7 +232,7 @@ test basic-17.1 {TclInvokeObjCommand} {emptyTest} { } {} test basic-18.1 {TclRenameCommand, name of existing cmd can have namespace qualifiers} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename cmd ""} namespace eval test_ns_basic { proc p {} { @@ -244,11 +244,11 @@ test basic-18.1 {TclRenameCommand, name of existing cmd can have namespace quali [test_ns_basic::q] } {{p in ::test_ns_basic} {} {p in ::test_ns_basic}} test basic-18.2 {TclRenameCommand, existing cmd must be found} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {rename test_ns_basic::p test_ns_basic::q} msg] $msg } {1 {can't rename "test_ns_basic::p": command doesn't exist}} test basic-18.3 {TclRenameCommand, delete cmd if new name is empty} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_basic { proc p {} { return "p in [namespace current]" @@ -259,7 +259,7 @@ test basic-18.3 {TclRenameCommand, delete cmd if new name is empty} { [info commands test_ns_basic::*] } {::test_ns_basic::p {} {}} test basic-18.4 {TclRenameCommand, bad new name} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_basic { proc p {} { return "p in [namespace current]" @@ -276,7 +276,7 @@ test basic-18.5 {TclRenameCommand, new name must not already exist} { list [catch {rename test_ns_basic::q :::george::martha} msg] $msg } {1 {can't rename to ":::george::martha": command already exists}} test basic-18.6 {TclRenameCommand, check for command shadowing by newly renamed cmd} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} catch {rename q ""} proc p {} { @@ -299,7 +299,7 @@ test basic-19.1 {Tcl_SetCommandInfo} {emptyTest} { } {} test basic-20.1 {Tcl_GetCommandInfo, names for commands created inside namespaces} {testcmdtoken} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} catch {rename q ""} catch {unset x} @@ -328,7 +328,7 @@ test basic-21.1 {Tcl_GetCommandName} {emptyTest} { } {} test basic-22.1 {Tcl_GetCommandFullName} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_basic1 { namespace export cmd* proc cmd1 {} {} @@ -374,7 +374,7 @@ test basic-24.1 {Tcl_DeleteCommandFromToken, invalidate all compiled code if cmd [interp delete test_interp] } {123 {set called with a 123} {}} test basic-24.2 {Tcl_DeleteCommandFromToken, deleting commands changes command epoch} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} proc p {} { return "global p" @@ -392,7 +392,7 @@ test basic-24.2 {Tcl_DeleteCommandFromToken, deleting commands changes command e [test_ns_basic::callP] } {{namespace p} {} {global p}} test basic-24.3 {Tcl_DeleteCommandFromToken, delete imported cmds that refer to a deleted cmd} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} namespace eval test_ns_basic { namespace export p @@ -502,7 +502,7 @@ test basic-32.1 {Tcl_ExprBooleanObj} {emptyTest} { } {} test basic-36.1 {Tcl_EvalObjv, lookup of "unknown" command} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} catch {interp delete test_interp} interp create test_interp interp eval test_interp { @@ -654,69 +654,69 @@ if $noComp { } test basic-47.2.$noComp {Tcl_EvalEx: error during word expansion} -body { - run {{expand}\{} + run {{*}\{} } -constraints $constraints -returnCodes error -result {unmatched open brace in list} test basic-47.3.$noComp {Tcl_EvalEx, error during substitution} -body { - run {{expand}[error foo]} + run {{*}[error foo]} } -constraints $constraints -returnCodes error -result foo test basic-47.4.$noComp {Tcl_EvalEx: no expansion} $constraints { - run {list {expand} {expand} {expand}} -} {expand expand expand} + run {list {*} {*} {*}} +} {* * *} test basic-47.5.$noComp {Tcl_EvalEx: expansion} $constraints { - run {list {expand}{} {expand} {expand}x {expand}"y z"} -} {expand x y z} + run {list {*}{} {*} {*}x {*}"y z"} +} {* x y z} test basic-47.6.$noComp {Tcl_EvalEx: expansion to zero args} $constraints { - run {list {expand}{}} + run {list {*}{}} } {} test basic-47.7.$noComp {Tcl_EvalEx: expansion to one arg} $constraints { - run {list {expand}x} + run {list {*}x} } x test basic-47.8.$noComp {Tcl_EvalEx: expansion to many args} $constraints { - run {list {expand}"y z"} + run {list {*}"y z"} } {y z} test basic-47.9.$noComp {Tcl_EvalEx: expansion and subst order} $constraints { set x 0 - run {list [incr x] {expand}[incr x] [incr x] \ - {expand}[list [incr x] [incr x]] [incr x]} + run {list [incr x] {*}[incr x] [incr x] \ + {*}[list [incr x] [incr x]] [incr x]} } {1 2 3 4 5 6} test basic-47.10.$noComp {Tcl_EvalEx: expand and memory management} $constraints { - run {concat {expand}{} a b c d e f g h i j k l m n o p q r} + run {concat {*}{} a b c d e f g h i j k l m n o p q r} } {a b c d e f g h i j k l m n o p q r} test basic-47.11.$noComp {Tcl_EvalEx: expand and memory management} $constraints { - run {concat {expand}1 a b c d e f g h i j k l m n o p q r} + run {concat {*}1 a b c d e f g h i j k l m n o p q r} } {1 a b c d e f g h i j k l m n o p q r} test basic-47.12.$noComp {Tcl_EvalEx: expand and memory management} $constraints { - run {concat {expand}{1 2} a b c d e f g h i j k l m n o p q r} + run {concat {*}{1 2} a b c d e f g h i j k l m n o p q r} } {1 2 a b c d e f g h i j k l m n o p q r} test basic-47.13.$noComp {Tcl_EvalEx: expand and memory management} $constraints { - run {concat {expand}{} {expand}{1 2} a b c d e f g h i j k l m n o p q} + run {concat {*}{} {*}{1 2} a b c d e f g h i j k l m n o p q} } {1 2 a b c d e f g h i j k l m n o p q} test basic-47.14.$noComp {Tcl_EvalEx: expand and memory management} $constraints { - run {concat {expand}{} a b c d e f g h i j k l m n o p q r s} + run {concat {*}{} a b c d e f g h i j k l m n o p q r s} } {a b c d e f g h i j k l m n o p q r s} test basic-47.15.$noComp {Tcl_EvalEx: expand and memory management} $constraints { - run {concat {expand}1 a b c d e f g h i j k l m n o p q r s} + run {concat {*}1 a b c d e f g h i j k l m n o p q r s} } {1 a b c d e f g h i j k l m n o p q r s} test basic-47.16.$noComp {Tcl_EvalEx: expand and memory management} $constraints { - run {concat {expand}{1 2} a b c d e f g h i j k l m n o p q r s} + run {concat {*}{1 2} a b c d e f g h i j k l m n o p q r s} } {1 2 a b c d e f g h i j k l m n o p q r s} test basic-47.17.$noComp {Tcl_EvalEx: expand and memory management} $constraints { - run {concat {expand}{} {expand}{1 2} a b c d e f g h i j k l m n o p q r} + run {concat {*}{} {*}{1 2} a b c d e f g h i j k l m n o p q r} } {1 2 a b c d e f g h i j k l m n o p q r} test basic-48.1.$noComp {expansion: parsing} $constraints { @@ -724,7 +724,7 @@ test basic-48.1.$noComp {expansion: parsing} $constraints { # Another comment list 1 2\ - 3 {expand}$::l1 + 3 {*}$::l1 # Comment again } @@ -735,13 +735,13 @@ test basic-48.2.$noComp {no expansion} $constraints { } {{a {b b} c d} {e f {g g} h} {i j k {l l}}} test basic-48.3.$noComp {expansion} $constraints { - run {list {expand}$::l1 $::l2 {expand}[l3]} + run {list {*}$::l1 $::l2 {*}[l3]} } {a {b b} c d {e f {g g} h} i j k {l l}} test basic-48.4.$noComp {expansion: really long cmd} $constraints { set cmd [list list] for {set t 0} {$t < 500} {incr t} { - lappend cmd {{expand}$::l1} + lappend cmd {{*}$::l1} } llength [run [join $cmd]] } 2000 @@ -749,31 +749,31 @@ test basic-48.4.$noComp {expansion: really long cmd} $constraints { test basic-48.5.$noComp {expansion: error detection} -setup { set l "a {a b}x y" } -constraints $constraints -body { - run {list $::l1 {expand}$l} + run {list $::l1 {*}$l} } -cleanup { unset l } -returnCodes 1 -result {list element in braces followed by "x" instead of space} test basic-48.6.$noComp {expansion: odd usage} $constraints { - run {list {expand}$::l1$::l2} + run {list {*}$::l1$::l2} } {a {b b} c de f {g g} h} test basic-48.7.$noComp {expansion: odd usage} -constraints $constraints -body { - run {list {expand}[l3]$::l1} + run {list {*}[l3]$::l1} } -returnCodes 1 -result {list element in braces followed by "a" instead of space} test basic-48.8.$noComp {expansion: odd usage} $constraints { - run {list {expand}hej$::l1} + run {list {*}hej$::l1} } {heja {b b} c d} -test basic-48.9.$noComp {expansion: Not all {expand} should trigger} $constraints { - run {list {expand}$::l1 \{expand\}$::l2 "{expand}$::l1" {{expand} i j k}} -} {a {b b} c d {{expand}e f {g g} h} {{expand}a {b b} c d} {{expand} i j k}} +test basic-48.9.$noComp {expansion: Not all {*} should trigger} $constraints { + run {list {*}$::l1 \{*\}$::l2 "{*}$::l1" {{*} i j k}} +} {a {b b} c d {{*}e f {g g} h} {{*}a {b b} c d} {{*} i j k}} test basic-48.10.$noComp {expansion: expansion of command word} -setup { set cmd [list string range jultomte] } -constraints $constraints -body { - run {{expand}$cmd 2 6} + run {{*}$cmd 2 6} } -cleanup { unset cmd } -result ltomt @@ -782,24 +782,24 @@ test basic-48.11.$noComp {expansion: expansion into nothing} -setup { set cmd {} set bar {} } -constraints $constraints -body { - run {{expand}$cmd {expand}$bar} + run {{*}$cmd {*}$bar} } -cleanup { unset cmd bar } -result {} test basic-48.12.$noComp {expansion: odd usage} $constraints { - run {list {expand}$::l1 {expand}"hej hopp" {expand}$::l2} + run {list {*}$::l1 {*}"hej hopp" {*}$::l2} } {a {b b} c d hej hopp e f {g g} h} test basic-48.13.$noComp {expansion: odd usage} $constraints { - run {list {expand}$::l1 {expand}{hej hopp} {expand}$::l2} + run {list {*}$::l1 {*}{hej hopp} {*}$::l2} } {a {b b} c d hej hopp e f {g g} h} test basic-48.14.$noComp {expansion: hash command} -setup { catch {rename \# ""} set cmd "#" } -constraints $constraints -body { - run { {expand}$cmd apa bepa } + run { {*}$cmd apa bepa } } -cleanup { unset cmd } -returnCodes 1 -result {invalid command name "#"} @@ -810,7 +810,7 @@ test basic-48.15.$noComp {expansion: complex words} -setup { set c [list {f\ g h\ i j k} x y] set d {0\ 1 2 3} } -constraints $constraints -body { - run { lappend d {expand}$a($b) {expand}[lindex $c 0] } + run { lappend d {*}$a($b) {*}[lindex $c 0] } } -cleanup { unset a b c d } -result {{0 1} 2 3 a {b c} d e {f g} {h i} j k} @@ -828,25 +828,25 @@ test basic-48.16.$noComp {expansion: testing for leaks} -setup { # Create free objects that should disappear set l [list 1$a 2$a 3$a 4$a 5$a 6$a 7$a] # A short number of words and a short result (8) - set l [run {list {expand}$l $a$a}] + set l [run {list {*}$l $a$a}] # A short number of words and a longer result (27) - set l [run {list {expand}$l $a$a {expand}$l $a$a {expand}$l $a$a}] + set l [run {list {*}$l $a$a {*}$l $a$a {*}$l $a$a}] # A short number of words and a longer result, with an error # This is to stress the cleanup in the error case - if {![catch {run {_moo_ {expand}$l $a$a {expand}$l $a$a {expand}$l}}]} { + if {![catch {run {_moo_ {*}$l $a$a {*}$l $a$a {*}$l}}]} { error "An error was expected in the previous statement" } # Many words - set l [run {list {expand}$l $a$a {expand}$l $a$a \ - {expand}$l $a$a {expand}$l $a$a \ - {expand}$l $a$a {expand}$l $a$a \ - {expand}$l $a$a {expand}$l $a$a \ - {expand}$l $a$a {expand}$l $a$a \ - {expand}$l $a$a {expand}$l $a$a \ - {expand}$l $a$a {expand}$l $a$a \ - {expand}$l $a$a {expand}$l $a$a \ - {expand}$l $a$a {expand}$l $a$a \ - {expand}$l $a$a}] + set l [run {list {*}$l $a$a {*}$l $a$a \ + {*}$l $a$a {*}$l $a$a \ + {*}$l $a$a {*}$l $a$a \ + {*}$l $a$a {*}$l $a$a \ + {*}$l $a$a {*}$l $a$a \ + {*}$l $a$a {*}$l $a$a \ + {*}$l $a$a {*}$l $a$a \ + {*}$l $a$a {*}$l $a$a \ + {*}$l $a$a {*}$l $a$a \ + {*}$l $a$a}] if {[llength $l] != 19*28} { error "Bad Length: [llength $l] should be [expr {19*28}]" @@ -872,7 +872,7 @@ test basic-48.17.$noComp {expansion: object safety} -setup { } -constraints $constraints -body { set third [expr {1.0/3.0}] set l [list $third $third] - set x [run {list $third {expand}$l $third}] + set x [run {list $third {*}$l $third}] set res [list] foreach t $x { lappend res [expr {$t * 3.0}] @@ -889,7 +889,7 @@ test basic-48.18.$noComp {expansion: list semantics} -constraints $constraints - set apa 10 } set apa 0 - list [llength [run { {expand}$badcmd }]] $apa + list [llength [run { {*}$badcmd }]] $apa } -cleanup { unset apa badcmd } -result {5 0} @@ -898,38 +898,38 @@ test basic-48.19.$noComp {expansion: error checking order} -body { set badlist "a {}x y" set a 0 set b 0 - catch {run {list [incr a] {expand}$badlist [incr b]}} + catch {run {list [incr a] {*}$badlist [incr b]}} list $a $b } -constraints $constraints -cleanup { unset badlist a b } -result {1 0} test basic-48.20.$noComp {expansion: odd case with word boundaries} $constraints { - run {list {expand}$::l1 {expand}"hej hopp" {expand}$::l2} + run {list {*}$::l1 {*}"hej hopp" {*}$::l2} } {a {b b} c d hej hopp e f {g g} h} test basic-48.21.$noComp {expansion: odd case with word boundaries} $constraints { - run {list {expand}$::l1 {expand}{hej hopp} {expand}$::l2} + run {list {*}$::l1 {*}{hej hopp} {*}$::l2} } {a {b b} c d hej hopp e f {g g} h} test basic-48.22.$noComp {expansion: odd case with word boundaries} -body { - run {list {expand}$::l1 {expand}"hej hopp {expand}$::l2} + run {list {*}$::l1 {*}"hej hopp {*}$::l2} } -constraints $constraints -returnCodes error -result {missing "} test basic-48.23.$noComp {expansion: handle return codes} -constraints $constraints -body { set res {} for {set t 0} {$t < 10} {incr t} { - run { {expand}break } + run { {*}break } } lappend res $t for {set t 0} {$t < 10} {incr t} { - run { {expand}continue } + run { {*}continue } set t 20 } lappend res $t - lappend res [catch { run { {expand}{error Hejsan} } } err] + lappend res [catch { run { {*}{error Hejsan} } } err] lappend res $err } -cleanup { unset res t @@ -963,7 +963,7 @@ rename l3 {} rename run {} #cleanup -catch {namespace delete {expand}[namespace children :: test_ns_*]} +catch {namespace delete {*}[namespace children :: test_ns_*]} catch {namespace delete george} catch {interp delete test_interp} catch {rename p ""} diff --git a/tests/cmdInfo.test b/tests/cmdInfo.test index 799c6e3..010d3d1 100644 --- a/tests/cmdInfo.test +++ b/tests/cmdInfo.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: cmdInfo.test,v 1.9 2006/03/21 11:12:29 dkf Exp $ +# RCS: @(#) $Id: cmdInfo.test,v 1.10 2006/11/03 00:34:52 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -69,7 +69,7 @@ test cmdinfo-4.1 {Tcl_GetCommandName/Tcl_GetCommandFullName procedures} \ rename x1 newName set y [testcmdtoken name $x] rename newName x1 - lappend y {expand}[testcmdtoken name $x] + lappend y {*}[testcmdtoken name $x] } {newName ::newName x1 ::x1} catch {rename newTestCmd {}} @@ -86,7 +86,7 @@ test cmdinfo-5.1 {Names for commands created when inside namespaces} \ }] set y [testcmdtoken name $x] rename ::testCmd newTestCmd - lappend y {expand}[testcmdtoken name $x] + lappend y {*}[testcmdtoken name $x] } {testCmd ::testCmd newTestCmd ::newTestCmd} test cmdinfo-6.1 {Names for commands created when outside namespaces} \ @@ -94,7 +94,7 @@ test cmdinfo-6.1 {Names for commands created when outside namespaces} \ set x [testcmdtoken create cmdInfoNs1::cmdInfoNs2::testCmd] set y [testcmdtoken name $x] rename cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 - lappend y {expand}[testcmdtoken name $x] + lappend y {*}[testcmdtoken name $x] } {testCmd ::cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 ::newTestCmd2} # cleanup diff --git a/tests/compile.test b/tests/compile.test index b499b10..2481a81 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: compile.test,v 1.43 2006/08/22 04:03:23 dgp Exp $ +# RCS: @(#) $Id: compile.test,v 1.44 2006/11/03 00:34:52 hobbs Exp $ package require tcltest 2 namespace import -force ::tcltest::* @@ -444,81 +444,81 @@ if $noComp { } test compile-16.1.$noComp {TclCompileScript: word expansion} $constraints { - run "list [string repeat {{expand}a } 255]" + run "list [string repeat {{*}a } 255]" } [lrepeat 255 a] test compile-16.2.$noComp {TclCompileScript: word expansion} $constraints { - run "list [string repeat {{expand}a } 256]" + run "list [string repeat {{*}a } 256]" } [lrepeat 256 a] test compile-16.3.$noComp {TclCompileScript: word expansion} $constraints { - run "list [string repeat {{expand}a } 257]" + run "list [string repeat {{*}a } 257]" } [lrepeat 257 a] test compile-16.4.$noComp {TclCompileScript: word expansion} $constraints { - run {{expand}list} + run {{*}list} } {} test compile-16.5.$noComp {TclCompileScript: word expansion} $constraints { - run {{expand}list {expand}{x y z}} + run {{*}list {*}{x y z}} } {x y z} test compile-16.6.$noComp {TclCompileScript: word expansion} $constraints { - run {{expand}list {expand}[list x y z]} + run {{*}list {*}[list x y z]} } {x y z} test compile-16.7.$noComp {TclCompileScript: word expansion} $constraints { - run {{expand}list {expand}[list x y z][list x y z]} + run {{*}list {*}[list x y z][list x y z]} } {x y zx y z} test compile-16.8.$noComp {TclCompileScript: word expansion} -body { set l {x y z} - run {{expand}list {expand}$l} + run {{*}list {*}$l} } -constraints $constraints -cleanup { unset l } -result {x y z} test compile-16.9.$noComp {TclCompileScript: word expansion} -body { set l {x y z} - run {{expand}list {expand}$l$l} + run {{*}list {*}$l$l} } -constraints $constraints -cleanup { unset l } -result {x y zx y z} test compile-16.10.$noComp {TclCompileScript: word expansion} -body { - run {{expand}\{} + run {{*}\{} } -constraints $constraints -returnCodes error \ -result {unmatched open brace in list} test compile-16.11.$noComp {TclCompileScript: word expansion} -body { proc badList {} {return \{} - run {{expand}[badList]} + run {{*}[badList]} } -constraints $constraints -cleanup { rename badList {} } -returnCodes error -result {unmatched open brace in list} test compile-16.12.$noComp {TclCompileScript: word expansion} $constraints { - run {{expand}list x y z} + run {{*}list x y z} } {x y z} test compile-16.13.$noComp {TclCompileScript: word expansion} $constraints { - run {{expand}list x y {expand}z} + run {{*}list x y {*}z} } {x y z} test compile-16.14.$noComp {TclCompileScript: word expansion} $constraints { - run {{expand}list x {expand}y z} + run {{*}list x {*}y z} } {x y z} test compile-16.15.$noComp {TclCompileScript: word expansion} $constraints { - run {list x y {expand}z} + run {list x y {*}z} } {x y z} test compile-16.16.$noComp {TclCompileScript: word expansion} $constraints { - run {list x {expand}y z} + run {list x {*}y z} } {x y z} test compile-16.17.$noComp {TclCompileScript: word expansion} $constraints { - run {list {expand}x y z} + run {list {*}x y z} } {x y z} # These tests note that expansion can in theory cause the number of @@ -535,21 +535,21 @@ test compile-16.17.$noComp {TclCompileScript: word expansion} $constraints { # test compile-16.18.$noComp {TclCompileScript: word expansion} -body { proc LongList {} {return [lrepeat [expr {1<<10}] x]} - llength [run "list [string repeat {{expand}[LongList] } [expr {1<<10}]]"] + llength [run "list [string repeat {{*}[LongList] } [expr {1<<10}]]"] } -constraints [linsert $constraints 0 knownBug] -cleanup { rename LongList {} } -returnCodes ok -result [expr {1<<20}] test compile-16.19.$noComp {TclCompileScript: word expansion} -body { proc LongList {} {return [lrepeat [expr {1<<11}] x]} - llength [run "list [string repeat {{expand}[LongList] } [expr {1<<11}]]"] + llength [run "list [string repeat {{*}[LongList] } [expr {1<<11}]]"] } -constraints [linsert $constraints 0 knownBug] -cleanup { rename LongList {} } -returnCodes ok -result [expr {1<<22}] test compile-16.20.$noComp {TclCompileScript: word expansion} -body { proc LongList {} {return [lrepeat [expr {1<<12}] x]} - llength [run "list [string repeat {{expand}[LongList] } [expr {1<<12}]]"] + llength [run "list [string repeat {{*}[LongList] } [expr {1<<12}]]"] } -constraints [linsert $constraints 0 knownBug] -cleanup { rename LongList {} } -returnCodes ok -result [expr {1<<24}] @@ -557,7 +557,7 @@ test compile-16.20.$noComp {TclCompileScript: word expansion} -body { # This is the one that should cause overflow test compile-16.21.$noComp {TclCompileScript: word expansion} -body { proc LongList {} {return [lrepeat [expr {1<<16}] x]} - llength [run "list [string repeat {{expand}[LongList] } [expr {1<<16}]]"] + llength [run "list [string repeat {{*}[LongList] } [expr {1<<16}]]"] } -constraints [linsert $constraints 0 knownBug] -cleanup { rename LongList {} } -returnCodes ok -result [expr {wide(1)<<32}] diff --git a/tests/encoding.test b/tests/encoding.test index 8b7f60e..36eb475 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: encoding.test,v 1.25 2006/10/05 21:24:40 hobbs Exp $ +# RCS: @(#) $Id: encoding.test,v 1.26 2006/11/03 00:34:52 hobbs Exp $ package require tcltest 2 namespace import -force ::tcltest::* @@ -570,7 +570,7 @@ test encoding-26.0 {Tcl_GetDefaultEncodingDir} -constraints { testsetdefenc $origDir } -result slappy -file delete {expand}[glob -directory [temporaryDirectory] *.chars *.tcltestout] +file delete {*}[glob -directory [temporaryDirectory] *.chars *.tcltestout] # ===> Cut here <=== # EscapeFreeProc, GetTableEncoding, unilen diff --git a/tests/execute.test b/tests/execute.test index 0175706..bc54725 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -14,14 +14,14 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: execute.test,v 1.23 2006/07/21 10:47:19 msofer Exp $ +# RCS: @(#) $Id: execute.test,v 1.24 2006/11/03 00:34:52 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } -catch {namespace delete {expand}[namespace children :: test_ns_*]} +catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename foo ""} catch {unset x} catch {unset y} @@ -506,7 +506,7 @@ test execute-3.77 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is non-numeri # INST_PUSH_RETURN_CODE not tested test execute-4.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} catch {unset x} catch {unset y} namespace eval test_ns_1 { @@ -524,7 +524,7 @@ test execute-4.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} { [catch {namespace which -command ${x}${y}:cmd2} msg] $msg } {::test_ns_1::test_ns_2::cmd1 0 {} 0 {}} test execute-4.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is invalid} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename foo ""} catch {unset l} proc foo {} { @@ -546,7 +546,7 @@ test execute-4.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is inval set l } {::foo ::test_ns_1::foo} test execute-4.3 {Tcl_GetCommandFromObj, command never found} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename foo ""} namespace eval test_ns_1 { proc foo {} { @@ -564,7 +564,7 @@ test execute-4.3 {Tcl_GetCommandFromObj, command never found} { } {::test_ns_1::foo {} 0 {}} test execute-5.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} catch {unset l} proc {} {} {return {}} {} @@ -778,7 +778,7 @@ test execute-9.1 {Interp result resetting [Bug 1522803]} { if {[info commands testobj] != {}} { testobj freeallvars } -catch {namespace delete {expand}[namespace children :: test_ns_*]} +catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename foo ""} catch {rename p ""} catch {rename {} ""} diff --git a/tests/fCmd.test b/tests/fCmd.test index db5dff9..be5d311 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: fCmd.test,v 1.55 2006/03/27 18:56:25 dgp Exp $ +# RCS: @(#) $Id: fCmd.test,v 1.56 2006/11/03 00:34:52 hobbs Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -2136,19 +2136,19 @@ test fCmd-27.4 {TclFileAttrsCmd - getting one option} { catch {file delete -force -- foo.tmp} createfile foo.tmp set attrs [file attributes foo.tmp] - list [catch {file attributes foo.tmp {expand}[lindex $attrs 0]}] [file delete -force -- foo.tmp] + list [catch {file attributes foo.tmp {*}[lindex $attrs 0]}] [file delete -force -- foo.tmp] } {0 {}} test fCmd-27.5 {TclFileAttrsCmd - setting one option} {foundGroup} { catch {file delete -force -- foo.tmp} createfile foo.tmp set attrs [file attributes foo.tmp] - list [catch {file attributes foo.tmp {expand}[lrange $attrs 0 1]} msg] $msg [file delete -force -- foo.tmp] + list [catch {file attributes foo.tmp {*}[lrange $attrs 0 1]} msg] $msg [file delete -force -- foo.tmp] } {0 {} {}} test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} {foundGroup} { catch {file delete -force -- foo.tmp} createfile foo.tmp set attrs [file attributes foo.tmp] - list [catch {file attributes foo.tmp {expand}[lrange $attrs 0 3]} msg] $msg [file delete -force -- foo.tmp] + list [catch {file attributes foo.tmp {*}[lrange $attrs 0 3]} msg] $msg [file delete -force -- foo.tmp] } {0 {} {}} if { diff --git a/tests/http.test b/tests/http.test index a4b11d0..e5aaa19 100644 --- a/tests/http.test +++ b/tests/http.test @@ -12,7 +12,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # -# RCS: @(#) $Id: http.test,v 1.43 2006/10/09 19:15:44 msofer Exp $ +# RCS: @(#) $Id: http.test,v 1.44 2006/11/03 00:34:52 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -97,7 +97,7 @@ test http-1.4 {http::config} { -proxyfilter myFilter -useragent "Tcl Test Suite" \ -urlencoding iso8859-1 set x [http::config] - http::config {expand}$savedconf + http::config {*}$savedconf set x } {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -urlencoding iso8859-1 -useragent {Tcl Test Suite}} test http-1.5 {http::config} { diff --git a/tests/init.test b/tests/init.test index 694ce74..da94d67 100644 --- a/tests/init.test +++ b/tests/init.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: init.test,v 1.14 2005/05/24 19:13:46 dgp Exp $ +# RCS: @(#) $Id: init.test,v 1.15 2006/11/03 00:34:52 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -18,7 +18,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} { } # Clear out any namespaces called test_ns_* -catch {namespace delete {expand}[namespace children :: test_ns_*]} +catch {namespace delete {*}[namespace children :: test_ns_*]} # Six cases - white box testing diff --git a/tests/interp.test b/tests/interp.test index 90cb346..d55ac73 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: interp.test,v 1.50 2006/10/12 16:24:14 msofer Exp $ +# RCS: @(#) $Id: interp.test,v 1.51 2006/11/03 00:34:52 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -2122,7 +2122,7 @@ test interp-26.6 {result code transmission: all combined--bug 1637} \ proc MyTestAlias {interp args} { global aliasTrace; lappend aliasTrace $args; - interp invokehidden $interp {expand}$args + interp invokehidden $interp {*}$args } foreach c {return} { interp hide $interp $c; diff --git a/tests/io.test b/tests/io.test index f1f816d..c940222 100644 --- a/tests/io.test +++ b/tests/io.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: io.test,v 1.72 2006/10/09 19:15:45 msofer Exp $ +# RCS: @(#) $Id: io.test,v 1.73 2006/11/03 00:34:52 hobbs Exp $ if {[catch {package require tcltest 2}]} { puts stderr "Skipping tests in [info script]. tcltest 2 required." @@ -2138,7 +2138,7 @@ test io-28.4 {Tcl_Close} {testchannel} { close $f lappend l [lsort [testchannel open]] set x [list $consoleFileNames \ - [lsort [list {expand}$consoleFileNames $f]] \ + [lsort [list {*}$consoleFileNames $f]] \ $consoleFileNames] string compare $l $x } 0 diff --git a/tests/ioUtil.test b/tests/ioUtil.test index bb084b0..c2894ce 100644 --- a/tests/ioUtil.test +++ b/tests/ioUtil.test @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: ioUtil.test,v 1.16 2006/03/21 11:12:29 dkf Exp $ +# RCS: @(#) $Id: ioUtil.test,v 1.17 2006/11/03 00:34:53 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -189,7 +189,7 @@ set oldpwd [pwd] cd [temporaryDirectory] test ioUtil-3.1 {TclOpenFileChannel: Check that none of the test procs are there.} {testopenfilechannelproc} { - catch {file delete -force {expand}[glob *testOpenFileChannel*]} + catch {file delete -force {*}[glob *testOpenFileChannel*]} catch {file exists testOpenFileChannel1%.fil} err1 catch {file exists testOpenFileChannel2%.fil} err2 catch {file exists testOpenFileChannel3%.fil} err3 diff --git a/tests/iogt.test b/tests/iogt.test index ac52f5b..969e43c 100644 --- a/tests/iogt.test +++ b/tests/iogt.test @@ -10,7 +10,7 @@ # Copyright (c) 2000 Andreas Kupries. # All rights reserved. # -# RCS: @(#) $Id: iogt.test,v 1.14 2006/03/21 11:12:29 dkf Exp $ +# RCS: @(#) $Id: iogt.test,v 1.15 2006/11/03 00:34:53 hobbs Exp $ if {[catch {package require tcltest 2.1}]} { puts stderr "Skipping tests in [info script]. tcltest 2.1 required." @@ -143,7 +143,7 @@ proc fevent {fdelay idelay blocks script data} { set port 4000 exec tclsh __echo_srv__.tcl \ - $port $fdelay $idelay {expand}$blocks >@stdout & + $port $fdelay $idelay {*}$blocks >@stdout & after 500 diff --git a/tests/namespace-old.test b/tests/namespace-old.test index 0fadd1f..16f103a 100644 --- a/tests/namespace-old.test +++ b/tests/namespace-old.test @@ -14,7 +14,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: namespace-old.test,v 1.9 2004/08/27 14:39:14 dkf Exp $ +# RCS: @(#) $Id: namespace-old.test,v 1.10 2006/11/03 00:34:53 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -22,7 +22,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} { } # Clear out any namespaces called test_ns_* -catch {namespace delete {expand}[namespace children :: test_ns_*]} +catch {namespace delete {*}[namespace children :: test_ns_*]} test namespace-old-1.1 {usage for "namespace" command} { list [catch {namespace} msg] $msg @@ -252,7 +252,7 @@ test namespace-old-4.4 {command "namespace delete" handles multiple args} { set cmd { namespace eval test_ns_delete { namespace delete \ - {expand}[namespace children [namespace current] ns?] + {*}[namespace children [namespace current] ns?] } } list [catch $cmd msg] $msg [namespace children test_ns_delete] diff --git a/tests/namespace.test b/tests/namespace.test index a9243bd..ed9889c 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: namespace.test,v 1.61 2006/10/31 13:46:33 dkf Exp $ +# RCS: @(#) $Id: namespace.test,v 1.62 2006/11/03 00:34:53 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -24,7 +24,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} { # # Clear out any namespaces called test_ns_* -catch {namespace delete {expand}[namespace children :: test_ns_*]} +catch {namespace delete {*}[namespace children :: test_ns_*]} test namespace-1.1 {TclInitNamespaces, GetNamespaceFromObj, NamespaceChildrenCmd} { namespace children :: test_ns_* @@ -84,7 +84,7 @@ test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} { } {123} test namespace-6.1 {Tcl_CreateNamespace} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} list [lsort [namespace children :: test_ns_*]] \ [namespace eval test_ns_1 {namespace current}] \ [namespace eval test_ns_2 {namespace current}] \ @@ -103,7 +103,7 @@ test namespace-6.3 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} { list [catch {namespace eval test_ns_7::: {namespace current}} msg] $msg } {0 ::test_ns_7} test namespace-6.4 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1:: { namespace eval test_ns_2:: {} namespace eval test_ns_3:: {} @@ -121,7 +121,7 @@ test namespace-6.5 {Tcl_CreateNamespace, relative ns names now only looked up in } {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_2} test namespace-7.1 {Tcl_DeleteNamespace, active call frames in ns} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1 { proc p {} { namespace delete [namespace current] @@ -201,7 +201,7 @@ test namespace-8.1 {TclTeardownNamespace, delete global namespace} { [interp delete test_interp] } {{::test_ns_1 27} {} 1 {invalid command name "set"} {}} test namespace-8.2 {TclTeardownNamespace, remove deleted ns from parent} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}} namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}} list [namespace children test_ns_1] \ @@ -209,7 +209,7 @@ test namespace-8.2 {TclTeardownNamespace, remove deleted ns from parent} { [namespace children test_ns_1] } {::test_ns_1::test_ns_2 {} {}} test namespace-8.3 {TclTeardownNamespace, delete child namespaces} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}} namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}} list [namespace children test_ns_1] \ @@ -219,7 +219,7 @@ test namespace-8.3 {TclTeardownNamespace, delete child namespaces} { [info commands test_ns_1::test_ns_2::test_ns_3a::*] } {::test_ns_1::test_ns_2 {} {} 1 {unknown namespace "test_ns_1::test_ns_2" in namespace children command} {}} test namespace-8.4 {TclTeardownNamespace, cmds imported from deleted ns go away} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_export { namespace export cmd1 cmd2 proc cmd1 {args} {return "cmd1: $args"} @@ -260,7 +260,7 @@ test namespace-8.7 {TclTeardownNamespace: preserve errorInfo; errorCode values} } baz test namespace-9.1 {Tcl_Import, empty import pattern} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace eval test_ns_import {namespace import {}}} msg] $msg } {1 {empty import pattern}} test namespace-9.2 {Tcl_Import, unknown namespace in import pattern} { @@ -270,7 +270,7 @@ test namespace-9.3 {Tcl_Import, import ns == export ns} { list [catch {namespace eval test_ns_import {namespace import ::test_ns_import::puts}} msg] $msg } {1 {import pattern "::test_ns_import::puts" tries to import from namespace "test_ns_import" into itself}} test namespace-9.4 {Tcl_Import, simple import} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_export { namespace export cmd1 proc cmd1 {args} {return "cmd1: $args"} @@ -292,7 +292,7 @@ test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} { } } {cmd1: 555} test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_export { namespace export cmd1 proc cmd1 {args} {return "cmd1: $args"} @@ -354,7 +354,7 @@ test namespace-9.9 {Tcl_Import: Bug 1017299} -setup { } -returnCodes error -match glob -result {import pattern * would create a loop*} test namespace-10.1 {Tcl_ForgetImport, check for valid namespaces} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace forget xyzzy::*} msg] $msg } {1 {unknown namespace in namespace forget pattern "xyzzy::*"}} test namespace-10.2 {Tcl_ForgetImport, ignores patterns that don't match} { @@ -494,7 +494,7 @@ test namespace-10.9 {Tcl_ForgetImport: Bug 560297} -setup { } -returnCodes error -match glob -result * test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_export { namespace export cmd1 proc cmd1 {args} {return "cmd1: $args"} @@ -518,7 +518,7 @@ test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} { } {{cmd1: 123} ::test_ns_export::cmd1} test namespace-12.1 {InvokeImportedCmd} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_export { namespace export cmd1 proc cmd1 {args} {namespace current} @@ -539,7 +539,7 @@ test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} { } {::test_ns_import::cmd1 {}} test namespace-14.1 {TclGetNamespaceForQualName, absolute names} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} variable v 10 namespace eval test_ns_1::test_ns_2 { variable v 20 @@ -617,7 +617,7 @@ test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for lappend l [test_ns_1::test_ns_2:: hello] } {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}} test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1 { variable {} set test_ns_1::(x) y @@ -625,12 +625,12 @@ test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for set test_ns_1::(x) } y test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace eval test_ns_1 {proc {} {} {}; namespace eval {} {}; {}}} msg] $msg } {1 {can't create namespace "": only global namespace can have empty name}} test namespace-15.1 {Tcl_FindNamespace, absolute name found} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_delete { namespace eval test_ns_delete2 {} proc cmd {args} {namespace current} @@ -657,7 +657,7 @@ test namespace-15.4 {Tcl_FindNamespace, relative name not found} { } {1 {unknown namespace "test_ns_delete2" in namespace delete command}} test namespace-16.1 {Tcl_FindCommand, absolute name found} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1 { proc cmd {args} {return "[namespace current]::cmd: $args"} variable v "::test_ns_1::cmd" @@ -725,7 +725,7 @@ test namespace-16.11 {Tcl_FindCommand, relative name not found} { catch {unset x} test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} set x 314159 namespace eval test_ns_1 { set ::x @@ -802,7 +802,7 @@ catch {unset x} catch {unset l} catch {rename foo {}} test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} proc foo {} {return "global foo"} namespace eval test_ns_1 { proc trigger {} { @@ -843,7 +843,7 @@ catch {unset l} catch {rename foo {}} test namespace-19.1 {GetNamespaceFromObj, global name found} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1::test_ns_2 {} namespace children ::test_ns_1 } {::test_ns_1::test_ns_2} @@ -873,7 +873,7 @@ test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} { } {{} ::test_ns_1::test_ns_2::test_ns_3} test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace} msg] $msg } {1 {wrong # args: should be "namespace subcommand ?arg ...?"}} test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} -body { @@ -884,7 +884,7 @@ test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} { } {} test namespace-21.1 {NamespaceChildrenCmd, no args} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1::test_ns_2 {} expr {[string first ::test_ns_1 [namespace children]] != -1} } {1} @@ -916,7 +916,7 @@ test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} { } [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}] test namespace-22.1 {NamespaceCodeCmd, bad args} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace code} msg] $msg \ [catch {namespace code xxx yyy} msg] $msg } {1 {wrong # args: should be "namespace code arg"} 1 {wrong # args: should be "namespace code arg"}} @@ -950,7 +950,7 @@ test namespace-22.6 {NamespaceCodeCmd, in other namespace} { } {42} test namespace-23.1 {NamespaceCurrentCmd, bad args} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace current xxx} msg] $msg \ [catch {namespace current xxx yyy} msg] $msg } {1 {wrong # args: should be "namespace current"} 1 {wrong # args: should be "namespace current"}} @@ -964,7 +964,7 @@ test namespace-23.3 {NamespaceCurrentCmd, in nested ns} { } {::test_ns_1::test_ns_2} test namespace-24.1 {NamespaceDeleteCmd, no args} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace delete } {} test namespace-24.2 {NamespaceDeleteCmd, one arg} { @@ -980,7 +980,7 @@ test namespace-24.4 {NamespaceDeleteCmd, unknown ns} { } {1 {unknown namespace "::test_ns_foo" in namespace delete command}} test namespace-25.1 {NamespaceEvalCmd, bad args} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace eval} msg] $msg } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}} test namespace-25.2 {NamespaceEvalCmd, bad args} -body { @@ -1033,7 +1033,7 @@ test namespace-25.9 {NamespaceEvalCmd, 545325} { } {namespace eval test_ns_1 info level 0} test namespace-26.1 {NamespaceExportCmd, no args and new ns} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace export } {} test namespace-26.2 {NamespaceExportCmd, just -clear arg} { @@ -1082,7 +1082,7 @@ test namespace-26.7 {NamespaceExportCmd, -clear resets export list} { } [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}] test namespace-27.1 {NamespaceForgetCmd, no args} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace forget } {} test namespace-27.2 {NamespaceForgetCmd, args must be valid namespaces} { @@ -1102,7 +1102,7 @@ test namespace-27.3 {NamespaceForgetCmd, arg is forgotten} { } {::test_ns_2::cmd2} test namespace-28.1 {NamespaceImportCmd, no args} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace import } {} test namespace-28.2 {NamespaceImportCmd, no args and just "-force"} { @@ -1122,7 +1122,7 @@ test namespace-28.3 {NamespaceImportCmd, arg is imported} { } {::test_ns_2::cmd2} test namespace-29.1 {NamespaceInscopeCmd, bad args} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace inscope} msg] $msg } {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}} test namespace-29.2 {NamespaceInscopeCmd, bad args} { @@ -1151,7 +1151,7 @@ test namespace-29.6 {NamespaceInscopeCmd, 1400572} { test namespace-30.1 {NamespaceOriginCmd, bad args} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace origin} msg] $msg } {1 {wrong # args: should be "namespace origin name"}} test namespace-30.2 {NamespaceOriginCmd, bad args} { @@ -1184,7 +1184,7 @@ test namespace-30.5 {NamespaceOriginCmd, imported command} { } {::foreach ::test_ns_2::p ::test_ns_1::cmd1 ::test_ns_1::cmd2} test namespace-31.1 {NamespaceParentCmd, bad args} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace parent a b} msg] $msg } {1 {wrong # args: should be "namespace parent ?name?"}} test namespace-31.2 {NamespaceParentCmd, no args} { @@ -1205,7 +1205,7 @@ test namespace-31.4 {NamespaceParentCmd, bad namespace specified} { } {1 {unknown namespace "test_ns_1::test_ns_foo" in namespace parent command}} test namespace-32.1 {NamespaceQualifiersCmd, bad args} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace qualifiers} msg] $msg } {1 {wrong # args: should be "namespace qualifiers string"}} test namespace-32.2 {NamespaceQualifiersCmd, bad args} { @@ -1231,7 +1231,7 @@ test namespace-32.8 {NamespaceQualifiersCmd, odd number of :s} { } {foo} test namespace-33.1 {NamespaceTailCmd, bad args} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace tail} msg] $msg } {1 {wrong # args: should be "namespace tail string"}} test namespace-33.2 {NamespaceTailCmd, bad args} { @@ -1257,7 +1257,7 @@ test namespace-33.8 {NamespaceTailCmd, odd number of :s} { } {} test namespace-34.1 {NamespaceWhichCmd, bad args} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {namespace which} msg] $msg } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}} test namespace-34.2 {NamespaceWhichCmd, bad args} { @@ -1310,7 +1310,7 @@ test namespace-34.7 {NamespaceWhichCmd, variable lookup} { } {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}} test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1 { proc p {} { namespace delete [namespace current] @@ -1333,7 +1333,7 @@ test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} { catch {unset x} catch {unset y} test namespace-36.1 {DupNsNameInternalRep} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1 {} set x "::test_ns_1" list [namespace parent $x] [set y $x] [namespace parent $y] @@ -1342,7 +1342,7 @@ catch {unset x} catch {unset y} test namespace-37.1 {SetNsNameFromAny, ns name found} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1::test_ns_2 {} namespace eval test_ns_1 { namespace children ::test_ns_1 @@ -1355,14 +1355,14 @@ test namespace-37.2 {SetNsNameFromAny, ns name not found} { } {1 {unknown namespace "::test_ns_1::test_ns_foo" in namespace children command}} test namespace-38.1 {UpdateStringOfNsName} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} ;# Tcl_NamespaceObjCmd calls UpdateStringOfNsName to get subcmd name list [namespace eval {} {namespace current}] \ [namespace eval {} {namespace current}] } {:: ::} test namespace-39.1 {NamespaceExistsCmd} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval ::test_ns_z::test_me { variable foo } list [namespace exists ::] \ [namespace exists ::bogus_namespace] \ @@ -2592,7 +2592,7 @@ catch {rename cmd1 {}} catch {unset l} catch {unset msg} catch {unset trigger} -namespace delete {expand}[namespace children :: test_ns_*] +namespace delete {*}[namespace children :: test_ns_*] ::tcltest::cleanupTests return diff --git a/tests/parse.test b/tests/parse.test index 7ab0f01..1a2f3a3 100644 --- a/tests/parse.test +++ b/tests/parse.test @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: parse.test,v 1.25 2006/10/09 19:15:45 msofer Exp $ +# RCS: @(#) $Id: parse.test,v 1.26 2006/11/03 00:34:53 hobbs Exp $ if {[catch {package require tcltest 2.0.2}]} { puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required." @@ -154,75 +154,75 @@ test parse-5.10 {Tcl_ParseCommand procedure, multiple deletion of non-static buf invoked from within \"testparser \"a \\\"\\\\1\\\\2\\\\3\\\\4\\\\5\\\\6\\\\7\\\\8\\\\9\\\\1\\\\2\\\\3\\\\4\\\\5\\\\6\\\\7\\\\8\" 0\"}" -test parse-5.11 {Tcl_ParseCommand: {expand} parsing} testparser { +test parse-5.11 {Tcl_ParseCommand: {*} parsing} testparser { testparser {{expan}} 0 } {- {{expan}} 1 simple {{expan}} 1 text expan 0 {}} -test parse-5.12 {Tcl_ParseCommand: {expand} parsing} -constraints { +test parse-5.12 {Tcl_ParseCommand: {*} parsing} -constraints { testparser } -body { testparser {{expan}x} 0 } -returnCodes error -result {extra characters after close-brace} -test parse-5.13 {Tcl_ParseCommand: {expand} parsing} testparser { - testparser {{expandy}} 0 -} {- {{expandy}} 1 simple {{expandy}} 1 text expandy 0 {}} -test parse-5.14 {Tcl_ParseCommand: {expand} parsing} -constraints { +test parse-5.13 {Tcl_ParseCommand: {*} parsing} testparser { + testparser {{**}} 0 +} {- {{**}} 1 simple {{**}} 1 text ** 0 {}} +test parse-5.14 {Tcl_ParseCommand: {*} parsing} -constraints { testparser } -body { - testparser {{expandy}x} 0 + testparser {{**}x} 0 } -returnCodes error -result {extra characters after close-brace} -test parse-5.15 {Tcl_ParseCommand: {expand} parsing} -constraints { +test parse-5.15 {Tcl_ParseCommand: {*} parsing} -constraints { testparser } -body { - testparser {{expand}{123456}x} 0 + testparser {{*}{123456}x} 0 } -returnCodes error -result {extra characters after close-brace} -test parse-5.16 {Tcl_ParseCommand: {expand} parsing} testparser { +test parse-5.16 {Tcl_ParseCommand: {*} parsing} testparser { testparser {{123456\ }} 0 } {- {{123456 }} 1 simple {{123456 }} 1 text {123456 } 0 {}} -test parse-5.17 {Tcl_ParseCommand: {expand} parsing} -constraints { +test parse-5.17 {Tcl_ParseCommand: {*} parsing} -constraints { testparser } -body { testparser {{123456\ }x} 0 } -returnCodes error -result {extra characters after close-brace} -test parse-5.18 {Tcl_ParseCommand: {expand} parsing} testparser { - testparser {{expand\ +test parse-5.18 {Tcl_ParseCommand: {*} parsing} testparser { + testparser {{*\ }} 0 -} {- {{expand }} 1 simple {{expand }} 1 text {expand } 0 {}} -test parse-5.19 {Tcl_ParseCommand: {expand} parsing} -constraints { +} {- {{* }} 1 simple {{* }} 1 text {* } 0 {}} +test parse-5.19 {Tcl_ParseCommand: {*} parsing} -constraints { testparser } -body { - testparser {{expand\ + testparser {{*\ }x} 0 } -returnCodes error -result {extra characters after close-brace} -test parse-5.20 {Tcl_ParseCommand: {expand} parsing} testparser { +test parse-5.20 {Tcl_ParseCommand: {*} parsing} testparser { testparser {{123456}} 0 } {- {{123456}} 1 simple {{123456}} 1 text 123456 0 {}} -test parse-5.21 {Tcl_ParseCommand: {expand} parsing} -constraints { +test parse-5.21 {Tcl_ParseCommand: {*} parsing} -constraints { testparser } -body { testparser {{123456}x} 0 } -returnCodes error -result {extra characters after close-brace} -test parse-5.22 {Tcl_ParseCommand: {expand} parsing} testparser { - testparser {{expand}} 0 -} {- {{expand}} 1 simple {{expand}} 1 text expand 0 {}} -test parse-5.23 {Tcl_ParseCommand: {expand} parsing} testparser { - testparser {{expand} } 0 -} {- {{expand} } 1 simple {{expand}} 1 text expand 0 {}} -test parse-5.24 {Tcl_ParseCommand: {expand} parsing} testparser { - testparser {{expand}x} 0 -} {- {{expand}x} 1 expand {{expand}x} 1 text x 0 {}} -test parse-5.25 {Tcl_ParseCommand: {expand} parsing} testparser { - testparser {{expand} +test parse-5.22 {Tcl_ParseCommand: {*} parsing} testparser { + testparser {{*}} 0 +} {- {{*}} 1 simple {{*}} 1 text * 0 {}} +test parse-5.23 {Tcl_ParseCommand: {*} parsing} testparser { + testparser {{*} } 0 +} {- {{*} } 1 simple {{*}} 1 text * 0 {}} +test parse-5.24 {Tcl_ParseCommand: {*} parsing} testparser { + testparser {{*}x} 0 +} {- {{*}x} 1 expand {{*}x} 1 text x 0 {}} +test parse-5.25 {Tcl_ParseCommand: {*} parsing} testparser { + testparser {{*} } 0 -} {- {{expand} -} 1 simple {{expand}} 1 text expand 0 {}} -test parse-5.26 {Tcl_ParseCommand: {expand} parsing} testparser { - testparser {{expand};} 0 -} {- {{expand};} 1 simple {{expand}} 1 text expand 0 {}} -test parse-5.27 {Tcl_ParseCommand: {expand} parsing} testparser { - testparser "{expand}\\\n foo bar" 0 -} {- \{expand\}\\\n\ foo\ bar 3 simple {{expand}} 1 text expand 0 simple foo 1 text foo 0 simple bar 1 text bar 0 {}} +} {- {{*} +} 1 simple {{*}} 1 text * 0 {}} +test parse-5.26 {Tcl_ParseCommand: {*} parsing} testparser { + testparser {{*};} 0 +} {- {{*};} 1 simple {{*}} 1 text * 0 {}} +test parse-5.27 {Tcl_ParseCommand: {*} parsing} testparser { + testparser "{*}\\\n foo bar" 0 +} {- \{*\}\\\n\ foo\ bar 3 simple {{*}} 1 text * 0 simple foo 1 text foo 0 simple bar 1 text bar 0 {}} test parse-6.1 {ParseTokens procedure, empty word} testparser { testparser {""} 0 diff --git a/tests/pkg.test b/tests/pkg.test index 520f50a..116f006 100644 --- a/tests/pkg.test +++ b/tests/pkg.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: pkg.test,v 1.21 2006/10/09 19:15:45 msofer Exp $ +# RCS: @(#) $Id: pkg.test,v 1.22 2006/11/03 00:34:53 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -26,7 +26,7 @@ interp eval $i [list package require tcltest 2] interp eval $i [list namespace import -force ::tcltest::*] interp eval $i { -package forget {expand}[package names] +package forget {*}[package names] set oldPkgUnknown [package unknown] package unknown {} set oldPath $auto_path diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test index c71f087..0db6533 100644 --- a/tests/pkgMkIndex.test +++ b/tests/pkgMkIndex.test @@ -8,7 +8,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: pkgMkIndex.test,v 1.28 2006/03/21 11:12:29 dkf Exp $ +# RCS: @(#) $Id: pkgMkIndex.test,v 1.29 2006/11/03 00:34:53 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -89,7 +89,7 @@ proc pkgtest::parseIndex { filePath } { set ver [lindex $args 2] set ::PKGS($pkg:$ver) [lindex $args 3] } else { - return [package_original {expand}$args] + return [package_original {*}$args] } } array set ::PKGS {} @@ -148,7 +148,7 @@ proc pkgtest::parseIndex { filePath } { # 1: the error result if element 0 was 1 proc pkgtest::createIndex { args } { - set parsed [parseArgs {expand}$args] + set parsed [parseArgs {*}$args] set options [lindex $parsed 0] set dirPath [lindex $parsed 1] set patternList [lindex $parsed 2] @@ -157,7 +157,7 @@ proc pkgtest::createIndex { args } { if {[catch { file delete [file join $dirPath pkgIndex.tcl] - pkg_mkIndex {expand}$options $dirPath {expand}$patternList + pkg_mkIndex {*}$options $dirPath {*}$patternList } err]} { return [list 1 $err] } @@ -231,7 +231,7 @@ proc makePkgList { inList } { proc pkgtest::runCreatedIndex {rv args} { if {[lindex $rv 0] == 0} { - set parsed [parseArgs {expand}$args] + set parsed [parseArgs {*}$args] set dirPath [lindex $parsed 1] set idxFile [file join $dirPath pkgIndex.tcl] @@ -248,8 +248,8 @@ proc pkgtest::runCreatedIndex {rv args} { return $result } proc pkgtest::runIndex { args } { - set rv [createIndex {expand}$args] - return [runCreatedIndex $rv {expand}$args] + set rv [createIndex {*}$args] + return [runCreatedIndex $rv {*}$args] } # If there is no match to the patterns, make sure the directory hasn't diff --git a/tests/proc.test b/tests/proc.test index 49f9a7b..8fdc159 100644 --- a/tests/proc.test +++ b/tests/proc.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: proc.test,v 1.18 2006/02/01 19:26:02 dgp Exp $ +# RCS: @(#) $Id: proc.test,v 1.19 2006/11/03 00:34:53 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -26,13 +26,13 @@ if {[catch {package require procbodytest}]} { testConstraint procbodytest 1 } -catch {namespace delete {expand}[namespace children :: test_ns_*]} +catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} catch {rename {} ""} catch {unset msg} test proc-1.1 {Tcl_ProcObjCmd, put proc in namespace specified in name, if any} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1 { namespace eval baz {} } @@ -44,11 +44,11 @@ test proc-1.1 {Tcl_ProcObjCmd, put proc in namespace specified in name, if any} [info commands test_ns_1::baz::*] } {{p in ::test_ns_1::baz} {p in ::test_ns_1::baz} ::test_ns_1::baz::p} test proc-1.2 {Tcl_ProcObjCmd, namespace specified in proc name must exist} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} list [catch {proc test_ns_1::baz::p {} {}} msg] $msg } {1 {can't create procedure "test_ns_1::baz::p": unknown namespace}} test proc-1.3 {Tcl_ProcObjCmd, empty proc name} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} proc :: {} { return "empty called" } @@ -58,7 +58,7 @@ test proc-1.3 {Tcl_ProcObjCmd, empty proc name} { return "empty called" }} test proc-1.4 {Tcl_ProcObjCmd, simple proc name and proc defined in namespace} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1 { namespace eval baz { proc p {} { @@ -70,7 +70,7 @@ test proc-1.4 {Tcl_ProcObjCmd, simple proc name and proc defined in namespace} { [info commands test_ns_1::baz::*] } {{p in ::test_ns_1::baz} ::test_ns_1::baz::p} test proc-1.5 {Tcl_ProcObjCmd, qualified proc name and proc defined in namespace} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1::baz {} namespace eval test_ns_1 { proc baz::p {} { @@ -82,7 +82,7 @@ test proc-1.5 {Tcl_ProcObjCmd, qualified proc name and proc defined in namespace [namespace eval test_ns_1::baz {namespace which p}] } {{p in ::test_ns_1::baz} ::test_ns_1::baz::p ::test_ns_1::baz::p} test proc-1.6 {Tcl_ProcObjCmd, namespace code ignores single ":"s in middle or end of command names} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1 { proc q: {} {return "q:"} proc value:at: {} {return "value:at:"} @@ -109,13 +109,13 @@ test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple name } {1 {formal parameter "b::a" is not a simple name}} test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} proc p {} {return "p in [namespace current]"} info body p } {return "p in [namespace current]"} test proc-2.2 {TclFindProc, simple proc name and proc defined in namespace} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1 { namespace eval baz { proc p {} {return "p in [namespace current]"} @@ -124,7 +124,7 @@ test proc-2.2 {TclFindProc, simple proc name and proc defined in namespace} { namespace eval test_ns_1::baz {info body p} } {return "p in [namespace current]"} test proc-2.3 {TclFindProc, qualified proc name and proc defined in namespace} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1::baz {} namespace eval test_ns_1 { proc baz::p {} {return "p in [namespace current]"} @@ -132,26 +132,26 @@ test proc-2.3 {TclFindProc, qualified proc name and proc defined in namespace} { namespace eval test_ns_1 {info body baz::p} } {return "p in [namespace current]"} test proc-2.4 {TclFindProc, global proc and executing in namespace} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} proc p {} {return "global p"} namespace eval test_ns_1::baz {info body p} } {return "global p"} test proc-3.1 {TclObjInterpProc, proc defined and executing in same namespace} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} proc p {} {return "p in [namespace current]"} p } {p in ::} test proc-3.2 {TclObjInterpProc, proc defined and executing in same namespace} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_1::baz { proc p {} {return "p in [namespace current]"} p } } {p in ::test_ns_1::baz} test proc-3.3 {TclObjInterpProc, proc defined and executing in different namespaces} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} proc p {} {return "p in [namespace current]"} namespace eval test_ns_1::baz { @@ -159,7 +159,7 @@ test proc-3.3 {TclObjInterpProc, proc defined and executing in different namespa } } {p in ::} test proc-3.4 {TclObjInterpProc, procs execute in the namespace in which they were defined unless renamed into new namespace} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} namespace eval test_ns_1::baz { proc p {} {return "p in [namespace current]"} @@ -177,7 +177,7 @@ test proc-3.6 {TclObjInterpProc, proper quoting of proc name, Bug 942757} { list [catch {{a b c}} msg] $msg } {1 {wrong # args: should be "{a b c} x"}} -catch {namespace delete {expand}[namespace children :: test_ns_*]} +catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} catch {rename {} ""} catch {rename {a b c} {}} diff --git a/tests/reg.test b/tests/reg.test index 37536ce..40b8766 100644 --- a/tests/reg.test +++ b/tests/reg.test @@ -9,7 +9,7 @@ # # Copyright (c) 1998, 1999 Henry Spencer. All rights reserved. # -# RCS: @(#) $Id: reg.test,v 1.22 2004/11/05 15:15:25 dkf Exp $ +# RCS: @(#) $Id: reg.test,v 1.23 2006/11/03 00:34:53 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -187,8 +187,8 @@ namespace eval RETest { # if &, test as both BRE and ARE if {[string match *&* $flags]} { set f [string map {& {}} $flags] - MatchExpected $opts "$testid ARE" ${f} $re $target {expand}$args - MatchExpected $opts "$testid BRE" ${f}b $re $target {expand}$args + MatchExpected $opts "$testid ARE" ${f} $re $target {*}$args + MatchExpected $opts "$testid BRE" ${f}b $re $target {*}$args return } @@ -207,8 +207,8 @@ namespace eval RETest { set f [TestFlags $flags] set infoflags [TestInfoFlags $flags] - set ccmd [list testregexp -about {expand}$f $re] - set ecmd [list testregexp {expand}$opts {expand}$f $re $target] + set ccmd [list testregexp -about {*}$f $re] + set ecmd [list testregexp {*}$opts {*}$f $re $target] set nsub [expr {[llength $args] - 1}] set names [list] @@ -230,7 +230,7 @@ namespace eval RETest { incr nsub -1 ;# the extra does not count } set erun "list \[[concat $ecmd $names]\] $refs" - set result [list [expr {![string match *!* $flags]}] {expand}$args] + set result [list [expr {![string match *!* $flags]}] {*}$args] set info [list $nsub $infoflags] ::tcltest::test [TestNum $testid compile] [TestDesc $testid compile] \ @@ -262,7 +262,7 @@ namespace eval RETest { lappend constraints localeRegexp } - set cmd [list testregexp -about {expand}[TestFlags $flags] $re] + set cmd [list testregexp -about {*}[TestFlags $flags] $re] ::tcltest::test [TestNum $testid error] [TestDesc $testid error] \ -constraints $constraints -result [list 1 REG_$err] -body \ "list \[catch \{$cmd\}\] \[lindex \$::errorCode 1\]" @@ -273,8 +273,8 @@ namespace eval RETest { # if &, test as both ARE and BRE if {[string match *&* $flags]} { set f [string map {& {}} $flags] - expectNomatch "$testid ARE" ${f} $re $target {expand}$args - expectNomatch "$testid BRE" ${f}b $re $target {expand}$args + expectNomatch "$testid ARE" ${f} $re $target {*}$args + expectNomatch "$testid BRE" ${f}b $re $target {*}$args return } @@ -288,7 +288,7 @@ namespace eval RETest { set f [TestFlags $flags] set infoflags [TestInfoFlags $flags] - set ccmd [list testregexp -about {expand}$f $re] + set ccmd [list testregexp -about {*}$f $re] set nsub [expr {[llength $args] - 1}] if {$nsub == -1} { # didn't tell us number of subexps @@ -297,7 +297,7 @@ namespace eval RETest { } else { set info [list $nsub $infoflags] } - set ecmd [list testregexp {expand}$f $re $target] + set ecmd [list testregexp {*}$f $re $target] ::tcltest::test [TestNum $testid compile] [TestDesc $testid compile] \ -constraints $constraints -body $ccmd -result $info @@ -308,13 +308,13 @@ namespace eval RETest { # match expected (no missing, empty, or ambiguous submatches) # expectMatch testno flags re target mat submat ... proc expectMatch {args} { - MatchExpected {} {expand}$args + MatchExpected {} {*}$args } # match expected (full fanciness) # expectIndices testno flags re target mat submat ... proc expectIndices {args} { - MatchExpected -indices {expand}$args + MatchExpected -indices {*}$args } # partial match expected @@ -322,7 +322,7 @@ namespace eval RETest { # Quirk: number of ""s must be one more than number of subREs. proc expectPartial {args} { lset args 1 ![lindex $args 1] ;# add ! flag - MatchExpected -indices {expand}$args + MatchExpected -indices {*}$args } # test is a knownBug diff --git a/tests/trace.test b/tests/trace.test index a6afc4e..7c74c0c 100644 --- a/tests/trace.test +++ b/tests/trace.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: trace.test,v 1.49 2006/04/11 14:37:54 dgp Exp $ +# RCS: @(#) $Id: trace.test,v 1.50 2006/11/03 00:34:53 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -1422,7 +1422,7 @@ test trace-20.7 {trace add command delete in subinterp while being deleted} { } {} proc traceDelete {cmd old new op} { - trace remove command $cmd {expand}[lindex [trace info command $cmd] 0] + trace remove command $cmd {*}[lindex [trace info command $cmd] 0] global info set info [list $old $new $op] } @@ -1732,7 +1732,7 @@ test trace-23.3 {recursive(3) trace execution: enter, leave, enterstep, leaveste {factorial 3} 0 6 leave} proc traceDelete {cmd args} { - trace remove execution $cmd {expand}[lindex [trace info execution $cmd] 0] + trace remove execution $cmd {*}[lindex [trace info execution $cmd] 0] global info set info $args } diff --git a/tests/upvar.test b/tests/upvar.test index 2b8bbab..59d55a9 100644 --- a/tests/upvar.test +++ b/tests/upvar.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: upvar.test,v 1.13 2006/08/26 13:00:39 msofer Exp $ +# RCS: @(#) $Id: upvar.test,v 1.14 2006/11/03 00:34:53 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -324,7 +324,7 @@ test upvar-8.8 {create nested array with upvar} -body { unset x } -result {1 {can't set "b(2)": variable isn't array}} test upvar-8.9 {upvar won't create namespace variable that refers to procedure variable} { - catch {namespace delete {expand}[namespace children :: test_ns_*]} + catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename MakeLink ""} namespace eval ::test_ns_1 {} proc MakeLink {a} { @@ -417,7 +417,7 @@ catch {unset a} # # Clear out any namespaces called test_ns_* -catch {namespace delete {expand}[namespace children :: test_ns_*]} +catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_0 { variable x test_ns_0 diff --git a/tests/winConsole.test b/tests/winConsole.test index 6b8b2db..51c1781 100644 --- a/tests/winConsole.test +++ b/tests/winConsole.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: winConsole.test,v 1.7 2004/06/23 15:36:58 dkf Exp $ +# RCS: @(#) $Id: winConsole.test,v 1.8 2006/11/03 00:34:53 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -37,7 +37,7 @@ test winConsole-1.1 {Console file channel: non-blocking gets} {win interactive} #cleanup the fileevent fileevent stdin readable {} - fconfigure stdin {expand}$oldmode + fconfigure stdin {*}$oldmode set result diff --git a/tests/winFCmd.test b/tests/winFCmd.test index 8c95a4c..e2575dd 100644 --- a/tests/winFCmd.test +++ b/tests/winFCmd.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: winFCmd.test,v 1.40 2006/03/20 11:39:03 dkf Exp $ +# RCS: @(#) $Id: winFCmd.test,v 1.41 2006/11/03 00:34:53 hobbs Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -50,7 +50,7 @@ proc cleanup {args} { set x [glob -directory $p tf* td*] } if {$x != ""} { - catch {file delete -force -- {expand}$x} + catch {file delete -force -- {*}$x} } } } |