sl@0: # -*- tcl -*-
sl@0: # Commands covered:  info
sl@0: #
sl@0: # This file contains a collection of tests for one or more of the Tcl
sl@0: # built-in commands.  Sourcing this file into Tcl runs the tests and
sl@0: # generates output for errors.  No output means no errors were found.
sl@0: #
sl@0: # Copyright (c) 1991-1994 The Regents of the University of California.
sl@0: # Copyright (c) 1994-1997 Sun Microsystems, Inc.
sl@0: # Copyright (c) 1998-1999 by Scriptics Corporation.
sl@0: # Copyright (c) 2006      ActiveState
sl@0: #
sl@0: # See the file "license.terms" for information on usage and redistribution
sl@0: # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0: #
sl@0: # RCS: @(#) $Id: info.test,v 1.24.2.5 2006/11/28 22:20:02 andreas_kupries Exp $
sl@0: 
sl@0: if {[lsearch [namespace children] ::tcltest] == -1} {
sl@0:     package require tcltest 2
sl@0:     namespace import -force ::tcltest::*
sl@0: }
sl@0: 
sl@0: # Set up namespaces needed to test operation of "info args", "info body",
sl@0: # "info default", and "info procs" with imported procedures.
sl@0: 
sl@0: catch {namespace delete test_ns_info1 test_ns_info2}
sl@0: 
sl@0: namespace eval test_ns_info1 {
sl@0:     namespace export *
sl@0:     proc p {x} {return "x=$x"}
sl@0:     proc q {{y 27} {z {}}} {return "y=$y"}
sl@0: }
sl@0: 
sl@0: testConstraint tip280  [info exists tcl_platform(tip,280)]
sl@0: testConstraint !tip280 [expr {![info exists tcl_platform(tip,280)]}]
sl@0: 
sl@0: 
sl@0: test info-1.1 {info args option} {
sl@0:     proc t1 {a bbb c} {return foo}
sl@0:     info args t1
sl@0: } {a bbb c}
sl@0: test info-1.2 {info args option} {
sl@0:     proc t1 {{a default1} {bbb default2} {c default3} args} {return foo}
sl@0:     info a t1
sl@0: } {a bbb c args}
sl@0: test info-1.3 {info args option} {
sl@0:     proc t1 "" {return foo}
sl@0:     info args t1
sl@0: } {}
sl@0: test info-1.4 {info args option} {
sl@0:     catch {rename t1 {}}
sl@0:     list [catch {info args t1} msg] $msg
sl@0: } {1 {"t1" isn't a procedure}}
sl@0: test info-1.5 {info args option} {
sl@0:     list [catch {info args set} msg] $msg
sl@0: } {1 {"set" isn't a procedure}}
sl@0: test info-1.6 {info args option} {
sl@0:     proc t1 {a b} {set c 123; set d $c}
sl@0:     t1 1 2
sl@0:     info args t1
sl@0: } {a b}
sl@0: test info-1.7 {info args option} {
sl@0:     catch {namespace delete test_ns_info2}
sl@0:     namespace eval test_ns_info2 {
sl@0:         namespace import ::test_ns_info1::*
sl@0:         list [info args p] [info args q]
sl@0:     }
sl@0: } {x {y z}}
sl@0: 
sl@0: test info-2.1 {info body option} {
sl@0:     proc t1 {} {body of t1}
sl@0:     info body t1
sl@0: } {body of t1}
sl@0: test info-2.2 {info body option} {
sl@0:     list [catch {info body set} msg] $msg
sl@0: } {1 {"set" isn't a procedure}}
sl@0: test info-2.3 {info body option} {
sl@0:     list [catch {info args set 1} msg] $msg
sl@0: } {1 {wrong # args: should be "info args procname"}}
sl@0: test info-2.4 {info body option} {
sl@0:     catch {namespace delete test_ns_info2}
sl@0:     namespace eval test_ns_info2 {
sl@0:         namespace import ::test_ns_info1::*
sl@0:         list [info body p] [info body q]
sl@0:     }
sl@0: } {{return "x=$x"} {return "y=$y"}}
sl@0: # Prior to 8.3.0 this would cause a crash because [info body]
sl@0: # would return the bytecompiled version of foo, which the catch
sl@0: # would then try and eval out of the foo context, accessing
sl@0: # compiled local indices
sl@0: test info-2.5 {info body option, returning bytecompiled bodies} {
sl@0:     catch {unset args}
sl@0:     proc foo {args} {
sl@0: 	foreach v $args {
sl@0: 	    upvar $v var
sl@0: 	    return "variable $v existence: [info exists var]"
sl@0: 	}
sl@0:     }
sl@0:     foo a
sl@0:     list [catch [info body foo] msg] $msg
sl@0: } {1 {can't read "args": no such variable}}
sl@0: # Fix for problem tested for in info-2.5 caused problems when
sl@0: # procedure body had no string rep (i.e. was not yet bytecode)
sl@0: # causing an empty string to be returned [Bug #545644]
sl@0: test info-2.6 {info body option, returning list bodies} {
sl@0:     proc foo args [list subst bar]
sl@0:     list [string bytelength [info body foo]] \
sl@0: 	    [foo; string bytelength [info body foo]]
sl@0: } {9 9}
sl@0: 
sl@0: # "info cmdcount" is no longer accurate for compiled commands!
sl@0: # The expected result for info-3.1 used to be "3" and is now "1"
sl@0: # since the "set"s have been compiled away.  info-3.2 was corrected
sl@0: # in 8.3 because the eval'ed body won't be compiled.
sl@0: proc testinfocmdcount {} {
sl@0:     set x [info cmdcount]
sl@0:     set y 12345
sl@0:     set z [info cm]
sl@0:     expr $z-$x
sl@0: }
sl@0: test info-3.1 {info cmdcount compiled} {
sl@0:     testinfocmdcount
sl@0: } 1
sl@0: test info-3.2 {info cmdcount evaled} {
sl@0:     set x [info cmdcount]
sl@0:     set y 12345
sl@0:     set z [info cm]
sl@0:     expr $z-$x
sl@0: } 3
sl@0: test info-3.3 {info cmdcount evaled} [info body testinfocmdcount] 3
sl@0: test info-3.4 {info cmdcount option} {
sl@0:     list [catch {info cmdcount 1} msg] $msg
sl@0: } {1 {wrong # args: should be "info cmdcount"}}
sl@0: 
sl@0: test info-4.1 {info commands option} {
sl@0:     proc t1 {} {}
sl@0:     proc t2 {} {}
sl@0:     set x " [info commands] "
sl@0:     list [string match {* t1 *} $x] [string match {* t2 *} $x] \
sl@0:             [string match {* set *} $x] [string match {* list *} $x]
sl@0: } {1 1 1 1}
sl@0: test info-4.2 {info commands option} {
sl@0:     proc t1 {} {}
sl@0:     rename t1 {}
sl@0:     set x [info comm]
sl@0:     string match {* t1 *} $x
sl@0: } 0
sl@0: test info-4.3 {info commands option} {
sl@0:     proc _t1_ {} {}
sl@0:     proc _t2_ {} {}
sl@0:     info commands _t1_
sl@0: } _t1_
sl@0: test info-4.4 {info commands option} {
sl@0:     proc _t1_ {} {}
sl@0:     proc _t2_ {} {}
sl@0:     lsort [info commands _t*]
sl@0: } {_t1_ _t2_}
sl@0: catch {rename _t1_ {}}
sl@0: catch {rename _t2_ {}}
sl@0: test info-4.5 {info commands option} {
sl@0:     list [catch {info commands a b} msg] $msg
sl@0: } {1 {wrong # args: should be "info commands ?pattern?"}}
sl@0: 
sl@0: test info-5.1 {info complete option} {
sl@0:     list [catch {info complete} msg] $msg
sl@0: } {1 {wrong # args: should be "info complete command"}}
sl@0: test info-5.2 {info complete option} {
sl@0:     info complete abc
sl@0: } 1
sl@0: test info-5.3 {info complete option} {
sl@0:     info complete "\{abcd "
sl@0: } 0
sl@0: test info-5.4 {info complete option} {
sl@0:     info complete {# Comment should be complete command}
sl@0: } 1
sl@0: test info-5.5 {info complete option} {
sl@0:     info complete {[a [b] }
sl@0: } 0
sl@0: test info-5.6 {info complete option} {
sl@0:     info complete {[a [b]}
sl@0: } 0
sl@0: 
sl@0: test info-6.1 {info default option} {
sl@0:     proc t1 {a b {c d} {e "long default value"}} {}
sl@0:     info default t1 a value
sl@0: } 0
sl@0: test info-6.2 {info default option} {
sl@0:     proc t1 {a b {c d} {e "long default value"}} {}
sl@0:     set value 12345
sl@0:     info d t1 a value
sl@0:     set value
sl@0: } {}
sl@0: test info-6.3 {info default option} {
sl@0:     proc t1 {a b {c d} {e "long default value"}} {}
sl@0:     info default t1 c value
sl@0: } 1
sl@0: test info-6.4 {info default option} {
sl@0:     proc t1 {a b {c d} {e "long default value"}} {}
sl@0:     set value 12345
sl@0:     info default t1 c value
sl@0:     set value
sl@0: } d
sl@0: test info-6.5 {info default option} {
sl@0:     proc t1 {a b {c d} {e "long default value"}} {}
sl@0:     set value 12345
sl@0:     set x [info default t1 e value]
sl@0:     list $x $value
sl@0: } {1 {long default value}}
sl@0: test info-6.6 {info default option} {
sl@0:     list [catch {info default a b} msg] $msg
sl@0: } {1 {wrong # args: should be "info default procname arg varname"}}
sl@0: test info-6.7 {info default option} {
sl@0:     list [catch {info default _nonexistent_ a b} msg] $msg
sl@0: } {1 {"_nonexistent_" isn't a procedure}}
sl@0: test info-6.8 {info default option} {
sl@0:     proc t1 {a b} {}
sl@0:     list [catch {info default t1 x value} msg] $msg
sl@0: } {1 {procedure "t1" doesn't have an argument "x"}}
sl@0: test info-6.9 {info default option} {
sl@0:     catch {unset a}
sl@0:     set a(0) 88
sl@0:     proc t1 {a b} {}
sl@0:     list [catch {info default t1 a a} msg] $msg
sl@0: } {1 {couldn't store default value in variable "a"}}
sl@0: test info-6.10 {info default option} {
sl@0:     catch {unset a}
sl@0:     set a(0) 88
sl@0:     proc t1 {{a 18} b} {}
sl@0:     list [catch {info default t1 a a} msg] $msg
sl@0: } {1 {couldn't store default value in variable "a"}}
sl@0: test info-6.11 {info default option} {
sl@0:     catch {namespace delete test_ns_info2}
sl@0:     namespace eval test_ns_info2 {
sl@0:         namespace import ::test_ns_info1::*
sl@0:         list [info default p x foo] $foo [info default q y bar] $bar
sl@0:     }
sl@0: } {0 {} 1 27}
sl@0: catch {unset a}
sl@0: 
sl@0: test info-7.1 {info exists option} {
sl@0:     set value foo
sl@0:     info exists value
sl@0: } 1
sl@0: catch {unset _nonexistent_}
sl@0: test info-7.2 {info exists option} {
sl@0:     info exists _nonexistent_
sl@0: } 0
sl@0: test info-7.3 {info exists option} {
sl@0:     proc t1 {x} {return [info exists x]}
sl@0:     t1 2
sl@0: } 1
sl@0: test info-7.4 {info exists option} {
sl@0:     proc t1 {x} {
sl@0:         global _nonexistent_
sl@0:         return [info exists _nonexistent_]
sl@0:     }
sl@0:     t1 2
sl@0: } 0
sl@0: test info-7.5 {info exists option} {
sl@0:     proc t1 {x} {
sl@0:         set y 47
sl@0:         return [info exists y]
sl@0:     }
sl@0:     t1 2
sl@0: } 1
sl@0: test info-7.6 {info exists option} {
sl@0:     proc t1 {x} {return [info exists value]}
sl@0:     t1 2
sl@0: } 0
sl@0: test info-7.7 {info exists option} {
sl@0:     catch {unset x}
sl@0:     set x(2) 44
sl@0:     list [info exists x] [info exists x(1)] [info exists x(2)]
sl@0: } {1 0 1}
sl@0: catch {unset x}
sl@0: test info-7.8 {info exists option} {
sl@0:     list [catch {info exists} msg] $msg
sl@0: } {1 {wrong # args: should be "info exists varName"}}
sl@0: test info-7.9 {info exists option} {
sl@0:     list [catch {info exists 1 2} msg] $msg
sl@0: } {1 {wrong # args: should be "info exists varName"}}
sl@0: 
sl@0: test info-8.1 {info globals option} {
sl@0:     set x 1
sl@0:     set y 2
sl@0:     set value 23
sl@0:     set a " [info globals] "
sl@0:     list [string match {* x *} $a] [string match {* y *} $a] \
sl@0:             [string match {* value *} $a] [string match {* _foobar_ *} $a]
sl@0: } {1 1 1 0}
sl@0: test info-8.2 {info globals option} {
sl@0:     set _xxx1 1
sl@0:     set _xxx2 2
sl@0:     lsort [info g _xxx*]
sl@0: } {_xxx1 _xxx2}
sl@0: test info-8.3 {info globals option} {
sl@0:     list [catch {info globals 1 2} msg] $msg
sl@0: } {1 {wrong # args: should be "info globals ?pattern?"}}
sl@0: test info-8.4 {info globals option: may have leading namespace qualifiers} {
sl@0:     set x 0
sl@0:     list [info globals x] [info globals :x] [info globals ::x] [info globals :::x] [info globals ::::x]
sl@0: } {x {} x x x}
sl@0: test info-8.5 {info globals option: only return existing global variables} {
sl@0:     -setup {
sl@0: 	catch {unset ::NO_SUCH_VAR}
sl@0: 	proc evalInProc script {eval $script}
sl@0:     }
sl@0:     -body {
sl@0: 	evalInProc {global NO_SUCH_VAR; info globals NO_SUCH_VAR}
sl@0:     }
sl@0:     -cleanup {
sl@0: 	rename evalInProc {}
sl@0:     }
sl@0:     -result {}
sl@0: }
sl@0: 
sl@0: test info-9.1 {info level option} {
sl@0:     info level
sl@0: } 0
sl@0: test info-9.2 {info level option} {
sl@0:     proc t1 {a b} {
sl@0:         set x [info le]
sl@0:         set y [info level 1]
sl@0:         list $x $y
sl@0:     }
sl@0:     t1 146 testString
sl@0: } {1 {t1 146 testString}}
sl@0: test info-9.3 {info level option} {
sl@0:     proc t1 {a b} {
sl@0:         t2 [expr $a*2] $b
sl@0:     }
sl@0:     proc t2 {x y} {
sl@0:         list [info level] [info level 1] [info level 2] [info level -1] \
sl@0:                 [info level 0]
sl@0:     }
sl@0:     t1 146 {a {b c} {{{c}}}}
sl@0: } {2 {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}} {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}}}
sl@0: test info-9.4 {info level option} {
sl@0:     proc t1 {} {
sl@0:         set x [info level]
sl@0:         set y [info level 1]
sl@0:         list $x $y
sl@0:     }
sl@0:     t1
sl@0: } {1 t1}
sl@0: test info-9.5 {info level option} {
sl@0:     list [catch {info level 1 2} msg] $msg
sl@0: } {1 {wrong # args: should be "info level ?number?"}}
sl@0: test info-9.6 {info level option} {
sl@0:     list [catch {info level 123a} msg] $msg
sl@0: } {1 {expected integer but got "123a"}}
sl@0: test info-9.7 {info level option} {
sl@0:     list [catch {info level 0} msg] $msg
sl@0: } {1 {bad level "0"}}
sl@0: test info-9.8 {info level option} {
sl@0:     proc t1 {} {info level -1}
sl@0:     list [catch {t1} msg] $msg
sl@0: } {1 {bad level "-1"}}
sl@0: test info-9.9 {info level option} {
sl@0:     proc t1 {x} {info level $x}
sl@0:     list [catch {t1 -3} msg] $msg
sl@0: } {1 {bad level "-3"}}
sl@0: test info-9.10 {info level option, namespaces} {
sl@0:     set msg [namespace eval t {info level 0}]
sl@0:     namespace delete t
sl@0:     set msg
sl@0: } {namespace eval t {info level 0}}
sl@0: 
sl@0: set savedLibrary $tcl_library
sl@0: test info-10.1 {info library option} {
sl@0:     list [catch {info library x} msg] $msg
sl@0: } {1 {wrong # args: should be "info library"}}
sl@0: test info-10.2 {info library option} {
sl@0:     set tcl_library 12345
sl@0:     info library
sl@0: } {12345}
sl@0: test info-10.3 {info library option} {
sl@0:     unset tcl_library
sl@0:     list [catch {info library} msg] $msg
sl@0: } {1 {no library has been specified for Tcl}}
sl@0: set tcl_library $savedLibrary
sl@0: 
sl@0: test info-11.1 {info loaded option} {
sl@0:     list [catch {info loaded a b} msg] $msg
sl@0: } {1 {wrong # args: should be "info loaded ?interp?"}}
sl@0: test info-11.2 {info loaded option} {
sl@0:     list [catch {info loaded {}}] [catch {info loaded gorp} msg] $msg
sl@0: } {0 1 {could not find interpreter "gorp"}}
sl@0: 
sl@0: test info-12.1 {info locals option} {
sl@0:     set a 22
sl@0:     proc t1 {x y} {
sl@0:         set b 13
sl@0:         set c testing
sl@0:         global a
sl@0: 	global aa
sl@0: 	set aa 23
sl@0:         return [info locals]
sl@0:     }
sl@0:     lsort [t1 23 24]
sl@0: } {b c x y}
sl@0: test info-12.2 {info locals option} {
sl@0:     proc t1 {x y} {
sl@0:         set xx1 2
sl@0:         set xx2 3
sl@0:         set y 4
sl@0:         return [info loc x*]
sl@0:     }
sl@0:     lsort [t1 2 3]
sl@0: } {x xx1 xx2}
sl@0: test info-12.3 {info locals option} {
sl@0:     list [catch {info locals 1 2} msg] $msg
sl@0: } {1 {wrong # args: should be "info locals ?pattern?"}}
sl@0: test info-12.4 {info locals option} {
sl@0:     info locals
sl@0: } {}
sl@0: test info-12.5 {info locals option} {
sl@0:     proc t1 {} {return [info locals]}
sl@0:     t1
sl@0: } {}
sl@0: test info-12.6 {info locals vs unset compiled locals} {
sl@0:     proc t1 {lst} {
sl@0:         foreach $lst $lst {}
sl@0:         unset lst
sl@0:         return [info locals]
sl@0:     }
sl@0:     lsort [t1 {a b c c d e f}]
sl@0: } {a b c d e f}
sl@0: test info-12.7 {info locals with temporary variables} {
sl@0:     proc t1 {} {
sl@0:         foreach a {b c} {}
sl@0:         info locals
sl@0:     }
sl@0:     t1
sl@0: } {a}
sl@0: 
sl@0: test info-13.1 {info nameofexecutable option} {
sl@0:     list [catch {info nameofexecutable foo} msg] $msg
sl@0: } {1 {wrong # args: should be "info nameofexecutable"}}
sl@0: 
sl@0: test info-14.1 {info patchlevel option} {
sl@0:     set a [info patchlevel]
sl@0:     regexp {[0-9]+\.[0-9]+([p[0-9]+)?} $a
sl@0: } 1
sl@0: test info-14.2 {info patchlevel option} {
sl@0:     list [catch {info patchlevel a} msg] $msg
sl@0: } {1 {wrong # args: should be "info patchlevel"}}
sl@0: test info-14.3 {info patchlevel option} {
sl@0:     set t $tcl_patchLevel
sl@0:     unset tcl_patchLevel
sl@0:     set result [list [catch {info patchlevel} msg] $msg]
sl@0:     set tcl_patchLevel $t
sl@0:     set result
sl@0: } {1 {can't read "tcl_patchLevel": no such variable}}
sl@0: 
sl@0: test info-15.1 {info procs option} {
sl@0:     proc t1 {} {}
sl@0:     proc t2 {} {}
sl@0:     set x " [info procs] "
sl@0:     list [string match {* t1 *} $x] [string match {* t2 *} $x] \
sl@0:             [string match {* _undefined_ *} $x]
sl@0: } {1 1 0}
sl@0: test info-15.2 {info procs option} {
sl@0:     proc _tt1 {} {}
sl@0:     proc _tt2 {} {}
sl@0:     lsort [info pr _tt*]
sl@0: } {_tt1 _tt2}
sl@0: catch {rename _tt1 {}}
sl@0: catch {rename _tt2 {}}
sl@0: test info-15.3 {info procs option} {
sl@0:     list [catch {info procs 2 3} msg] $msg
sl@0: } {1 {wrong # args: should be "info procs ?pattern?"}}
sl@0: test info-15.4 {info procs option} {
sl@0:     catch {namespace delete test_ns_info2}
sl@0:     namespace eval test_ns_info2 {
sl@0:         namespace import ::test_ns_info1::*
sl@0:         proc r {} {}
sl@0:         list [info procs] [info procs p*]
sl@0:     }
sl@0: } {{p q r} p}
sl@0: test info-15.5 {info procs option with a proc in a namespace} {
sl@0:     catch {namespace delete test_ns_info2}
sl@0:     namespace eval test_ns_info2 {
sl@0: 	proc p1 { arg } {
sl@0: 	    puts cmd
sl@0: 	}
sl@0:         proc p2 { arg } {
sl@0: 	    puts cmd
sl@0: 	}
sl@0:     }
sl@0:     info procs ::test_ns_info2::p1
sl@0: } {::test_ns_info2::p1}
sl@0: test info-15.6 {info procs option with a pattern in a namespace} {
sl@0:     catch {namespace delete test_ns_info2}
sl@0:     namespace eval test_ns_info2 {
sl@0: 	proc p1 { arg } {
sl@0: 	    puts cmd
sl@0: 	}
sl@0:         proc p2 { arg } {
sl@0: 	    puts cmd
sl@0: 	}
sl@0:     }
sl@0:     lsort [info procs ::test_ns_info2::p*]
sl@0: } [lsort [list ::test_ns_info2::p1 ::test_ns_info2::p2]]
sl@0: test info-15.7 {info procs option with a global shadowing proc} {
sl@0:     catch {namespace delete test_ns_info2}
sl@0:     proc string_cmd { arg } {
sl@0:         puts cmd
sl@0:     }
sl@0:     namespace eval test_ns_info2 {
sl@0: 	proc string_cmd { arg } {
sl@0: 	    puts cmd
sl@0: 	}
sl@0:     }
sl@0:     info procs test_ns_info2::string*
sl@0: } {::test_ns_info2::string_cmd}
sl@0: # This regression test is currently commented out because it requires
sl@0: # that the implementation of "info procs" looks into the global namespace,
sl@0: # which it does not (in contrast to "info commands")
sl@0: if {0} {
sl@0: test info-15.8 {info procs option with a global shadowing proc} {
sl@0:     catch {namespace delete test_ns_info2}
sl@0:     proc string_cmd { arg } {
sl@0:         puts cmd
sl@0:     }
sl@0:     proc string_cmd2 { arg } {
sl@0:         puts cmd
sl@0:     }
sl@0:     namespace eval test_ns_info2 {
sl@0: 	proc string_cmd { arg } {
sl@0: 	    puts cmd
sl@0: 	}
sl@0:     }
sl@0:     namespace eval test_ns_info2 {
sl@0:         lsort [info procs string*]
sl@0:     }
sl@0: } [lsort [list string_cmd string_cmd2]]
sl@0: }
sl@0: 
sl@0: test info-16.1 {info script option} {
sl@0:     list [catch {info script x x} msg] $msg
sl@0: } {1 {wrong # args: should be "info script ?filename?"}}
sl@0: test info-16.2 {info script option} {
sl@0:     file tail [info sc]
sl@0: } "info.test"
sl@0: set gorpfile [makeFile "info script\n" gorp.info]
sl@0: test info-16.3 {info script option} {
sl@0:     list [source $gorpfile] [file tail [info script]]
sl@0: } [list $gorpfile info.test]
sl@0: test info-16.4 {resetting "info script" after errors} {
sl@0:     catch {source ~_nobody_/foo}
sl@0:     file tail [info script]
sl@0: } "info.test"
sl@0: test info-16.5 {resetting "info script" after errors} {
sl@0:     catch {source _nonexistent_}
sl@0:     file tail [info script]
sl@0: } "info.test"
sl@0: test info-16.6 {info script option} {
sl@0:     set script [info script]
sl@0:     list [file tail [info script]] \
sl@0: 	    [info script newname.txt] \
sl@0: 	    [file tail [info script $script]]
sl@0: } [list info.test newname.txt info.test]
sl@0: test info-16.7 {info script option} {
sl@0:     set script [info script]
sl@0:     info script newname.txt
sl@0:     list [source $gorpfile] [file tail [info script]] \
sl@0: 	    [file tail [info script $script]]
sl@0: } [list $gorpfile newname.txt info.test]
sl@0: removeFile gorp.info
sl@0: set gorpfile [makeFile {list [info script] [info script foo.bar]} gorp.info]
sl@0: test info-16.8 {info script option} {
sl@0:     list [source $gorpfile] [file tail [info script]]
sl@0: } [list [list $gorpfile foo.bar] info.test]
sl@0: removeFile gorp.info
sl@0: 
sl@0: test info-17.1 {info sharedlibextension option} {
sl@0:     list [catch {info sharedlibextension foo} msg] $msg
sl@0: } {1 {wrong # args: should be "info sharedlibextension"}}
sl@0: 
sl@0: test info-18.1 {info tclversion option} {
sl@0:     set x [info tclversion]
sl@0:     scan $x "%d.%d%c" a b c
sl@0: } 2
sl@0: test info-18.2 {info tclversion option} {
sl@0:     list [catch {info t 2} msg] $msg
sl@0: } {1 {wrong # args: should be "info tclversion"}}
sl@0: test info-18.3 {info tclversion option} {
sl@0:     set t $tcl_version
sl@0:     unset tcl_version
sl@0:     set result [list [catch {info tclversion} msg] $msg]
sl@0:     set tcl_version $t
sl@0:     set result
sl@0: } {1 {can't read "tcl_version": no such variable}}
sl@0: 
sl@0: test info-19.1 {info vars option} {
sl@0:     set a 1
sl@0:     set b 2
sl@0:     proc t1 {x y} {
sl@0:         global a b
sl@0:         set c 33
sl@0:         return [info vars]
sl@0:     }
sl@0:     lsort [t1 18 19]
sl@0: } {a b c x y}
sl@0: test info-19.2 {info vars option} {
sl@0:     set xxx1 1
sl@0:     set xxx2 2
sl@0:     proc t1 {xxa y} {
sl@0:         global xxx1 xxx2
sl@0:         set c 33
sl@0:         return [info vars x*]
sl@0:     }
sl@0:     lsort [t1 18 19]
sl@0: } {xxa xxx1 xxx2}
sl@0: test info-19.3 {info vars option} {
sl@0:     lsort [info vars]
sl@0: } [lsort [info globals]]
sl@0: test info-19.4 {info vars option} {
sl@0:     list [catch {info vars a b} msg] $msg
sl@0: } {1 {wrong # args: should be "info vars ?pattern?"}}
sl@0: test info-19.5 {info vars with temporary variables} {
sl@0:     proc t1 {} {
sl@0:         foreach a {b c} {}
sl@0:         info vars
sl@0:     }
sl@0:     t1
sl@0: } {a}
sl@0: test info-19.6 {info vars: Bug 1072654} -setup {
sl@0:     namespace eval :: unset -nocomplain foo
sl@0:     catch {namespace delete x}
sl@0: } -body {
sl@0:     namespace eval x info vars foo
sl@0: } -cleanup {
sl@0:     namespace delete x
sl@0: } -result {}
sl@0: 
sl@0: # Check whether the extra testing functions are defined...
sl@0: if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
sl@0:     set functions {abs acos asin atan atan2 ceil cos cosh double exp floor fmod hypot int log log10 pow rand round sin sinh sqrt srand tan tanh wide}
sl@0: } else {
sl@0:     set functions {T1 T2 T3 abs acos asin atan atan2 ceil cos cosh double exp floor fmod hypot int log log10 pow rand round sin sinh sqrt srand tan tanh wide}
sl@0: }
sl@0: test info-20.1 {info functions option} {info functions sin} sin
sl@0: test info-20.2 {info functions option} {lsort [info functions]} $functions
sl@0: test info-20.3 {info functions option} {
sl@0:     lsort [info functions a*]
sl@0: } {abs acos asin atan atan2}
sl@0: test info-20.4 {info functions option} {
sl@0:     lsort [info functions *tan*]
sl@0: } {atan atan2 tan tanh}
sl@0: test info-20.5 {info functions option} {
sl@0:     list [catch {info functions raise an error} msg] $msg
sl@0: } {1 {wrong # args: should be "info functions ?pattern?"}}
sl@0: 
sl@0: test info-21.1 {miscellaneous error conditions} {
sl@0:     list [catch {info} msg] $msg
sl@0: } {1 {wrong # args: should be "info option ?arg arg ...?"}}
sl@0: test info-21.2 {miscellaneous error conditions} !tip280 {
sl@0:     list [catch {info gorp} msg] $msg
sl@0: } {1 {bad option "gorp": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
sl@0: test info-21.2-280 {miscellaneous error conditions} tip280 {
sl@0:     list [catch {info gorp} msg] $msg
sl@0: } {1 {bad option "gorp": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
sl@0: test info-21.3 {miscellaneous error conditions} !tip280 {
sl@0:     list [catch {info c} msg] $msg
sl@0: } {1 {ambiguous option "c": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
sl@0: test info-21.3-280 {miscellaneous error conditions} tip280 {
sl@0:     list [catch {info c} msg] $msg
sl@0: } {1 {ambiguous option "c": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
sl@0: test info-21.4 {miscellaneous error conditions} !tip280 {
sl@0:     list [catch {info l} msg] $msg
sl@0: } {1 {ambiguous option "l": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
sl@0: test info-21.4-280 {miscellaneous error conditions} tip280 {
sl@0:     list [catch {info l} msg] $msg
sl@0: } {1 {ambiguous option "l": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
sl@0: test info-21.5 {miscellaneous error conditions} !tip280 {
sl@0:     list [catch {info s} msg] $msg
sl@0: } {1 {ambiguous option "s": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
sl@0: test info-21.5-280 {miscellaneous error conditions} tip280 {
sl@0:     list [catch {info s} msg] $msg
sl@0: } {1 {ambiguous option "s": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
sl@0: 
sl@0: ##
sl@0: # ### ### ### ######### ######### #########
sl@0: ## info frame
sl@0: 
sl@0: ## Helper
sl@0: # For the more complex results we cut the file name down to remove
sl@0: # path dependencies, and we use only part of the first line of the
sl@0: # reported command. The latter is required because otherwise the whole
sl@0: # test case may appear in some results, but the result is part of the
sl@0: # testcase. An infinite string would be required to describe that. The
sl@0: # cutting-down breaks this.
sl@0: 
sl@0: proc reduce {frame} {
sl@0:     set pos [lsearch -exact $frame cmd]
sl@0:     incr pos
sl@0:     set cmd   [lindex $frame $pos]
sl@0:     if {[regexp \n $cmd]} {
sl@0: 	set first [string range [lindex [split $cmd \n] 0] 0 end-11]
sl@0: 	set frame [lreplace $frame $pos $pos $first]
sl@0:     }
sl@0:     set pos [lsearch -exact $frame file]
sl@0:     if {$pos >=0} {
sl@0: 	incr pos
sl@0: 	set tail  [file tail [lindex $frame $pos]]
sl@0: 	set frame [lreplace $frame $pos $pos $tail]
sl@0:     }
sl@0:     set frame
sl@0: }
sl@0: 
sl@0: ## Helper
sl@0: # Generate a stacktrace from the current location to top.  This code
sl@0: # not only depends on the exact location of things, but also on the
sl@0: # implementation of tcltest. Any changes and these tests will have to
sl@0: # be updated.
sl@0: 
sl@0: proc etrace {} {
sl@0:     set res {}
sl@0:     set level [info frame]
sl@0:     while {$level} {
sl@0: 	lappend res [list $level [reduce [info frame $level]]]
sl@0: 	incr level -1
sl@0:     }
sl@0:     return $res
sl@0: }
sl@0: 
sl@0: ##
sl@0: 
sl@0: test info-22.0 {info frame, levels} tip280 {
sl@0:     info frame
sl@0: } 7
sl@0: 
sl@0: test info-22.1 {info frame, bad level relative} tip280 {
sl@0:     # catch is another level!, i.e. we have 8, not 7
sl@0:     catch {info frame -8} msg
sl@0:     set msg
sl@0: } {bad level "-8"}
sl@0: 
sl@0: test info-22.2 {info frame, bad level absolute} tip280 {
sl@0:     # catch is another level!, i.e. we have 8, not 7
sl@0:     catch {info frame 9} msg
sl@0:     set msg
sl@0: } {bad level "9"}
sl@0: 
sl@0: test info-22.3 {info frame, current, relative} tip280 {
sl@0:     info frame 0
sl@0: } {type eval line 2 cmd {info frame 0}}
sl@0: 
sl@0: test info-22.4 {info frame, current, relative, nested} tip280 {
sl@0:     set res [info frame 0]
sl@0: } {type eval line 2 cmd {info frame 0}}
sl@0: 
sl@0: test info-22.5 {info frame, current, absolute} tip280 {
sl@0:     reduce [info frame 7]
sl@0: } {type eval line 2 cmd {info frame 7}}
sl@0: 
sl@0: test info-22.6 {info frame, global, relative} tip280 {
sl@0:     reduce [info frame -6]
sl@0: } {type source line 759 file info.test cmd test\ info-22.6\ \{info\ frame,\ global,\ relativ}
sl@0: 
sl@0: test info-22.7 {info frame, global, absolute} tip280 {
sl@0:     reduce [info frame 1]
sl@0: } {type source line 763 file info.test cmd test\ info-22.7\ \{info\ frame,\ global,\ absolut}
sl@0: 
sl@0: test info-22.8 {info frame, basic trace} tip280 {
sl@0:     join [etrace] \n
sl@0: } {8 {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
sl@0: 7 {type eval line 2 cmd etrace}
sl@0: 6 {type source line 2277 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::RunTest}
sl@0: 5 {type eval line 1 cmd {::tcltest::RunTest }}
sl@0: 4 {type source line 1619 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::Eval}
sl@0: 3 {type eval line 1 cmd ::tcltest::Eval\ \{::tcltest::RunTest\ }
sl@0: 2 {type source line 1966 file tcltest.tcl cmd {uplevel 1 [list [namespace origin Eval] $command 1]} proc ::tcltest::test}
sl@0: 1 {type source line 767 file info.test cmd test\ info-22.8\ \{info\ frame,\ basic\ trac}}
sl@0: ## The line 1966 is off by 5 from the true value of 1971. This is a knownBug, see testcase 30.0
sl@0: test info-23.0 {eval'd info frame} tip280 {
sl@0:     eval {info frame}
sl@0: } 8
sl@0: 
sl@0: test info-23.1 {eval'd info frame, semi-dynamic} tip280 {
sl@0:     eval info frame
sl@0: } 8
sl@0: 
sl@0: test info-23.2 {eval'd info frame, dynamic} tip280 {
sl@0:     set script {info frame}
sl@0:     eval $script
sl@0: } 8
sl@0: 
sl@0: test info-23.3 {eval'd info frame, literal} tip280 {
sl@0:     eval {
sl@0: 	info frame 0
sl@0:     }
sl@0: } {type eval line 2 cmd {info frame 0}}
sl@0: 
sl@0: test info-23.4 {eval'd info frame, semi-dynamic} tip280 {
sl@0:     eval info frame 0
sl@0: } {type eval line 1 cmd {info frame 0}}
sl@0: 
sl@0: test info-23.5 {eval'd info frame, dynamic} tip280 {
sl@0:     set script {info frame 0}
sl@0:     eval $script
sl@0: } {type eval line 1 cmd {info frame 0}}
sl@0: 
sl@0: test info-23.6 {eval'd info frame, trace} tip280 {
sl@0:     set script {etrace}
sl@0:     join [eval $script] \n
sl@0: } {9 {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
sl@0: 8 {type eval line 1 cmd etrace}
sl@0: 7 {type eval line 3 cmd {eval $script}}
sl@0: 6 {type source line 2277 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::RunTest}
sl@0: 5 {type eval line 1 cmd {::tcltest::RunTest }}
sl@0: 4 {type source line 1619 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::Eval}
sl@0: 3 {type eval line 1 cmd ::tcltest::Eval\ \{::tcltest::RunTest\ }
sl@0: 2 {type source line 1966 file tcltest.tcl cmd {uplevel 1 [list [namespace origin Eval] $command 1]} proc ::tcltest::test}
sl@0: 1 {type source line 806 file info.test cmd test\ info-23.6\ \{eval'd\ info\ frame,\ trac}}
sl@0: ## The line 1966 is off by 5 from the true value of 1971. This is a knownBug, see testcase 30.0
sl@0: # -------------------------------------------------------------------------
sl@0: 
sl@0: # Procedures defined in scripts which are arguments to control
sl@0: # structures (like 'namespace eval', 'interp eval', 'if', 'while',
sl@0: # 'switch', 'catch', 'for', 'foreach', etc.) have no absolute
sl@0: # location. The command implementations execute such scripts through
sl@0: # Tcl_EvalObjEx. Flag 0 causes it to use the bytecode compiler. This
sl@0: # causes the connection to the context to be lost. Currently only
sl@0: # procedure bodies are able to remember their context.
sl@0: 
sl@0: # -------------------------------------------------------------------------
sl@0: 
sl@0: namespace eval foo {
sl@0:     proc bar {} {info frame 0}
sl@0: }
sl@0: 
sl@0: test info-24.0 {info frame, interaction, namespace eval} tip280 {
sl@0:     reduce [foo::bar]
sl@0: } {type source line 832 file info.test cmd {info frame 0} proc ::foo::bar level 0}
sl@0: 
sl@0: namespace delete foo
sl@0: 
sl@0: # -------------------------------------------------------------------------
sl@0: 
sl@0: set flag 1
sl@0: if {$flag} {
sl@0:     namespace eval foo {}
sl@0:     proc ::foo::bar {} {info frame 0}
sl@0: }
sl@0: 
sl@0: test info-24.1 {info frame, interaction, if} tip280 {
sl@0:     reduce [foo::bar]
sl@0: } {type source line 846 file info.test cmd {info frame 0} proc ::foo::bar level 0}
sl@0: 
sl@0: namespace delete foo
sl@0: 
sl@0: # -------------------------------------------------------------------------
sl@0: 
sl@0: set flag 1
sl@0: while {$flag} {
sl@0:     namespace eval foo {}
sl@0:     proc ::foo::bar {} {info frame 0}
sl@0:     set flag 0
sl@0: }
sl@0: 
sl@0: test info-24.2 {info frame, interaction, while} tip280 {
sl@0:     reduce [foo::bar]
sl@0: } {type source line 860 file info.test cmd {info frame 0} proc ::foo::bar level 0}
sl@0: 
sl@0: namespace delete foo
sl@0: 
sl@0: # -------------------------------------------------------------------------
sl@0: 
sl@0: catch {
sl@0:     namespace eval foo {}
sl@0:     proc ::foo::bar {} {info frame 0}
sl@0: }
sl@0: 
sl@0: test info-24.3 {info frame, interaction, catch} tip280 {
sl@0:     reduce [foo::bar]
sl@0: } {type source line 874 file info.test cmd {info frame 0} proc ::foo::bar level 0}
sl@0: 
sl@0: namespace delete foo
sl@0: 
sl@0: # -------------------------------------------------------------------------
sl@0: 
sl@0: foreach var val {
sl@0:     namespace eval foo {}
sl@0:     proc ::foo::bar {} {info frame 0}
sl@0:     break
sl@0: }
sl@0: 
sl@0: test info-24.4 {info frame, interaction, foreach} tip280 {
sl@0:     reduce [foo::bar]
sl@0: } {type source line 887 file info.test cmd {info frame 0} proc ::foo::bar level 0}
sl@0: 
sl@0: namespace delete foo
sl@0: 
sl@0: # -------------------------------------------------------------------------
sl@0: 
sl@0: for {} {1} {} {
sl@0:     namespace eval foo {}
sl@0:     proc ::foo::bar {} {info frame 0}
sl@0:     break
sl@0: }
sl@0: 
sl@0: test info-24.5 {info frame, interaction, for} tip280 {
sl@0:     reduce [foo::bar]
sl@0: } {type source line 901 file info.test cmd {info frame 0} proc ::foo::bar level 0}
sl@0: 
sl@0: namespace delete foo
sl@0: 
sl@0: # -------------------------------------------------------------------------
sl@0: 
sl@0: eval {
sl@0:     proc bar {} {info frame 0}
sl@0: }
sl@0: 
sl@0: test info-25.0 {info frame, proc in eval} tip280 {
sl@0:     reduce [bar]
sl@0: } {type source line 914 file info.test cmd {info frame 0} proc ::bar level 0}
sl@0: 
sl@0: proc bar {} {info frame 0}
sl@0: test info-25.1 {info frame, regular proc} tip280 {
sl@0:     reduce [bar]
sl@0: } {type source line 921 file info.test cmd {info frame 0} proc ::bar level 0}
sl@0: rename bar {}
sl@0: 
sl@0: 
sl@0: 
sl@0: test info-30.0 {bs+nl in literal words} {tip280 knownBug} {
sl@0:     if {1} {
sl@0: 	set res \
sl@0: 	    [reduce [info frame 0]]
sl@0:     }
sl@0:     set res
sl@0:     # This is reporting line 3 instead of the correct 4 because the
sl@0:     # bs+nl combination is subst by the parser before the 'if'
sl@0:     # command, and the the bcc sees the word. To fix record the
sl@0:     # offsets of all bs+nl sequences in literal words, then use the
sl@0:     # information in the bcc to bump line numbers when parsing over
sl@0:     # the location. Also affected: testcases 22.8 and 23.6.
sl@0: } {type eval line 4 cmd {info frame 0} proc ::tcltest::RunTest}
sl@0: 
sl@0: 
sl@0: 
sl@0: # -------------------------------------------------------------------------
sl@0: # See 24.0 - 24.5 for similar situations, using literal scripts.
sl@0: 
sl@0: set body {set flag 0
sl@0:     set a c
sl@0:     set res [info frame 0]} ;# line 3!
sl@0: 
sl@0: test info-31.0 {ns eval, script in variable} tip280 {
sl@0:     namespace eval foo $body
sl@0:     set res
sl@0: } {type eval line 3 cmd {info frame 0} level 0}
sl@0: catch {namespace delete foo}
sl@0: 
sl@0: 
sl@0: test info-31.1 {if, script in variable} tip280 {
sl@0:     if 1 $body
sl@0:     set res
sl@0: } {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
sl@0: 
sl@0: test info-31.1a {if, script in variable} tip280 {
sl@0:     if 1 then $body
sl@0:     set res
sl@0: } {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
sl@0: 
sl@0: 
sl@0: 
sl@0: test info-31.2 {while, script in variable} tip280 {
sl@0:     set flag 1
sl@0:     while {$flag} $body
sl@0:     set res
sl@0: } {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
sl@0: 
sl@0: # .3 - proc - scoping prevent return of result ...
sl@0: 
sl@0: test info-31.4 {foreach, script in variable} tip280 {
sl@0:     foreach var val $body
sl@0:     set res
sl@0: } {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
sl@0: 
sl@0: test info-31.5 {for, script in variable} tip280 {
sl@0:     set flag 1
sl@0:     for {} {$flag} {} $body
sl@0:     set res
sl@0: } {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
sl@0: 
sl@0: test info-31.6 {eval, script in variable} tip280 {
sl@0:     eval $body
sl@0:     set res
sl@0: } {type eval line 3 cmd {info frame 0}}
sl@0: 
sl@0: # -------------------------------------------------------------------------
sl@0: 
sl@0: namespace eval foo {}
sl@0: set x foo
sl@0: switch -exact -- $x {
sl@0:     foo {
sl@0: 	proc ::foo::bar {} {info frame 0}
sl@0:     }
sl@0: }
sl@0: 
sl@0: test info-24.6.0 {info frame, interaction, switch, list body} tip280 {
sl@0:     reduce [foo::bar]
sl@0: } {type source line 1001 file info.test cmd {info frame 0} proc ::foo::bar level 0}
sl@0: 
sl@0: namespace delete foo
sl@0: unset x
sl@0: 
sl@0: # -------------------------------------------------------------------------
sl@0: 
sl@0: namespace eval foo {}
sl@0: set x foo
sl@0: switch -exact -- $x foo {
sl@0:     proc ::foo::bar {} {info frame 0}
sl@0: }
sl@0: 
sl@0: test info-24.6.1 {info frame, interaction, switch, multi-body} tip280 {
sl@0:     reduce [foo::bar]
sl@0: } {type source line 1017 file info.test cmd {info frame 0} proc ::foo::bar level 0}
sl@0: 
sl@0: namespace delete foo
sl@0: unset x
sl@0: 
sl@0: # -------------------------------------------------------------------------
sl@0: 
sl@0: namespace eval foo {}
sl@0: set x foo
sl@0: switch -exact -- $x [list foo {
sl@0:     proc ::foo::bar {} {info frame 0}
sl@0: }]
sl@0: 
sl@0: test info-24.6.2 {info frame, interaction, switch, list body, dynamic} tip280 {
sl@0:     reduce [foo::bar]
sl@0: } {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
sl@0: 
sl@0: namespace delete foo
sl@0: unset x
sl@0: 
sl@0: # -------------------------------------------------------------------------
sl@0: 
sl@0: set body {
sl@0:     foo {
sl@0: 	proc ::foo::bar {} {info frame 0}
sl@0:     }
sl@0: }
sl@0: 
sl@0: namespace eval foo {}
sl@0: set x foo
sl@0: switch -exact -- $x $body
sl@0: 
sl@0: test info-31.7 {info frame, interaction, switch, dynamic} tip280 {
sl@0:     reduce [foo::bar]
sl@0: } {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
sl@0: 
sl@0: namespace delete foo
sl@0: unset x
sl@0: 
sl@0: # -------------------------------------------------------------------------
sl@0: 
sl@0: set body {
sl@0:     proc ::foo::bar {} {info frame 0}
sl@0: }
sl@0: 
sl@0: namespace eval foo {}
sl@0: eval $body
sl@0: 
sl@0: test info-32.0 {info frame, dynamic procedure} tip280 {
sl@0:     reduce [foo::bar]
sl@0: } {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
sl@0: 
sl@0: namespace delete foo
sl@0: 
sl@0: # -------------------------------------------------------------------------
sl@0: 
sl@0: # cleanup
sl@0: catch {namespace delete test_ns_info1 test_ns_info2}
sl@0: ::tcltest::cleanupTests
sl@0: return