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 | |
| 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]
40 files changed, 341 insertions, 316 deletions
@@ -1,3 +1,22 @@ +2006-11-02 Jeff Hobbs <jeffh@ActiveState.com> + + * 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] + 2006-11-02 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> * generic/tclBasic.c, generic/tclInterp.c, generic/tclProc.c: Silence diff --git a/doc/ParseCmd.3 b/doc/ParseCmd.3 index b49f839..e32077f 100644 --- a/doc/ParseCmd.3 +++ b/doc/ParseCmd.3 @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: ParseCmd.3,v 1.23 2006/08/09 10:06:28 dkf Exp $ +'\" RCS: @(#) $Id: ParseCmd.3,v 1.24 2006/11/03 00:34:51 hobbs Exp $ '\" .so man.macros .TH Tcl_ParseCommand 3 8.3 Tcl "Tcl Library Procedures" @@ -291,7 +291,7 @@ sub-token. The \fInumComponents\fR field is always 1. .VS 8.5 This token has the same meaning as \fBTCL_TOKEN_WORD\fR, except that the command parser notes this word began with the expansion -prefix \fB{expand}\fR, indicating that after substitution, +prefix \fB{*}\fR, indicating that after substitution, the list value of this word should be expanded to form multiple arguments in command evaluation. This token type can only be created by Tcl_ParseCommand. @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: Tcl.n,v 1.13 2005/12/19 10:05:29 dkf Exp $ +'\" RCS: @(#) $Id: Tcl.n,v 1.14 2006/11/03 00:34:51 hobbs Exp $ '\" .so man.macros .TH Tcl n "8.5" Tcl "Tcl Built-In Commands" @@ -51,12 +51,12 @@ are performed on the characters between the quotes as described below. The double-quotes are not retained as part of the word. .VS 8.5 br .IP "[5] \fBArgument expansion.\fR" -If a word starts with the string ``{expand}'' followed by a -non-whitespace character, then the leading ``{expand}'' is removed +If a word starts with the string ``{*}'' followed by a +non-whitespace character, then the leading ``{*}'' is removed and the rest of the word is parsed and substituted as any other word. After substitution, the word is parsed again without substitutions, and its words are added to the command being -substituted. For instance, ``cmd a {expand}{b c} d {expand}{e f}'' is +substituted. For instance, ``cmd a {*}{b c} d {*}{e f}'' is equivalent to ``cmd a b c d e f''. .VE 8.5 .IP "[6] \fBBraces.\fR" @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: eval.n,v 1.6 2004/10/27 09:36:58 dkf Exp $ +'\" RCS: @(#) $Id: eval.n,v 1.7 2006/11/03 00:34:51 hobbs Exp $ '\" .so man.macros .TH eval n "" Tcl "Tcl Built-In Commands" @@ -53,7 +53,7 @@ for {set i 0} {$i<10} {incr i} { .VS 8.5 Note that in the most common case (where the script fragment is actually just a list of words forming a command prefix), it is better -to use \fB{expand}$script\fR when doing this sort of invokation +to use \fB{*}$script\fR when doing this sort of invokation pattern. It is less general than the \fBeval\fR command, and hence easier to make robust in practice. .VE 8.5 @@ -73,7 +73,7 @@ proc lprepend {varName args} { However, the last line would now normally be written without \fBeval\fR, like this: .CS -set var [linsert $var 0 {expand}$args] +set var [linsert $var 0 {*}$args] .CE .VE 8.5 @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: exec.n,v 1.13 2004/11/20 00:17:32 dgp Exp $ +'\" RCS: @(#) $Id: exec.n,v 1.14 2006/11/03 00:34:51 hobbs Exp $ '\" .so man.macros .TH exec n 8.5 Tcl "Tcl Built-In Commands" @@ -367,7 +367,7 @@ remember that Tcl does not handle globbing or expand things into multiple arguments by default. Instead you should write things like this: .CS -\fBexec\fR ls -l {expand}[glob *.tcl] +\fBexec\fR ls -l {*}[glob *.tcl] .CE .PP .SH "WINDOWS EXAMPLES" @@ -407,7 +407,7 @@ applies especially when you want to run "internal" commands like \fIdir\fR from a Tcl script (if you just want to list filenames, use the \fBglob\fR command.) To do that, use this: .CS -\fBexec\fR {expand}[auto_execok dir] *.tcl +\fBexec\fR {*}[auto_execok dir] *.tcl .CE .SH "SEE ALSO" diff --git a/doc/fconfigure.n b/doc/fconfigure.n index d455862..6dedf75 100644 --- a/doc/fconfigure.n +++ b/doc/fconfigure.n @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: fconfigure.n,v 1.15 2006/03/14 22:52:17 andreas_kupries Exp $ +'\" RCS: @(#) $Id: fconfigure.n,v 1.16 2006/11/03 00:34:51 hobbs Exp $ '\" .so man.macros .TH fconfigure n 8.3 Tcl "Tcl Built-In Commands" @@ -256,7 +256,7 @@ set words {} while {[llength $words] < 3} { gets $f line if {[string match "#*" $line]} continue - lappend words {expand}[join [scan $line %d%d%d]] + lappend words {*}[join [scan $line %d%d%d]] } # Those words supply the size of the image and its diff --git a/doc/interp.n b/doc/interp.n index c426bfc..880925a 100644 --- a/doc/interp.n +++ b/doc/interp.n @@ -5,7 +5,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.n,v 1.24 2005/05/10 18:34:00 kennykb Exp $ +'\" RCS: @(#) $Id: interp.n,v 1.25 2006/11/03 00:34:52 hobbs Exp $ '\" .so man.macros .TH interp n 7.6 Tcl "Tcl Built-In Commands" @@ -769,7 +769,7 @@ set i [\fBinterp create\fR -safe] \fBinterp alias\fR $i lappend {} loggedLappend $i proc loggedLappend {i args} { puts "logged invokation of lappend $args" - \fBinterp invokehidden\fR $i lappend {expand}$args + \fBinterp invokehidden\fR $i lappend {*}$args } \fBinterp eval\fR $i $someUntrustedScript .CE diff --git a/doc/unknown.n b/doc/unknown.n index 6ece5f3..5b6f41e 100644 --- a/doc/unknown.n +++ b/doc/unknown.n @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: unknown.n,v 1.6 2006/02/01 18:27:43 dgp Exp $ +'\" RCS: @(#) $Id: unknown.n,v 1.7 2006/11/03 00:34:52 hobbs Exp $ '\" .so man.macros .TH unknown n "" Tcl "Tcl Built-In Commands" @@ -85,7 +85,7 @@ rename \fBunknown\fR _original_unknown # Provide our own implementation proc \fBunknown\fR args { puts stderr "WARNING: unknown command: $args" - uplevel 1 [list _original_unknown {expand}$args] + uplevel 1 [list _original_unknown {*}$args] } .CE diff --git a/generic/tclParse.c b/generic/tclParse.c index 3574cd3..d8a2655 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -12,12 +12,19 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclParse.c,v 1.47 2006/09/24 19:13:43 msofer Exp $ + * RCS: @(#) $Id: tclParse.c,v 1.48 2006/11/03 00:34:52 hobbs Exp $ */ #include "tclInt.h" /* + * For now, we enable the {expand} although it is deprecated - remove by final + */ +#ifndef ALLOW_EXPAND +#define ALLOW_EXPAND 1 +#endif + +/* * The following table provides parsing information about each possible 8-bit * character. The table is designed to be referenced with either signed or * unsigned characters, so it has 384 entries. The first 128 entries @@ -359,8 +366,6 @@ Tcl_ParseCommand( src = termPtr; numBytes = parsePtr->end - src; } else if (*src == '{') { - static char expPfx[] = "expand"; - CONST size_t expPfxLen = sizeof(expPfx) - 1; int expIdx = wordIndex + 1; Tcl_Token *expPtr; @@ -372,7 +377,7 @@ Tcl_ParseCommand( numBytes = parsePtr->end - src; /* - * Check whether the braces contained the word expansion prefix. + * Check whether the braces contained the word expansion prefix {*} */ expPtr = &parsePtr->tokenPtr[expIdx]; @@ -381,14 +386,15 @@ Tcl_ParseCommand( /* Haven't seen prefix already */ && (1 == parsePtr->numTokens - expIdx) /* Only one token */ - && (((expPfxLen == (size_t) expPtr->size) + && (((1 == (size_t) expPtr->size) /* Same length as prefix */ - && (0 == strncmp(expPfx,expPtr->start,expPfxLen))) -#ifdef ALLOW_EMPTY_EXPAND + && (expPtr->start[0] == '*')) +#if defined(ALLOW_EXPAND) && ALLOW_EXPAND == 1 /* - * Allow {} in addition to {expand} + * Allow {expand} in addition to {*} */ - || (0 == (size_t) expPtr->size) + || ((6 == (size_t) expPtr->size) + && (0 == memcmp("expand",expPtr->start,6))) #endif ) /* Is the prefix */ diff --git a/library/auto.tcl b/library/auto.tcl index 63260e7..881e6b9 100644 --- a/library/auto.tcl +++ b/library/auto.tcl @@ -3,7 +3,7 @@ # utility procs formerly in init.tcl dealing with auto execution # of commands and can be auto loaded themselves. # -# RCS: @(#) $Id: auto.tcl,v 1.27 2005/07/23 04:12:48 dgp Exp $ +# RCS: @(#) $Id: auto.tcl,v 1.28 2006/11/03 00:34:52 hobbs Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. @@ -212,7 +212,7 @@ proc auto_mkindex {dir args} { } auto_mkindex_parser::init - foreach file [glob -- {expand}$args] { + foreach file [glob -- {*}$args] { if {[catch {auto_mkindex_parser::mkindex $file} msg opts] == 0} { append index $msg } else { @@ -245,7 +245,7 @@ proc auto_mkindex_old {dir args} { if {[llength $args] == 0} { set args *.tcl } - foreach file [glob -- {expand}$args] { + foreach file [glob -- {*}$args] { set f "" set error [catch { set f [open $file] diff --git a/library/init.tcl b/library/init.tcl index 815965c..1c7a3a9 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -3,7 +3,7 @@ # Default system startup file for Tcl-based applications. Defines # "unknown" procedure and auto-load facilities. # -# RCS: @(#) $Id: init.tcl,v 1.87 2006/10/23 20:26:11 dgp Exp $ +# RCS: @(#) $Id: init.tcl,v 1.88 2006/11/03 00:34:52 hobbs Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -266,7 +266,7 @@ proc unknown args { set cmd [lindex $args 0] if {[regexp "^:*namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} { - #return -code error "You need an {expand}" + #return -code error "You need an {*}" set arglist [lrange $args 1 end] set ret [catch {uplevel 1 ::$cmd $arglist} result opts] dict unset opts -errorinfo @@ -809,7 +809,7 @@ proc tcl::CopyDirectory {action src dest} { # can be returned in various combinations. Anyway, # if any other file is returned, we must signal an error. set existing [glob -nocomplain -directory $dest * .*] - lappend existing {expand}[glob -nocomplain -directory $dest \ + lappend existing {*}[glob -nocomplain -directory $dest \ -type hidden * .*] foreach s $existing { if {([file tail $s] ne ".") && ([file tail $s] ne "..")} { diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 2aa321e..ccf4054 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -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: msgcat.tcl,v 1.25 2006/09/11 14:38:03 dgp Exp $ +# RCS: @(#) $Id: msgcat.tcl,v 1.26 2006/11/03 00:34:52 hobbs Exp $ package require Tcl 8.5 # When the version number changes, be sure to update the pkgIndex.tcl file, @@ -35,7 +35,7 @@ namespace eval msgcat { # Map of language codes used in Windows registry to those of ISO-639 if { $::tcl_platform(platform) eq "windows" } { - variable WinRegToISO639 [dict create {expand}{ + variable WinRegToISO639 [dict create {*}{ 01 ar 0401 ar_SA 0801 ar_IQ 0c01 ar_EG 1001 ar_LY 1401 ar_DZ 1801 ar_MA 1c01 ar_TN 2001 ar_OM 2401 ar_YE 2801 ar_SY 2c01 ar_JO 3001 ar_LB 3401 ar_KW 3801 ar_AE 3c01 ar_BH @@ -196,7 +196,7 @@ proc msgcat::mc {src args} { if {[llength $args] == 0} { return [dict get $Msgs $loc $ns $src] } else { - return [format [dict get $Msgs $loc $ns $src] {expand}$args] + return [format [dict get $Msgs $loc $ns $src] {*}$args] } } } @@ -204,7 +204,7 @@ proc msgcat::mc {src args} { } # we have not found the translation return [uplevel 1 [list [namespace origin mcunknown] \ - $Locale $src {expand}$args]] + $Locale $src {*}$args]] } # msgcat::mclocale -- @@ -382,7 +382,7 @@ proc msgcat::mcmset {locale pairs } { proc msgcat::mcunknown {locale src args} { if {[llength $args]} { - return [format $src {expand}$args] + return [format $src {*}$args] } else { return $src } diff --git a/library/package.tcl b/library/package.tcl index bd3ecf6..64197f7 100644 --- a/library/package.tcl +++ b/library/package.tcl @@ -3,7 +3,7 @@ # utility procs formerly in init.tcl which can be loaded on demand # for package management. # -# RCS: @(#) $Id: package.tcl,v 1.34 2006/09/22 18:13:29 andreas_kupries Exp $ +# RCS: @(#) $Id: package.tcl,v 1.35 2006/11/03 00:34:52 hobbs Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. @@ -135,7 +135,7 @@ proc pkg_mkIndex {args} { } if {[catch { - glob -directory $dir -tails -types {r f} -- {expand}$patternList + glob -directory $dir -tails -types {r f} -- {*}$patternList } fileList o]} { return -options $o $fileList } @@ -194,7 +194,7 @@ proc pkg_mkIndex {args} { proc package {what args} { switch -- $what { require { return ; # ignore transitive requires } - default { __package_orig $what {expand}$args } + default { __package_orig $what {*}$args } } } proc tclPkgUnknown args {} @@ -252,7 +252,7 @@ proc pkg_mkIndex {args} { proc ::tcl::GetAllNamespaces {{root ::}} { set list $root foreach ns [namespace children $root] { - lappend list {expand}[::tcl::GetAllNamespaces $ns] + lappend list {*}[::tcl::GetAllNamespaces $ns] } return $list } diff --git a/library/safe.tcl b/library/safe.tcl index 61246e8..186c2e7 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: safe.tcl,v 1.15 2005/07/23 04:12:49 dgp Exp $ +# RCS: @(#) $Id: safe.tcl,v 1.16 2006/11/03 00:34:52 hobbs Exp $ # # The implementation is based on namespaces. These naming conventions @@ -517,7 +517,7 @@ proc ::safe::interpDelete {slave} { # remove the hook now, otherwise if the hook # calls us somehow, we'll loop Unset $hookname - if {[catch {{expand}$hook $slave} err]} { + if {[catch {{*}$hook $slave} err]} { Log $slave "Delete hook error ($err)" } } @@ -628,15 +628,15 @@ proc ::safe::setLogCmd {args} { } # set/get values proc Set {args} { - Toplevel set {expand}$args + Toplevel set {*}$args } # lappend on toplevel vars proc Lappend {args} { - Toplevel lappend {expand}$args + Toplevel lappend {*}$args } # unset a var/token (currently just an global level eval) proc Unset {args} { - Toplevel unset {expand}$args + Toplevel unset {*}$args } # test existance proc Exists {varname} { @@ -683,7 +683,7 @@ proc ::safe::setLogCmd {args} { proc Log {slave msg {type ERROR}} { variable Log if {[info exists Log] && [llength $Log]} { - {expand}$Log "$type for slave $slave : $msg" + {*}$Log "$type for slave $slave : $msg" } } @@ -846,7 +846,7 @@ proc ::safe::setLogCmd {args} { proc Subset {slave command okpat args} { set subcommand [lindex $args 0] if {[regexp $okpat $subcommand]} { - return [$command {expand}$args] + return [$command {*}$args] } set msg "not allowed to invoke subcommand $subcommand of $command" Log $slave $msg @@ -881,7 +881,7 @@ proc ::safe::setLogCmd {args} { set subcommand [lindex $args 0] if {[regexp $okpat $subcommand]} { - return [::interp invokehidden $slave encoding {expand}$args] + return [::interp invokehidden $slave encoding {*}$args] } if {[string first $subcommand system] == 0} { diff --git a/library/tm.tcl b/library/tm.tcl index 31779ae..8fac14a 100644 --- a/library/tm.tcl +++ b/library/tm.tcl @@ -264,7 +264,7 @@ proc ::tcl::tm::UnknownHandler {original name args} { if { ($pkgname eq $name) && - [package vsatisfies $pkgversion {expand}$args] + [package vsatisfies $pkgversion {*}$args] } then { set satisfied 1 # We do not abort the loop, and keep adding 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} } } } diff --git a/tools/tclZIC.tcl b/tools/tclZIC.tcl index 5fd861f..07ecd5e 100755 --- a/tools/tclZIC.tcl +++ b/tools/tclZIC.tcl @@ -29,7 +29,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tclZIC.tcl,v 1.8 2005/12/05 20:40:42 kennykb Exp $ +# RCS: @(#) $Id: tclZIC.tcl,v 1.9 2006/11/03 00:34:53 hobbs Exp $ # #---------------------------------------------------------------------- @@ -168,7 +168,7 @@ proc loadZIC {fileName} { # Detect continuations of a zone and flag the list appropriately lappend words "" } - lappend words {expand}[regexp -all -inline {\S+} $line] + lappend words {*}[regexp -all -inline {\S+} $line] # Switch on the directive @@ -914,7 +914,7 @@ proc applyRules {ruleSet year startSecs stdGMTOffset DSTOffset nextGMTOffset set untilBaseSecs [expr { wide(86400) * wide($untilJCD) - 210866803200 }] set untilSecs [convertTimeOfDay $untilBaseSecs $stdGMTOffset \ - $DSTOffset {expand}$untilTimeOfDay] + $DSTOffset {*}$untilTimeOfDay] } set origStartSecs $startSecs @@ -979,7 +979,7 @@ proc applyRules {ruleSet year startSecs stdGMTOffset DSTOffset nextGMTOffset if {$until ne ""} { set untilSecs [convertTimeOfDay $untilBaseSecs \ - $stdGMTOffset $DSTOffset {expand}$untilTimeOfDay] + $stdGMTOffset $DSTOffset {*}$untilTimeOfDay] } } @@ -1081,7 +1081,7 @@ proc findEarliestRule {remainingRules year stdGMTOffset DSTOffset} { set dayIn [eval $daySpecOn] set secs [expr {wide(86400) * wide($dayIn) - 210866803200}] set secs [convertTimeOfDay $secs \ - $stdGMTOffset $DSTOffset {expand}$timeAt] + $stdGMTOffset $DSTOffset {*}$timeAt] if {$secs < $earliest} { set earliest $secs set earliestIdx $i @@ -1207,7 +1207,7 @@ proc processTimeZone {zoneName zoneData} { set startDay [eval $dayRule] set secs [expr {wide(86400) * wide($startDay) -210866803200}] set secs [convertTimeOfDay $secs \ - $stdGMTOffset $DSTOffset {expand}$timeOfDay] + $stdGMTOffset $DSTOffset {*}$timeOfDay] } lappend dstRule \ $year $secs $stdGMTOffset $DSTOffset $nextGMTOffset \ |