9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
|
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
|
-
+
|
# 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.
#
# RCS: @(#) $Id: info.test,v 1.24.2.5 2006/11/28 22:20:02 andreas_kupries Exp $
# RCS: @(#) $Id: info.test,v 1.24.2.6 2008/06/16 20:46:16 andreas_kupries Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
# Set up namespaces needed to test operation of "info args", "info body",
|
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
|
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
|
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
-
+
+
-
+
-
+
|
# catch is another level!, i.e. we have 8, not 7
catch {info frame 9} msg
set msg
} {bad level "9"}
test info-22.3 {info frame, current, relative} tip280 {
info frame 0
} {type eval line 2 cmd {info frame 0}}
} {type eval line 2 cmd {info frame 0} proc ::tcltest::RunTest}
test info-22.4 {info frame, current, relative, nested} tip280 {
set res [info frame 0]
} {type eval line 2 cmd {info frame 0}}
} {type eval line 2 cmd {info frame 0} proc ::tcltest::RunTest}
test info-22.5 {info frame, current, absolute} tip280 {
reduce [info frame 7]
} {type eval line 2 cmd {info frame 7}}
} {type eval line 2 cmd {info frame 7} proc ::tcltest::RunTest}
test info-22.6 {info frame, global, relative} tip280 {
reduce [info frame -6]
} {type source line 759 file info.test cmd test\ info-22.6\ \{info\ frame,\ global,\ relativ}
test info-22.7 {info frame, global, absolute} tip280 {
reduce [info frame 1]
} {type source line 763 file info.test cmd test\ info-22.7\ \{info\ frame,\ global,\ absolut}
test info-22.8 {info frame, basic trace} tip280 {
join [etrace] \n
} {8 {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
7 {type eval line 2 cmd etrace}
7 {type eval line 2 cmd etrace proc ::tcltest::RunTest}
6 {type source line 2277 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::RunTest}
5 {type eval line 1 cmd {::tcltest::RunTest }}
5 {type eval line 1 cmd {::tcltest::RunTest } proc ::tcltest::Eval}
4 {type source line 1619 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::Eval}
3 {type eval line 1 cmd ::tcltest::Eval\ \{::tcltest::RunTest\ }
3 {type eval line 1 cmd ::tcltest::Eval\ \{::tcltest::RunTest\ proc ::tcltest::test}
2 {type source line 1966 file tcltest.tcl cmd {uplevel 1 [list [namespace origin Eval] $command 1]} proc ::tcltest::test}
1 {type source line 767 file info.test cmd test\ info-22.8\ \{info\ frame,\ basic\ trac}}
## The line 1966 is off by 5 from the true value of 1971. This is a knownBug, see testcase 30.0
test info-23.0 {eval'd info frame} tip280 {
eval {info frame}
} 8
test info-23.1 {eval'd info frame, semi-dynamic} tip280 {
eval info frame
} 8
test info-23.2 {eval'd info frame, dynamic} tip280 {
set script {info frame}
eval $script
} 8
test info-23.3 {eval'd info frame, literal} tip280 {
eval {
info frame 0
}
} {type eval line 2 cmd {info frame 0}}
} {type eval line 2 cmd {info frame 0} proc ::tcltest::RunTest}
test info-23.4 {eval'd info frame, semi-dynamic} tip280 {
eval info frame 0
} {type eval line 1 cmd {info frame 0}}
} {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest}
test info-23.5 {eval'd info frame, dynamic} tip280 {
set script {info frame 0}
eval $script
} {type eval line 1 cmd {info frame 0}}
} {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest}
test info-23.6 {eval'd info frame, trace} tip280 {
set script {etrace}
join [eval $script] \n
} {9 {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
8 {type eval line 1 cmd etrace}
7 {type eval line 3 cmd {eval $script}}
8 {type eval line 1 cmd etrace proc ::tcltest::RunTest}
7 {type eval line 3 cmd {eval $script} proc ::tcltest::RunTest}
6 {type source line 2277 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::RunTest}
5 {type eval line 1 cmd {::tcltest::RunTest }}
5 {type eval line 1 cmd {::tcltest::RunTest } proc ::tcltest::Eval}
4 {type source line 1619 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::Eval}
3 {type eval line 1 cmd ::tcltest::Eval\ \{::tcltest::RunTest\ }
3 {type eval line 1 cmd ::tcltest::Eval\ \{::tcltest::RunTest\ proc ::tcltest::test}
2 {type source line 1966 file tcltest.tcl cmd {uplevel 1 [list [namespace origin Eval] $command 1]} proc ::tcltest::test}
1 {type source line 806 file info.test cmd test\ info-23.6\ \{eval'd\ info\ frame,\ trac}}
## The line 1966 is off by 5 from the true value of 1971. This is a knownBug, see testcase 30.0
# -------------------------------------------------------------------------
# Procedures defined in scripts which are arguments to control
# structures (like 'namespace eval', 'interp eval', 'if', 'while',
|
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
|
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
|
-
+
|
for {} {$flag} {} $body
set res
} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
test info-31.6 {eval, script in variable} tip280 {
eval $body
set res
} {type eval line 3 cmd {info frame 0}}
} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
# -------------------------------------------------------------------------
namespace eval foo {}
set x foo
switch -exact -- $x {
foo {
|