summaryrefslogtreecommitdiffstats
path: root/tests/basic.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/basic.test')
-rw-r--r--tests/basic.test214
1 files changed, 113 insertions, 101 deletions
diff --git a/tests/basic.test b/tests/basic.test
index ec6ad18..bff9a95 100644
--- a/tests/basic.test
+++ b/tests/basic.test
@@ -14,12 +14,12 @@
#
# 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.41 2006/01/18 19:48:11 dgp Exp $
-#
package require tcltest 2
-namespace import -force ::tcltest::*
+namespace import ::tcltest::*
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testevalex [llength [info commands testevalex]]
testConstraint testcmdtoken [llength [info commands testcmdtoken]]
@@ -31,7 +31,7 @@ catch {interp delete test_interp}
catch {rename p ""}
catch {rename q ""}
catch {rename cmd ""}
-catch {unset x}
+unset -nocomplain x
test basic-1.1 {Tcl_CreateInterp, creates interp's global namespace} {
catch {interp delete test_interp}
@@ -155,7 +155,7 @@ test basic-12.2 {Tcl_HideCommand, a hidden cmd remembers its containing namespac
[namespace delete test_ns_basic]
} {:: {} 1 {invalid command name "cmd"} {} :: {}}
-test basic-13.1 {Tcl_ExposeCommand, a command stays in the global namespace and can not go to another namespace} {
+test basic-13.1 {Tcl_ExposeCommand, a command stays in the global namespace and cannot go to another namespace} {
catch {namespace delete test_ns_basic}
catch {rename cmd ""}
proc cmd {} { ;# note that this is global
@@ -182,7 +182,7 @@ test basic-13.1 {Tcl_ExposeCommand, a command stays in the global namespace and
[test_ns_basic::exposeCmdWorkAround] \
[test_ns_basic::newCmd] \
[namespace delete test_ns_basic]
-} {:: {} 1 {can not expose to a namespace (use expose to toplevel, then rename)} {} ::test_ns_basic {}}
+} {:: {} 1 {cannot expose to a namespace (use expose to toplevel, then rename)} {} ::test_ns_basic {}}
test basic-13.2 {Tcl_ExposeCommand, invalidate cached refs to cmd now being exposed} {
catch {rename p ""}
catch {rename cmd ""}
@@ -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 {} {
@@ -241,14 +241,14 @@ test basic-18.1 {TclRenameCommand, name of existing cmd can have namespace quali
}
list [test_ns_basic::p] \
[rename test_ns_basic::p test_ns_basic::q] \
- [test_ns_basic::q]
+ [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]"
@@ -267,16 +267,26 @@ test basic-18.4 {TclRenameCommand, bad new name} {
}
rename test_ns_basic::p :::george::martha
} {}
-test basic-18.5 {TclRenameCommand, new name must not already exist} {
+test basic-18.5 {TclRenameCommand, new name must not already exist} -setup {
+ if {![llength [info commands :::george::martha]]} {
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
+ namespace eval test_ns_basic {
+ proc p {} {
+ return "p in [namespace current]"
+ }
+ }
+ rename test_ns_basic::p :::george::martha
+ }
+} -body {
namespace eval test_ns_basic {
proc q {} {
return 42
}
}
list [catch {rename test_ns_basic::q :::george::martha} msg] $msg
-} {1 {can't rename to ":::george::martha": command already exists}}
+} -result {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,10 +309,10 @@ 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}
+ unset -nocomplain x
set x [namespace eval test_ns_basic::test_ns_basic2 {
# the following creates a cmd in the global namespace
testcmdtoken create p
@@ -328,7 +338,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 {} {}
@@ -355,7 +365,7 @@ test basic-23.1 {Tcl_DeleteCommand} {emptyTest} {
test basic-24.1 {Tcl_DeleteCommandFromToken, invalidate all compiled code if cmd has compile proc} {
catch {interp delete test_interp}
- catch {unset x}
+ unset -nocomplain x
interp create test_interp
interp eval test_interp {
proc useSet {} {
@@ -374,7 +384,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 +402,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
@@ -427,7 +437,7 @@ test basic-26.1 {Tcl_EvalObj: preserve object while evaling it} -setup {
# string would have been freed, leaving garbage bytes for the error
# message.
set f [open $fName w]
- fileevent $f writable "fileevent $f writable {}; error foo"
+ chan event $f writable "chan event $f writable {}; error foo"
set x {}
vwait x
close $f
@@ -444,11 +454,11 @@ test basic-26.2 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} -body {
# a - the pure-list internal rep is destroyed by shimmering
# b - the command returns an error
# As the error code in Tcl_EvalObjv accesses the list elements, this will
- # cause a segfault if [Bug 1119369] has not been fixed.
+ # cause a segfault if [Bug 1119369] has not been fixed.
# NOTE: a MEM_DEBUG build may be necessary to guarantee the segfault.
#
- set SRC [list foo 1] ;# pure-list command
+ set SRC [list foo 1] ;# pure-list command
proc foo str {
# Shimmer pure-list to cmdName, cleanup and error
proc $::SRC {} {}; $::SRC
@@ -466,11 +476,11 @@ test basic-26.3 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} -body {
# Follow the pure-list branch in a manner that
# a - the pure-list internal rep is destroyed by shimmering
# b - the command accesses its command line
- # This will cause a segfault if [Bug 1119369] has not been fixed.
+ # This will cause a segfault if [Bug 1119369] has not been fixed.
# NOTE: a MEM_DEBUG build may be necessary to guarantee the segfault.
#
- set SRC [list foo 1] ;# pure-list command
+ set SRC [list foo 1] ;# pure-list command
proc foo str {
# Shimmer pure-list to cmdName, cleanup and error
proc $::SRC {} {}; $::SRC
@@ -502,7 +512,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 {
@@ -547,10 +557,10 @@ test basic-46.1 {Tcl_AllowExceptions: exception return not allowed} {stdio} {
catch {close $f}
set res [catch {
set f [open |[list [interpreter]] w+]
- fconfigure $f -buffering line
- puts $f {fconfigure stdout -buffering line}
+ chan configure $f -buffering line
+ puts $f {chan configure stdout -buffering line}
puts $f continue
- puts $f {puts $errorInfo}
+ puts $f {puts $::errorInfo}
puts $f {puts DONE}
set newMsg {}
set msg {}
@@ -582,7 +592,7 @@ test basic-46.2 {Tcl_AllowExceptions: exception return not allowed} -setup {
invoked "break" outside of a loop
while executing
"break"
- (file "*BREAKtest" line 3)}
+ (file "*BREAKtest" line 3)}
test basic-46.3 {Tcl_AllowExceptions: exception return not allowed} -setup {
set fName [makeFile {
@@ -599,7 +609,7 @@ test basic-46.3 {Tcl_AllowExceptions: exception return not allowed} -setup {
} -returnCodes error -match glob -result {invoked "break" outside of a loop
while executing
"break"
- (file "*BREAKtest" line 4)}
+ (file "*BREAKtest" line 4)}
test basic-46.4 {Tcl_AllowExceptions: exception return not allowed} -setup {
set fName [makeFile {
@@ -631,8 +641,10 @@ test basic-46.5 {Tcl_AllowExceptions: exception return not allowed} -setup {
"return -code return"
(file "*BREAKtest" line 2)}
-test basic-47.1 {Tcl_EvalEx: check for missing close-bracket} -body {
- subst {a[set b [format cd]}
+test basic-47.1 {Tcl_EvalEx: check for missing close-bracket} -constraints {
+ testevalex
+} -body {
+ testevalex {a[set b [format cd]}
} -returnCodes error -result {missing close-bracket}
# Some lists for expansion tests to work with
@@ -654,69 +666,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,8 +736,8 @@ test basic-48.1.$noComp {expansion: parsing} $constraints {
# Another comment
list 1 2\
- 3 {expand}$::l1
-
+ 3 {*}$::l1
+
# Comment again
}
} {1 2 3 a {b b} c d}
@@ -735,13 +747,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 +761,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 +794,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 }
+ } -constraints $constraints -body {
+ run { {*}$cmd apa bepa }
} -cleanup {
unset cmd
} -returnCodes 1 -result {invalid command name "#"}
@@ -810,7 +822,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 +840,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}]"
@@ -858,7 +870,7 @@ test basic-48.16.$noComp {expansion: testing for leaks} -setup {
stress
set tmp $end
set end [getbytes]
- }
+ }
set leak [expr {$end - $tmp}]
} -cleanup {
unset end i tmp
@@ -869,10 +881,10 @@ test basic-48.16.$noComp {expansion: testing for leaks} -setup {
test basic-48.17.$noComp {expansion: object safety} -setup {
set old_precision $::tcl_precision
set ::tcl_precision 4
- } -constraints $constraints -body {
+ } -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 +901,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 +910,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,13 +975,13 @@ 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 ""}
catch {rename q ""}
catch {rename cmd ""}
catch {rename value:at: ""}
-catch {unset x}
-::tcltest::cleanupTests
+unset -nocomplain x
+cleanupTests
return
generated by cgit v0.12 at 2025-10-31 16:57:35 (GMT)