summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2006-10-09 19:15:40 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2006-10-09 19:15:40 (GMT)
commit25e6ad437c89b37b6e1b4c2283cc0eef267e9c06 (patch)
tree5d5d3889692f5fb9e51abfce3aeb3b7d346b2297
parent57911c541c6dbf733b08171a1711081e59d2b95e (diff)
downloadtcl-25e6ad437c89b37b6e1b4c2283cc0eef267e9c06.zip
tcl-25e6ad437c89b37b6e1b4c2283cc0eef267e9c06.tar.gz
tcl-25e6ad437c89b37b6e1b4c2283cc0eef267e9c06.tar.bz2
* tests/*.test: updated all tests to refer explicitly to thetip_278_20061009
global variables ::errorInfo, ::errorCode, ::env and ::tcl_platform: many were relying on the alternative lookup in the global namespace, that feature is tested specifically in namespace and variable tests. The modified testfiles are: apply.test, basic.test, case.test, cmdIL.test, cmdMZ.test, compExpr-old.test, error.test, eval.test, event.test, expr.test, fileSystem.test, for.test, http.test, if.test, incr-old.test, incr.test, interp.test, io.test, ioCmd.test, load.test, misc.test, namespace.test, parse.test, parseOld.test, pkg.test, proc-old.test, set.test, switch.test, tcltest.test, thread.test, var.test, while-old.test, while.test.
Diffstat
-rw-r--r--ChangeLog15
-rw-r--r--tests/apply.test4
-rw-r--r--tests/basic.test4
-rw-r--r--tests/case.test6
-rw-r--r--tests/cmdIL.test4
-rw-r--r--tests/cmdMZ.test12
-rw-r--r--tests/compExpr-old.test14
-rw-r--r--tests/error.test42
-rw-r--r--tests/eval.test4
-rw-r--r--tests/event.test6
-rw-r--r--tests/expr.test14
-rw-r--r--tests/fileSystem.test2
-rw-r--r--tests/for.test18
-rw-r--r--tests/http.test4
-rw-r--r--tests/if.test18
-rw-r--r--tests/incr-old.test8
-rw-r--r--tests/incr.test18
-rw-r--r--tests/interp.test6
-rw-r--r--tests/io.test14
-rw-r--r--tests/ioCmd.test32
-rw-r--r--tests/load.test10
-rw-r--r--tests/misc.test4
-rw-r--r--tests/namespace.test14
-rw-r--r--tests/parse.test32
-rw-r--r--tests/parseOld.test4
-rw-r--r--tests/pkg.test10
-rw-r--r--tests/proc-old.test20
-rw-r--r--tests/set.test10
-rw-r--r--tests/switch.test6
-rwxr-xr-xtests/tcltest.test12
-rw-r--r--tests/thread.test10
-rw-r--r--tests/var.test8
-rw-r--r--tests/while-old.test4
-rw-r--r--tests/while.test10
34 files changed, 207 insertions, 192 deletions
diff --git a/ChangeLog b/ChangeLog
index f681ce6..73cbd4b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,18 @@
+2006-10-09 Miguel Sofer <msofer@users.sf.net>
+
+ * tests/*.test: updated all tests to refer explicitly to the
+ global variables ::errorInfo, ::errorCode, ::env and
+ ::tcl_platform: many were relying on the alternative lookup in the
+ global namespace, that feature is tested specifically in namespace
+ and variable tests.
+ The modified testfiles are: apply.test, basic.test, case.test,
+ cmdIL.test, cmdMZ.test, compExpr-old.test, error.test, eval.test,
+ event.test, expr.test, fileSystem.test, for.test, http.test,
+ if.test, incr-old.test, incr.test, interp.test, io.test,
+ ioCmd.test, load.test, misc.test, namespace.test, parse.test,
+ parseOld.test, pkg.test, proc-old.test, set.test, switch.test,
+ tcltest.test, thread.test, var.test, while-old.test, while.test.
+
2006-10-06 Pat Thoyts <patthoyts@users.sourceforge.net>
* win/rules.vc: bug #1571954: avoid /RTCc flag with MSVC8
diff --git a/tests/apply.test b/tests/apply.test
index a4e5b8c..b1769fa 100644
--- a/tests/apply.test
+++ b/tests/apply.test
@@ -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: apply.test,v 1.5 2006/03/10 19:49:14 msofer Exp $
+# RCS: @(#) $Id: apply.test,v 1.6 2006/10/09 19:15:41 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -128,7 +128,7 @@ test apply-4.2 {error in arguments to lambda expression} {
test apply-5.1 {runtime error in lambda expression} {
set lambda [list {} {error foo}]
set res [catch {apply $lambda}]
- list $res $errorInfo
+ list $res $::errorInfo
} {1 {foo
while executing
"error foo"
diff --git a/tests/basic.test b/tests/basic.test
index ec6ad18..7322eb0 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.41 2006/01/18 19:48:11 dgp Exp $
+# RCS: @(#) $Id: basic.test,v 1.42 2006/10/09 19:15:44 msofer Exp $
#
package require tcltest 2
@@ -550,7 +550,7 @@ test basic-46.1 {Tcl_AllowExceptions: exception return not allowed} {stdio} {
fconfigure $f -buffering line
puts $f {fconfigure stdout -buffering line}
puts $f continue
- puts $f {puts $errorInfo}
+ puts $f {puts $::errorInfo}
puts $f {puts DONE}
set newMsg {}
set msg {}
diff --git a/tests/case.test b/tests/case.test
index 477538c..023fdbb 100644
--- a/tests/case.test
+++ b/tests/case.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: case.test,v 1.6 2004/05/19 10:52:35 dkf Exp $
+# RCS: @(#) $Id: case.test,v 1.7 2006/10/09 19:15:44 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -42,7 +42,7 @@ test case-1.7 {list of patterns} {
test case-2.1 {error in executed command} {
list [catch {case a in a {error "Just a test"} default {format 1}} msg] \
- $msg $errorInfo
+ $msg $::errorInfo
} {1 {Just a test} {Just a test
while executing
"error "Just a test""
@@ -60,7 +60,7 @@ test case-2.4 {error: pattern with no body} {
} {1 {extra case pattern with no body}}
test case-2.5 {error in default command} {
list [catch {case foo in a {error case1} default {error case2} \
- b {error case 3}} msg] $msg $errorInfo
+ b {error case 3}} msg] $msg $::errorInfo
} {1 case2 {case2
while executing
"error case2"
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index 717370a..a4099a8 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.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: cmdIL.test,v 1.27 2006/08/09 14:16:03 dkf Exp $
+# RCS: @(#) $Id: cmdIL.test,v 1.28 2006/10/09 19:15:44 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -206,7 +206,7 @@ test cmdIL-3.15 {SortCompare procedure, -command option} -body {
proc cmp {a b} {
error "comparison error"
}
- list [catch {lsort -command cmp {48 6}} msg] $msg $errorInfo
+ list [catch {lsort -command cmp {48 6}} msg] $msg $::errorInfo
} -cleanup {
rename cmp ""
} -result {1 {comparison error} {comparison error
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test
index 2eff71f..85b7bde 100644
--- a/tests/cmdMZ.test
+++ b/tests/cmdMZ.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: cmdMZ.test,v 1.24 2004/07/06 21:08:37 dgp Exp $
+# RCS: @(#) $Id: cmdMZ.test,v 1.25 2006/10/09 19:15:44 msofer Exp $
if {[catch {package require tcltest 2.1}]} {
puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
@@ -58,10 +58,10 @@ test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} {unix nonPortable} {
# Tcl_RenameObjCmd
test cmdMZ-2.1 {Tcl_RenameObjCmd: error conditions} {
- list [catch {rename r1} msg] $msg $errorCode
+ list [catch {rename r1} msg] $msg $::errorCode
} {1 {wrong # args: should be "rename oldName newName"} NONE}
test cmdMZ-2.2 {Tcl_RenameObjCmd: error conditions} {
- list [catch {rename r1 r2 r3} msg] $msg $errorCode
+ list [catch {rename r1 r2 r3} msg] $msg $::errorCode
} {1 {wrong # args: should be "rename oldName newName"} NONE}
test cmdMZ-2.3 {Tcl_RenameObjCmd: success} {
catch {rename r2 {}}
@@ -248,7 +248,7 @@ test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} -body {
error "error in sourced file"
set y $x
} source.file]
- set result [list [catch {source $file} msg] $msg $errorInfo]
+ set result [list [catch {source $file} msg] $msg $::errorInfo]
removeFile source.file
set result
} -match listGlob -result {1 {error in sourced file} {error in sourced file
@@ -267,10 +267,10 @@ test cmdMZ-3.6 {Tcl_SourceObjCmd: simple script} {
# Tcl_SplitObjCmd
test cmdMZ-4.1 {Tcl_SplitObjCmd: split errors} {
- list [catch split msg] $msg $errorCode
+ list [catch split msg] $msg $::errorCode
} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
test cmdMZ-4.2 {Tcl_SplitObjCmd: split errors} {
- list [catch {split a b c} msg] $msg $errorCode
+ list [catch {split a b c} msg] $msg $::errorCode
} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
test cmdMZ-4.3 {Tcl_SplitObjCmd: basic split commands} {
split "a\n b\t\r c\n "
diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test
index b24397f..78e6090 100644
--- a/tests/compExpr-old.test
+++ b/tests/compExpr-old.test
@@ -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: compExpr-old.test,v 1.20 2006/08/22 04:03:23 dgp Exp $
+# RCS: @(#) $Id: compExpr-old.test,v 1.21 2006/10/09 19:15:44 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -535,7 +535,7 @@ test compExpr-old-14.22 {CompilePrimaryExpr: subcommand primary} {
} 123
test compExpr-old-14.23 {CompilePrimaryExpr: error in subcommand primary} -body {
catch {expr {[set]}} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}
@@ -556,7 +556,7 @@ test compExpr-old-14.28 {CompilePrimaryExpr: subexpression primary} {
} 14
test compExpr-old-14.29 {CompilePrimaryExpr: error in subexpression primary} -body {
catch {expr 2+(3*[set])} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}
@@ -576,25 +576,25 @@ test compExpr-old-15.1 {CompileMathFuncCall: missing parenthesis} -body {
} -returnCodes error -match glob -result *
test compExpr-old-15.2 {CompileMathFuncCall: unknown math function} -body {
catch {expr whazzathuh(1)} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {* "*whazzathuh"
while *ing
"expr whazzathuh(1)"}
test compExpr-old-15.3 {CompileMathFuncCall: too many arguments} -body {
catch {expr sin(1,2,3)} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {too many arguments for math function*
while *ing
"expr sin(1,2,3)"}
test compExpr-old-15.4 {CompileMathFuncCall: ')' found before last required arg} -body {
catch {expr sin()} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {too few arguments for math function*
while *ing
"expr sin()"}
test compExpr-old-15.5 {CompileMathFuncCall: too few arguments} -body {
catch {expr pow(1)} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {too few arguments for math function*
while *ing
"expr pow(1)"}
diff --git a/tests/error.test b/tests/error.test
index 9f55de8..67c87b4 100644
--- a/tests/error.test
+++ b/tests/error.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: error.test,v 1.15 2006/01/18 19:48:11 dgp Exp $
+# RCS: @(#) $Id: error.test,v 1.16 2006/10/09 19:15:44 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -44,7 +44,7 @@ test error-1.2 {simple errors from commands} {
test error-1.3 {simple errors from commands} {
catch {format [string index]} b
- set errorInfo
+ set ::errorInfo
# this used to return '... while executing ...', but
# string index is fully compiled as of 8.4a3
} {wrong # args: should be "string index string charIndex"
@@ -98,7 +98,7 @@ test error-2.2 {errors in nested procedures} {
test error-2.3 {errors in nested procedures} {
catch foo b
- set errorInfo
+ set ::errorInfo
} {Human-generated
while executing
"error {Human-generated}"
@@ -117,7 +117,7 @@ test error-2.5 {errors in nested procedures} {
test error-2.6 {errors in nested procedures} {
catch foo2 b
- set errorInfo
+ set ::errorInfo
} {glorp2
while executing
"error glorp2"
@@ -143,27 +143,27 @@ catch {unset a}
# More tests related to errorInfo and errorCode
test error-4.1 {errorInfo and errorCode variables} {
- list [catch {error msg1 msg2 msg3} msg] $msg $errorInfo $errorCode
+ list [catch {error msg1 msg2 msg3} msg] $msg $::errorInfo $::errorCode
} {1 msg1 msg2 msg3}
test error-4.2 {errorInfo and errorCode variables} {
- list [catch {error msg1 {} msg3} msg] $msg $errorInfo $errorCode
+ list [catch {error msg1 {} msg3} msg] $msg $::errorInfo $::errorCode
} {1 msg1 {msg1
while executing
"error msg1 {} msg3"} msg3}
test error-4.3 {errorInfo and errorCode variables} {
- list [catch {error msg1 {}} msg] $msg $errorInfo $errorCode
+ list [catch {error msg1 {}} msg] $msg $::errorInfo $::errorCode
} {1 msg1 {msg1
while executing
"error msg1 {}"} NONE}
test error-4.4 {errorInfo and errorCode variables} {
- set errorCode bogus
- list [catch {error msg1} msg] $msg $errorInfo $errorCode
+ set ::errorCode bogus
+ list [catch {error msg1} msg] $msg $::errorInfo $::errorCode
} {1 msg1 {msg1
while executing
"error msg1"} NONE}
test error-4.5 {errorInfo and errorCode variables} {
- set errorCode bogus
- list [catch {error msg1 msg2 {}} msg] $msg $errorInfo $errorCode
+ set ::errorCode bogus
+ list [catch {error msg1 msg2 {}} msg] $msg $::errorInfo $::errorCode
} {1 msg1 msg2 {}}
# Errors in error command itself
@@ -179,46 +179,46 @@ test error-5.2 {errors in error command} {
test error-6.1 {catch must reset error state} {
catch {error outer [catch {error inner inner.errorInfo inner.errorCode}]}
- list $errorCode $errorInfo
+ list $::errorCode $::errorInfo
} {NONE 1}
test error-6.2 {catch must reset error state} {
catch {error outer [catch {return -level 0 -code error -errorcode BUG}]}
- list $errorCode $errorInfo
+ list $::errorCode $::errorInfo
} {NONE 1}
test error-6.3 {catch must reset error state} {
- set errorCode BUG
+ set ::errorCode BUG
catch {error outer [catch set]}
- list $errorCode $errorInfo
+ list $::errorCode $::errorInfo
} {NONE 1}
test error-6.4 {catch must reset error state} {
catch {error [catch {error foo bar baz}] 1}
- list $errorCode $errorInfo
+ list $::errorCode $::errorInfo
} {NONE 1}
test error-6.5 {catch must reset error state} {
catch {error [catch {return -level 0 -code error -errorcode BUG}] 1}
- list $errorCode $errorInfo
+ list $::errorCode $::errorInfo
} {NONE 1}
test error-6.6 {catch must reset error state} {
catch {return -level 0 -code error -errorinfo [catch {error foo bar baz}]}
- list $errorCode $errorInfo
+ list $::errorCode $::errorInfo
} {NONE 1}
test error-6.7 {catch must reset error state} {
proc foo {} {
return -code error -errorinfo [catch {error foo bar baz}]
}
catch foo
- list $errorCode
+ list $::errorCode
} {NONE}
test error-6.8 {catch must reset error state} {
catch {return -level 0 -code error [catch {error foo bar baz}]}
- list $errorCode
+ list $::errorCode
} {NONE}
test error-6.9 {catch must reset error state} {
proc foo {} {
return -code error [catch {error foo bar baz}]
}
catch foo
- list $errorCode
+ list $::errorCode
} {NONE}
test error-7.0 {Bug 1397843} -body {
diff --git a/tests/eval.test b/tests/eval.test
index a068c1b..98acd08 100644
--- a/tests/eval.test
+++ b/tests/eval.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: eval.test,v 1.8 2006/01/18 19:48:11 dgp Exp $
+# RCS: @(#) $Id: eval.test,v 1.9 2006/10/09 19:15:44 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -47,7 +47,7 @@ test eval-2.5 {error in eval'ed command: setting errorInfo} {
set a 1
error "test error"
}} msg
- set errorInfo
+ set ::errorInfo
} "test error
while executing
\"error \"test error\"\"
diff --git a/tests/event.test b/tests/event.test
index 0cf627b..5e8cc4c 100644
--- a/tests/event.test
+++ b/tests/event.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: event.test,v 1.20 2002/07/10 11:56:44 dgp Exp $
+# RCS: @(#) $Id: event.test,v 1.21 2006/10/09 19:15:44 msofer Exp $
package require tcltest 2
namespace import -force ::tcltest::*
@@ -365,8 +365,8 @@ test event-9.4 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
test event-10.1 {Tcl_Exit procedure} {stdio} {
set child [open |[list [interpreter]] r+]
puts $child "exit 3"
- list [catch {close $child} msg] $msg [lindex $errorCode 0] \
- [lindex $errorCode 2]
+ list [catch {close $child} msg] $msg [lindex $::errorCode 0] \
+ [lindex $::errorCode 2]
} {1 {child process exited abnormally} CHILDSTATUS 3}
test event-11.1 {Tcl_VwaitCmd procedure} {
diff --git a/tests/expr.test b/tests/expr.test
index 0af0747..dafdc8e 100644
--- a/tests/expr.test
+++ b/tests/expr.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: expr.test,v 1.62 2006/09/28 20:06:43 dgp Exp $
+# RCS: @(#) $Id: expr.test,v 1.63 2006/10/09 19:15:44 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -618,7 +618,7 @@ test expr-14.22 {CompilePrimaryExpr: subcommand primary} {
} 123
test expr-14.23 {CompilePrimaryExpr: error in subcommand primary} -body {
catch {expr {[set]}} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}
@@ -639,7 +639,7 @@ test expr-14.28 {CompilePrimaryExpr: subexpression primary} {
} 14
test expr-14.29 {CompilePrimaryExpr: error in subexpression primary} -body {
catch {expr 2+(3*[set])} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}
@@ -659,25 +659,25 @@ test expr-15.1 {CompileMathFuncCall: missing parenthesis} -body {
} -returnCodes error -match glob -result *
test expr-15.2 {CompileMathFuncCall: unknown math function} -body {
catch {expr whazzathuh(1)} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {* "*whazzathuh"
while *ing
"expr whazzathuh(1)"}
test expr-15.3 {CompileMathFuncCall: too many arguments} -body {
catch {expr sin(1,2,3)} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {too many arguments for math function*
while *ing
"expr sin(1,2,3)"}
test expr-15.4 {CompileMathFuncCall: ')' found before last required arg} -body {
catch {expr sin()} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {too few arguments for math function*
while *ing
"expr sin()"}
test expr-15.5 {CompileMathFuncCall: too few arguments} -body {
catch {expr pow(1)} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {too few arguments for math function*
while *ing
"expr pow(1)"}
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 87e5e26..2acdbd2 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -584,7 +584,7 @@ test filesystem-5.1 {cache and ~} {
-constraints testfilesystem
-match regexp
-body {
- set orig $env(HOME)
+ set orig $::env(HOME)
set ::env(HOME) /foo/bar/blah
set testdir ~
set res1 "Parent of ~ (/foo/bar/blah) is [file dirname $testdir]"
diff --git a/tests/for.test b/tests/for.test
index 0266de4..8665df6 100644
--- a/tests/for.test
+++ b/tests/for.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: for.test,v 1.15 2006/08/22 18:10:43 dgp Exp $
+# RCS: @(#) $Id: for.test,v 1.16 2006/10/09 19:15:44 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -22,7 +22,7 @@ test for-1.1 {TclCompileForCmd: missing initial command} {
list [catch {for} msg] $msg
} {1 {wrong # args: should be "for start test next command"}}
test for-1.2 {TclCompileForCmd: error in initial command} -body {
- list [catch {for {set}} msg] $msg $errorInfo
+ list [catch {for {set}} msg] $msg $::errorInfo
} -match glob -result {1 {wrong # args: should be "for start test next command"} {wrong # args: should be "for start test next command"
while *ing
"for {set}"}}
@@ -33,7 +33,7 @@ test for-1.3 {TclCompileForCmd: missing test expression} {
} {wrong # args: should be "for start test next command"}
test for-1.4 {TclCompileForCmd: error in test expression} -body {
catch {for {set i 0} {$i<}} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "for start test next command"
while *ing
"for {set i 0} {$i<}"}
@@ -51,7 +51,7 @@ test for-1.7 {TclCompileForCmd: missing command body} {
} {wrong # args: should be "for start test next command"}
test for-1.8 {TclCompileForCmd: error compiling command body} -body {
catch {for {set i 0} {$i < 5} {incr i} {set}} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}
@@ -82,7 +82,7 @@ test for-1.11 {TclCompileForCmd: computed command body} {
} {x1}
test for-1.12 {TclCompileForCmd: error in "next" command} -body {
catch {for {set i 0} {$i < 5} {set} {format $i}} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}
@@ -652,7 +652,7 @@ test for-6.5 {Tcl_ForObjCmd: number of args} {
} {wrong # args: should be "for start test next command"}
test for-6.6 {Tcl_ForObjCmd: error in initial command} -body {
set z for
- list [catch {$z {set} {$i < 5} {incr i} {body}} msg] $msg $errorInfo
+ list [catch {$z {set} {$i < 5} {incr i} {body}} msg] $msg $::errorInfo
} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
while *ing
"set"
@@ -662,7 +662,7 @@ test for-6.6 {Tcl_ForObjCmd: error in initial command} -body {
test for-6.7 {Tcl_ForObjCmd: error in test expression} -body {
set z for
catch {$z {set i 0} {i < 5} {incr i} {body}}
- set errorInfo
+ set ::errorInfo
} -match glob -result {*"$z {set i 0} {i < 5} {incr i} {body}"}
test for-6.8 {Tcl_ForObjCmd: test expression is enclosed in quotes} {
set z for
@@ -673,7 +673,7 @@ test for-6.8 {Tcl_ForObjCmd: test expression is enclosed in quotes} {
test for-6.9 {Tcl_ForObjCmd: error executing command body} -body {
set z for
catch {$z {set i 0} {$i < 5} {incr i} {set}} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"
@@ -710,7 +710,7 @@ test for-6.12 {Tcl_ForObjCmd: computed command body} {
test for-6.13 {Tcl_ForObjCmd: error in "next" command} -body {
set z for
catch {$z {set i 0} {$i < 5} {set} {set j 4}} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"
diff --git a/tests/http.test b/tests/http.test
index 1e62f9d..a4b11d0 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.42 2006/09/16 00:19:42 hobbs Exp $
+# RCS: @(#) $Id: http.test,v 1.43 2006/10/09 19:15:44 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -280,7 +280,7 @@ test http-3.12 {http::geturl querychannel with aborted request} {nonPortable} {
http::wait $t
upvar #0 $t state
} err]} {
- puts $errorInfo
+ puts $::errorInfo
error $err
}
diff --git a/tests/if.test b/tests/if.test
index 5f625b9..4f46354 100644
--- a/tests/if.test
+++ b/tests/if.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: if.test,v 1.11 2006/08/22 18:10:44 dgp Exp $
+# RCS: @(#) $Id: if.test,v 1.12 2006/10/09 19:15:44 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -27,7 +27,7 @@ test if-1.2 {TclCompileIfCmd: error in if/elseif test} {
list [catch {if {[error "error in condition"]} foo} msg] $msg
} {1 {error in condition}}
test if-1.3 {TclCompileIfCmd: error in if/elseif test} -body {
- list [catch {if {1+}} msg] $msg $errorInfo
+ list [catch {if {1+}} msg] $msg $::errorInfo
} -match glob -result {1 * {*"if {1+}"}}
test if-1.4 {TclCompileIfCmd: if/elseif test in braces} {
set a {}
@@ -62,7 +62,7 @@ test if-1.9 {TclCompileIfCmd: missing "then" body} {
} {wrong # args: no script following "then" argument}
test if-1.10 {TclCompileIfCmd: error in "then" body} -body {
set a {}
- list [catch {if {$a!="xxx"} then {set}} msg] $msg $errorInfo
+ list [catch {if {$a!="xxx"} then {set}} msg] $msg $::errorInfo
} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}}
@@ -173,7 +173,7 @@ test if-2.3 {TclCompileIfCmd: missing expression after "elseif"} {
} {wrong # args: no expression after "elseif" argument}
test if-2.4 {TclCompileIfCmd: error in expression after "elseif"} -body {
set a {}
- list [catch {if 3>4 {set a 1} elseif {1>}} msg] $msg $errorInfo
+ list [catch {if 3>4 {set a 1} elseif {1>}} msg] $msg $::errorInfo
} -match glob -result {1 * {*"if 3>4 {set a 1} elseif {1>}"}}
test if-2.5 {TclCompileIfCmd: test jumpFalse instruction replacement after long "elseif" body} {
catch {unset i}
@@ -298,7 +298,7 @@ test if-3.3 {TclCompileIfCmd: missing body after "else"} {
test if-3.4 {TclCompileIfCmd: error compiling body after "else"} -body {
set a {}
catch {if 2<1 {set a 1} else {set}} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}
@@ -499,7 +499,7 @@ test if-5.2 {if cmd with computed command names: error in if/elseif test} {
} {1 {error in condition}}
test if-5.3 {if cmd with computed command names: error in if/elseif test} -body {
set z if
- list [catch {$z {1+}} msg] $msg $errorInfo
+ list [catch {$z {1+}} msg] $msg $::errorInfo
} -match glob -result {1 * {*"$z {1+}"}}
test if-5.4 {if cmd with computed command names: if/elseif test in braces} {
set z if
@@ -541,7 +541,7 @@ test if-5.9 {if cmd with computed command names: missing "then" body} {
test if-5.10 {if cmd with computed command names: error in "then" body} -body {
set z if
set a {}
- list [catch {$z {$a!="xxx"} then {set}} msg] $msg $errorInfo
+ list [catch {$z {$a!="xxx"} then {set}} msg] $msg $::errorInfo
} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
while *ing
"set"
@@ -665,7 +665,7 @@ test if-6.3 {if cmd with computed command names: missing expression after "elsei
test if-6.4 {if cmd with computed command names: error in expression after "elseif"} -body {
set z if
set a {}
- list [catch {$z 3>4 {set a 1} elseif {1>}} msg] $msg $errorInfo
+ list [catch {$z 3>4 {set a 1} elseif {1>}} msg] $msg $::errorInfo
} -match glob -result {1 * {*"$z 3>4 {set a 1} elseif {1>}"}}
test if-6.5 {if cmd with computed command names: test jumpFalse instruction replacement after long "elseif" body} {
set z if
@@ -795,7 +795,7 @@ test if-7.4 {if cmd with computed command names: error compiling body after "els
set z if
set a {}
catch {$z 2<1 {set a 1} else {set}} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"
diff --git a/tests/incr-old.test b/tests/incr-old.test
index 5b93268..96c68b7 100644
--- a/tests/incr-old.test
+++ b/tests/incr-old.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: incr-old.test,v 1.9 2006/02/09 17:34:42 dgp Exp $
+# RCS: @(#) $Id: incr-old.test,v 1.10 2006/10/09 19:15:44 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -51,13 +51,13 @@ test incr-old-2.3 {incr errors} {
} 1
test incr-old-2.4 {incr errors} {
set x abc
- list [catch {incr x} msg] $msg $errorInfo
+ list [catch {incr x} msg] $msg $::errorInfo
} {1 {expected integer but got "abc"} {expected integer but got "abc"
while executing
"incr x"}}
test incr-old-2.5 {incr errors} {
set x 123
- list [catch {incr x 1a} msg] $msg $errorInfo
+ list [catch {incr x 1a} msg] $msg $::errorInfo
} {1 {expected integer but got "1a"} {expected integer but got "1a"
(reading increment)
invoked from within
@@ -66,7 +66,7 @@ test incr-old-2.6 {incr errors} -body {
proc readonly args {error "variable is read-only"}
set x 123
trace var x w readonly
- list [catch {incr x 1} msg] $msg $errorInfo
+ list [catch {incr x 1} msg] $msg $::errorInfo
} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
while executing
*
diff --git a/tests/incr.test b/tests/incr.test
index 9ac1443..9546db8 100644
--- a/tests/incr.test
+++ b/tests/incr.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: incr.test,v 1.13 2006/03/08 16:07:43 dgp Exp $
+# RCS: @(#) $Id: incr.test,v 1.14 2006/10/09 19:15:44 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -176,7 +176,7 @@ test incr-1.18 {TclCompileIncrCmd: increment given, simple int} {
test incr-1.19 {TclCompileIncrCmd: increment given, but erroneous} -body {
set i 5
catch {incr i [set]} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}
@@ -214,7 +214,7 @@ test incr-1.26 {TclCompileIncrCmd: runtime error, bad variable name} {
incr {"foo}
} 1
test incr-1.27 {TclCompileIncrCmd: runtime error, bad variable name} -body {
- list [catch {incr [set]} msg] $msg $errorInfo
+ list [catch {incr [set]} msg] $msg $::errorInfo
} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}}
@@ -222,7 +222,7 @@ test incr-1.28 {TclCompileIncrCmd: runtime error, readonly variable} -body {
proc readonly args {error "variable is read-only"}
set x 123
trace var x w readonly
- list [catch {incr x 1} msg] $msg $errorInfo
+ list [catch {incr x 1} msg] $msg $::errorInfo
} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
while executing
*
@@ -423,7 +423,7 @@ test incr-2.19 {incr command (not compiled): increment given, but erroneous} -bo
set z incr
set i 5
catch {$z i [set]} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}
@@ -469,7 +469,7 @@ test incr-2.26 {incr command (not compiled): runtime error, bad variable name} {
} 1
test incr-2.27 {incr command (not compiled): runtime error, bad variable name} -body {
set z incr
- list [catch {$z [set]} msg] $msg $errorInfo
+ list [catch {$z [set]} msg] $msg $::errorInfo
} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}}
@@ -478,7 +478,7 @@ test incr-2.28 {incr command (not compiled): runtime error, readonly variable} -
proc readonly args {error "variable is read-only"}
set x 123
trace var x w readonly
- list [catch {$z x 1} msg] $msg $errorInfo
+ list [catch {$z x 1} msg] $msg $::errorInfo
} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
while executing
*
@@ -492,13 +492,13 @@ test incr-2.29 {incr command (not compiled): runtime error, bad variable value}
test incr-2.30 {incr command (not compiled): bad increment} {
set z incr
set x 0
- list [catch {$z x 1a} msg] $msg $errorInfo
+ list [catch {$z x 1a} msg] $msg $::errorInfo
} {1 {expected integer but got "1a"} {expected integer but got "1a"
(reading increment)
invoked from within
"$z x 1a"}}
test incr-2.31 {incr command (compiled): bad increment} {
- list [catch {incr x 1a} msg] $msg $errorInfo
+ list [catch {incr x 1a} msg] $msg $::errorInfo
} {1 {expected integer but got "1a"} {expected integer but got "1a"
(reading increment)
invoked from within
diff --git a/tests/interp.test b/tests/interp.test
index 94657e2..07e758e 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.48 2006/01/18 19:48:11 dgp Exp $
+# RCS: @(#) $Id: interp.test,v 1.49 2006/10/09 19:15:44 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -2065,7 +2065,7 @@ test interp-26.7 {errorInfo transmission: regular interps} {
MyError "some secret"
}
interp alias $interp test {} MyTestAlias $interp;
- set res [interp eval $interp {catch test;set errorInfo}]
+ set res [interp eval $interp {catch test;set ::errorInfo}]
interp delete $interp;
set res
} {msg
@@ -2088,7 +2088,7 @@ test interp-26.8 {errorInfo transmission: safe interps--bug 1637} {knownBug} {
MyError "some secret"
}
interp alias $interp test {} MyTestAlias $interp;
- set res [interp eval $interp {catch test;set errorInfo}]
+ set res [interp eval $interp {catch test;set ::errorInfo}]
interp delete $interp;
set res
} {msg
diff --git a/tests/io.test b/tests/io.test
index a25f3c3..f1f816d 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.71 2006/03/21 11:12:29 dkf Exp $
+# RCS: @(#) $Id: io.test,v 1.72 2006/10/09 19:15:45 msofer Exp $
if {[catch {package require tcltest 2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2 required."
@@ -2539,11 +2539,11 @@ test io-29.27 {Tcl_Flush on closed pipeline} {stdio openpipe} {
# you disable the debugger's signal interception.
#
if {[catch {flush $f} msg]} {
- set x [list 1 $msg $errorCode]
+ set x [list 1 $msg $::errorCode]
catch {close $f}
} else {
if {[catch {close $f} msg]} {
- set x [list 1 $msg $errorCode]
+ set x [list 1 $msg $::errorCode]
} else {
set x {this was supposed to fail and did not}
}
@@ -5278,15 +5278,15 @@ test io-40.15 {POSIX open access modes: RDWR} {
test io-40.16 {tilde substitution in open} -constraints makeFileInHome -setup {
makeFile {Some text} _test_ ~
} -body {
- file exists [file join $env(HOME) _test_]
+ file exists [file join $::env(HOME) _test_]
} -cleanup {
removeFile _test_ ~
} -result 1
test io-40.17 {tilde substitution in open} {
- set home $env(HOME)
- unset env(HOME)
+ set home $::env(HOME)
+ unset ::env(HOME)
set x [list [catch {open ~/foo} msg] $msg]
- set env(HOME) $home
+ set ::env(HOME) $home
set x
} {1 {couldn't find HOME environment variable to expand path}}
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index ed09720..cbe653e 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.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: ioCmd.test,v 1.28 2006/03/16 18:23:00 andreas_kupries Exp $
+# RCS: @(#) $Id: ioCmd.test,v 1.29 2006/10/09 19:15:45 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -117,7 +117,7 @@ test iocmd-4.4 {read command} {
list [catch {read -nonewline} msg] $msg
} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"}}
test iocmd-4.5 {read command} {
- list [catch {read -nonew file4} msg] $msg $errorCode
+ list [catch {read -nonew file4} msg] $msg $::errorCode
} {1 {can not find channel named "-nonew"} NONE}
test iocmd-4.6 {read command} {
list [catch {read stdout} msg] $msg
@@ -132,29 +132,29 @@ test iocmd-4.8 {read command with incorrect combination of arguments} {
puts $f "and this one"
close $f
set f [open $path(test1)]
- set x [list [catch {read -nonewline $f 20 z} msg] $msg $errorCode]
+ set x [list [catch {read -nonewline $f 20 z} msg] $msg $::errorCode]
close $f
set x
} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"} NONE}
test iocmd-4.9 {read command} {
- list [catch {read stdin foo} msg] $msg $errorCode
+ list [catch {read stdin foo} msg] $msg $::errorCode
} {1 {bad argument "foo": should be "nonewline"} NONE}
test iocmd-4.10 {read command} {
- list [catch {read file107} msg] $msg $errorCode
+ list [catch {read file107} msg] $msg $::errorCode
} {1 {can not find channel named "file107"} NONE}
set path(test3) [makeFile {} test3]
test iocmd-4.11 {read command} {
set f [open $path(test3) w]
- set x [list [catch {read $f} msg] $msg $errorCode]
+ set x [list [catch {read $f} msg] $msg $::errorCode]
close $f
string compare [string tolower $x] \
[list 1 [format "channel \"%s\" wasn't opened for reading" $f] none]
} 0
test iocmd-4.12 {read command} {
set f [open $path(test1)]
- set x [list [catch {read $f 12z} msg] $msg $errorCode]
+ set x [list [catch {read $f 12z} msg] $msg $::errorCode]
close $f
set x
} {1 {expected integer but got "12z"} NONE}
@@ -343,14 +343,14 @@ test iocmd-8.19 {fconfigure command / win tty channel} -constraints {nonPortable
# open channel to work with).
test iocmd-9.1 {eof command} {
- list [catch {eof} msg] $msg $errorCode
+ list [catch {eof} msg] $msg $::errorCode
} {1 {wrong # args: should be "eof channelId"} NONE}
test iocmd-9.2 {eof command} {
- list [catch {eof a b} msg] $msg $errorCode
+ list [catch {eof a b} msg] $msg $::errorCode
} {1 {wrong # args: should be "eof channelId"} NONE}
test iocmd-9.3 {eof command} {
catch {close file100}
- list [catch {eof file100} msg] $msg $errorCode
+ list [catch {eof file100} msg] $msg $::errorCode
} {1 {can not find channel named "file100"} NONE}
# The tests for Tcl_ExecObjCmd are in exec.test
@@ -378,13 +378,13 @@ file delete $path(test5)
test iocmd-11.1 {I/O to command pipelines} {unixOrPc unixExecs} {
set f [open $path(test4) w]
close $f
- list [catch {open "| cat < $path(test4) > $path(test5)" w} msg] $msg $errorCode
+ list [catch {open "| cat < $path(test4) > $path(test5)" w} msg] $msg $::errorCode
} {1 {can't write input to command: standard input was redirected} NONE}
test iocmd-11.2 {I/O to command pipelines} {unixOrPc unixExecs} {
- list [catch {open "| echo > $path(test5)" r} msg] $msg $errorCode
+ list [catch {open "| echo > $path(test5)" r} msg] $msg $::errorCode
} {1 {can't read output from command: standard output was redirected} NONE}
test iocmd-11.3 {I/O to command pipelines} {unixOrPc unixExecs} {
- list [catch {open "| echo > $path(test5)" r+} msg] $msg $errorCode
+ list [catch {open "| echo > $path(test5)" r+} msg] $msg $::errorCode
} {1 {can't read output from command: standard output was redirected} NONE}
test iocmd-12.1 {POSIX open access modes: RDONLY} {
@@ -434,7 +434,7 @@ test iocmd-12.5 {POSIX open access modes: RDWR} -match regexp -body {
open $path(test3) RDWR
} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
test iocmd-12.6 {POSIX open access modes: errors} {
- concat [catch {open $path(test3) "FOO \{BAR BAZ"} msg] $msg\n$errorInfo
+ concat [catch {open $path(test3) "FOO \{BAR BAZ"} msg] $msg\n$::errorInfo
} "1 unmatched open brace in list
unmatched open brace in list
while processing open access modes \"FOO {BAR BAZ\"
@@ -489,7 +489,7 @@ test iocmd-13.5 {errors in open command} {
list [catch {open $path(test1) r+1} msg] $msg
} {1 {illegal access mode "r+1"}}
test iocmd-13.6 {errors in open command} {
- set msg [list [catch {open _non_existent_} msg] $msg $errorCode]
+ set msg [list [catch {open _non_existent_} msg] $msg $::errorCode]
regsub [file join {} _non_existent_] $msg "_non_existent_" msg
string tolower $msg
} {1 {couldn't open "_non_existent_": no such file or directory} {posix enoent {no such file or directory}}}
@@ -536,7 +536,7 @@ test iocmd-13.10.2 {open for append, O_APPEND} -setup {
} -result {0 1 2 3 4 5 6 7 8 9}
test iocmd-14.1 {file id parsing errors} {
- list [catch {eof gorp} msg] $msg $errorCode
+ list [catch {eof gorp} msg] $msg $::errorCode
} {1 {can not find channel named "gorp"} NONE}
test iocmd-14.2 {file id parsing errors} {
list [catch {eof filex} msg] $msg
diff --git a/tests/load.test b/tests/load.test
index 6ef2f53..acdb025 100644
--- a/tests/load.test
+++ b/tests/load.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: load.test,v 1.15 2006/03/21 11:12:29 dkf Exp $
+# RCS: @(#) $Id: load.test,v 1.16 2006/10/09 19:15:45 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -81,7 +81,7 @@ test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] {
test load-3.1 {error in _Init procedure, same interpreter} \
[list $dll $loaded] {
list [catch {load [file join $testDir pkge$ext] pkge} msg] \
- $msg $errorInfo $errorCode
+ $msg $::errorInfo $::errorCode
} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
while executing
"open non_existent"
@@ -93,10 +93,10 @@ test load-3.2 {error in _Init procedure, slave interpreter} \
[list $dll $loaded] {
catch {interp delete x}
interp create x
- set errorCode foo
- set errorInfo bar
+ set ::errorCode foo
+ set ::errorInfo bar
set result [list [catch {load [file join $testDir pkge$ext] pkge x} msg] \
- $msg $errorInfo $errorCode]
+ $msg $::errorInfo $::errorCode]
interp delete x
set result
} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
diff --git a/tests/misc.test b/tests/misc.test
index c82944b..7015c52 100644
--- a/tests/misc.test
+++ b/tests/misc.test
@@ -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: misc.test,v 1.10 2004/09/22 22:23:40 dgp Exp $
+# RCS: @(#) $Id: misc.test,v 1.11 2006/10/09 19:15:45 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -53,7 +53,7 @@ test misc-1.2 {error in variable ref. in command in array reference} {
# this is a bogus comment
"
set msg {}
- join [list [catch tstProc msg] $msg $errorInfo] \n
+ join [list [catch tstProc msg] $msg $::errorInfo] \n
} [subst -novariables -nocommands {1
missing close-brace for variable name
missing close-brace for variable name
diff --git a/tests/namespace.test b/tests/namespace.test
index 00f5243..25bdb6f 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.56 2006/02/28 15:47:10 dgp Exp $
+# RCS: @(#) $Id: namespace.test,v 1.57 2006/10/09 19:15:45 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -1008,7 +1008,7 @@ test namespace-25.5 {NamespaceEvalCmd, multiple args} {
namespace eval test_ns_1 "set" "v"
} {314159}
test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} {
- list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $errorInfo
+ list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $::errorInfo
} {1 {invalid command name "xxxx"} {invalid command name "xxxx"
while executing
"xxxx"
@@ -1016,13 +1016,13 @@ test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} {
invoked from within
"namespace eval test_ns_1 {xxxx}"}}
test namespace-25.7 {NamespaceEvalCmd, error in eval'd script} {
- list [catch {namespace eval test_ns_1 {error foo bar baz}} msg] $msg $errorInfo
+ list [catch {namespace eval test_ns_1 {error foo bar baz}} msg] $msg $::errorInfo
} {1 foo {bar
(in namespace eval "::test_ns_1" script line 1)
invoked from within
"namespace eval test_ns_1 {error foo bar baz}"}}
test namespace-25.8 {NamespaceEvalCmd, error in eval'd script} {
- list [catch {namespace eval test_ns_1 error foo bar baz} msg] $msg $errorInfo
+ list [catch {namespace eval test_ns_1 error foo bar baz} msg] $msg $::errorInfo
} {1 foo {bar
(in namespace eval "::test_ns_1" script line 1)
invoked from within
@@ -1824,7 +1824,7 @@ test namespace-47.2 {ensemble: unknown handler} {
}
namespace ensemble create -unknown ::ns::Magic
}
- list [catch {ns spong} msg] $msg $errorInfo [namespace delete ns]
+ list [catch {ns spong} msg] $msg $::errorInfo [namespace delete ns]
} {1 foobar {foobar
while executing
"error foobar"
@@ -1857,7 +1857,7 @@ test namespace-47.4 {ensemble: unknown handler} {
}
namespace ensemble create -unknown ::ns::Magic
}
- list [catch {ns spong} msg] $msg $errorInfo [namespace delete ns]
+ list [catch {ns spong} msg] $msg $::errorInfo [namespace delete ns]
} {1 {unknown subcommand handler returned bad code: break} {unknown subcommand handler returned bad code: break
result of ensemble unknown subcommand handler: ::ns::Magic ::ns spong
invoked from within
@@ -1882,7 +1882,7 @@ test namespace-47.6 {ensemble: unknown handler} {
proc bar {args} {
return "\{"
}
- set result [list [catch {foo bar} msg] $msg $errorInfo]
+ set result [list [catch {foo bar} msg] $msg $::errorInfo]
rename foo {}
set result
} {1 {unmatched open brace in list} {unmatched open brace in list
diff --git a/tests/parse.test b/tests/parse.test
index 8989033..7ab0f01 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.24 2006/03/21 11:12:29 dkf Exp $
+# RCS: @(#) $Id: parse.test,v 1.25 2006/10/09 19:15:45 msofer Exp $
if {[catch {package require tcltest 2.0.2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
@@ -90,7 +90,7 @@ test parse-3.6 {Tcl_ParseCommand procedure, words in braces} testparser {
testparser {foo {a $b [concat foo]} {c d}} 0
} {- {foo {a $b [concat foo]} {c d}} 3 simple foo 1 text foo 0 simple {{a $b [concat foo]}} 1 text {a $b [concat foo]} 0 simple {{c d}} 1 text {c d} 0 {}}
test parse-3.7 {Tcl_ParseCommand procedure, error in unquoted word} testparser {
- list [catch {testparser "foo \$\{abc" 0} msg] $msg $errorInfo
+ list [catch {testparser "foo \$\{abc" 0} msg] $msg $::errorInfo
} {1 {missing close-brace for variable name} missing\ close-brace\ for\ variable\ name\n\ \ \ \ (remainder\ of\ script:\ \"\{abc\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"foo\ \\\$\\\{abc\"\ 0\"}
test parse-4.1 {Tcl_ParseCommand procedure, simple words} testparser {
@@ -129,7 +129,7 @@ test parse-5.5 {Tcl_ParseCommand procedure, word terminator is end of string} te
testparser "\"foo\" bar" 5
} {- {"foo"} 1 simple {"foo"} 1 text foo 0 { bar}}
test parse-5.6 {Tcl_ParseCommand procedure, junk after close quote} testparser {
- list [catch {testparser {foo "bar"x} 0} msg] $msg $errorInfo
+ list [catch {testparser {foo "bar"x} 0} msg] $msg $::errorInfo
} {1 {extra characters after close-quote} {extra characters after close-quote
(remainder of script: "x")
invoked from within
@@ -138,7 +138,7 @@ test parse-5.7 {Tcl_ParseCommand procedure, backslash-newline after close quote}
testparser "foo \"bar\"\\\nx" 0
} {- foo\ \"bar\"\\\nx 3 simple foo 1 text foo 0 simple {"bar"} 1 text bar 0 simple x 1 text x 0 {}}
test parse-5.8 {Tcl_ParseCommand procedure, junk after close brace} testparser {
- list [catch {testparser {foo {bar}x} 0} msg] $msg $errorInfo
+ list [catch {testparser {foo {bar}x} 0} msg] $msg $::errorInfo
} {1 {extra characters after close-brace} {extra characters after close-brace
(remainder of script: "x")
invoked from within
@@ -148,7 +148,7 @@ test parse-5.9 {Tcl_ParseCommand procedure, backslash-newline after close brace}
} {- foo\ \{bar\}\\\nx 3 simple foo 1 text foo 0 simple {{bar}} 1 text bar 0 simple x 1 text x 0 {}}
test parse-5.10 {Tcl_ParseCommand procedure, multiple deletion of non-static buffer} testparser {
# This test is designed to catch bug 1681.
- list [catch {testparser "a \"\\1\\2\\3\\4\\5\\6\\7\\8\\9\\1\\2\\3\\4\\5\\6\\7\\8" 0} msg] $msg $errorInfo
+ list [catch {testparser "a \"\\1\\2\\3\\4\\5\\6\\7\\8\\9\\1\\2\\3\\4\\5\\6\\7\\8" 0} msg] $msg $::errorInfo
} "1 {missing \"} {missing \"
(remainder of script: \"\"\\1\\2\\3\\4\\5\\6\\7\\8\\9\\1\\2\\3\\4\\5\\6\\7\\8\")
invoked from within
@@ -243,7 +243,7 @@ test parse-6.6 {ParseTokens procedure, command substitution} testparser {
testparser {[foo \] [a b]]} 0
} {- {[foo \] [a b]]} 1 word {[foo \] [a b]]} 1 command {[foo \] [a b]]} 0 {}}
test parse-6.7 {ParseTokens procedure, error in command substitution} testparser {
- list [catch {testparser {a [b {}c d] e} 0} msg] $msg $errorInfo
+ list [catch {testparser {a [b {}c d] e} 0} msg] $msg $::errorInfo
} {1 {extra characters after close-brace} {extra characters after close-brace
(remainder of script: "c d] e")
invoked from within
@@ -263,13 +263,13 @@ test parse-6.11 {ParseTokens procedure, memory allocation for big nested command
testparser {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 0
} {- {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 1 word {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 1 command {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 0 {}}
test parse-6.12 {ParseTokens procedure, missing close bracket} testparser {
- list [catch {testparser {[foo $x bar} 0} msg] $msg $errorInfo
+ list [catch {testparser {[foo $x bar} 0} msg] $msg $::errorInfo
} {1 {missing close-bracket} {missing close-bracket
(remainder of script: "[foo $x bar")
invoked from within
"testparser {[foo $x bar} 0"}}
test parse-6.13 {ParseTokens procedure, backslash-newline without continuation line} testparser {
- list [catch {testparser "\"a b\\\n" 0} msg] $msg $errorInfo
+ list [catch {testparser "\"a b\\\n" 0} msg] $msg $::errorInfo
} {1 {missing "} missing\ \"\n\ \ \ \ (remainder\ of\ script:\ \"\"a\ b\\\n\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"\\\"a\ b\\\\\\n\"\ 0\"}
test parse-6.14 {ParseTokens procedure, backslash-newline} testparser {
testparser "b\\\nc" 0
@@ -425,7 +425,7 @@ test parse-9.1 {Tcl_LogCommandInfo, line numbers} testevalex {
# asdf
set x
- }}}] $errorInfo
+ }}}] $::errorInfo
} {1 {can't read "x": no such variable
while executing
"set x"
@@ -445,7 +445,7 @@ test parse-9.1 {Tcl_LogCommandInfo, line numbers} testevalex {
set x
}}"}}
test parse-9.2 {Tcl_LogCommandInfo, truncating long commands} {
- list [catch {set a b 111111111 222222222 333333333 444444444 555555555 666666666 777777777 888888888 999999999 000000000 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd eeeeeeeee fffffffff ggggggggg}] $errorInfo
+ list [catch {set a b 111111111 222222222 333333333 444444444 555555555 666666666 777777777 888888888 999999999 000000000 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd eeeeeeeee fffffffff ggggggggg}] $::errorInfo
} {1 {wrong # args: should be "set varName ?newValue?"
while executing
"set a b 111111111 222222222 333333333 444444444 555555555 666666666 777777777 888888888 999999999 000000000 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd ee..."}}
@@ -580,7 +580,7 @@ test parse-12.7 {Tcl_ParseVarName procedure, braced variable name} testparser {
testparser "\$\{\{\} " 0
} {- \$\{\{\}\ 1 word \$\{\{\} 2 variable \$\{\{\} 1 text \{ 0 {}}
test parse-12.8 {Tcl_ParseVarName procedure, missing close brace} testparser {
- list [catch {testparser "$\{abc" 0} msg] $msg $errorInfo
+ list [catch {testparser "$\{abc" 0} msg] $msg $::errorInfo
} {1 {missing close-brace for variable name} missing\ close-brace\ for\ variable\ name\n\ \ \ \ (remainder\ of\ script:\ \"\{abc\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"\$\\\{abc\"\ 0\"}
test parse-12.9 {Tcl_ParseVarName procedure, missing close brace} testparsevarname {
list [catch {testparsevarname {${bcd}} 4 0} msg] $msg
@@ -625,13 +625,13 @@ test parse-12.22 {Tcl_ParseVarName procedure, array reference} testparser {
testparser {$x([cmd arg]zz)} 0
} {- {$x([cmd arg]zz)} 1 word {$x([cmd arg]zz)} 4 variable {$x([cmd arg]zz)} 3 text x 0 command {[cmd arg]} 0 text zz 0 {}}
test parse-12.23 {Tcl_ParseVarName procedure, missing close paren in array reference} testparser {
- list [catch {testparser {$x(poiu} 0} msg] $msg $errorInfo
+ list [catch {testparser {$x(poiu} 0} msg] $msg $::errorInfo
} {1 {missing )} {missing )
(remainder of script: "(poiu")
invoked from within
"testparser {$x(poiu} 0"}}
test parse-12.24 {Tcl_ParseVarName procedure, missing close paren in array reference} testparsevarname {
- list [catch {testparsevarname {$ab(cd)} 6 0} msg] $msg $errorInfo
+ list [catch {testparsevarname {$ab(cd)} 6 0} msg] $msg $::errorInfo
} {1 {missing )} {missing )
(remainder of script: "(cd)")
invoked from within
@@ -678,7 +678,7 @@ test parse-14.6 {Tcl_ParseBraces procedure, backslashes in words in braces} test
testparser "foo {a \\n\\\{}" 0
} {- {foo {a \n\{}} 2 simple foo 1 text foo 0 simple {{a \n\{}} 1 text {a \n\{} 0 {}}
test parse-14.7 {Tcl_ParseBraces procedure, missing continuation line in braces} testparser {
- list [catch {testparser "\{abc\\\n" 0} msg] $msg $errorInfo
+ list [catch {testparser "\{abc\\\n" 0} msg] $msg $::errorInfo
} {1 {missing close-brace} missing\ close-brace\n\ \ \ \ (remainder\ of\ script:\ \"\{abc\\\n\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"\\\{abc\\\\\\n\"\ 0\"}
test parse-14.8 {Tcl_ParseBraces procedure, backslash-newline in braces} testparser {
testparser "foo {\\\nx}" 0
@@ -693,7 +693,7 @@ test parse-14.11 {Tcl_ParseBraces procedure, empty braced string} testparser {
testparser {foo {}} 0
} {- {foo {}} 2 simple foo 1 text foo 0 simple {{}} 1 text {} 0 {}}
test parse-14.12 {Tcl_ParseBraces procedure, missing close brace} testparser {
- list [catch {testparser "foo \{xy\\\nz" 0} msg] $msg $errorInfo
+ list [catch {testparser "foo \{xy\\\nz" 0} msg] $msg $::errorInfo
} {1 {missing close-brace} missing\ close-brace\n\ \ \ \ (remainder\ of\ script:\ \"\{xy\\\nz\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"foo\ \\\{xy\\\\\\nz\"\ 0\"}
test parse-15.1 {Tcl_ParseQuotedString procedure, computing string length} testparser {
@@ -706,7 +706,7 @@ test parse-15.3 {Tcl_ParseQuotedString procedure, word is quoted string} testpar
testparser {foo "a b c" d "efg";} 0
} {- {foo "a b c" d "efg";} 4 simple foo 1 text foo 0 simple {"a b c"} 1 text {a b c} 0 simple d 1 text d 0 simple {"efg"} 1 text efg 0 {}}
test parse-15.4 {Tcl_ParseQuotedString procedure, garbage after quoted string} testparser {
- list [catch {testparser {foo "a b c"d} 0} msg] $msg $errorInfo
+ list [catch {testparser {foo "a b c"d} 0} msg] $msg $::errorInfo
} {1 {extra characters after close-quote} {extra characters after close-quote
(remainder of script: "d")
invoked from within
diff --git a/tests/parseOld.test b/tests/parseOld.test
index 12317e1..9cc90fe 100644
--- a/tests/parseOld.test
+++ b/tests/parseOld.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: parseOld.test,v 1.13 2006/03/21 11:12:29 dkf Exp $
+# RCS: @(#) $Id: parseOld.test,v 1.14 2006/10/09 19:15:45 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -352,7 +352,7 @@ test parseOld-10.13 {syntax errors} {
# since MetroWerks may some day fix this.
test parseOld-10.14 {syntax errors} {
- list [catch {eval \$x[format "%01000d" 0](} msg] $msg $errorInfo
+ list [catch {eval \$x[format "%01000d" 0](} msg] $msg $::errorInfo
} {1 {missing )} {missing )
while executing
"$x0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000..."
diff --git a/tests/pkg.test b/tests/pkg.test
index f64c18b..520f50a 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.20 2006/10/04 18:05:23 dgp Exp $
+# RCS: @(#) $Id: pkg.test,v 1.21 2006/10/09 19:15:45 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -151,7 +151,7 @@ test pkg-2.9 {Tcl_PkgRequire procedure, can't find suitable version} {
test pkg-2.10 {Tcl_PkgRequire procedure, error in ifneeded script} -body {
package forget t
package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test"}
- list [catch {package require t 2.1} msg] $msg $errorInfo
+ list [catch {package require t 2.1} msg] $msg $::errorInfo
} -match glob -result {1 {ifneeded test} {ifneeded test
while executing
"error "ifneeded test""
@@ -219,7 +219,7 @@ test pkg-2.16 {Tcl_PkgRequire procedure, "package unknown" error} {
}
package forget t
package unknown pkgUnknown
- set result [list [catch {package require t} msg] $msg $errorInfo]
+ set result [list [catch {package require t} msg] $msg $::errorInfo]
package unknown {}
set result
} {1 {testing package unknown} {testing package unknown
@@ -284,7 +284,7 @@ test pkg-2.24 {Tcl_PkgRequire procedure, version checks} {
test pkg-2.25 {Tcl_PkgRequire procedure, error in ifneeded script} -body {
package forget t
package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test" EI}
- list [catch {package require t 2.1} msg] $msg $errorInfo
+ list [catch {package require t 2.1} msg] $msg $::errorInfo
} -match glob -result {1 {ifneeded test} {EI
("package ifneeded*" script)
invoked from within
@@ -292,7 +292,7 @@ test pkg-2.25 {Tcl_PkgRequire procedure, error in ifneeded script} -body {
test pkg-2.26 {Tcl_PkgRequire procedure, error in ifneeded script} -body {
package forget t
package ifneeded t 2.1 {package provide t 2.1; foreach x 1 {error "ifneeded test" EI}}
- list [catch {package require t 2.1} msg] $msg $errorInfo
+ list [catch {package require t 2.1} msg] $msg $::errorInfo
} -match glob -result {1 {ifneeded test} {EI
("foreach" body line 1)
invoked from within
diff --git a/tests/proc-old.test b/tests/proc-old.test
index fe33ef4..7e2a067 100644
--- a/tests/proc-old.test
+++ b/tests/proc-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: proc-old.test,v 1.14 2006/02/01 19:26:02 dgp Exp $
+# RCS: @(#) $Id: proc-old.test,v 1.15 2006/10/09 19:15:45 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -316,7 +316,7 @@ test proc-old-5.13 {error conditions} {
return
}
catch tproc msg
- set errorInfo
+ set ::errorInfo
} {error in procedure
while executing
"error "error in procedure""
@@ -330,7 +330,7 @@ test proc-old-5.14 {error conditions} {
return
}
catch tproc msg
- set errorInfo
+ set ::errorInfo
} {invoked "break" outside of a loop
(procedure "tproc" line 1)
invoked from within
@@ -342,7 +342,7 @@ test proc-old-5.15 {error conditions} {
return
}
catch tproc msg
- set errorInfo
+ set ::errorInfo
} {invoked "continue" outside of a loop
(procedure "tproc" line 1)
invoked from within
@@ -360,7 +360,7 @@ test proc-old-5.16 {error conditions} {
}
}
set fooMsg "foo not called"
- list [catch tproc msg] $msg $errorInfo $fooMsg
+ list [catch tproc msg] $msg $::errorInfo $fooMsg
} {1 {Nested error} {Nested error
while executing
"error "Nested error""
@@ -395,7 +395,7 @@ test proc-old-7.1 {return with special completion code} {
list [catch {tproc ok} msg] $msg
} {0 abc}
test proc-old-7.2 {return with special completion code} {
- list [catch {tproc error} msg] $msg $errorInfo $errorCode
+ list [catch {tproc error} msg] $msg $::errorInfo $::errorCode
} {1 abc {abc
while executing
"tproc error"} NONE}
@@ -435,7 +435,7 @@ test proc-old-7.11 {return with special completion code} {
catch {open _bad_file_name r} msg
return -code error -errorinfo $errorInfo -errorcode $errorCode $msg
}
- set msg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+ set msg [list [catch tproc2 msg] $msg $::errorInfo $::errorCode]
regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg
normalizeMsg $msg
} {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
@@ -449,7 +449,7 @@ test proc-old-7.12 {return with special completion code} {
catch {open _bad_file_name r} msg
return -code error -errorcode $errorCode $msg
}
- set msg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+ set msg [list [catch tproc2 msg] $msg $::errorInfo $::errorCode]
regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg
normalizeMsg $msg
} {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
@@ -461,7 +461,7 @@ test proc-old-7.13 {return with special completion code} {
catch {open _bad_file_name r} msg
return -code error -errorinfo $errorInfo $msg
}
- set msg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+ set msg [list [catch tproc2 msg] $msg $::errorInfo $::errorCode]
regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg
normalizeMsg $msg
} {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
@@ -475,7 +475,7 @@ test proc-old-7.14 {return with special completion code} {
catch {open _bad_file_name r} msg
return -code error $msg
}
- set msg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+ set msg [list [catch tproc2 msg] $msg $::errorInfo $::errorCode]
regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg
normalizeMsg $msg
} {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
diff --git a/tests/set.test b/tests/set.test
index 2a0dc61..f57eb50 100644
--- a/tests/set.test
+++ b/tests/set.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: set.test,v 1.10 2006/02/09 17:34:42 dgp Exp $
+# RCS: @(#) $Id: set.test,v 1.11 2006/10/09 19:15:45 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -234,7 +234,7 @@ test set-1.26 {TclCompileSetCmd: various array constructs} {
test set-2.1 {set command: runtime error, bad variable name} {
unset -nocomplain {"foo}
- list [catch {set {"foo}} msg] $msg $errorInfo
+ list [catch {set {"foo}} msg] $msg $::errorInfo
} {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
while executing
"set {"foo}"}}
@@ -252,7 +252,7 @@ test set-2.4 {set command: runtime error, readonly variable} -body {
proc readonly args {error "variable is read-only"}
set x 123
trace var x w readonly
- list [catch {set x 1} msg] $msg $errorInfo
+ list [catch {set x 1} msg] $msg $::errorInfo
} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
while executing
*
@@ -479,7 +479,7 @@ test set-3.24 {uncompiled set command: too many arguments} {
test set-4.1 {uncompiled set command: runtime error, bad variable name} {
unset -nocomplain {"foo}
set z set
- list [catch {$z {"foo}} msg] $msg $errorInfo
+ list [catch {$z {"foo}} msg] $msg $::errorInfo
} {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
while executing
"$z {"foo}"}}
@@ -500,7 +500,7 @@ test set-4.4 {uncompiled set command: runtime error, readonly variable} -body {
proc readonly args {error "variable is read-only"}
$z x 123
trace var x w readonly
- list [catch {$z x 1} msg] $msg $errorInfo
+ list [catch {$z x 1} msg] $msg $::errorInfo
} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
while executing
*
diff --git a/tests/switch.test b/tests/switch.test
index f611888..830f400 100644
--- a/tests/switch.test
+++ b/tests/switch.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: switch.test,v 1.15 2005/12/02 17:34:03 dgp Exp $
+# RCS: @(#) $Id: switch.test,v 1.16 2006/10/09 19:15:45 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -169,7 +169,7 @@ test switch-3.18 {-exact vs. -glob vs. -regexp} {
test switch-4.1 {error in executed command} {
list [catch {switch a a {error "Just a test"} default {format 1}} msg] \
- $msg $errorInfo
+ $msg $::errorInfo
} {1 {Just a test} {Just a test
while executing
"error "Just a test""
@@ -187,7 +187,7 @@ test switch-4.4 {error: pattern with no body} {
} {1 {extra switch pattern with no body}}
test switch-4.5 {error in default command} {
list [catch {switch foo a {error switch1} b {error switch 3} \
- default {error switch2}} msg] $msg $errorInfo
+ default {error switch2}} msg] $msg $::errorInfo
} {1 switch2 {switch2
while executing
"error switch2"
diff --git a/tests/tcltest.test b/tests/tcltest.test
index 7515a80..421a777 100755
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -6,7 +6,7 @@
# Copyright (c) 2000 by Ajuba Solutions
# All rights reserved.
#
-# RCS: @(#) $Id: tcltest.test,v 1.53 2006/03/18 18:15:13 vincentdarley Exp $
+# RCS: @(#) $Id: tcltest.test,v 1.54 2006/10/09 19:15:45 msofer Exp $
# Note that there are several places where the value of
# tcltest::currentFailure is stored/reset in the -setup/-cleanup
@@ -439,7 +439,7 @@ test tcltest-6.7 {tcltest::outputChannel - retrieval} {
}
-result {stdout}
-cleanup {
- set tcltest::outputChannel $of
+ set ::tcltest::outputChannel $of
}
}
@@ -551,7 +551,7 @@ set notWriteableDir [file join [temporaryDirectory] notwriteable]
makeDirectory notreadable
makeDirectory notwriteable
-switch -- $tcl_platform(platform) {
+switch -- $::tcl_platform(platform) {
"unix" {
file attributes $notReadableDir -permissions 00333
file attributes $notWriteableDir -permissions 00555
@@ -684,7 +684,7 @@ test tcltest-8.60 {::workingDirectory} {
# clean up from directory testing
-switch $tcl_platform(platform) {
+switch $::tcl_platform(platform) {
"unix" {
file attributes $notReadableDir -permissions 777
file attributes $notWriteableDir -permissions 777
@@ -1759,7 +1759,7 @@ test tcltest-25.3 {
test tcltest-26.1 {Bug/RFE 1017151} -setup {
makeFile {
package require tcltest
- set errorInfo "Should never see this"
+ set ::errorInfo "Should never see this"
tcltest::test tcltest-26.1.0 {
no errorInfo when only return code mismatch
} -body {
@@ -1779,7 +1779,7 @@ test tcltest-26.1 {Bug/RFE 1017151} -setup {
test tcltest-26.2 {Bug/RFE 1017151} -setup {
makeFile {
package require tcltest
- set errorInfo "Should never see this"
+ set ::errorInfo "Should never see this"
tcltest::test tcltest-26.2.0 {do not mask body errorInfo} -body {
error "body error"
} -cleanup {
diff --git a/tests/thread.test b/tests/thread.test
index 50c3360..1084f5c 100644
--- a/tests/thread.test
+++ b/tests/thread.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: thread.test,v 1.14 2004/10/25 20:24:14 dgp Exp $
+# RCS: @(#) $Id: thread.test,v 1.15 2006/10/09 19:15:45 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -185,7 +185,7 @@ test thread-4.3 {TclThreadSend preserve errorInfo} {testthread} {
set serverthread [testthread create]
set x [catch {testthread send $serverthread {set undef}} msg]
threadReap
- list $len $x $msg $errorInfo
+ list $len $x $msg $::errorInfo
} {1 1 {can't read "undef": no such variable} {can't read "undef": no such variable
while executing
"set undef"
@@ -195,9 +195,9 @@ test thread-4.4 {TclThreadSend preserve code} {testthread} {
threadReap
set len [llength [testthread names]]
set serverthread [testthread create]
- set x [catch {testthread send $serverthread {set errorInfo {}; break}} msg]
+ set x [catch {testthread send $serverthread {set ::errorInfo {}; break}} msg]
threadReap
- list $len $x $msg $errorInfo
+ list $len $x $msg $::errorInfo
} {1 3 {} {}}
test thread-4.5 {TclThreadSend preserve errorCode} {testthread} {
threadReap
@@ -205,7 +205,7 @@ test thread-4.5 {TclThreadSend preserve errorCode} {testthread} {
set serverthread [testthread create]
set x [catch {testthread send $serverthread {error ERR INFO CODE}} msg]
threadReap
- list $x $msg $errorCode
+ list $x $msg $::errorCode
} {1 ERR CODE}
diff --git a/tests/var.test b/tests/var.test
index df9d553..b3fc475 100644
--- a/tests/var.test
+++ b/tests/var.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: var.test,v 1.26 2004/09/30 23:06:49 dgp Exp $
+# RCS: @(#) $Id: var.test,v 1.27 2006/10/09 19:15:45 msofer Exp $
#
if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -696,10 +696,10 @@ test var-15.1 {segfault in [unset], [Bug 735335]} {
test var-16.1 {CallVarTraces: save/restore interp error state} {
- trace add variable errorCode write { ;#}
+ trace add variable ::errorCode write { ;#}
catch {error foo bar baz}
- trace remove variable errorCode write { ;#}
- set errorInfo
+ trace remove variable ::errorCode write { ;#}
+ set ::errorInfo
} bar
catch {namespace delete ns}
diff --git a/tests/while-old.test b/tests/while-old.test
index a62bcb1..12e8537 100644
--- a/tests/while-old.test
+++ b/tests/while-old.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: while-old.test,v 1.7 2004/05/19 13:06:15 dkf Exp $
+# RCS: @(#) $Id: while-old.test,v 1.8 2006/10/09 19:15:45 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -103,7 +103,7 @@ test while-old-4.5 {errors in while loops} {
} {1 {expected boolean value but got "foo"}}
test while-old-4.6 {errors in while loops} {
set err [catch {while {1} {error "loop aborted"}} msg]
- list $err $msg $errorInfo
+ list $err $msg $::errorInfo
} {1 {loop aborted} {loop aborted
while executing
"error "loop aborted""}}
diff --git a/tests/while.test b/tests/while.test
index 562a2aa..5aadd10 100644
--- a/tests/while.test
+++ b/tests/while.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: while.test,v 1.12 2006/08/22 18:10:44 dgp Exp $
+# RCS: @(#) $Id: while.test,v 1.13 2006/10/09 19:15:45 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -29,7 +29,7 @@ test while-1.1 {TclCompileWhileCmd: missing test expression} {
test while-1.2 {TclCompileWhileCmd: error in test expression} -body {
set i 0
catch {while {$i<} break} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {*"while {$i<} break"}
test while-1.3 {TclCompileWhileCmd: error in test expression} {
set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
@@ -66,7 +66,7 @@ test while-1.7 {TclCompileWhileCmd: missing command body} {
test while-1.8 {TclCompileWhileCmd: error compiling command body} -body {
set i 0
catch {while {$i < 5} {set}} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}
@@ -303,7 +303,7 @@ test while-4.3 {while (not compiled): error in test expression} -body {
set i 0
set z while
catch {$z {$i<} {set x 1}} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {*"$z {$i<} {set x 1}"}
test while-4.4 {while (not compiled): error in test expression} {
set z while
@@ -346,7 +346,7 @@ test while-4.9 {while (not compiled): error compiling command body} -body {
set i 0
set z while
catch {$z {$i < 5} {set}} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"
generated by cgit v0.12 at 2024-11-05 13:52:35 (GMT)