summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/info.test453
-rw-r--r--tests/namespace.test9
-rw-r--r--tests/trace.test4
3 files changed, 235 insertions, 231 deletions
diff --git a/tests/info.test b/tests/info.test
index 527d217..94db6e7 100644
--- a/tests/info.test
+++ b/tests/info.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: info.test,v 1.44 2007/05/18 18:39:31 dgp Exp $
+# RCS: @(#) $Id: info.test,v 1.45 2007/06/12 12:34:04 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -43,13 +43,13 @@ test info-1.3 {info args option} {
proc t1 "" {return foo}
info args t1
} {}
-test info-1.4 {info args option} {
+test info-1.4 {info args option} -body {
catch {rename t1 {}}
- list [catch {info args t1} msg] $msg
-} {1 {"t1" isn't a procedure}}
-test info-1.5 {info args option} {
- list [catch {info args set} msg] $msg
-} {1 {"set" isn't a procedure}}
+ info args t1
+} -returnCodes error -result {"t1" isn't a procedure}
+test info-1.5 {info args option} -body {
+ info args set
+} -returnCodes error -result {"set" isn't a procedure}
test info-1.6 {info args option} {
proc t1 {a b} {set c 123; set d $c}
t1 1 2
@@ -67,12 +67,12 @@ test info-2.1 {info body option} {
proc t1 {} {body of t1}
info body t1
} {body of t1}
-test info-2.2 {info body option} {
- list [catch {info body set} msg] $msg
-} {1 {"set" isn't a procedure}}
-test info-2.3 {info body option} {
- list [catch {info args set 1} msg] $msg
-} {1 {wrong # args: should be "info args procname"}}
+test info-2.2 {info body option} -body {
+ info body set
+} -returnCodes error -result {"set" isn't a procedure}
+test info-2.3 {info body option} -body {
+ info args set 1
+} -returnCodes error -result {wrong # args: should be "info args procname"}
test info-2.4 {info body option} {
catch {namespace delete test_ns_info2}
namespace eval test_ns_info2 {
@@ -112,17 +112,17 @@ proc testinfocmdcount {} {
}
test info-3.1 {info cmdcount compiled} {
testinfocmdcount
-} 3
+} 4
test info-3.2 {info cmdcount evaled} {
set x [info cmdcount]
set y 12345
set z [info cm]
expr $z-$x
-} 3
-test info-3.3 {info cmdcount evaled} [info body testinfocmdcount] 3
-test info-3.4 {info cmdcount option} {
- list [catch {info cmdcount 1} msg] $msg
-} {1 {wrong # args: should be "info cmdcount"}}
+} 4
+test info-3.3 {info cmdcount evaled} [info body testinfocmdcount] 4
+test info-3.4 {info cmdcount option} -body {
+ info cmdcount 1
+} -returnCodes error -result {wrong # args: should be "info cmdcount"}
test info-4.1 {info commands option} {
proc t1 {} {}
@@ -149,14 +149,14 @@ test info-4.4 {info commands option} {
} {_t1_ _t2_}
catch {rename _t1_ {}}
catch {rename _t2_ {}}
-test info-4.5 {info commands option} {
- list [catch {info commands a b} msg] $msg
-} {1 {wrong # args: should be "info commands ?pattern?"}}
+test info-4.5 {info commands option} -returnCodes error -body {
+ info commands a b
+} -result {wrong # args: should be "info commands ?pattern?"}
# Also some tests in namespace.test
-test info-5.1 {info complete option} {
- list [catch {info complete} msg] $msg
-} {1 {wrong # args: should be "info complete command"}}
+test info-5.1 {info complete option} -body {
+ info complete
+} -returnCodes error -result {wrong # args: should be "info complete command"}
test info-5.2 {info complete option} {
info complete abc
} 1
@@ -199,28 +199,30 @@ test info-6.5 {info default option} {
set x [info default t1 e value]
list $x $value
} {1 {long default value}}
-test info-6.6 {info default option} {
- list [catch {info default a b} msg] $msg
-} {1 {wrong # args: should be "info default procname arg varname"}}
-test info-6.7 {info default option} {
- list [catch {info default _nonexistent_ a b} msg] $msg
-} {1 {"_nonexistent_" isn't a procedure}}
-test info-6.8 {info default option} {
+test info-6.6 {info default option} -returnCodes error -body {
+ info default a b
+} -result {wrong # args: should be "info default procname arg varname"}
+test info-6.7 {info default option} -returnCodes error -body {
+ info default _nonexistent_ a b
+} -result {"_nonexistent_" isn't a procedure}
+test info-6.8 {info default option} -returnCodes error -body {
proc t1 {a b} {}
- list [catch {info default t1 x value} msg] $msg
-} {1 {procedure "t1" doesn't have an argument "x"}}
-test info-6.9 {info default option} {
+ info default t1 x value
+} -result {procedure "t1" doesn't have an argument "x"}
+test info-6.9 {info default option} -returnCodes error -setup {
catch {unset a}
+} -body {
set a(0) 88
proc t1 {a b} {}
- list [catch {info default t1 a a} msg] $msg
-} {1 {couldn't store default value in variable "a"}}
-test info-6.10 {info default option} {
+ info default t1 a a
+} -returnCodes error -result {couldn't store default value in variable "a"}
+test info-6.10 {info default option} -setup {
catch {unset a}
+} -body {
set a(0) 88
proc t1 {{a 18} b} {}
- list [catch {info default t1 a a} msg] $msg
-} {1 {couldn't store default value in variable "a"}}
+ info default t1 a a
+} -returnCodes error -result {couldn't store default value in variable "a"}
test info-6.11 {info default option} {
catch {namespace delete test_ns_info2}
namespace eval test_ns_info2 {
@@ -260,18 +262,19 @@ test info-7.6 {info exists option} {
proc t1 {x} {return [info exists value]}
t1 2
} 0
-test info-7.7 {info exists option} {
+test info-7.7 {info exists option} -setup {
catch {unset x}
+} -body {
set x(2) 44
list [info exists x] [info exists x(1)] [info exists x(2)]
-} {1 0 1}
+} -result {1 0 1}
catch {unset x}
-test info-7.8 {info exists option} {
- list [catch {info exists} msg] $msg
-} {1 {wrong # args: should be "info exists varName"}}
-test info-7.9 {info exists option} {
- list [catch {info exists 1 2} msg] $msg
-} {1 {wrong # args: should be "info exists varName"}}
+test info-7.8 {info exists option} -body {
+ info exists
+} -returnCodes error -result {wrong # args: should be "info exists varName"}
+test info-7.9 {info exists option} -body {
+ info exists 1 2
+} -returnCodes error -result {wrong # args: should be "info exists varName"}
test info-8.1 {info globals option} {
set x 1
@@ -286,9 +289,9 @@ test info-8.2 {info globals option} {
set _xxx2 2
lsort [info g _xxx*]
} {_xxx1 _xxx2}
-test info-8.3 {info globals option} {
- list [catch {info globals 1 2} msg] $msg
-} {1 {wrong # args: should be "info globals ?pattern?"}}
+test info-8.3 {info globals option} -returnCodes error -body {
+ info globals 1 2
+} -result {wrong # args: should be "info globals ?pattern?"}
test info-8.4 {info globals option: may have leading namespace qualifiers} {
set x 0
list [info globals x] [info globals :x] [info globals ::x] [info globals :::x] [info globals ::::x]
@@ -336,23 +339,23 @@ test info-9.4 {info level option} {
}
t1
} {1 t1}
-test info-9.5 {info level option} {
- list [catch {info level 1 2} msg] $msg
-} {1 {wrong # args: should be "info level ?number?"}}
-test info-9.6 {info level option} {
- list [catch {info level 123a} msg] $msg
-} {1 {expected integer but got "123a"}}
-test info-9.7 {info level option} {
- list [catch {info level 0} msg] $msg
-} {1 {bad level "0"}}
-test info-9.8 {info level option} {
+test info-9.5 {info level option} -body {
+ info level 1 2
+} -returnCodes error -result {wrong # args: should be "info level ?number?"}
+test info-9.6 {info level option} -body {
+ info level 123a
+} -returnCodes error -result {expected integer but got "123a"}
+test info-9.7 {info level option} -body {
+ info level 0
+} -returnCodes error -result {bad level "0"}
+test info-9.8 {info level option} -body {
proc t1 {} {info level -1}
- list [catch {t1} msg] $msg
-} {1 {bad level "-1"}}
-test info-9.9 {info level option} {
+ t1
+} -returnCodes error -result {bad level "-1"}
+test info-9.9 {info level option} -body {
proc t1 {x} {info level $x}
- list [catch {t1 -3} msg] $msg
-} {1 {bad level "-3"}}
+ t1 -3
+} -returnCodes error -result {bad level "-3"}
test info-9.10 {info level option, namespaces} {
set msg [namespace eval t {info level 0}]
namespace delete t
@@ -378,22 +381,22 @@ test info-9.12 {info level option, ensembles} -constraints knownBug -setup {
} -result {a foo 1 2 3}
set savedLibrary $tcl_library
-test info-10.1 {info library option} {
- list [catch {info library x} msg] $msg
-} {1 {wrong # args: should be "info library"}}
+test info-10.1 {info library option} -body {
+ info library x
+} -returnCodes error -result {wrong # args: should be "info library"}
test info-10.2 {info library option} {
set tcl_library 12345
info library
} {12345}
-test info-10.3 {info library option} {
+test info-10.3 {info library option} -body {
unset tcl_library
- list [catch {info library} msg] $msg
-} {1 {no library has been specified for Tcl}}
+ info library
+} -returnCodes error -result {no library has been specified for Tcl}
set tcl_library $savedLibrary
-test info-11.1 {info loaded option} {
- list [catch {info loaded a b} msg] $msg
-} {1 {wrong # args: should be "info loaded ?interp?"}}
+test info-11.1 {info loaded option} -body {
+ info loaded a b
+} -returnCodes error -result {wrong # args: should be "info loaded ?interp?"}
test info-11.2 {info loaded option} {
list [catch {info loaded {}}] [catch {info loaded gorp} msg] $msg
} {0 1 {could not find interpreter "gorp"}}
@@ -419,9 +422,9 @@ test info-12.2 {info locals option} {
}
lsort [t1 2 3]
} {x xx1 xx2}
-test info-12.3 {info locals option} {
- list [catch {info locals 1 2} msg] $msg
-} {1 {wrong # args: should be "info locals ?pattern?"}}
+test info-12.3 {info locals option} -body {
+ info locals 1 2
+} -returnCodes error -result {wrong # args: should be "info locals ?pattern?"}
test info-12.4 {info locals option} {
info locals
} {}
@@ -445,24 +448,25 @@ test info-12.7 {info locals with temporary variables} {
t1
} {a}
-test info-13.1 {info nameofexecutable option} {
- list [catch {info nameofexecutable foo} msg] $msg
-} {1 {wrong # args: should be "info nameofexecutable"}}
+test info-13.1 {info nameofexecutable option} -returnCodes error -body {
+ info nameofexecutable foo
+} -result {wrong # args: should be "info nameofexecutable"}
test info-14.1 {info patchlevel option} {
set a [info patchlevel]
regexp {[0-9]+\.[0-9]+([p[0-9]+)?} $a
} 1
-test info-14.2 {info patchlevel option} {
- list [catch {info patchlevel a} msg] $msg
-} {1 {wrong # args: should be "info patchlevel"}}
-test info-14.3 {info patchlevel option} {
+test info-14.2 {info patchlevel option} -returnCodes error -body {
+ info patchlevel a
+} -result {wrong # args: should be "info patchlevel"}
+test info-14.3 {info patchlevel option} -setup {
set t $tcl_patchLevel
+} -body {
unset tcl_patchLevel
- set result [list [catch {info patchlevel} msg] $msg]
+ info patchlevel
+} -cleanup {
set tcl_patchLevel $t
- set result
-} {1 {can't read "tcl_patchLevel": no such variable}}
+} -returnCodes error -result {can't read "tcl_patchLevel": no such variable}
test info-15.1 {info procs option} {
proc t1 {} {}
@@ -478,19 +482,21 @@ test info-15.2 {info procs option} {
} {_tt1 _tt2}
catch {rename _tt1 {}}
catch {rename _tt2 {}}
-test info-15.3 {info procs option} {
- list [catch {info procs 2 3} msg] $msg
-} {1 {wrong # args: should be "info procs ?pattern?"}}
-test info-15.4 {info procs option} {
+test info-15.3 {info procs option} -body {
+ info procs 2 3
+} -returnCodes error -result {wrong # args: should be "info procs ?pattern?"}
+test info-15.4 {info procs option} -setup {
catch {namespace delete test_ns_info2}
+} -body {
namespace eval test_ns_info2 {
namespace import ::test_ns_info1::*
proc r {} {}
list [info procs] [info procs p*]
}
-} {{p q r} p}
-test info-15.5 {info procs option with a proc in a namespace} {
+} -result {{p q r} p}
+test info-15.5 {info procs option with a proc in a namespace} -setup {
catch {namespace delete test_ns_info2}
+} -body {
namespace eval test_ns_info2 {
proc p1 { arg } {
puts cmd
@@ -500,9 +506,10 @@ test info-15.5 {info procs option with a proc in a namespace} {
}
}
info procs ::test_ns_info2::p1
-} {::test_ns_info2::p1}
-test info-15.6 {info procs option with a pattern in a namespace} {
+} -result {::test_ns_info2::p1}
+test info-15.6 {info procs option with a pattern in a namespace} -setup {
catch {namespace delete test_ns_info2}
+} -body {
namespace eval test_ns_info2 {
proc p1 { arg } {
puts cmd
@@ -512,9 +519,10 @@ test info-15.6 {info procs option with a pattern in a namespace} {
}
}
lsort [info procs ::test_ns_info2::p*]
-} [lsort [list ::test_ns_info2::p1 ::test_ns_info2::p2]]
-test info-15.7 {info procs option with a global shadowing proc} {
+} -result [lsort [list ::test_ns_info2::p1 ::test_ns_info2::p2]]
+test info-15.7 {info procs option with a global shadowing proc} -setup {
catch {namespace delete test_ns_info2}
+} -body {
proc string_cmd { arg } {
puts cmd
}
@@ -524,12 +532,13 @@ test info-15.7 {info procs option with a global shadowing proc} {
}
}
info procs test_ns_info2::string*
-} {::test_ns_info2::string_cmd}
+} -result {::test_ns_info2::string_cmd}
# This regression test is currently commented out because it requires
# that the implementation of "info procs" looks into the global namespace,
# which it does not (in contrast to "info commands")
-test info-15.8 {info procs option with a global shadowing proc} knownBug {
+test info-15.8 {info procs option with a global shadowing proc} -setup {
catch {namespace delete test_ns_info2}
+} -constraints knownBug -body {
proc string_cmd { arg } {
puts cmd
}
@@ -544,11 +553,11 @@ test info-15.8 {info procs option with a global shadowing proc} knownBug {
namespace eval test_ns_info2 {
lsort [info procs string*]
}
-} [lsort [list string_cmd string_cmd2]]
+} -result [lsort [list string_cmd string_cmd2]]
-test info-16.1 {info script option} {
- list [catch {info script x x} msg] $msg
-} {1 {wrong # args: should be "info script ?filename?"}}
+test info-16.1 {info script option} -returnCodes error -body {
+ info script x x
+} -result {wrong # args: should be "info script ?filename?"}
test info-16.2 {info script option} {
file tail [info sc]
} "info.test"
@@ -583,24 +592,24 @@ test info-16.8 {info script option} {
} [list [list $gorpfile foo.bar] info.test]
removeFile gorp.info
-test info-17.1 {info sharedlibextension option} {
- list [catch {info sharedlibextension foo} msg] $msg
-} {1 {wrong # args: should be "info sharedlibextension"}}
+test info-17.1 {info sharedlibextension option} -returnCodes error -body {
+ info sharedlibextension foo
+} -result {wrong # args: should be "info sharedlibextension"}
test info-18.1 {info tclversion option} {
- set x [info tclversion]
- scan $x "%d.%d%c" a b c
+ scan [info tclversion] "%d.%d%c" a b c
} 2
-test info-18.2 {info tclversion option} {
- list [catch {info t 2} msg] $msg
-} {1 {wrong # args: should be "info tclversion"}}
-test info-18.3 {info tclversion option} {
- set t $tcl_version
+test info-18.2 {info tclversion option} -body {
+ info t 2
+} -returnCodes error -result {wrong # args: should be "info tclversion"}
+test info-18.3 {info tclversion option} -body {
unset tcl_version
- set result [list [catch {info tclversion} msg] $msg]
+ info tclversion
+} -returnCodes error -setup {
+ set t $tcl_version
+} -cleanup {
set tcl_version $t
- set result
-} {1 {can't read "tcl_version": no such variable}}
+} -result {can't read "tcl_version": no such variable}
test info-19.1 {info vars option} {
set a 1
@@ -625,9 +634,9 @@ test info-19.2 {info vars option} {
test info-19.3 {info vars option} {
lsort [info vars]
} [lsort [info globals]]
-test info-19.4 {info vars option} {
- list [catch {info vars a b} msg] $msg
-} {1 {wrong # args: should be "info vars ?pattern?"}}
+test info-19.4 {info vars option} -returnCodes error -body {
+ info vars a b
+} -result {wrong # args: should be "info vars ?pattern?"}
test info-19.5 {info vars with temporary variables} {
proc t1 {} {
foreach a {b c} {}
@@ -657,25 +666,25 @@ test info-20.3 {info functions option} {
test info-20.4 {info functions option} {
lsort [info functions *tan*]
} {atan atan2 tan tanh}
-test info-20.5 {info functions option} {
- list [catch {info functions raise an error} msg] $msg
-} {1 {wrong # args: should be "info functions ?pattern?"}}
-
-test info-21.1 {miscellaneous error conditions} {
- list [catch {info} msg] $msg
-} {1 {wrong # args: should be "info option ?arg arg ...?"}}
-test info-21.2 {miscellaneous error conditions} {
- list [catch {info gorp} msg] $msg
-} {1 {bad option "gorp": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
-test info-21.3 {miscellaneous error conditions} {
- list [catch {info c} msg] $msg
-} {1 {ambiguous option "c": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
-test info-21.4 {miscellaneous error conditions} {
- list [catch {info l} msg] $msg
-} {1 {ambiguous option "l": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
-test info-21.5 {miscellaneous error conditions} {
- list [catch {info s} msg] $msg
-} {1 {ambiguous option "s": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
+test info-20.5 {info functions option} -returnCodes error -body {
+ info functions raise an error
+} -result {wrong # args: should be "info functions ?pattern?"}
+
+test info-21.1 {miscellaneous error conditions} -returnCodes error -body {
+ info
+} -result {wrong # args: should be "info subcommand ?argument ...?"}
+test info-21.2 {miscellaneous error conditions} -returnCodes error -body {
+ info gorp
+} -result {unknown or ambiguous subcommand "gorp": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+test info-21.3 {miscellaneous error conditions} -returnCodes error -body {
+ info c
+} -result {unknown or ambiguous subcommand "c": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+test info-21.4 {miscellaneous error conditions} -returnCodes error -body {
+ info l
+} -result {unknown or ambiguous subcommand "l": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+test info-21.5 {miscellaneous error conditions} -returnCodes error -body {
+ info s
+} -result {unknown or ambiguous subcommand "s": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
##
# ### ### ### ######### ######### #########
@@ -727,82 +736,69 @@ proc etrace {} {
test info-22.0 {info frame, levels} {!singleTestInterp} {
info frame
} 7
-
test info-22.1 {info frame, bad level relative} {!singleTestInterp} {
# catch is another level!, i.e. we have 8, not 7
catch {info frame -8} msg
set msg
} {bad level "-8"}
-
test info-22.2 {info frame, bad level absolute} {!singleTestInterp} {
# catch is another level!, i.e. we have 8, not 7
catch {info frame 9} msg
set msg
} {bad level "9"}
-
test info-22.3 {info frame, current, relative} {
info frame 0
} {type eval line 2 cmd {info frame 0}}
-
test info-22.4 {info frame, current, relative, nested} {
set res [info frame 0]
} {type eval line 2 cmd {info frame 0}}
-
test info-22.5 {info frame, current, absolute} {!singleTestInterp} {
reduce [info frame 7]
} {type eval line 2 cmd {info frame 7}}
-
test info-22.6 {info frame, global, relative} {!singleTestInterp} {
reduce [info frame -6]
-} {type source line 755 file info.test cmd test\ info-22.6\ \{info\ frame,\ global,\ relative\}\ \{!singleTestInter level 0}
-
+} {type source line 758 file info.test cmd test\ info-22.6\ \{info\ frame,\ global,\ relative\}\ \{!singleTestInter level 0}
test info-22.7 {info frame, global, absolute} {!singleTestInterp} {
reduce [info frame 1]
-} {type source line 759 file info.test cmd test\ info-22.7\ \{info\ frame,\ global,\ absolute\}\ \{!singleTestInter level 0}
-
+} {type source line 761 file info.test cmd test\ info-22.7\ \{info\ frame,\ global,\ absolute\}\ \{!singleTestInter level 0}
test info-22.8 {info frame, basic trace} {!singleTestInterp} {
join [etrace] \n
-} {8 {type source line 719 file info.test cmd {info frame $level} proc ::etrace level 0}
+} {8 {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
7 {type eval line 2 cmd etrace}
6 {type source line 2299 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::RunTest}
5 {type eval line 1 cmd {::tcltest::RunTest info-22}}
4 {type source line 1621 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::Eval}
3 {type eval line 1 cmd ::tcltest::Eval\ \{::tcltest::RunTest\ info-22}
2 {type source line 1967 file tcltest.tcl cmd {uplevel 1 [list [namespace origin Eval] $command 1]} proc ::tcltest::test}
-1 {type source line 763 file info.test cmd test\ info-22.8\ \{info\ frame,\ basic\ trace\}\ \{!singleTestInter level 1}}
+1 {type source line 764 file info.test cmd test\ info-22.8\ \{info\ frame,\ basic\ trace\}\ \{!singleTestInter level 1}}
+
## The line 1967 is off by 5 from the true value of 1972. This is a knownBug, see testcase 30.0
test info-23.0 {eval'd info frame} {!singleTestInterp} {
eval {info frame}
} 8
-
test info-23.1 {eval'd info frame, semi-dynamic} {!singleTestInterp} {
eval info frame
} 8
-
test info-23.2 {eval'd info frame, dynamic} {!singleTestInterp} {
set script {info frame}
eval $script
} 8
-
test info-23.3 {eval'd info frame, literal} {
eval {
info frame 0
}
} {type eval line 2 cmd {info frame 0}}
-
test info-23.4 {eval'd info frame, semi-dynamic} {
eval info frame 0
} {type eval line 1 cmd {info frame 0}}
-
test info-23.5 {eval'd info frame, dynamic} {
set script {info frame 0}
eval $script
} {type eval line 1 cmd {info frame 0}}
-
test info-23.6 {eval'd info frame, trace} {!singleTestInterp} {
set script {etrace}
join [eval $script] \n
-} {9 {type source line 719 file info.test cmd {info frame $level} proc ::etrace level 0}
+} {9 {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
8 {type eval line 1 cmd etrace}
7 {type eval line 3 cmd {eval $script}}
6 {type source line 2299 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::RunTest}
@@ -810,7 +806,7 @@ test info-23.6 {eval'd info frame, trace} {!singleTestInterp} {
4 {type source line 1621 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::Eval}
3 {type eval line 1 cmd ::tcltest::Eval\ \{::tcltest::RunTest\ info-23}
2 {type source line 1967 file tcltest.tcl cmd {uplevel 1 [list [namespace origin Eval] $command 1]} proc ::tcltest::test}
-1 {type source line 802 file info.test cmd test\ info-23.6\ \{eval'd\ info\ frame,\ trace\}\ \{!singleTestInter level 1}}
+1 {type source line 798 file info.test cmd test\ info-23.6\ \{eval'd\ info\ frame,\ trace\}\ \{!singleTestInter level 1}}
## The line 1967 is off by 5 from the true value of 1972. This is a knownBug, see testcase 30.0
# -------------------------------------------------------------------------
@@ -822,17 +818,19 @@ test info-23.6 {eval'd info frame, trace} {!singleTestInterp} {
# causes the connection to the context to be lost. Currently only
# procedure bodies are able to remember their context.
+# NOTE THAT THESE DO NOT USE THE -setup OPTION TO [test]
+
# -------------------------------------------------------------------------
namespace eval foo {
proc bar {} {info frame 0}
}
-test info-24.0 {info frame, interaction, namespace eval} {
+test info-24.0 {info frame, interaction, namespace eval} -body {
reduce [foo::bar]
-} {type source line 828 file info.test cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
+} -cleanup {
+ namespace delete foo
+} -result {type source line 826 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
@@ -842,11 +840,11 @@ if {$flag} {
proc ::foo::bar {} {info frame 0}
}
-test info-24.1 {info frame, interaction, if} {
+test info-24.1 {info frame, interaction, if} -body {
reduce [foo::bar]
-} {type source line 842 file info.test cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
+} -cleanup {
+ namespace delete foo
+} -result {type source line 840 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
@@ -857,11 +855,11 @@ while {$flag} {
set flag 0
}
-test info-24.2 {info frame, interaction, while} {
+test info-24.2 {info frame, interaction, while} -body {
reduce [foo::bar]
-} {type source line 856 file info.test cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
+} -cleanup {
+ namespace delete foo
+} -result {type source line 854 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
@@ -870,11 +868,11 @@ catch {
proc ::foo::bar {} {info frame 0}
}
-test info-24.3 {info frame, interaction, catch} {
+test info-24.3 {info frame, interaction, catch} -body {
reduce [foo::bar]
-} {type source line 870 file info.test cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
+} -cleanup {
+ namespace delete foo
+} -result {type source line 868 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
@@ -884,11 +882,11 @@ foreach var val {
break
}
-test info-24.4 {info frame, interaction, foreach} {
+test info-24.4 {info frame, interaction, foreach} -body {
reduce [foo::bar]
-} {type source line 883 file info.test cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
+} -cleanup {
+ namespace delete foo
+} -result {type source line 881 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
@@ -898,11 +896,11 @@ for {} {1} {} {
break
}
-test info-24.5 {info frame, interaction, for} {
+test info-24.5 {info frame, interaction, for} -body {
reduce [foo::bar]
-} {type source line 897 file info.test cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
+} -cleanup {
+ namespace delete foo
+} -result {type source line 895 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
@@ -912,12 +910,15 @@ eval {
test info-25.0 {info frame, proc in eval} {
reduce [bar]
-} {type source line 910 file info.test cmd {info frame 0} proc ::bar level 0}
+} {type source line 908 file info.test cmd {info frame 0} proc ::bar level 0}
+# Don't need to clean up yet...
proc bar {} {info frame 0}
+
test info-25.1 {info frame, regular proc} {
reduce [bar]
-} {type source line 917 file info.test cmd {info frame 0} proc ::bar level 0}
+} {type source line 916 file info.test cmd {info frame 0} proc ::bar level 0}
+
rename bar {}
# -------------------------------------------------------------------------
@@ -993,12 +994,12 @@ switch -exact -- $x {
}
}
-test info-24.6.0 {info frame, interaction, switch, list body} {
+test info-24.6.0 {info frame, interaction, switch, list body} -body {
reduce [foo::bar]
-} {type source line 992 file info.test cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
-unset x
+} -cleanup {
+ namespace delete foo
+ unset x
+} -result {type source line 993 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
@@ -1008,12 +1009,12 @@ switch -exact -- $x foo {
proc ::foo::bar {} {info frame 0}
}
-test info-24.6.1 {info frame, interaction, switch, multi-body} {
+test info-24.6.1 {info frame, interaction, switch, multi-body} -body {
reduce [foo::bar]
-} {type source line 1008 file info.test cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
-unset x
+} -cleanup {
+ namespace delete foo
+ unset x
+} -result {type source line 1009 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
@@ -1023,12 +1024,12 @@ switch -exact -- $x [list foo {
proc ::foo::bar {} {info frame 0}
}]
-test info-24.6.2 {info frame, interaction, switch, list body, dynamic} {
+test info-24.6.2 {info frame, interaction, switch, list body, dynamic} -body {
reduce [foo::bar]
-} {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
-unset x
+} -cleanup {
+ namespace delete foo
+ unset x
+} -result {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
@@ -1042,12 +1043,12 @@ namespace eval foo {}
set x foo
switch -exact -- $x $body
-test info-31.7 {info frame, interaction, switch, dynamic} {
+test info-31.7 {info frame, interaction, switch, dynamic} -body {
reduce [foo::bar]
-} {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
-unset x
+} -cleanup {
+ namespace delete foo
+ unset x
+} -result {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
@@ -1058,11 +1059,11 @@ set body {
namespace eval foo {}
eval $body
-test info-32.0 {info frame, dynamic procedure} {
+test info-32.0 {info frame, dynamic procedure} -body {
reduce [foo::bar]
-} {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
+} -cleanup {
+ namespace delete foo
+} -result {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
@@ -1071,11 +1072,11 @@ namespace {*}{
foo
{proc bar {} {info frame 0}}
}
-test info-33.0 {{*}, literal, direct} {
+test info-33.0 {{*}, literal, direct} -body {
reduce [foo::bar]
-} {type source line 1072 file info.test cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
+} -cleanup {
+ namespace delete foo
+} -result {type source line 1073 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
@@ -1087,11 +1088,11 @@ proc foo::bar {} {
{info frame 0}
}
}
-test info-33.1 {{*}, literal, simple, bytecompiled} {
+test info-33.1 {{*}, literal, simple, bytecompiled} -body {
reduce [foo::bar]
-} {type source line 1087 file info.test cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
+} -cleanup {
+ namespace delete foo
+} -result {type source line 1088 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
@@ -1138,7 +1139,7 @@ proc foo {} {
}
test info-35.0 {apply, literal} {
reduce [foo]
-} {type source line 1136 file info.test cmd {info frame 0} lambda {
+} {type source line 1137 file info.test cmd {info frame 0} lambda {
{x y}
{info frame 0}
} level 0}
@@ -1165,7 +1166,7 @@ dict for {k v} {foo bar} {
test info-24.7 {info frame, interaction, dict for} {
reduce [foo::bar]
-} {type source line 1163 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 1164 file info.test cmd {info frame 0} proc ::foo::bar level 0}
namespace delete foo
@@ -1179,7 +1180,7 @@ dict with thedict {
test info-24.8 {info frame, interaction, dict with} {
reduce [foo::bar]
-} {type source line 1177 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 1178 file info.test cmd {info frame 0} proc ::foo::bar level 0}
namespace delete foo
unset thedict
@@ -1194,7 +1195,7 @@ dict filter {foo bar} script {k v} {
test info-24.9 {info frame, interaction, dict filter} {
reduce [foo::bar]
-} {type source line 1191 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 1192 file info.test cmd {info frame 0} proc ::foo::bar level 0}
namespace delete foo
unset x
@@ -1210,7 +1211,7 @@ proc foo::bar {} {
}
test info-36.0 {info frame, dict for, bcc} {
reduce [foo::bar]
-} {type source line 1207 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 1208 file info.test cmd {info frame 0} proc ::foo::bar level 0}
namespace delete foo
@@ -1227,7 +1228,7 @@ proc foo::bar {} {
test info-36.1.0 {switch, list literal, bcc} {
reduce [foo::bar]
-} {type source line 1223 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 1224 file info.test cmd {info frame 0} proc ::foo::bar level 0}
namespace delete foo
@@ -1242,7 +1243,7 @@ proc foo::bar {} {
test info-36.1.1 {switch, multi-body literals, bcc} {
reduce [foo::bar]
-} {type source line 1239 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 1240 file info.test cmd {info frame 0} proc ::foo::bar level 0}
namespace delete foo
@@ -1255,7 +1256,7 @@ namespace {*}"
"
test info-33.2 {{*}, literal, direct} {
reduce [foo::bar]
-} {type source line 1254 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 1255 file info.test cmd {info frame 0} proc ::foo::bar level 0}
namespace delete foo
@@ -1281,7 +1282,7 @@ proc foo::bar {} {
}
test info-33.3 {{*}, literal, simple, bytecompiled} {
reduce [foo::bar]
-} {type source line 1279 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 1280 file info.test cmd {info frame 0} proc ::foo::bar level 0}
namespace delete foo
diff --git a/tests/namespace.test b/tests/namespace.test
index f8433cc..3228d72 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.66 2007/03/12 19:10:50 dgp Exp $
+# RCS: @(#) $Id: namespace.test,v 1.67 2007/06/12 12:34:04 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -172,7 +172,10 @@ test namespace-7.6 {recursive Tcl_DeleteNamespace, no active call frames in ns}
} {}
test namespace-7.7 {Bug 1655305} -setup {
interp create slave
- slave hide info
+ # Can't invoke through the ensemble, since deleting the global namespace
+ # (indirectly, via deleting ::tcl) deletes the ensemble.
+ slave eval {rename ::tcl::Info_commands ::infocommands}
+ slave hide infocommands
slave eval {
proc foo {} {
namespace delete ::
@@ -180,7 +183,7 @@ test namespace-7.7 {Bug 1655305} -setup {
}
} -body {
slave eval foo
- slave invokehidden info commands
+ slave invokehidden infocommands
} -cleanup {
interp delete slave
} -result {}
diff --git a/tests/trace.test b/tests/trace.test
index 5ab6a72..f549a4b 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -11,7 +11,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: trace.test,v 1.51 2006/11/03 23:24:43 msofer Exp $
+# RCS: @(#) $Id: trace.test,v 1.52 2007/06/12 12:34:04 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -2249,7 +2249,7 @@ test trace-29.1 {Tcl_CreateTrace, correct command and argc/argv arguments of tra
} {{expr 14 + 16} {expr 14 + 16} {set stuff [expr 14 + 16]} {set stuff 30}}
test trace-29.2 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
testcmdtrace tracetest {set stuff [info tclversion]}
-} [list {info tclversion} {info tclversion} {set stuff [info tclversion]} "set stuff [info tclversion]"]
+} [concat {{info tclversion} {info tclversion} ::tcl::Info_tclversion {::tcl::Info_tclversion} {set stuff [info tclversion]}} [list "set stuff [info tclversion]"]]
test trace-29.3 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
testcmdtrace deletetest {set stuff [info tclversion]}
} [info tclversion]