diff options
Diffstat (limited to 'tests/info.test')
| -rw-r--r-- | tests/info.test | 1367 |
1 files changed, 301 insertions, 1066 deletions
diff --git a/tests/info.test b/tests/info.test index ef41bdf..937da8c 100644 --- a/tests/info.test +++ b/tests/info.test @@ -5,24 +5,21 @@ # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # -# Copyright © 1991-1994 The Regents of the University of California. -# Copyright © 1994-1997 Sun Microsystems, Inc. -# Copyright © 1998-1999 Scriptics Corporation. -# Copyright © 2006 ActiveState +# Copyright (c) 1991-1994 The Regents of the University of California. +# Copyright (c) 1994-1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright (c) 2006 ActiveState # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # DO NOT DELETE THIS LINE -if {{::tcltest} ni [namespace children]} { - package require tcltest 2.5 +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest 2 namespace import -force ::tcltest::* } -::tcltest::loadTestedCommands -source [file join [file dirname [info script]] tcltests.tcl] -catch [list package require -exact tcl::test [info patchlevel]] -testConstraint zlib [llength [info commands zlib]] + # Set up namespaces needed to test operation of "info args", "info body", # "info default", and "info procs" with imported procedures. @@ -33,7 +30,7 @@ namespace eval test_ns_info1 { proc p {x} {return "x=$x"} proc q {{y 27} {z {}}} {return "y=$y"} } - + test info-1.1 {info args option} { proc t1 {a bbb c} {return foo} info args t1 @@ -87,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} -body { +test info-2.5 {info body option, returning bytecompiled bodies} { catch {unset args} proc foo {args} { foreach v $args { @@ -96,12 +93,12 @@ test info-2.5 {info body option, returning bytecompiled bodies} -body { } } foo a - eval [info body foo] -} -returnCodes error -result {can't read "args": no such variable} + list [catch [info body foo] msg] $msg +} {1 {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] -test info-2.6 {info body option, returning list bodies} deprecated { +test info-2.6 {info body option, returning list bodies} { proc foo args [list subst bar] list [string bytelength [info body foo]] \ [foo; string bytelength [info body foo]] @@ -110,36 +107,36 @@ test info-2.6 {info body option, returning list bodies} deprecated { proc testinfocmdcount {} { set x [info cmdcount] set y 12345 - set z [info cmdc] - expr {$z-$x} + set z [info cm] + expr $z-$x } test info-3.1 {info cmdcount compiled} { testinfocmdcount } 4 -test info-3.2 {info cmdcount evaled} -body { +test info-3.2 {info cmdcount evaled} { set x [info cmdcount] set y 12345 - set z [info cmdc] - 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 + set z [info cm] + expr $z-$x +} 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} -body { +test info-4.1 {info commands option} { 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] -} -cleanup {unset x} -result {1 1 1 1} -test info-4.2 {info commands option} -body { +} {1 1 1 1} +test info-4.2 {info commands option} { proc t1 {} {} rename t1 {} - string match {* t1 *} \ - [info comm] -} -result 0 + set x [info comm] + string match {* t1 *} $x +} 0 test info-4.3 {info commands option} { proc _t1_ {} {} proc _t2_ {} {} @@ -180,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} -body { +test info-6.2 {info default option} { proc t1 {a b {c d} {e "long default value"}} {} set value 12345 info d t1 a value - return $value -} -cleanup {unset value} -result {} -test info-6.3 {info default option} -body { + set value +} {} +test info-6.3 {info default option} { proc t1 {a b {c d} {e "long default value"}} {} info default t1 c value -} -cleanup {unset value} -result 1 -test info-6.4 {info default option} -body { +} 1 +test info-6.4 {info default option} { proc t1 {a b {c d} {e "long default value"}} {} set value 12345 info default t1 c value - return $value -} -cleanup {unset value} -result d -test info-6.5 {info default option} -body { + set value +} d +test info-6.5 {info default option} { proc t1 {a b {c d} {e "long default value"}} {} set value 12345 set x [info default t1 e value] list $x $value -} -cleanup {unset x value} -result {1 {long default value}} +} {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"} @@ -214,18 +211,18 @@ 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} -} -cleanup {unset a} -body { +} -body { set a(0) 88 proc t1 {a b} {} info default t1 a a -} -returnCodes error -result {can't set "a": variable is array} +} -returnCodes error -result {couldn't store default value in variable "a"} test info-6.10 {info default option} -setup { catch {unset a} -} -cleanup {unset a} -body { +} -body { set a(0) 88 proc t1 {{a 18} b} {} info default t1 a a -} -returnCodes error -result {can't set "a": variable is array} +} -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 { @@ -233,26 +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} -body { +test info-7.1 {info exists option} { set value foo info exists value -} -cleanup {unset value} -result 1 - -test info-7.2 {info exists option} -setup {catch {unset _nonexistent_}} -body { +} 1 +catch {unset _nonexistent_} +test info-7.2 {info exists option} { info exists _nonexistent_ -} -result 0 +} 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} -body { +test info-7.4 {info exists option} { proc t1 {x} { global _nonexistent_ return [info exists _nonexistent_] } t1 2 -} -setup {unset -nocomplain _nonexistent_} -result 0 +} 0 test info-7.5 {info exists option} { proc t1 {x} { set y 47 @@ -278,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} -body { +test info-8.1 {info globals option} { 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] -} -cleanup {unset x y value a} -result {1 1 1 0} -test info-8.2 {info globals option} -body { +} {1 1 1 0} +test info-8.2 {info globals option} { set _xxx1 1 set _xxx2 2 lsort [info g _xxx*] -} -cleanup {unset _xxx1 _xxx2} -result {_xxx1 _xxx2} +} {_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} -body { +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] -} -cleanup {unset x} -result {x {} x x x} +} {x {} x x x} test info-8.5 {info globals option: only return existing global variables} { -setup { - unset -nocomplain ::NO_SUCH_VAR + catch {unset ::NO_SUCH_VAR} proc evalInProc script {eval $script} } -body { @@ -325,7 +323,7 @@ test info-9.2 {info level option} { } {1 {t1 146 testString}} test info-9.3 {info level option} { proc t1 {a b} { - t2 [expr {$a*2}] $b + t2 [expr $a*2] $b } proc t2 {x y} { list [info level] [info level 1] [info level 2] [info level -1] \ @@ -358,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} -body { - namespace eval t {info level 0} -} -cleanup { +test info-9.10 {info level option, namespaces} { + set msg [namespace eval t {info level 0}] namespace delete t -} -result {namespace eval t {info level 0}} + set msg +} {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 @@ -394,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; unset savedLibrary +set tcl_library $savedLibrary test info-11.1 {info loaded option} -body { - info loaded a b c -} -returnCodes error -result {wrong # args: should be "info loaded ?interp? ?packageName?"} -test info-11.2 {info loaded option} -body { - info loaded {}; info loaded gorp -} -returnCodes error -result {could not find interpreter "gorp"} + 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-12.1 {info locals option} -body { +test info-12.1 {info locals option} { set a 22 proc t1 {x y} { set b 13 @@ -414,7 +412,7 @@ test info-12.1 {info locals option} -body { return [info locals] } lsort [t1 23 24] -} -cleanup {unset a aa} -result {b c x y} +} {b c x y} test info-12.2 {info locals option} { proc t1 {x y} { set xx1 2 @@ -454,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} -body { +test info-14.1 {info patchlevel option} { set a [info patchlevel] regexp {[0-9]+\.[0-9]+([p[0-9]+)?} $a -} -cleanup {unset a} -result 1 +} 1 test info-14.2 {info patchlevel option} -returnCodes error -body { info patchlevel a } -result {wrong # args: should be "info patchlevel"} @@ -467,16 +465,16 @@ test info-14.3 {info patchlevel option} -setup { unset tcl_patchLevel info patchlevel } -cleanup { - set tcl_patchLevel $t; unset t + set tcl_patchLevel $t } -returnCodes error -result {can't read "tcl_patchLevel": no such variable} -test info-15.1 {info procs option} -body { +test info-15.1 {info procs option} { proc t1 {} {} proc t2 {} {} set x " [info procs] " list [string match {* t1 *} $x] [string match {* t2 *} $x] \ [string match {* _undefined_ *} $x] -} -cleanup {unset x} -result {1 1 0} +} {1 1 0} test info-15.2 {info procs option} { proc _tt1 {} {} proc _tt2 {} {} @@ -493,7 +491,7 @@ test info-15.4 {info procs option} -setup { namespace eval test_ns_info2 { namespace import ::test_ns_info1::* proc r {} {} - list [lsort [info procs]] [info procs p*] + list [info procs] [info procs p*] } } -result {{p q r} p} test info-15.5 {info procs option with a proc in a namespace} -setup { @@ -575,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} -body { +test info-16.6 {info script option} { set script [info script] list [file tail [info script]] \ [info script newname.txt] \ [file tail [info script $script]] -} -result [list info.test newname.txt info.test] -cleanup {unset script} -test info-16.7 {info script option} -body { +} [list info.test newname.txt info.test] +test info-16.7 {info script option} { set script [info script] info script newname.txt list [source $gorpfile] [file tail [info script]] \ [file tail [info script $script]] -} -result [list $gorpfile newname.txt info.test] -cleanup {unset script} +} [list $gorpfile newname.txt info.test] 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; unset gorpfile +removeFile gorp.info 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} -body { +test info-18.1 {info tclversion option} { scan [info tclversion] "%d.%d%c" a b c -} -cleanup {unset -nocomplain a b c} -result 2 +} 2 test info-18.2 {info tclversion option} -body { info t 2 } -returnCodes error -result {wrong # args: should be "info tclversion"} @@ -610,10 +608,10 @@ test info-18.3 {info tclversion option} -body { } -returnCodes error -setup { set t $tcl_version } -cleanup { - set tcl_version $t; unset t + set tcl_version $t } -result {can't read "tcl_version": no such variable} -test info-19.1 {info vars option} -body { +test info-19.1 {info vars option} { set a 1 set b 2 proc t1 {x y} { @@ -622,8 +620,8 @@ test info-19.1 {info vars option} -body { return [info vars] } lsort [t1 18 19] -} -cleanup {unset a b} -result {a b c x y} -test info-19.2 {info vars option} -body { +} {a b c x y} +test info-19.2 {info vars option} { set xxx1 1 set xxx2 2 proc t1 {xxa y} { @@ -632,7 +630,7 @@ test info-19.2 {info vars option} -body { return [info vars x*] } lsort [t1 18 19] -} -cleanup {unset xxx1 xxx2} -result {xxa xxx1 xxx2} +} {xxa xxx1 xxx2} test info-19.3 {info vars option} { lsort [info vars] } [lsort [info globals]] @@ -655,9 +653,9 @@ test info-19.6 {info vars: Bug 1072654} -setup { namespace delete x } -result {} -set functions {abs acos asin atan atan2 bool ceil cos cosh double entier exp floor fmod hypot int isfinite isinf isnan isnormal isqrt issubnormal isunordered log log10 max min pow rand round sin sinh sqrt srand tan tanh wide} +set functions {abs acos asin atan atan2 bool ceil cos cosh double entier exp floor fmod hypot int isqrt log log10 max min pow rand round sin sinh sqrt srand tan tanh wide} # Check whether the extra testing functions are defined... -if {!([catch {expr {T1()}} msg] && ($msg eq {invalid command name "tcl::mathfunc::T1"}))} { +if {!([catch {expr T1()} msg] && ($msg eq {invalid command name "tcl::mathfunc::T1"}))} { set functions "T1 T2 T3 $functions" ;# A lazy way of prepending! } test info-20.1 {info functions option} {info functions sin} sin @@ -671,52 +669,52 @@ 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 ?arg ...?"} +} -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, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} +} -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, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} +} -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, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} +} -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, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} +} -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} ## # ### ### ### ######### ######### ######### ## 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 cmd [dict get $frame cmd] + set pos [lsearch -exact $frame cmd] + incr pos + set cmd [lindex $frame $pos] if {[regexp \n $cmd]} { - dict set frame cmd \ - [string range [lindex [split $cmd \n] 0] 0 end-4] + set first [string range [lindex [split $cmd \n] 0] 0 end-4] + set frame [lreplace $frame $pos $pos $first] } - if {[dict exists $frame file]} { - dict set frame file \ - [file tail [dict get $frame file]] + set pos [lsearch -exact $frame file] + if {$pos >=0} { + incr pos + set tail [file tail [lindex $frame $pos]] + set frame [lreplace $frame $pos $pos $tail] } - return $frame + set frame } - proc subinterp {} { interp create sub ; interp debug sub -frame 1; interp eval sub [list proc reduce [info args reduce] [info body reduce]] } - ## Helper # Generate a stacktrace from the current location to top. This code # not only depends on the exact location of things, but also on the @@ -733,6 +731,8 @@ proc etrace {} { return $res } +## + test info-22.0 {info frame, levels} {!singleTestInterp} { info frame } 7 @@ -748,29 +748,24 @@ 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 */info.test cmd {info frame 0} proc ::tcltest::RunTest} +} -result {type source line 750 file * 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 */info.test cmd {info frame 0} proc ::tcltest::RunTest} -cleanup {unset res} +} -result {type source line 753 file * cmd {info frame 0} proc ::tcltest::RunTest} test info-22.5 {info frame, current, absolute} -constraints {!singleTestInterp} -match glob -body { reduce [info frame 7] -} -result {type source line 756 file info.test cmd {info frame 7} proc ::tcltest::RunTest} +} -result {type source line 756 file * 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} -match glob -body { +test info-22.8 {info frame, basic trace} -constraints {!singleTestInterp} -match glob -body { join [lrange [etrace] 0 2] \n -} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0} +} -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 - - - - @@ -778,35 +773,41 @@ 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} -constraints {!singleTestInterp} -body { - list [i eval {info frame}] [i eval {eval {info frame}}] -} -setup {interp create i} -cleanup {interp delete i} -result {1 2} -test info-23.1 {eval'd info frame, semi-dynamic} -constraints {!singleTestInterp} -body { - i eval {eval info frame} -} -setup {interp create i} -cleanup {interp delete i} -result 2 -test info-23.2 {eval'd info frame, dynamic} -constraints {!singleTestInterp} -body { - i eval { set script {info frame} - eval $script} -} -setup {interp create i} -cleanup {interp delete i} -result 2 +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} -match glob -body { eval { info frame 0 } -} -result {type source line 793 file * cmd {info frame 0} proc ::tcltest::RunTest} +} -result {type source line 788 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} -cleanup {unset script} -body { +test info-23.5 {eval'd info frame, dynamic} { set script {info frame 0} eval $script -} -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 { +} {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 { set script {etrace} join [lrange [eval $script] 0 2] \n -} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0} +} -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 805 file info.test cmd {eval $script} proc ::tcltest::RunTest}} +* {type source line 800 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 @@ -829,7 +830,7 @@ test info-24.0 {info frame, interaction, namespace eval} -body { reduce [foo::bar] } -cleanup { namespace delete foo -} -result {type source line 825 file info.test cmd {info frame 0} proc ::foo::bar level 0} +} -result {type source line 826 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- @@ -843,7 +844,7 @@ test info-24.1 {info frame, interaction, if} -body { reduce [foo::bar] } -cleanup { namespace delete foo -} -result {type source line 839 file info.test cmd {info frame 0} proc ::foo::bar level 0} +} -result {type source line 840 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- @@ -852,13 +853,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 853 file info.test cmd {info frame 0} proc ::foo::bar level 0} +} -result {type source line 854 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- @@ -871,7 +872,7 @@ test info-24.3 {info frame, interaction, catch} -body { reduce [foo::bar] } -cleanup { namespace delete foo -} -result {type source line 867 file info.test cmd {info frame 0} proc ::foo::bar level 0} +} -result {type source line 868 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- @@ -879,13 +880,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 880 file info.test cmd {info frame 0} proc ::foo::bar level 0} +} -result {type source line 881 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- @@ -899,7 +900,7 @@ test info-24.5 {info frame, interaction, for} -body { reduce [foo::bar] } -cleanup { namespace delete foo -} -result {type source line 894 file info.test cmd {info frame 0} proc ::foo::bar level 0} +} -result {type source line 895 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- @@ -916,7 +917,7 @@ test info-24.6.0 {info frame, interaction, switch, list body} -body { } -cleanup { namespace delete foo unset x -} -result {type source line 910 file info.test cmd {info frame 0} proc ::foo::bar level 0} +} -result {type source line 911 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- @@ -931,7 +932,7 @@ test info-24.6.1 {info frame, interaction, switch, multi-body} -body { } -cleanup { namespace delete foo unset x -} -result {type source line 926 file info.test cmd {info frame 0} proc ::foo::bar level 0} +} -result {type source line 927 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- @@ -957,9 +958,9 @@ dict for {k v} {foo bar} { test info-24.7 {info frame, interaction, dict for} { reduce [foo::bar] -} {type source line 955 file info.test cmd {info frame 0} proc ::foo::bar level 0} +} {type source line 956 file info.test cmd {info frame 0} proc ::foo::bar level 0} -namespace delete foo; unset k v +namespace delete foo # ------------------------------------------------------------------------- @@ -971,10 +972,10 @@ dict with thedict { test info-24.8 {info frame, interaction, dict with} { reduce [foo::bar] -} {type source line 969 file info.test cmd {info frame 0} proc ::foo::bar level 0} +} {type source line 970 file info.test cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo -unset thedict foo +unset thedict # ------------------------------------------------------------------------- @@ -982,14 +983,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 983 file info.test cmd {info frame 0} proc ::foo::bar level 0} +} {type source line 984 file info.test cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo -#unset x +unset x # ------------------------------------------------------------------------- @@ -999,32 +1000,32 @@ eval { test info-25.0 {info frame, proc in eval} { reduce [bar] -} {type source line 997 file info.test cmd {info frame 0} proc ::bar level 0} +} {type source line 998 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 1005 file info.test cmd {info frame 0} proc ::bar level 0} +} {type source line 1006 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} -cleanup {unset res} -body { +test info-30.0 {bs+nl in literal words} { if {1} { set res \ - [reduce [info frame 0]];#1018 + [reduce [info frame 0]];# 1019 } - return $res + set 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. -} -result {type source line 1018 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} {type source line 1019 file info.test cmd {info frame 0} proc ::tcltest::RunTest} # ------------------------------------------------------------------------- # See 24.0 - 24.5 for similar situations, using literal scripts. @@ -1033,45 +1034,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} -body {namespace eval foo {variable res {}} +test info-31.0 {ns eval, script in variable} {set res {} namespace eval foo $body - 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 { + set res +} {type eval line 3 cmd {info frame 0} level 0} +catch {namespace delete foo} + +test info-31.1 {if, script in variable} { if 1 $body - return $res -} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} + set res +} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} -test info-31.1a {if, script in variable} -cleanup {unset res a flag} -body { +test info-31.1a {if, script in variable} { if 1 then $body - return $res -} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} + set res +} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} -test info-31.2 {while, script in variable} -cleanup {unset flag res a} -body { +test info-31.2 {while, script in variable} { set flag 1 while {$flag} $body - return $res -} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} + set res +} {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} -cleanup {unset var res a flag} -body { +test info-31.4 {foreach, script in variable} { foreach var val $body set res -} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} +} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} -test info-31.5 {for, script in variable} -cleanup {unset flag res a} -body { +test info-31.5 {for, script in variable} { set flag 1 for {} {$flag} {} $body - return $res -} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} + set res +} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} -test info-31.6 {eval, script in variable} -cleanup {unset res a flag} -body { +test info-31.6 {eval, script in variable} { eval $body - return $res -} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} + set res +} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} # ------------------------------------------------------------------------- @@ -1083,7 +1084,7 @@ set body { namespace eval foo {} set x foo -switch -exact -- $x $body; unset body +switch -exact -- $x $body test info-31.7 {info frame, interaction, switch, dynamic} -body { reduce [foo::bar] @@ -1118,7 +1119,7 @@ test info-33.0 {{*}, literal, direct} -body { reduce [foo::bar] } -cleanup { namespace delete foo -} -result {type source line 1115 file info.test cmd {info frame 0} proc ::foo::bar level 0} +} -result {type source line 1116 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- @@ -1134,7 +1135,7 @@ test info-33.1 {{*}, literal, simple, bytecompiled} -body { reduce [foo::bar] } -cleanup { namespace delete foo -} -result {type source line 1130 file info.test cmd {info frame 0} proc ::foo::bar level 0} +} -result {type source line 1131 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- @@ -1145,7 +1146,7 @@ namespace {*}" " test info-33.2 {{*}, literal, direct} { reduce [foo::bar] -} {type source line 1144 file info.test cmd {info frame 0} proc ::foo::bar level 0} +} {type source line 1145 file info.test cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo @@ -1171,7 +1172,7 @@ proc foo::bar {} { } test info-33.3 {{*}, literal, simple, bytecompiled} { reduce [foo::bar] -} {type source line 1169 file info.test cmd {info frame 0} proc ::foo::bar level 0} +} {type source line 1170 file info.test cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo @@ -1233,7 +1234,7 @@ proc foo {} { } test info-35.0 {apply, literal} { reduce [foo] -} {type source line 1231 file info.test cmd {info frame 0} lambda { +} {type source line 1232 file info.test cmd {info frame 0} lambda { {x y} {info frame 0} } level 0} @@ -1260,9 +1261,9 @@ proc foo::bar {} { } set x } -test info-36.0 {info frame, dict for, bcc} -body { +test info-36.0 {info frame, dict for, bcc} { reduce [foo::bar] -} -result {type source line 1259 file info.test cmd {info frame 0} proc ::foo::bar level 0} +} {type source line 1260 file info.test cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo @@ -1277,9 +1278,9 @@ proc foo::bar {} { set y } -test info-36.1.0 {switch, list literal, bcc} -body { +test info-36.1.0 {switch, list literal, bcc} { reduce [foo::bar] -} -result {type source line 1275 file info.test cmd {info frame 0} proc ::foo::bar level 0} +} {type source line 1276 file info.test cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo @@ -1292,15 +1293,15 @@ proc foo::bar {} { set y } -test info-36.1.1 {switch, multi-body literals, bcc} -body { +test info-36.1.1 {switch, multi-body literals, bcc} { reduce [foo::bar] -} -result {type source line 1291 file info.test cmd {info frame 0} proc ::foo::bar level 0} +} {type source line 1292 file info.test cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo # ------------------------------------------------------------------------- -test info-37.0 {eval pure list, single line} -match glob -body { +test info-37.0 {eval pure list, single line} -constraints {!singleTestInterp} -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. @@ -1317,10 +1318,10 @@ test info-37.0 {eval pure list, single line} -match glob -body { break }] eval $cmd - return $res -} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0} + set 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}} -cleanup {unset foo cmd res b c} +* {type eval line 1 cmd foreac proc ::tcltest::RunTest}} # ------------------------------------------------------------------------- @@ -1359,9 +1360,9 @@ test info-38.1 {location information for uplevel, dv, direct-var} -match glob -b etrace } join [lrange [uplevel \#0 $script] 0 2] \n -} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0} +} -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 1361 file info.test cmd {uplevel \\#0 $script} proc ::tcltest::RunTest}} -cleanup {unset script y} +* {type source line 1362 file info.test cmd {uplevel \\#0 $script} proc ::tcltest::RunTest}} # 38.2 moved to bottom to not disturb other tests with the necessary changes to this one. @@ -1378,10 +1379,10 @@ test info-38.3 {location information for uplevel, dpv, direct-proc-var} -match g etrace } join [lrange [control y $script] 0 3] \n -} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0} +} -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 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} +* {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}} # 38.4 moved to bottom to not disturb other tests with the necessary changes to this one. @@ -1395,11 +1396,11 @@ test info-38.3 {location information for uplevel, dpv, direct-proc-var} -match g test info-38.5 {location information for uplevel, ppv, proc-proc-var} -match glob -body { join [lrange [datav] 0 4] \n -} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0} +} -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 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}} +* {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}} # 38.6 moved to bottom to not disturb other tests with the necessary changes to this one. @@ -1409,14 +1410,6 @@ 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 730 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 @@ -1431,127 +1424,127 @@ test info-39.0 {location information not confused by literal sharing} -body { set res [::foo::bar] namespace delete ::foo join $res \n -} -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} +} -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} # ------------------------------------------------------------------------- # Additional tests for info-30.*, handling of continuation lines (bs+nl sequences). -test info-30.1 {bs+nl in literal words, procedure body, compiled} -body { +test info-30.1 {bs+nl in literal words, procedure body, compiled} { proc abra {} { if {1} \ { return \ - [reduce [info frame 0]];# line 1446 + [reduce [info frame 0]];# line 1439 } } - abra -} -cleanup { + set res [abra] rename abra {} -} -result {type source line 1446 file info.test cmd {info frame 0} proc ::abra level 0} + set res +} {type source line 1439 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 { - variable res \ - [info frame 0];# line 1457 + set res \ + [reduce [info frame 0]];# line 1450 } - return [reduce $xxx::res] -} {type source line 1457 file info.test cmd {info frame 0} level 0} + set res +} {type source line 1450 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 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} + 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} -test info-30.4 {bs+nl in literal words, eval script} -cleanup {unset res} -body { +test info-30.4 {bs+nl in literal words, eval script} { eval { set ::res \ - [reduce [info frame 0]];# line 1471 + [reduce [info frame 0]];# line 1464 } - return $res -} -result {type source line 1471 file info.test cmd {info frame 0} proc ::tcltest::RunTest} + set res +} {type source line 1464 file info.test cmd {info frame 0} proc ::tcltest::RunTest} -test info-30.5 {bs+nl in literal words, eval script, with nested words} -body { +test info-30.5 {bs+nl in literal words, eval script, with nested words} { eval { if {1} \ { set ::res \ - [reduce [info frame 0]];# line 1481 + [reduce [info frame 0]];# line 1474 } } - return $res -} -cleanup {unset res} -result {type source line 1481 file info.test cmd {info frame 0} proc ::tcltest::RunTest} + set res +} {type source line 1474 file info.test cmd {info frame 0} proc ::tcltest::RunTest} -test info-30.6 {bs+nl in computed word} -cleanup {unset res} -body { +test info-30.6 {bs+nl in computed word} { set res "\ -[reduce [info frame 0]]";# line 1489 -} -result { type source line 1489 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +[reduce [info frame 0]]";# line 1482 +} { type source line 1482 file info.test cmd {info frame 0} proc ::tcltest::RunTest} -test info-30.7 {bs+nl in computed word, in proc} -body { +test info-30.7 {bs+nl in computed word, in proc} { proc abra {} { return "\ -[reduce [info frame 0]]";# line 1495 +[reduce [info frame 0]]";# line 1488 } - abra -} -cleanup { + set res [abra] rename abra {} -} -result { type source line 1495 file info.test cmd {info frame 0} proc ::abra level 0} + set res +} { type source line 1488 file info.test cmd {info frame 0} proc ::abra level 0} -test info-30.8 {bs+nl in computed word, nested eval} -body { +test info-30.8 {bs+nl in computed word, nested eval} { eval { set \ res "\ -[reduce [info frame 0]]";# line 1506 +[reduce [info frame 0]]";# line 1499 } -} -cleanup {unset res} -result { type source line 1506 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} { type source line 1499 file info.test cmd {info frame 0} proc ::tcltest::RunTest} -test info-30.9 {bs+nl in computed word, nested eval} -body { +test info-30.9 {bs+nl in computed word, nested eval} { eval { set \ res "\ [reduce \ - [info frame 0]]";# line 1515 + [info frame 0]]";# line 1508 } -} -cleanup {unset res} -result { type source line 1515 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} { type source line 1508 file info.test cmd {info frame 0} proc ::tcltest::RunTest} -test info-30.10 {bs+nl in computed word, key to array} -body { +test info-30.10 {bs+nl in computed word, key to array} { set tmp([set \ res "\ [reduce \ - [info frame 0]]"]) x ; #1523 + [info frame 0]]"]) x ; #1516 unset tmp set res -} -cleanup {unset res} -result { type source line 1523 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} { type source line 1516 file info.test cmd {info frame 0} proc ::tcltest::RunTest} -test info-30.11 {bs+nl in subst arguments} -body { +test info-30.11 {bs+nl in subst arguments, no true counting} { subst {[set \ res "\ [reduce \ - [info frame 0]]"]} ; #1532 -} -cleanup {unset res} -result { type source line 1532 file info.test cmd {info frame 0} proc ::tcltest::RunTest} + [info frame 0]]"]} +} { type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest} -test info-30.12 {bs+nl in computed word, nested eval} -body { +test info-30.12 {bs+nl in computed word, nested eval} { eval { set \ res "\ [set x {}] \ [reduce \ - [info frame 0]]";# line 1541 + [info frame 0]]";# line 1534 } -} -cleanup {unset res x} -result { type source line 1541 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} { type source line 1534 file info.test cmd {info frame 0} proc ::tcltest::RunTest} -test info-30.13 {bs+nl in literal words, uplevel script, with nested words} -body { +test info-30.13 {bs+nl in literal words, uplevel script, with nested words} { subinterp ; set res [interp eval sub { uplevel #0 { if {1} \ { set ::res \ - [reduce [info frame 0]];# line 1550 + [reduce [info frame 0]];# line 1543 } } set res }] ; interp delete sub ; set res -} -cleanup {unset res} -result {type source line 1550 file info.test cmd {info frame 0} level 0} +} {type source line 1543 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} { @@ -1559,11 +1552,11 @@ test info-30.14 {bs+nl, literal word, uplevel through proc} { } set res [abra { return "\ -[reduce [info frame 0]]";# line 1562 + [reduce [info frame 0]]";# line 1555 }] rename abra {} set res }] ; interp delete sub ; set res -} { type source line 1562 file info.test cmd {info frame 0} proc ::abra} +} { type source line 1555 file info.test cmd {info frame 0} proc ::abra} test info-30.15 {bs+nl in literal words, nested proc body, compiled} { proc a {} { @@ -1571,7 +1564,7 @@ test info-30.15 {bs+nl in literal words, nested proc body, compiled} { if {1} \ { return \ - [reduce [info frame 0]];# line 1574 + [reduce [info frame 0]];# line 1567 } } } @@ -1579,29 +1572,29 @@ test info-30.15 {bs+nl in literal words, nested proc body, compiled} { rename a {} rename b {} set res -} {type source line 1574 file info.test cmd {info frame 0} proc ::b level 0} +} {type source line 1567 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; # 1587 } \ - \t### { info frame 0; # 1588 } \ - {[0-9]*} { info frame 0; # 1589 } + ^key { info frame 0; # 1580 } \ + \t### { info frame 0; # 1581 } \ + {[0-9]*} { info frame 0; # 1582 } } set res {} lappend res [reduce [a {key }]] lappend res [reduce [a {1alpha}]] set res "\n[join $res \n]" } { -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} +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} test info-30.17 {bs+nl in multi-body switch, direct} { switch -regexp -- {key } \ - ^key { reduce [info frame 0] ;# 1601 } \ + ^key { reduce [info frame 0] ;# 1594 } \ \t### { } \ {[0-9]*} { } -} {type source line 1601 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} {type source line 1594 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} { @@ -1610,7 +1603,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 1613, still line of 3 appended script +[reduce [info frame 0]]";# line 1606, still line of 3 appended script }] rename abra {} set res @@ -1633,8 +1626,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 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} +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} test info-30.20 {bs+nl in single-body switch, direct} { switch -regexp -- {key } { \ @@ -1644,50 +1637,50 @@ test info-30.20 {bs+nl in single-body switch, direct} { \t### { } {[0-9]*} { } } -} {type source line 1643 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} {type source line 1636 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} ; # 1653 + {info frame 0} } set res {} lappend res [reduce [a 1]] lappend res [reduce [a 0]] set res "\n[join $res \n]" } { -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} +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} test info-30.22 {bs+nl in computed word, key to array, compiled} { proc a {} { set tmp([set \ res "\ [reduce \ - [info frame 0]]"]) x ; #1668 + [info frame 0]]"]) x ; #1661 unset tmp set res } set res [a] rename a {} set res -} { type source line 1668 file info.test cmd {info frame 0} proc ::a level 0} +} { type source line 1661 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; # 1680 } \ - xxx { info frame 0; # 1681 } \ - 000 { info frame 0; # 1682 } + key { info frame 0; # 1673 } \ + xxx { info frame 0; # 1674 } \ + 000 { info frame 0; # 1675 } } set res {} lappend res [reduce [a key]] lappend res [reduce [a 000]] set res "\n[join $res \n]" } { -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} +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} test info-30.24 {bs+nl in single-body switch, full compiled} { proc a {value} { @@ -1705,138 +1698,8 @@ 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 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} - +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} # ------------------------------------------------------------------------- # literal sharing 2, bug 2933089 @@ -1852,12 +1715,12 @@ test info-39.1 {location information not confused by literal sharing, bug 293308 if "$x != 1" { } else { print_one - } ;#line 1854^ + } ;#line 1717^ if "$$y != 1" { } else { print_one - } ;#line 1859^ + } ;#line 1722^ # 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. @@ -1875,8 +1738,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 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} +} -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} # ------------------------------------------------------------------------- # Tests moved to the end to not disturb other tests and their locations. @@ -1904,11 +1767,11 @@ test info-38.6 {location information for uplevel, ppl, proc-proc-literal} -match } join [lrange [datal] 0 4] \n } -} -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} +} -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} test info-38.4 {location information for uplevel, dpv, direct-proc-literal} -match glob -setup {subinterp} -body { interp eval sub { @@ -1930,10 +1793,10 @@ test info-38.4 {location information for uplevel, dpv, direct-proc-literal} -mat etrace }] 0 3] \n } -} -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} +} -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} test info-38.2 {location information for uplevel, dl, direct-literal} -match glob -setup {subinterp} -body { interp eval sub { @@ -1951,637 +1814,9 @@ test info-38.2 {location information for uplevel, dl, direct-literal} -match glo etrace }] 0 2] \n } -} -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} - -# This test at the end of this file _only_ to avoid disturbing above line -# numbers. It _belongs_ after info-9.12 -test info-9.13 {info level option, value in global context} -body { - uplevel #0 {info level 2} -} -returnCodes error -result {bad level "2"} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - catch {*}{ - {info frame 0} - res - } - return $res -} -test info-33.4 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 1968 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - dict for {a b} {c d} {*}{ - {set res [info frame 0]} - } - return $res -} -test info-33.5 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 1983 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - set d {a b} - dict update d x y {*}{ - {set res [info frame 0]} - } - return $res -} -test info-33.6 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 1998 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - set d {} - dict with d {*}{ - {set res [info frame 0]} - } - return $res -} -test info-33.7 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2013 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - for {*}{ - {set res [info frame 0]} - {1} {} {break} - } - return $res -} -test info-33.8 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2027 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - for {*}{ - {} {1} {} - {set res [info frame 0]; break} - } - return $res -} -test info-33.9 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2043 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - for {*}{ - {} {1} - {return [info frame 0]} - {} - } -} -test info-33.10 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2058 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - for {*}{ - {} - {[return [info frame 0]]} - {} {} - } -} -test info-33.11 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2073 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - foreach {*}{ - x - } [return [info frame 0]] {} -} -test info-33.12 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2088 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - foreach {*}{ - x y - {set res [info frame 0]} - } - return $res -} -test info-33.13 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2101 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - if {*}{ - {[return [info frame 0]]} - {} - } -} -test info-33.14 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2115 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - if 0 {*}{ - {} else - {return [info frame 0]} - } -} -test info-33.15 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2130 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - incr {*}{ - x - } [return [info frame 0]] -} -test info-33.16 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2144 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - info level {*}{ - } [return [info frame 0]] -} -test info-33.17 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2156 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - string match {*}{ - } [return [info frame 0]] {} -} -test info-33.18 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2168 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - string match {*}{ - {} - } [return [info frame 0]] -} -test info-33.19 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2181 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - string length {*}{ - } [return [info frame 0]] -} -test info-33.20 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2193 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - while {*}{ - {[return [info frame 0]]} - } {} -} -test info-33.21 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2205 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - switch -- {*}{ - } [return [info frame 0]] {*}{ - } x y -} -test info-33.22 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2218 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - try {*}{ - {set res [info frame 0]} - } - return $res -} -test info-33.23 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2231 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - try {*}{ - {set res [info frame 0]} - } finally {} - return $res -} -test info-33.24 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2245 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - try {*}{ - {set res [info frame 0]} - } on ok {} {} - return $res -} -test info-33.25 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2259 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - try {*}{ - {set res [info frame 0]} - } on ok {} {} finally {} - return $res -} -test info-33.26 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2273 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - while 1 {*}{ - {return [info frame 0]} - } -} -test info-33.27 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2287 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - try {} finally {*}{ - {return [info frame 0]} - } -} -test info-33.28 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2300 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - try {} on ok {} {} finally {*}{ - {return [info frame 0]} - } -} -test info-33.29 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2313 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - try {} on ok {} {*}{ - {return [info frame 0]} - } -} -test info-33.30 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2326 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - try {} on ok {} {*}{ - {return [info frame 0]} - } finally {} -} -test info-33.31 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2339 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - binary format {*}{ - } [return [info frame 0]] -} -test info-33.32 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2352 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - set format format - binary $format {*}{ - } [return [info frame 0]] -} -test info-33.33 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2365 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - append x {*}{ - } [return [info frame 0]] -} -test info-33.34 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2377 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval foo {} -proc foo::bar {} { - append {*}{ - } x([return [info frame 0]]) {*}{ - } a -} -test info-33.35 {{*}, literal, simple, bytecompiled} -body { - reduce [foo::bar] -} -cleanup { - namespace delete foo -} -result {type source line 2389 file info.test cmd {info frame 0} proc ::foo::bar level 0} - -# ------------------------------------------------------------------------- -namespace eval ::testinfocmdtype { - apply {cmds { - foreach c $cmds {rename $c {}} - } ::testinfocmdtype} [info commands ::testinfocmdtype::*] -} -test info-40.1 {info cmdtype: syntax} -body { - info cmdtype -} -returnCodes error -result {wrong # args: should be "info cmdtype commandName"} -test info-40.2 {info cmdtype: syntax} -body { - info cmdtype foo bar -} -returnCodes error -result {wrong # args: should be "info cmdtype commandName"} -test info-40.3 {info cmdtype: no such command} -body { - info cmdtype ::testinfocmdtype::foo -} -returnCodes error -result {unknown command "::testinfocmdtype::foo"} -test info-40.4 {info cmdtype: native commands} -body { - info cmdtype ::if -} -result native -test info-40.5 {info cmdtype: native commands} -body { - info cmdtype ::puts -} -result native -test info-40.6 {info cmdtype: native commands} -body { - info cmdtype ::yield -} -result native -test info-40.7 {info cmdtype: procedures} -setup { - proc ::testinfocmdtype::someproc {} {} -} -body { - info cmdtype ::testinfocmdtype::someproc -} -cleanup { - rename ::testinfocmdtype::someproc {} -} -result proc -test info-40.8 {info cmdtype: aliases} -setup { - interp alias {} ::testinfocmdtype::somealias {} ::puts -} -body { - info cmdtype ::testinfocmdtype::somealias -} -cleanup { - rename ::testinfocmdtype::somealias {} -} -result alias -test info-40.9 {info cmdtype: imports} -setup { - namespace eval ::testinfocmdtype { - namespace eval foo { - proc bar {} {} - namespace export bar - } - namespace import foo::bar - } -} -body { - info cmdtype ::testinfocmdtype::bar -} -cleanup { - rename ::testinfocmdtype::bar {} - namespace delete ::testinfocmdtype::foo -} -result import -test info-40.10 {info cmdtype: interps} -setup { - apply {i { - rename $i ::testinfocmdtype::child - variable ::testinfocmdtype::child $i - }} [interp create] -} -body { - info cmdtype ::testinfocmdtype::child -} -cleanup { - interp delete $::testinfocmdtype::child -} -result interp -test info-40.11 {info cmdtype: objects} -setup { - apply {{} { - oo::object create obj - } ::testinfocmdtype} -} -body { - info cmdtype ::testinfocmdtype::obj -} -cleanup { - ::testinfocmdtype::obj destroy -} -result object -test info-40.12 {info cmdtype: objects} -setup { - apply {{} { - oo::object create obj - } ::testinfocmdtype} -} -body { - info cmdtype [info object namespace ::testinfocmdtype::obj]::my -} -cleanup { - ::testinfocmdtype::obj destroy -} -result privateObject -test info-40.13 {info cmdtype: ensembles} -setup { - namespace eval ::testinfocmdtype { - namespace eval ensmbl { - proc bar {} {} - namespace export * - namespace ensemble create - } - } -} -body { - info cmdtype ::testinfocmdtype::ensmbl -} -cleanup { - namespace delete ::testinfocmdtype::ensmbl -} -result ensemble -test info-40.14 {info cmdtype: zlib streams} -constraints zlib -setup { - namespace eval ::testinfocmdtype { - rename [zlib stream gzip] zstream - } -} -body { - info cmdtype ::testinfocmdtype::zstream -} -cleanup { - ::testinfocmdtype::zstream close -} -result zlibStream -test info-40.15 {info cmdtype: coroutines} -setup { - coroutine ::testinfocmdtype::coro eval yield -} -body { - info cmdtype ::testinfocmdtype::coro -} -cleanup { - ::testinfocmdtype::coro -} -result coroutine -test info-40.16 {info cmdtype: dynamic behavior} -setup { - proc ::testinfocmdtype::foo {} {} -} -body { - namespace eval ::testinfocmdtype { - list [catch {info cmdtype foo}] [catch {info cmdtype bar}] \ - [namespace which foo] [rename foo bar] [namespace which bar] \ - [catch {info cmdtype foo}] [catch {info cmdtype bar}] - } -} -cleanup { - namespace eval ::testinfocmdtype { - catch {rename foo {}} - catch {rename bar {}} - } -} -result {0 1 ::testinfocmdtype::foo {} ::testinfocmdtype::bar 1 0} -test info-40.17 {info cmdtype: aliases in child interpreters} -setup { - set i [interp create] -} -body { - $i alias foo gorp - $i eval { - info cmdtype foo - } -} -cleanup { - interp delete $i -} -result alias -test info-40.18 {info cmdtype: aliases in child interpreters} -setup { - set safe [interp create -safe] -} -body { - $safe alias foo gorp - $safe eval { - info cmdtype foo - } -} -returnCodes error -cleanup { - interp delete $safe -} -result {not allowed to invoke subcommand cmdtype of info} -test info-40.19 {info cmdtype: aliases in child interpreters} -setup { - set safe [interp create -safe] -} -body { - set inner [interp create [list $safe bar]] - interp alias $inner foo $safe gorp - $safe eval { - bar eval { - info cmdtype foo - } - } -} -returnCodes error -cleanup { - interp delete $safe -} -result {not allowed to invoke subcommand cmdtype of info} -test info-40.20 {info cmdtype: aliases in child interpreters} -setup { - set safe [interp create -safe] -} -body { - $safe eval { - interp alias {} foo {} gorp - info cmdtype foo - } -} -returnCodes error -cleanup { - interp delete $safe -} -result {not allowed to invoke subcommand cmdtype of info} -namespace delete ::testinfocmdtype - -# ------------------------------------------------------------------------- -unset -nocomplain res - -test info-39.2 {Bug 4b61afd660} -setup { - proc probe {} { - return [dict get [info frame -1] line] - } - set body { - set cmd probe - $cmd - } - proc demo {} $body -} -body { - demo -} -cleanup { - unset -nocomplain body - rename demo {} - rename probe {} -} -result 3 +} -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} # cleanup catch {namespace delete test_ns_info1 test_ns_info2} |