summaryrefslogtreecommitdiffstats
path: root/tests/info.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/info.test')
-rw-r--r--tests/info.test670
1 files changed, 405 insertions, 265 deletions
diff --git a/tests/info.test b/tests/info.test
index 937da8c..9977054 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -15,7 +15,7 @@
#
# DO NOT DELETE THIS LINE
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {{::tcltest} ni [namespace children]} {
package require tcltest 2
namespace import -force ::tcltest::*
}
@@ -84,7 +84,7 @@ test info-2.4 {info body option} {
# would return the bytecompiled version of foo, which the catch
# would then try and eval out of the foo context, accessing
# compiled local indices
-test info-2.5 {info body option, returning bytecompiled bodies} {
+test info-2.5 {info body option, returning bytecompiled bodies} -body {
catch {unset args}
proc foo {args} {
foreach v $args {
@@ -93,8 +93,8 @@ test info-2.5 {info body option, returning bytecompiled bodies} {
}
}
foo a
- list [catch [info body foo] msg] $msg
-} {1 {can't read "args": no such variable}}
+ eval [info body foo]
+} -returnCodes error -result {can't read "args": no such variable}
# Fix for problem tested for in info-2.5 caused problems when
# procedure body had no string rep (i.e. was not yet bytecode)
# causing an empty string to be returned [Bug #545644]
@@ -108,35 +108,35 @@ proc testinfocmdcount {} {
set x [info cmdcount]
set y 12345
set z [info cm]
- expr $z-$x
+ expr {$z-$x}
}
test info-3.1 {info cmdcount compiled} {
testinfocmdcount
} 4
-test info-3.2 {info cmdcount evaled} {
+test info-3.2 {info cmdcount evaled} -body {
set x [info cmdcount]
set y 12345
set z [info cm]
- expr $z-$x
-} 4
-test info-3.3 {info cmdcount evaled} [info body testinfocmdcount] 4
+ expr {$z-$x}
+} -cleanup {unset x y z} -result 4
+test info-3.3 {info cmdcount evaled} -body [info body testinfocmdcount] -cleanup {unset x y z} -result 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} {
+test info-4.1 {info commands option} -body {
proc t1 {} {}
proc t2 {} {}
set x " [info commands] "
list [string match {* t1 *} $x] [string match {* t2 *} $x] \
[string match {* set *} $x] [string match {* list *} $x]
-} {1 1 1 1}
-test info-4.2 {info commands option} {
+} -cleanup {unset x} -result {1 1 1 1}
+test info-4.2 {info commands option} -body {
proc t1 {} {}
rename t1 {}
- set x [info comm]
- string match {* t1 *} $x
-} 0
+ string match {* t1 *} \
+ [info comm]
+} -result 0
test info-4.3 {info commands option} {
proc _t1_ {} {}
proc _t2_ {} {}
@@ -177,28 +177,28 @@ test info-6.1 {info default option} {
proc t1 {a b {c d} {e "long default value"}} {}
info default t1 a value
} 0
-test info-6.2 {info default option} {
+test info-6.2 {info default option} -body {
proc t1 {a b {c d} {e "long default value"}} {}
set value 12345
info d t1 a value
- set value
-} {}
-test info-6.3 {info default option} {
+ return $value
+} -cleanup {unset value} -result {}
+test info-6.3 {info default option} -body {
proc t1 {a b {c d} {e "long default value"}} {}
info default t1 c value
-} 1
-test info-6.4 {info default option} {
+} -cleanup {unset value} -result 1
+test info-6.4 {info default option} -body {
proc t1 {a b {c d} {e "long default value"}} {}
set value 12345
info default t1 c value
- set value
-} d
-test info-6.5 {info default option} {
+ return $value
+} -cleanup {unset value} -result d
+test info-6.5 {info default option} -body {
proc t1 {a b {c d} {e "long default value"}} {}
set value 12345
set x [info default t1 e value]
list $x $value
-} {1 {long default value}}
+} -cleanup {unset x value} -result {1 {long default value}}
test info-6.6 {info default option} -returnCodes error -body {
info default a b
} -result {wrong # args: should be "info default procname arg varname"}
@@ -211,14 +211,14 @@ test info-6.8 {info default option} -returnCodes error -body {
} -result {procedure "t1" doesn't have an argument "x"}
test info-6.9 {info default option} -returnCodes error -setup {
catch {unset a}
-} -body {
+} -cleanup {unset a} -body {
set a(0) 88
proc t1 {a b} {}
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 {
+} -cleanup {unset a} -body {
set a(0) 88
proc t1 {{a 18} b} {}
info default t1 a a
@@ -230,27 +230,27 @@ test info-6.11 {info default option} {
list [info default p x foo] $foo [info default q y bar] $bar
}
} {0 {} 1 27}
-catch {unset a}
-test info-7.1 {info exists option} {
+
+test info-7.1 {info exists option} -body {
set value foo
info exists value
-} 1
-catch {unset _nonexistent_}
-test info-7.2 {info exists option} {
+} -cleanup {unset value} -result 1
+
+test info-7.2 {info exists option} -setup {catch {unset _nonexistent_}} -body {
info exists _nonexistent_
-} 0
+} -result 0
test info-7.3 {info exists option} {
proc t1 {x} {return [info exists x]}
t1 2
} 1
-test info-7.4 {info exists option} {
+test info-7.4 {info exists option} -body {
proc t1 {x} {
global _nonexistent_
return [info exists _nonexistent_]
}
t1 2
-} 0
+} -setup {unset -nocomplain _nonexistent_} -result 0
test info-7.5 {info exists option} {
proc t1 {x} {
set y 47
@@ -276,29 +276,29 @@ 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} {
+test info-8.1 {info globals option} -body {
set x 1
set y 2
set value 23
set a " [info globals] "
list [string match {* x *} $a] [string match {* y *} $a] \
[string match {* value *} $a] [string match {* _foobar_ *} $a]
-} {1 1 1 0}
-test info-8.2 {info globals option} {
+} -cleanup {unset x y value a} -result {1 1 1 0}
+test info-8.2 {info globals option} -body {
set _xxx1 1
set _xxx2 2
lsort [info g _xxx*]
-} {_xxx1 _xxx2}
+} -cleanup {unset _xxx1 _xxx2} -result {_xxx1 _xxx2}
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} {
+test info-8.4 {info globals option: may have leading namespace qualifiers} -body {
set x 0
list [info globals x] [info globals :x] [info globals ::x] [info globals :::x] [info globals ::::x]
-} {x {} x x x}
+} -cleanup {unset x} -result {x {} x x x}
test info-8.5 {info globals option: only return existing global variables} {
-setup {
- catch {unset ::NO_SUCH_VAR}
+ unset -nocomplain ::NO_SUCH_VAR
proc evalInProc script {eval $script}
}
-body {
@@ -356,11 +356,11 @@ test info-9.9 {info level option} -body {
proc t1 {x} {info level $x}
t1 -3
} -returnCodes error -result {bad level "-3"}
-test info-9.10 {info level option, namespaces} {
- set msg [namespace eval t {info level 0}]
+test info-9.10 {info level option, namespaces} -body {
+ namespace eval t {info level 0}
+} -cleanup {
namespace delete t
- set msg
-} {namespace eval t {info level 0}}
+} -result {namespace eval t {info level 0}}
test info-9.11 {info level option, aliases} -constraints knownBug -setup {
proc w {x y z} {info level 0}
interp alias {} a {} w a b
@@ -392,16 +392,16 @@ test info-10.3 {info library option} -body {
unset tcl_library
info library
} -returnCodes error -result {no library has been specified for Tcl}
-set tcl_library $savedLibrary
+set tcl_library $savedLibrary; unset savedLibrary
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"}}
+test info-11.2 {info loaded option} -body {
+ info loaded {}; info loaded gorp
+} -returnCodes error -result {could not find interpreter "gorp"}
-test info-12.1 {info locals option} {
+test info-12.1 {info locals option} -body {
set a 22
proc t1 {x y} {
set b 13
@@ -412,7 +412,7 @@ test info-12.1 {info locals option} {
return [info locals]
}
lsort [t1 23 24]
-} {b c x y}
+} -cleanup {unset a aa} -result {b c x y}
test info-12.2 {info locals option} {
proc t1 {x y} {
set xx1 2
@@ -452,10 +452,10 @@ 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} {
+test info-14.1 {info patchlevel option} -body {
set a [info patchlevel]
regexp {[0-9]+\.[0-9]+([p[0-9]+)?} $a
-} 1
+} -cleanup {unset a} -result 1
test info-14.2 {info patchlevel option} -returnCodes error -body {
info patchlevel a
} -result {wrong # args: should be "info patchlevel"}
@@ -465,16 +465,16 @@ test info-14.3 {info patchlevel option} -setup {
unset tcl_patchLevel
info patchlevel
} -cleanup {
- set tcl_patchLevel $t
+ set tcl_patchLevel $t; unset t
} -returnCodes error -result {can't read "tcl_patchLevel": no such variable}
-test info-15.1 {info procs option} {
+test info-15.1 {info procs option} -body {
proc t1 {} {}
proc t2 {} {}
set x " [info procs] "
list [string match {* t1 *} $x] [string match {* t2 *} $x] \
[string match {* _undefined_ *} $x]
-} {1 1 0}
+} -cleanup {unset x} -result {1 1 0}
test info-15.2 {info procs option} {
proc _tt1 {} {}
proc _tt2 {} {}
@@ -491,7 +491,7 @@ test info-15.4 {info procs option} -setup {
namespace eval test_ns_info2 {
namespace import ::test_ns_info1::*
proc r {} {}
- list [info procs] [info procs p*]
+ list [lsort [info procs]] [info procs p*]
}
} -result {{p q r} p}
test info-15.5 {info procs option with a proc in a namespace} -setup {
@@ -573,32 +573,32 @@ test info-16.5 {resetting "info script" after errors} {
catch {source _nonexistent_}
file tail [info script]
} "info.test"
-test info-16.6 {info script option} {
+test info-16.6 {info script option} -body {
set script [info script]
list [file tail [info script]] \
[info script newname.txt] \
[file tail [info script $script]]
-} [list info.test newname.txt info.test]
-test info-16.7 {info script option} {
+} -result [list info.test newname.txt info.test] -cleanup {unset script}
+test info-16.7 {info script option} -body {
set script [info script]
info script newname.txt
list [source $gorpfile] [file tail [info script]] \
[file tail [info script $script]]
-} [list $gorpfile newname.txt info.test]
+} -result [list $gorpfile newname.txt info.test] -cleanup {unset script}
removeFile gorp.info
set gorpfile [makeFile {list [info script] [info script foo.bar]} gorp.info]
test info-16.8 {info script option} {
list [source $gorpfile] [file tail [info script]]
} [list [list $gorpfile foo.bar] info.test]
-removeFile gorp.info
+removeFile gorp.info; unset gorpfile
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} {
+test info-18.1 {info tclversion option} -body {
scan [info tclversion] "%d.%d%c" a b c
-} 2
+} -cleanup {unset -nocomplain a b c} -result 2
test info-18.2 {info tclversion option} -body {
info t 2
} -returnCodes error -result {wrong # args: should be "info tclversion"}
@@ -608,10 +608,10 @@ test info-18.3 {info tclversion option} -body {
} -returnCodes error -setup {
set t $tcl_version
} -cleanup {
- set tcl_version $t
+ set tcl_version $t; unset t
} -result {can't read "tcl_version": no such variable}
-test info-19.1 {info vars option} {
+test info-19.1 {info vars option} -body {
set a 1
set b 2
proc t1 {x y} {
@@ -620,8 +620,8 @@ test info-19.1 {info vars option} {
return [info vars]
}
lsort [t1 18 19]
-} {a b c x y}
-test info-19.2 {info vars option} {
+} -cleanup {unset a b} -result {a b c x y}
+test info-19.2 {info vars option} -body {
set xxx1 1
set xxx2 2
proc t1 {xxa y} {
@@ -630,7 +630,7 @@ test info-19.2 {info vars option} {
return [info vars x*]
}
lsort [t1 18 19]
-} {xxa xxx1 xxx2}
+} -cleanup {unset xxx1 xxx2} -result {xxa xxx1 xxx2}
test info-19.3 {info vars option} {
lsort [info vars]
} [lsort [info globals]]
@@ -669,33 +669,33 @@ test info-20.4 {info functions option} {
test info-20.5 {info functions option} -returnCodes error -body {
info functions raise an error
} -result {wrong # args: should be "info functions ?pattern?"}
+unset functions msg
test info-21.1 {miscellaneous error conditions} -returnCodes error -body {
info
-} -result {wrong # args: should be "info subcommand ?argument ...?"}
+} -result {wrong # args: should be "info subcommand ?arg ...?"}
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}
+} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, 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}
+} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, 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}
+} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, 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}
+} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
##
# ### ### ### ######### ######### #########
## info frame
## Helper
-# For the more complex results we cut the file name down to remove
-# path dependencies, and we use only part of the first line of the
-# reported command. The latter is required because otherwise the whole
-# test case may appear in some results, but the result is part of the
-# testcase. An infinite string would be required to describe that. The
-# cutting-down breaks this.
+# For the more complex results we cut the file name down to remove path
+# dependencies, and we use only part of the first line of the reported
+# command. The latter is required because otherwise the whole test case may
+# appear in some results, but the result is part of the testcase. An infinite
+# string would be required to describe that. The cutting-down breaks this.
proc reduce {frame} {
set pos [lsearch -exact $frame cmd]
incr pos
@@ -748,66 +748,65 @@ test info-22.2 {info frame, bad level absolute} {!singleTestInterp} {
} {bad level "9"}
test info-22.3 {info frame, current, relative} -match glob -body {
info frame 0
-} -result {type source line 750 file * cmd {info frame 0} proc ::tcltest::RunTest}
+} -result {type source line 750 file */info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-22.4 {info frame, current, relative, nested} -match glob -body {
set res [info frame 0]
-} -result {type source line 753 file * cmd {info frame 0} proc ::tcltest::RunTest}
+} -result {type source line 753 file */info.test cmd {info frame 0} proc ::tcltest::RunTest} -cleanup {unset res}
test info-22.5 {info frame, current, absolute} -constraints {!singleTestInterp} -match glob -body {
reduce [info frame 7]
-} -result {type source line 756 file * cmd {info frame 7} proc ::tcltest::RunTest}
+} -result {type source line 756 file info.test cmd {info frame 7} proc ::tcltest::RunTest}
test info-22.6 {info frame, global, relative} {!singleTestInterp} {
reduce [info frame -6]
} {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 761 file info.test cmd test\ info-22.7\ \{info\ frame,\ global,\ absolute\}\ \{!singleTestInter level 0}
-test info-22.8 {info frame, basic trace} -constraints {!singleTestInterp} -match glob -body {
+test info-22.8 {info frame, basic trace} -match glob -body {
join [lrange [etrace] 0 2] \n
} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type source line 765 file info.test cmd etrace proc ::tcltest::RunTest}
* {type source line * file tcltest* cmd {uplevel 1 $script} proc ::tcltest::RunTest}}
+unset -nocomplain msg
-
-
-
-
-
-## 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} {
+test info-23.0.0 {eval'd info frame} {!singleTestInterp} {
eval {info frame}
} 8
-test info-23.1 {eval'd info frame, semi-dynamic} {!singleTestInterp} {
+test info-23.0.1 {eval'd info frame} -constraints {singleTestInterp} -match glob -body {
+ eval {info frame}
+} -result {1[12]} ;# SingleTestInterp results changes depending on running the whole suite, or info.test alone.
+test info-23.1.0 {eval'd info frame, semi-dynamic} {!singleTestInterp} {
eval info frame
} 8
-test info-23.2 {eval'd info frame, dynamic} {!singleTestInterp} {
+test info-23.1.1 {eval'd info frame, semi-dynamic} -constraints {singleTestInterp} -match glob -body {
+ eval info frame
+} -result {1[12]}
+test info-23.2.0 {eval'd info frame, dynamic} -constraints {!singleTestInterp} -body {
set script {info frame}
eval $script
-} 8
+} -cleanup {unset script} -result 8
+test info-23.2.1 {eval'd info frame, dynamic} -constraints {singleTestInterp} -match glob -body {
+ set script {info frame}
+ eval $script
+} -cleanup {unset script} -result {1[12]}
test info-23.3 {eval'd info frame, literal} -match glob -body {
eval {
info frame 0
}
-} -result {type source line 788 file * cmd {info frame 0} proc ::tcltest::RunTest}
+} -result {type source line 793 file * cmd {info frame 0} proc ::tcltest::RunTest}
test info-23.4 {eval'd info frame, semi-dynamic} {
eval info frame 0
} {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest}
-test info-23.5 {eval'd info frame, dynamic} {
+test info-23.5 {eval'd info frame, dynamic} -cleanup {unset script} -body {
set script {info frame 0}
eval $script
-} {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest}
-test info-23.6 {eval'd info frame, trace} -constraints {!singleTestInterp} -match glob -body {
+} -result {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest}
+test info-23.6 {eval'd info frame, trace} -match glob -cleanup {unset script} -body {
set script {etrace}
join [lrange [eval $script] 0 2] \n
} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type eval line 1 cmd etrace proc ::tcltest::RunTest}
-* {type source line 800 file info.test cmd {eval $script} proc ::tcltest::RunTest}}
-
+* {type source line 805 file info.test cmd {eval $script} proc ::tcltest::RunTest}}
-
-
-
-
-## The line 1967 is off by 5 from the true value of 1972. This is a knownBug, see testcase 30.0
# -------------------------------------------------------------------------
# Procedures defined in scripts which are arguments to control
@@ -830,7 +829,7 @@ test info-24.0 {info frame, interaction, namespace eval} -body {
reduce [foo::bar]
} -cleanup {
namespace delete foo
-} -result {type source line 826 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} -result {type source line 825 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
@@ -844,7 +843,7 @@ test info-24.1 {info frame, interaction, if} -body {
reduce [foo::bar]
} -cleanup {
namespace delete foo
-} -result {type source line 840 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} -result {type source line 839 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
@@ -853,13 +852,13 @@ while {$flag} {
namespace eval foo {}
proc ::foo::bar {} {info frame 0}
set flag 0
-}
+};unset flag
test info-24.2 {info frame, interaction, while} -body {
reduce [foo::bar]
} -cleanup {
namespace delete foo
-} -result {type source line 854 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} -result {type source line 853 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
@@ -872,7 +871,7 @@ test info-24.3 {info frame, interaction, catch} -body {
reduce [foo::bar]
} -cleanup {
namespace delete foo
-} -result {type source line 868 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} -result {type source line 867 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
@@ -880,13 +879,13 @@ foreach var val {
namespace eval foo {}
proc ::foo::bar {} {info frame 0}
break
-}
+}; unset var
test info-24.4 {info frame, interaction, foreach} -body {
reduce [foo::bar]
} -cleanup {
namespace delete foo
-} -result {type source line 881 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} -result {type source line 880 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
@@ -900,7 +899,7 @@ test info-24.5 {info frame, interaction, for} -body {
reduce [foo::bar]
} -cleanup {
namespace delete foo
-} -result {type source line 895 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} -result {type source line 894 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
@@ -917,7 +916,7 @@ test info-24.6.0 {info frame, interaction, switch, list body} -body {
} -cleanup {
namespace delete foo
unset x
-} -result {type source line 911 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} -result {type source line 910 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
@@ -932,7 +931,7 @@ test info-24.6.1 {info frame, interaction, switch, multi-body} -body {
} -cleanup {
namespace delete foo
unset x
-} -result {type source line 927 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} -result {type source line 926 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
@@ -958,9 +957,9 @@ dict for {k v} {foo bar} {
test info-24.7 {info frame, interaction, dict for} {
reduce [foo::bar]
-} {type source line 956 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 955 file info.test cmd {info frame 0} proc ::foo::bar level 0}
-namespace delete foo
+namespace delete foo; unset k v
# -------------------------------------------------------------------------
@@ -972,10 +971,10 @@ dict with thedict {
test info-24.8 {info frame, interaction, dict with} {
reduce [foo::bar]
-} {type source line 970 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 969 file info.test cmd {info frame 0} proc ::foo::bar level 0}
namespace delete foo
-unset thedict
+unset thedict foo
# -------------------------------------------------------------------------
@@ -983,14 +982,14 @@ namespace eval foo {}
dict filter {foo bar} script {k v} {
proc ::foo::bar {} {info frame 0}
set x 1
-}
+}; unset k v x
test info-24.9 {info frame, interaction, dict filter} {
reduce [foo::bar]
-} {type source line 984 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 983 file info.test cmd {info frame 0} proc ::foo::bar level 0}
namespace delete foo
-unset x
+#unset x
# -------------------------------------------------------------------------
@@ -1000,32 +999,32 @@ eval {
test info-25.0 {info frame, proc in eval} {
reduce [bar]
-} {type source line 998 file info.test cmd {info frame 0} proc ::bar level 0}
+} {type source line 997 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 1006 file info.test cmd {info frame 0} proc ::bar level 0}
+} {type source line 1005 file info.test cmd {info frame 0} proc ::bar level 0}
rename bar {}
# -------------------------------------------------------------------------
# More info-30.x test cases at the end of the file.
-test info-30.0 {bs+nl in literal words} {
+test info-30.0 {bs+nl in literal words} -cleanup {unset res} -body {
if {1} {
set res \
- [reduce [info frame 0]];# 1019
+ [reduce [info frame 0]];#1018
}
- set res
+ return $res
# This was reporting line 3 instead of the correct 4 because the
# bs+nl combination is subst by the parser before the 'if'
# command, and the bcc, see the word. Fixed by recording the
# offsets of all bs+nl sequences in literal words, then using the
# information in the bcc and other places to bump line numbers when
# parsing over the location. Also affected: testcases 22.8 and 23.6.
-} {type source line 1019 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+} -result {type source line 1018 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
# -------------------------------------------------------------------------
# See 24.0 - 24.5 for similar situations, using literal scripts.
@@ -1034,45 +1033,45 @@ set body {set flag 0
set a c
set res [info frame 0]} ;# line 3!
-test info-31.0 {ns eval, script in variable} {set res {}
+test info-31.0 {ns eval, script in variable} -body {namespace eval foo {variable res {}}
namespace eval foo $body
- set res
-} {type eval line 3 cmd {info frame 0} level 0}
-catch {namespace delete foo}
-
-test info-31.1 {if, script in variable} {
+ return $foo::res
+} -result {type eval line 3 cmd {info frame 0} level 0} -cleanup {
+ catch {namespace delete foo}
+}
+test info-31.1 {if, script in variable} -cleanup {unset res a flag} -body {
if 1 $body
- set res
-} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
+ return $res
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
-test info-31.1a {if, script in variable} {
+test info-31.1a {if, script in variable} -cleanup {unset res a flag} -body {
if 1 then $body
- set res
-} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
+ return $res
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
-test info-31.2 {while, script in variable} {
+test info-31.2 {while, script in variable} -cleanup {unset flag res a} -body {
set flag 1
while {$flag} $body
- set res
-} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
+ return $res
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
# .3 - proc - scoping prevent return of result ...
-test info-31.4 {foreach, script in variable} {
+test info-31.4 {foreach, script in variable} -cleanup {unset var res a flag} -body {
foreach var val $body
set res
-} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
-test info-31.5 {for, script in variable} {
+test info-31.5 {for, script in variable} -cleanup {unset flag res a} -body {
set flag 1
for {} {$flag} {} $body
- set res
-} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
+ return $res
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
-test info-31.6 {eval, script in variable} {
+test info-31.6 {eval, script in variable} -cleanup {unset res a flag} -body {
eval $body
- set res
-} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
+ return $res
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
# -------------------------------------------------------------------------
@@ -1084,7 +1083,7 @@ set body {
namespace eval foo {}
set x foo
-switch -exact -- $x $body
+switch -exact -- $x $body; unset body
test info-31.7 {info frame, interaction, switch, dynamic} -body {
reduce [foo::bar]
@@ -1119,7 +1118,7 @@ test info-33.0 {{*}, literal, direct} -body {
reduce [foo::bar]
} -cleanup {
namespace delete foo
-} -result {type source line 1116 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} -result {type source line 1115 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
@@ -1135,7 +1134,7 @@ test info-33.1 {{*}, literal, simple, bytecompiled} -body {
reduce [foo::bar]
} -cleanup {
namespace delete foo
-} -result {type source line 1131 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} -result {type source line 1130 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
@@ -1146,7 +1145,7 @@ namespace {*}"
"
test info-33.2 {{*}, literal, direct} {
reduce [foo::bar]
-} {type source line 1145 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 1144 file info.test cmd {info frame 0} proc ::foo::bar level 0}
namespace delete foo
@@ -1172,7 +1171,7 @@ proc foo::bar {} {
}
test info-33.3 {{*}, literal, simple, bytecompiled} {
reduce [foo::bar]
-} {type source line 1170 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 1169 file info.test cmd {info frame 0} proc ::foo::bar level 0}
namespace delete foo
@@ -1234,7 +1233,7 @@ proc foo {} {
}
test info-35.0 {apply, literal} {
reduce [foo]
-} {type source line 1232 file info.test cmd {info frame 0} lambda {
+} {type source line 1231 file info.test cmd {info frame 0} lambda {
{x y}
{info frame 0}
} level 0}
@@ -1261,9 +1260,9 @@ proc foo::bar {} {
}
set x
}
-test info-36.0 {info frame, dict for, bcc} {
+test info-36.0 {info frame, dict for, bcc} -body {
reduce [foo::bar]
-} {type source line 1260 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} -result {type source line 1259 file info.test cmd {info frame 0} proc ::foo::bar level 0}
namespace delete foo
@@ -1278,9 +1277,9 @@ proc foo::bar {} {
set y
}
-test info-36.1.0 {switch, list literal, bcc} {
+test info-36.1.0 {switch, list literal, bcc} -body {
reduce [foo::bar]
-} {type source line 1276 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} -result {type source line 1275 file info.test cmd {info frame 0} proc ::foo::bar level 0}
namespace delete foo
@@ -1293,15 +1292,15 @@ proc foo::bar {} {
set y
}
-test info-36.1.1 {switch, multi-body literals, bcc} {
+test info-36.1.1 {switch, multi-body literals, bcc} -body {
reduce [foo::bar]
-} {type source line 1292 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} -result {type source line 1291 file info.test cmd {info frame 0} proc ::foo::bar level 0}
namespace delete foo
# -------------------------------------------------------------------------
-test info-37.0 {eval pure list, single line} -constraints {!singleTestInterp} -match glob -body {
+test info-37.0 {eval pure list, single line} -match glob -body {
# Basically, counting the newline in the word seen through $foo
# doesn't really make sense. It makes a bit of sense if the word
# would have been a string literal in the command list.
@@ -1318,10 +1317,10 @@ test info-37.0 {eval pure list, single line} -constraints {!singleTestInterp} -m
break
}]
eval $cmd
- set res
+ return $res
} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type eval line 2 cmd etrace proc ::tcltest::RunTest}
-* {type eval line 1 cmd foreac proc ::tcltest::RunTest}}
+* {type eval line 1 cmd foreac proc ::tcltest::RunTest}} -cleanup {unset foo cmd res b c}
# -------------------------------------------------------------------------
@@ -1362,7 +1361,7 @@ test info-38.1 {location information for uplevel, dv, direct-var} -match glob -b
join [lrange [uplevel \#0 $script] 0 2] \n
} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type eval line 3 cmd etrace proc ::tcltest::RunTest}
-* {type source line 1362 file info.test cmd {uplevel \\#0 $script} proc ::tcltest::RunTest}}
+* {type source line 1361 file info.test cmd {uplevel \\#0 $script} proc ::tcltest::RunTest}} -cleanup {unset script y}
# 38.2 moved to bottom to not disturb other tests with the necessary changes to this one.
@@ -1381,8 +1380,8 @@ test info-38.3 {location information for uplevel, dpv, direct-proc-var} -match g
join [lrange [control y $script] 0 3] \n
} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type eval line 3 cmd etrace proc ::control}
-* {type source line 1339 file info.test cmd {uplevel 1 $script} proc ::control}
-* {type source line 1381 file info.test cmd {control y $script} proc ::tcltest::RunTest}}
+* {type source line 1338 file info.test cmd {uplevel 1 $script} proc ::control}
+* {type source line 1380 file info.test cmd {control y $script} proc ::tcltest::RunTest}} -cleanup {unset script y}
# 38.4 moved to bottom to not disturb other tests with the necessary changes to this one.
@@ -1398,9 +1397,9 @@ test info-38.5 {location information for uplevel, ppv, proc-proc-var} -match glo
join [lrange [datav] 0 4] \n
} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type eval line 3 cmd etrace proc ::control}
-* {type source line 1339 file info.test cmd {uplevel 1 $script} proc ::control}
-* {type source line 1354 file info.test cmd {control y $script} proc ::datav level 1}
-* {type source line 1398 file info.test cmd datav proc ::tcltest::RunTest}}
+* {type source line 1338 file info.test cmd {uplevel 1 $script} proc ::control}
+* {type source line 1353 file info.test cmd {control y $script} proc ::datav level 1}
+* {type source line 1397 file info.test cmd datav proc ::tcltest::RunTest}}
# 38.6 moved to bottom to not disturb other tests with the necessary changes to this one.
@@ -1410,6 +1409,14 @@ test info-38.5 {location information for uplevel, ppv, proc-proc-var} -match glo
+testConstraint testevalex [llength [info commands testevalex]]
+test info-38.7 {location information for arg substitution} -constraints testevalex -match glob -body {
+ join [lrange [testevalex {return -level 0 [etrace]}] 0 3] \n
+} -result {* {type source line 728 file info.test cmd {info frame \$level} proc ::etrace level 0}
+* {type eval line 1 cmd etrace proc ::tcltest::RunTest}
+* {type source line 1414 file info.test cmd {testevalex {return -level 0 \[etrace]}} proc ::tcltest::RunTest}
+* {type source line * file tcltest* cmd {uplevel 1 $script} proc ::tcltest::RunTest}}
+
# -------------------------------------------------------------------------
# literal sharing
@@ -1424,127 +1431,127 @@ test info-39.0 {location information not confused by literal sharing} -body {
set res [::foo::bar]
namespace delete ::foo
join $res \n
-} -result {
-type source line 1420 file info.test cmd {info frame 0} proc ::foo::bar level 0
-type source line 1421 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} -cleanup {unset res} -result {
+type source line 1427 file info.test cmd {info frame 0} proc ::foo::bar level 0
+type source line 1428 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
# Additional tests for info-30.*, handling of continuation lines (bs+nl sequences).
-test info-30.1 {bs+nl in literal words, procedure body, compiled} {
+test info-30.1 {bs+nl in literal words, procedure body, compiled} -body {
proc abra {} {
if {1} \
{
return \
- [reduce [info frame 0]];# line 1439
+ [reduce [info frame 0]];# line 1446
}
}
- set res [abra]
+ abra
+} -cleanup {
rename abra {}
- set res
-} {type source line 1439 file info.test cmd {info frame 0} proc ::abra level 0}
+} -result {type source line 1446 file info.test cmd {info frame 0} proc ::abra level 0}
test info-30.2 {bs+nl in literal words, namespace script} {
namespace eval xxx {
- set res \
- [reduce [info frame 0]];# line 1450
+ variable res \
+ [reduce [info frame 0]];# line 1457
}
- set res
-} {type source line 1450 file info.test cmd {info frame 0} level 0}
+ return $xxx::res
+} {type source line 1457 file info.test cmd {info frame 0} level 0}
test info-30.3 {bs+nl in literal words, namespace multi-word script} {
- namespace eval xxx set res \
- [list [reduce [info frame 0]]];# line 1457
- set res
-} {type source line 1457 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+ namespace eval xxx variable res \
+ [list [reduce [info frame 0]]];# line 1464
+ return $xxx::res
+} {type source line 1464 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
-test info-30.4 {bs+nl in literal words, eval script} {
+test info-30.4 {bs+nl in literal words, eval script} -cleanup {unset res} -body {
eval {
set ::res \
- [reduce [info frame 0]];# line 1464
+ [reduce [info frame 0]];# line 1471
}
- set res
-} {type source line 1464 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+ return $res
+} -result {type source line 1471 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
-test info-30.5 {bs+nl in literal words, eval script, with nested words} {
+test info-30.5 {bs+nl in literal words, eval script, with nested words} -body {
eval {
if {1} \
{
set ::res \
- [reduce [info frame 0]];# line 1474
+ [reduce [info frame 0]];# line 1481
}
}
- set res
-} {type source line 1474 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+ return $res
+} -cleanup {unset res} -result {type source line 1481 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
-test info-30.6 {bs+nl in computed word} {
+test info-30.6 {bs+nl in computed word} -cleanup {unset res} -body {
set res "\
-[reduce [info frame 0]]";# line 1482
-} { type source line 1482 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+[reduce [info frame 0]]";# line 1489
+} -result { type source line 1489 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
-test info-30.7 {bs+nl in computed word, in proc} {
+test info-30.7 {bs+nl in computed word, in proc} -body {
proc abra {} {
return "\
-[reduce [info frame 0]]";# line 1488
+[reduce [info frame 0]]";# line 1495
}
- set res [abra]
+ abra
+} -cleanup {
rename abra {}
- set res
-} { type source line 1488 file info.test cmd {info frame 0} proc ::abra level 0}
+} -result { type source line 1495 file info.test cmd {info frame 0} proc ::abra level 0}
-test info-30.8 {bs+nl in computed word, nested eval} {
+test info-30.8 {bs+nl in computed word, nested eval} -body {
eval {
set \
res "\
-[reduce [info frame 0]]";# line 1499
+[reduce [info frame 0]]";# line 1506
}
-} { type source line 1499 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+} -cleanup {unset res} -result { type source line 1506 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
-test info-30.9 {bs+nl in computed word, nested eval} {
+test info-30.9 {bs+nl in computed word, nested eval} -body {
eval {
set \
res "\
[reduce \
- [info frame 0]]";# line 1508
+ [info frame 0]]";# line 1515
}
-} { type source line 1508 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+} -cleanup {unset res} -result { type source line 1515 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
-test info-30.10 {bs+nl in computed word, key to array} {
+test info-30.10 {bs+nl in computed word, key to array} -body {
set tmp([set \
res "\
[reduce \
- [info frame 0]]"]) x ; #1516
+ [info frame 0]]"]) x ; #1523
unset tmp
set res
-} { type source line 1516 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+} -cleanup {unset res} -result { type source line 1523 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
-test info-30.11 {bs+nl in subst arguments, no true counting} {
+test info-30.11 {bs+nl in subst arguments} -body {
subst {[set \
res "\
[reduce \
- [info frame 0]]"]}
-} { type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest}
+ [info frame 0]]"]} ; #1532
+} -cleanup {unset res} -result { type source line 1532 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
-test info-30.12 {bs+nl in computed word, nested eval} {
+test info-30.12 {bs+nl in computed word, nested eval} -body {
eval {
set \
res "\
[set x {}] \
[reduce \
- [info frame 0]]";# line 1534
+ [info frame 0]]";# line 1541
}
-} { type source line 1534 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+} -cleanup {unset res x} -result { type source line 1541 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
-test info-30.13 {bs+nl in literal words, uplevel script, with nested words} {
+test info-30.13 {bs+nl in literal words, uplevel script, with nested words} -body {
subinterp ; set res [interp eval sub { uplevel #0 {
if {1} \
{
set ::res \
- [reduce [info frame 0]];# line 1543
+ [reduce [info frame 0]];# line 1550
}
}
set res }] ; interp delete sub ; set res
-} {type source line 1543 file info.test cmd {info frame 0} level 0}
+} -cleanup {unset res} -result {type source line 1550 file info.test cmd {info frame 0} level 0}
test info-30.14 {bs+nl, literal word, uplevel through proc} {
subinterp ; set res [interp eval sub { proc abra {script} {
@@ -1552,11 +1559,11 @@ test info-30.14 {bs+nl, literal word, uplevel through proc} {
}
set res [abra {
return "\
- [reduce [info frame 0]]";# line 1555
+[reduce [info frame 0]]";# line 1562
}]
rename abra {}
set res }] ; interp delete sub ; set res
-} { type source line 1555 file info.test cmd {info frame 0} proc ::abra}
+} { type source line 1562 file info.test cmd {info frame 0} proc ::abra}
test info-30.15 {bs+nl in literal words, nested proc body, compiled} {
proc a {} {
@@ -1564,7 +1571,7 @@ test info-30.15 {bs+nl in literal words, nested proc body, compiled} {
if {1} \
{
return \
- [reduce [info frame 0]];# line 1567
+ [reduce [info frame 0]];# line 1574
}
}
}
@@ -1572,29 +1579,29 @@ test info-30.15 {bs+nl in literal words, nested proc body, compiled} {
rename a {}
rename b {}
set res
-} {type source line 1567 file info.test cmd {info frame 0} proc ::b level 0}
+} {type source line 1574 file info.test cmd {info frame 0} proc ::b level 0}
test info-30.16 {bs+nl in multi-body switch, compiled} {
proc a {value} {
switch -regexp -- $value \
- ^key { info frame 0; # 1580 } \
- \t### { info frame 0; # 1581 } \
- {[0-9]*} { info frame 0; # 1582 }
+ ^key { info frame 0; # 1587 } \
+ \t### { info frame 0; # 1588 } \
+ {[0-9]*} { info frame 0; # 1589 }
}
set res {}
lappend res [reduce [a {key }]]
lappend res [reduce [a {1alpha}]]
set res "\n[join $res \n]"
} {
-type source line 1580 file info.test cmd {info frame 0} proc ::a level 0
-type source line 1582 file info.test cmd {info frame 0} proc ::a level 0}
+type source line 1587 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1589 file info.test cmd {info frame 0} proc ::a level 0}
test info-30.17 {bs+nl in multi-body switch, direct} {
switch -regexp -- {key } \
- ^key { reduce [info frame 0] ;# 1594 } \
+ ^key { reduce [info frame 0] ;# 1601 } \
\t### { } \
{[0-9]*} { }
-} {type source line 1594 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+} {type source line 1601 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.18 {bs+nl, literal word, uplevel through proc, appended, loss of primary tracking data} {
proc abra {script} {
@@ -1603,7 +1610,7 @@ test info-30.18 {bs+nl, literal word, uplevel through proc, appended, loss of pr
}
set res [abra {
return "\
-[reduce [info frame 0]]";# line 1606, still line of 3 appended script
+[reduce [info frame 0]]";# line 1613, still line of 3 appended script
}]
rename abra {}
set res
@@ -1626,8 +1633,8 @@ test info-30.19 {bs+nl in single-body switch, compiled} {
lappend res [a {1alpha}]
set res "\n[join $res \n]"
} {
-type source line 1617 file info.test cmd {info frame 0} proc ::a level 0
-type source line 1621 file info.test cmd {info frame 0} proc ::a level 0}
+type source line 1624 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1628 file info.test cmd {info frame 0} proc ::a level 0}
test info-30.20 {bs+nl in single-body switch, direct} {
switch -regexp -- {key } { \
@@ -1637,50 +1644,50 @@ test info-30.20 {bs+nl in single-body switch, direct} {
\t### { }
{[0-9]*} { }
}
-} {type source line 1636 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+} {type source line 1643 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.21 {bs+nl in if, full compiled} {
proc a {value} {
if {$value} \
{info frame 0} \
- {info frame 0}
+ {info frame 0} ; # 1653
}
set res {}
lappend res [reduce [a 1]]
lappend res [reduce [a 0]]
set res "\n[join $res \n]"
} {
-type source line 1645 file info.test cmd {info frame 0} proc ::a level 0
-type source line 1646 file info.test cmd {info frame 0} proc ::a level 0}
+type source line 1652 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1653 file info.test cmd {info frame 0} proc ::a level 0}
test info-30.22 {bs+nl in computed word, key to array, compiled} {
proc a {} {
set tmp([set \
res "\
[reduce \
- [info frame 0]]"]) x ; #1661
+ [info frame 0]]"]) x ; #1668
unset tmp
set res
}
set res [a]
rename a {}
set res
-} { type source line 1661 file info.test cmd {info frame 0} proc ::a level 0}
+} { type source line 1668 file info.test cmd {info frame 0} proc ::a level 0}
test info-30.23 {bs+nl in multi-body switch, full compiled} {
proc a {value} {
switch -exact -- $value \
- key { info frame 0; # 1673 } \
- xxx { info frame 0; # 1674 } \
- 000 { info frame 0; # 1675 }
+ key { info frame 0; # 1680 } \
+ xxx { info frame 0; # 1681 } \
+ 000 { info frame 0; # 1682 }
}
set res {}
lappend res [reduce [a key]]
lappend res [reduce [a 000]]
set res "\n[join $res \n]"
} {
-type source line 1673 file info.test cmd {info frame 0} proc ::a level 0
-type source line 1675 file info.test cmd {info frame 0} proc ::a level 0}
+type source line 1680 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1682 file info.test cmd {info frame 0} proc ::a level 0}
test info-30.24 {bs+nl in single-body switch, full compiled} {
proc a {value} {
@@ -1698,8 +1705,138 @@ test info-30.24 {bs+nl in single-body switch, full compiled} {
lappend res [a 000]
set res "\n[join $res \n]"
} {
-type source line 1689 file info.test cmd {info frame 0} proc ::a level 0
-type source line 1693 file info.test cmd {info frame 0} proc ::a level 0}
+type source line 1696 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1700 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.25 {TIP 280 for compiled [subst]} {
+ subst {[reduce [info frame 0]]} ; # 1712
+} {type source line 1712 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.26 {TIP 280 for compiled [subst]} {
+ subst \
+ {[reduce [info frame 0]]} ; # 1716
+} {type source line 1716 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.27 {TIP 280 for compiled [subst]} {
+ subst {
+[reduce [info frame 0]]} ; # 1720
+} {
+type source line 1720 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.28 {TIP 280 for compiled [subst]} {
+ subst {\
+[reduce [info frame 0]]} ; # 1725
+} { type source line 1725 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.29 {TIP 280 for compiled [subst]} {
+ subst {foo\
+[reduce [info frame 0]]} ; # 1729
+} {foo type source line 1729 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.30 {TIP 280 for compiled [subst]} {
+ subst {foo
+[reduce [info frame 0]]} ; # 1733
+} {foo
+type source line 1733 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.31 {TIP 280 for compiled [subst]} {
+ subst {[][reduce [info frame 0]]} ; # 1737
+} {type source line 1737 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.32 {TIP 280 for compiled [subst]} {
+ subst {[\
+][reduce [info frame 0]]} ; # 1741
+} {type source line 1741 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.33 {TIP 280 for compiled [subst]} {
+ subst {[
+][reduce [info frame 0]]} ; # 1745
+} {type source line 1745 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.34 {TIP 280 for compiled [subst]} {
+ subst {[format %s {}
+][reduce [info frame 0]]} ; # 1749
+} {type source line 1749 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.35 {TIP 280 for compiled [subst]} {
+ subst {[format %s {}
+]
+[reduce [info frame 0]]} ; # 1754
+} {
+type source line 1754 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.36 {TIP 280 for compiled [subst]} {
+ subst {
+[format %s {}][reduce [info frame 0]]} ; # 1759
+} {
+type source line 1759 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.37 {TIP 280 for compiled [subst]} {
+ subst {
+[format %s {}]
+[reduce [info frame 0]]} ; # 1765
+} {
+
+type source line 1765 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.38 {TIP 280 for compiled [subst]} {
+ subst {\
+[format %s {}][reduce [info frame 0]]} ; # 1771
+} { type source line 1771 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.39 {TIP 280 for compiled [subst]} {
+ subst {\
+[format %s {}]\
+[reduce [info frame 0]]} ; # 1776
+} { type source line 1776 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.40 {TIP 280 for compiled [subst]} -setup {
+ unset -nocomplain empty
+} -body {
+ set empty {}
+ subst {$empty[reduce [info frame 0]]} ; # 1782
+} -cleanup {
+ unset empty
+} -result {type source line 1782 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.41 {TIP 280 for compiled [subst]} -setup {
+ unset -nocomplain empty
+} -body {
+ set empty {}
+ subst {$empty
+[reduce [info frame 0]]} ; # 1791
+} -cleanup {
+ unset empty
+} -result {
+type source line 1791 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.42 {TIP 280 for compiled [subst]} -setup {
+ unset -nocomplain empty
+} -body {
+ set empty {}; subst {$empty\
+[reduce [info frame 0]]} ; # 1800
+} -cleanup {
+ unset empty
+} -result { type source line 1800 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.43 {TIP 280 for compiled [subst]} -body {
+ unset -nocomplain a\nb
+ set a\nb {}
+ subst {${a
+b}[reduce [info frame 0]]} ; # 1808
+} -cleanup {unset a\nb} -result {type source line 1808 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.44 {TIP 280 for compiled [subst]} {
+ unset -nocomplain a
+ set a(\n) {}
+ subst {$a(
+)[reduce [info frame 0]]} ; # 1814
+} {type source line 1814 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.45 {TIP 280 for compiled [subst]} {
+ unset -nocomplain a
+ set a() {}
+ subst {$a([
+return -level 0])[reduce [info frame 0]]} ; # 1820
+} {type source line 1820 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.46 {TIP 280 for compiled [subst]} {
+ unset -nocomplain a
+ set a(1825) YES; set a(1824) 1824; set a(1826) 1826
+ subst {$a([dict get [info frame 0] line])} ; # 1825
+} YES
+test info-30.47 {TIP 280 for compiled [subst]} {
+ unset -nocomplain a
+ set a(\n1831) YES; set a(\n1830) 1830; set a(\n1832) 1832
+ subst {$a(
+[dict get [info frame 0] line])} ; # 1831
+} YES
+unset -nocomplain a
+
+test info-30.48 {Bug 2850901} testevalex {
+ testevalex {return -level 0 [format %s {}
+][reduce [info frame 0]]} ; # line 2 of the eval
+} {type eval line 2 cmd {info frame 0} proc ::tcltest::RunTest}
+
# -------------------------------------------------------------------------
# literal sharing 2, bug 2933089
@@ -1715,12 +1852,12 @@ test info-39.1 {location information not confused by literal sharing, bug 293308
if "$x != 1" {
} else {
print_one
- } ;#line 1717^
+ } ;#line 1854^
if "$$y != 1" {
} else {
print_one
- } ;#line 1722^
+ } ;#line 1859^
# Do not put the comments listing the line numbers into the
# branches. We need shared literals, and the comments would
# make them different, thus unshared.
@@ -1738,8 +1875,8 @@ test info-39.1 {location information not confused by literal sharing, bug 293308
rename get_frame_info {}
rename test_info_frame {}
rename print_one {}
-} -result {type source line 1717 file info.test cmd print_one proc ::test_info_frame level 1
-type source line 1722 file info.test cmd print_one proc ::test_info_frame level 1}
+} -result {type source line 1854 file info.test cmd print_one proc ::test_info_frame level 1
+type source line 1859 file info.test cmd print_one proc ::test_info_frame level 1}
# -------------------------------------------------------------------------
# Tests moved to the end to not disturb other tests and their locations.
@@ -1767,11 +1904,11 @@ test info-38.6 {location information for uplevel, ppl, proc-proc-literal} -match
}
join [lrange [datal] 0 4] \n
}
-} -result {* {type source line 1753 file info.test cmd {info frame $level} proc ::etrace level 0}
-* {type source line 1765 file info.test cmd etrace proc ::control}
-* {type source line 1760 file info.test cmd {uplevel 1 $script} proc ::control}
-* {type source line 1763 file info.test cmd control proc ::datal level 1}
-* {type source line 1768 file info.test cmd datal level 2}} -cleanup {interp delete sub}
+} -result {* {type source line 1890 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type source line 1902 file info.test cmd etrace proc ::control}
+* {type source line 1897 file info.test cmd {uplevel 1 $script} proc ::control}
+* {type source line 1900 file info.test cmd control proc ::datal level 1}
+* {type source line 1905 file info.test cmd datal level 2}} -cleanup {interp delete sub}
test info-38.4 {location information for uplevel, dpv, direct-proc-literal} -match glob -setup {subinterp} -body {
interp eval sub {
@@ -1793,10 +1930,10 @@ test info-38.4 {location information for uplevel, dpv, direct-proc-literal} -mat
etrace
}] 0 3] \n
}
-} -result {* {type source line 1782 file info.test cmd {info frame $level} proc ::etrace level 0}
-* {type source line 1793 file info.test cmd etrace proc ::control}
-* {type source line 1789 file info.test cmd {uplevel 1 $script} proc ::control}
-* {type source line 1791 file info.test cmd control level 1}} -cleanup {interp delete sub}
+} -result {* {type source line 1919 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type source line 1930 file info.test cmd etrace proc ::control}
+* {type source line 1926 file info.test cmd {uplevel 1 $script} proc ::control}
+* {type source line 1928 file info.test cmd control level 1}} -cleanup {interp delete sub}
test info-38.2 {location information for uplevel, dl, direct-literal} -match glob -setup {subinterp} -body {
interp eval sub {
@@ -1814,9 +1951,12 @@ test info-38.2 {location information for uplevel, dl, direct-literal} -match glo
etrace
}] 0 2] \n
}
-} -result {* {type source line 1807 file info.test cmd {info frame $level} proc ::etrace level 0}
-* {type source line 1814 file info.test cmd etrace level 1}
-* {type source line 1812 file info.test cmd uplevel\\ \\\\ level 1}} -cleanup {interp delete sub}
+} -result {* {type source line 1944 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type source line 1951 file info.test cmd etrace level 1}
+* {type source line 1949 file info.test cmd uplevel\\ \\\\ level 1}} -cleanup {interp delete sub}
+
+# -------------------------------------------------------------------------
+unset -nocomplain res
# cleanup
catch {namespace delete test_ns_info1 test_ns_info2}