Diff
Not logged in

Differences From Artifact [4fd6201c70]:

To Artifact [b948d171e6]:


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 {