summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorandreas_kupries <akupries@shaw.ca>2008-07-28 20:00:57 (GMT)
committerandreas_kupries <akupries@shaw.ca>2008-07-28 20:00:57 (GMT)
commit24cd37cd688085d4c016ab87e112add167d69173 (patch)
treec9ae4bdded6df431ec80cf526bc7ebae73c19e7a /tests
parentc5be2d186c8738b465587c5433f3f4c422c95313 (diff)
downloadtcl-24cd37cd688085d4c016ab87e112add167d69173.zip
tcl-24cd37cd688085d4c016ab87e112add167d69173.tar.gz
tcl-24cd37cd688085d4c016ab87e112add167d69173.tar.bz2
* generic/tclBasic.c: Added missing release of extended command
word index when deleting an interpreter (DeleteInterpProc). Added missing ref count when creating an empty string as path (EvalEx). * generic/tclCompile.c (TclInitCompileEnv): Made same change to control flow as in TclEvalObjEx. Not needed while uplevel and siblings go through the eval-direct code path, however if that changes (like it did in 8.5+) better to have this in place instead of re-searching why certain places are without absolute locations. * tests/info.test: Added tests 38.*, exactly testing the tracking of location for uplevel scripts, and made the testsuite fully usable with and without -singleproc 1.
Diffstat (limited to 'tests')
-rw-r--r--tests/info.test184
1 files changed, 102 insertions, 82 deletions
diff --git a/tests/info.test b/tests/info.test
index 9f875ee..b30a4be 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -13,7 +13,7 @@
# 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.10 2008/07/25 21:24:45 das Exp $
+# RCS: @(#) $Id: info.test,v 1.24.2.11 2008/07/28 20:01:12 andreas_kupries Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -728,71 +728,97 @@ proc etrace {} {
##
-test info-22.0 {info frame, levels} {tip280 && !singleTestInterp} {
+test info-22.0.0 {info frame, levels} {tip280 && !singleTestInterp} {
info frame
} 7
+test info-22.0.1 {info frame, levels} {tip280 && singleTestInterp} {
+ info frame
+} 10
-test info-22.1 {info frame, bad level relative} {tip280 && !singleTestInterp} {
+test info-22.1.0 {info frame, bad level relative} {tip280 && !singleTestInterp} {
# catch is another level!, i.e. we have 8, not 7
catch {info frame -8} msg
set msg
} {bad level "-8"}
+test info-22.1.1 {info frame, bad level relative} {tip280 && singleTestInterp} {
+ # catch is another level!, i.e. we have 11, not 10
+ catch {info frame -11} msg
+ set msg
+} {bad level "-11"}
-test info-22.2 {info frame, bad level absolute} {tip280 && !singleTestInterp} {
+test info-22.2.0 {info frame, bad level absolute} {tip280 && !singleTestInterp} {
# catch is another level!, i.e. we have 8, not 7
catch {info frame 9} msg
set msg
} {bad level "9"}
+test info-22.2.1 {info frame, bad level absolute} {tip280 && singleTestInterp} {
+ # catch is another level!, i.e. we have 12, not 10
+ catch {info frame 12} msg
+ set msg
+} {bad level "12"}
test info-22.3 {info frame, current, relative} -constraints tip280 -match glob -body {
info frame 0
-} -result {type source line 748 file *info.test cmd {info frame 0} proc ::tcltest::RunTest}
+} -result {type source line 761 file * cmd {info frame 0} proc ::tcltest::RunTest}
test info-22.4 {info frame, current, relative, nested} -constraints tip280 -match glob -body {
set res [info frame 0]
-} -result {type source line 752 file *info.test cmd {info frame 0} proc ::tcltest::RunTest}
+} -result {type source line 765 file * cmd {info frame 0} proc ::tcltest::RunTest}
-test info-22.5 {info frame, current, absolute} -constraints {tip280 && !singleTestInterp} -match glob -body {
+test info-22.5.0 {info frame, current, absolute} -constraints {tip280 && !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 769 file * cmd {info frame 7} proc ::tcltest::RunTest}
+test info-22.5.1 {info frame, current, absolute} -constraints {tip280 && singleTestInterp} -match glob -body {
+ reduce [info frame 10]
+} -result {type source line 772 file * cmd {info frame 10} proc ::tcltest::RunTest}
-test info-22.6 {info frame, global, relative} {tip280 && !singleTestInterp} {
+test info-22.6.0 {info frame, global, relative} {tip280 && !singleTestInterp} {
+ reduce [info frame -6]
+} {type source line 775 file info.test cmd test\ info-22.6.0\ \{info\ frame,\ global,\ relative\}\ \{tip280\ &&\ !singleTe}
+test info-22.6.1 {info frame, global, relative} {tip280 && singleTestInterp} {
reduce [info frame -6]
-} {type source line 759 file info.test cmd test\ info-22.6\ \{info\ frame,\ global,\ relative\}\ \{tip280\ &&\ !singleTe}
+} {type source line 778 file info.test cmd test\ info-22.6.1\ \{info\ frame,\ global,\ relative\}\ \{tip280\ &&\ singleTe proc ::tcltest::runAllTests}
-test info-22.7 {info frame, global, absolute} {tip280 && !singleTestInterp} {
+test info-22.7.0 {info frame, global, absolute} {tip280 && !singleTestInterp} {
reduce [info frame 1]
-} {type source line 763 file info.test cmd test\ info-22.7\ \{info\ frame,\ global,\ absolute\}\ \{tip280\ &&\ !singleTe}
-
-test info-22.8 {info frame, basic trace} -constraints {tip280 && !singleTestInterp} -match glob -body {
- join [etrace] \n
-} -result {8 {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
-7 {type source line 768 file info.test cmd etrace proc ::tcltest::RunTest}
-6 {type source line * file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::RunTest}
-5 {type eval line 1 cmd {::tcltest::RunTest } proc ::tcltest::Eval}
-4 {type source line * file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::Eval}
-3 {type eval line 1 cmd ::tcltest::Eval\\ \\\{::tcltest::RunTest\\ proc ::tcltest::test}
-2 {type source line * 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 trace} -constraints {tip280 && !singleTestInterp} -match g}}}
+} {type source line 782 file info.test cmd test\ info-22.7.0\ \{info\ frame,\ global,\ absolute\}\ \{tip280\ &&\ !singleTe}
+test info-22.7.1 {info frame, global, absolute} {tip280 && singleTestInterp} {
+ reduce [info frame 4]
+} {type source line 785 file info.test cmd test\ info-22.7.1\ \{info\ frame,\ global,\ absolute\}\ \{tip280\ &&\ singleTe proc ::tcltest::runAllTests}
+
+test info-22.8 {info frame, basic trace} -constraints {tip280} -match glob -body {
+ join [lrange [etrace] 0 1] \n
+} -result {* {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type source line 790 file info.test cmd etrace proc ::tcltest::RunTest}}
## 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 && !singleTestInterp} {
+test info-23.0.0 {eval'd info frame} {tip280 && !singleTestInterp} {
eval {info frame}
} 8
+test info-23.0.1 {eval'd info frame} {tip280 && singleTestInterp} {
+ eval {info frame}
+} 11
-test info-23.1 {eval'd info frame, semi-dynamic} {tip280 && !singleTestInterp} {
+test info-23.1.0 {eval'd info frame, semi-dynamic} {tip280 && !singleTestInterp} {
eval info frame
} 8
+test info-23.1.1 {eval'd info frame, semi-dynamic} {tip280 && singleTestInterp} {
+ eval info frame
+} 11
-test info-23.2 {eval'd info frame, dynamic} {tip280 && !singleTestInterp} {
+test info-23.2.0 {eval'd info frame, dynamic} {tip280 && !singleTestInterp} {
set script {info frame}
eval $script
} 8
+test info-23.2.1 {eval'd info frame, dynamic} {tip280 && singleTestInterp} {
+ set script {info frame}
+ eval $script
+} 11
test info-23.3 {eval'd info frame, literal} -constraints tip280 -match glob -body {
eval {
info frame 0
}
-} -result {type source line 793 file *info.test cmd {info frame 0} proc ::tcltest::RunTest}
+} -result {type source line 819 file *info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-23.4 {eval'd info frame, semi-dynamic} tip280 {
eval info frame 0
@@ -803,18 +829,12 @@ test info-23.5 {eval'd info frame, dynamic} tip280 {
eval $script
} {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest}
-test info-23.6 {eval'd info frame, trace} -constraints {tip280 && !singleTestInterp} -match glob -body {
+test info-23.6 {eval'd info frame, trace} -constraints {tip280} -match glob -body {
set script {etrace}
- join [eval $script] \n
-} -result {9 {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
-8 {type eval line 1 cmd etrace proc ::tcltest::RunTest}
-7 {type source line 808 file info.test cmd {eval $script} proc ::tcltest::RunTest}
-6 {type source line * file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::RunTest}
-5 {type eval line 1 cmd {::tcltest::RunTest } proc ::tcltest::Eval}
-4 {type source line * file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::Eval}
-3 {type eval line 1 cmd ::tcltest::Eval\\ \\\{::tcltest::RunTest\\ proc ::tcltest::test}
-2 {type source line * 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, trace} -constraints {tip280 && !singleTestInterp} -match g}}}
+ join [lrange [eval $script] 0 2] \n
+} -result {* {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type eval line 1 cmd etrace proc ::tcltest::RunTest}
+* {type source line 834 file info.test cmd {eval $script} proc ::tcltest::RunTest}}
## The line 1966 is off by 5 from the true value of 1971. This is a knownBug, see testcase 30.0
# -------------------------------------------------------------------------
@@ -834,7 +854,7 @@ namespace eval foo {
test info-24.0 {info frame, interaction, namespace eval} tip280 {
reduce [foo::bar]
-} {type source line 832 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 852 file info.test cmd {info frame 0} proc ::foo::bar level 0}
namespace delete foo
@@ -848,7 +868,7 @@ if {$flag} {
test info-24.1 {info frame, interaction, if} tip280 {
reduce [foo::bar]
-} {type source line 846 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 866 file info.test cmd {info frame 0} proc ::foo::bar level 0}
namespace delete foo
@@ -863,7 +883,7 @@ while {$flag} {
test info-24.2 {info frame, interaction, while} tip280 {
reduce [foo::bar]
-} {type source line 860 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 880 file info.test cmd {info frame 0} proc ::foo::bar level 0}
namespace delete foo
@@ -876,7 +896,7 @@ catch {
test info-24.3 {info frame, interaction, catch} tip280 {
reduce [foo::bar]
-} {type source line 874 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 894 file info.test cmd {info frame 0} proc ::foo::bar level 0}
namespace delete foo
@@ -890,7 +910,7 @@ foreach var val {
test info-24.4 {info frame, interaction, foreach} tip280 {
reduce [foo::bar]
-} {type source line 887 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 907 file info.test cmd {info frame 0} proc ::foo::bar level 0}
namespace delete foo
@@ -904,7 +924,7 @@ for {} {1} {} {
test info-24.5 {info frame, interaction, for} tip280 {
reduce [foo::bar]
-} {type source line 901 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 921 file info.test cmd {info frame 0} proc ::foo::bar level 0}
namespace delete foo
@@ -916,12 +936,12 @@ eval {
test info-25.0 {info frame, proc in eval} tip280 {
reduce [bar]
-} {type source line 914 file info.test cmd {info frame 0} proc ::bar level 0}
+} {type source line 934 file info.test cmd {info frame 0} proc ::bar level 0}
proc bar {} {info frame 0}
test info-25.1 {info frame, regular proc} tip280 {
reduce [bar]
-} {type source line 921 file info.test cmd {info frame 0} proc ::bar level 0}
+} {type source line 941 file info.test cmd {info frame 0} proc ::bar level 0}
rename bar {}
@@ -1004,7 +1024,7 @@ switch -exact -- $x {
test info-24.6.0 {info frame, interaction, switch, list body} tip280 {
reduce [foo::bar]
-} {type source line 1001 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 1021 file info.test cmd {info frame 0} proc ::foo::bar level 0}
namespace delete foo
unset x
@@ -1019,7 +1039,7 @@ switch -exact -- $x foo {
test info-24.6.1 {info frame, interaction, switch, multi-body} tip280 {
reduce [foo::bar]
-} {type source line 1017 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 1037 file info.test cmd {info frame 0} proc ::foo::bar level 0}
namespace delete foo
unset x
@@ -1075,7 +1095,7 @@ namespace delete foo
# -------------------------------------------------------------------------
-test info-34.0 {eval pure list, single line} {tip280 && !singleTestInterp} {
+test info-34.0 {eval pure list, single line} -constraints {tip280} -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.
@@ -1093,9 +1113,9 @@ test info-34.0 {eval pure list, single line} {tip280 && !singleTestInterp} {
}]
eval $cmd
set res
-} {10 {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
-9 {type eval line 2 cmd etrace proc ::tcltest::RunTest}
-8 {type eval line 1 cmd foreac proc ::tcltest::RunTest}}
+} -result {* {type source line 723 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}}
# -------------------------------------------------------------------------
@@ -1128,61 +1148,61 @@ proc datav {} {
control y $script
}
-test info-38.1 {location information for uplevel, dv, direct-var} tip280 {
+test info-38.1 {location information for uplevel, dv, direct-var} -constraints tip280 -match glob -body {
set script {
set y DV.
etrace
}
join [lrange [uplevel \#0 $script] 0 2] \n
-} {9 {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
-8 {type eval line 3 cmd etrace proc ::tcltest::RunTest}
-7 {type source line 1136 file info.test cmd {uplevel \#0 $script} proc ::tcltest::RunTest}}
+} -result {* {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type eval line 3 cmd etrace proc ::tcltest::RunTest}
+* {type source line 1156 file info.test cmd {uplevel \\#0 $script} proc ::tcltest::RunTest}}
-test info-38.2 {location information for uplevel, dl, direct-literal} tip280 {
+test info-38.2 {location information for uplevel, dl, direct-literal} -constraints tip280 -match glob -body {
join [lrange [uplevel \#0 {
set y DL.
etrace
}] 0 2] \n
-} {9 {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
-8 {type source line 1144 file info.test cmd etrace proc ::tcltest::RunTest}
-7 {type source line 1142 file info.test cmd up proc ::tcltest::RunTest}}
+} -result {* {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type source line 1164 file info.test cmd etrace proc ::tcltest::RunTest}
+* {type source line 1162 file info.test cmd up proc ::tcltest::RunTest}}
-test info-38.3 {location information for uplevel, dpv, direct-proc-var} tip280 {
+test info-38.3 {location information for uplevel, dpv, direct-proc-var} -constraints tip280 -match glob -body {
set script {
set y DPV
etrace
}
join [lrange [control y $script] 0 3] \n
-} {10 {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
-9 {type eval line 3 cmd etrace proc ::control}
-8 {type source line 1113 file info.test cmd {uplevel 1 $script} proc ::control}
-7 {type source line 1155 file info.test cmd {control y $script} proc ::tcltest::RunTest}}
+} -result {* {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type eval line 3 cmd etrace proc ::control}
+* {type source line 1133 file info.test cmd {uplevel 1 $script} proc ::control}
+* {type source line 1175 file info.test cmd {control y $script} proc ::tcltest::RunTest}}
-test info-38.4 {location information for uplevel, dpv, direct-proc-literal} tip280 {
+test info-38.4 {location information for uplevel, dpv, direct-proc-literal} -constraints tip280 -match glob -body {
join [lrange [control y {
set y DPL
etrace
}] 0 3] \n
-} {10 {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
-9 {type source line 1164 file info.test cmd etrace proc ::control}
-8 {type source line 1113 file info.test cmd {uplevel 1 $script} proc ::control}
-7 {type source line 1162 file info.test cmd control proc ::tcltest::RunTest}}
+} -result {* {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type source line 1184 file info.test cmd etrace proc ::control}
+* {type source line 1133 file info.test cmd {uplevel 1 $script} proc ::control}
+* {type source line 1182 file info.test cmd control proc ::tcltest::RunTest}}
-test info-38.5 {location information for uplevel, ppv, proc-proc-var} tip280 {
+test info-38.5 {location information for uplevel, ppv, proc-proc-var} -constraints tip280 -match glob -body {
join [lrange [datav] 0 4] \n
-} {11 {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
-10 {type eval line 3 cmd etrace proc ::control}
-9 {type source line 1113 file info.test cmd {uplevel 1 $script} proc ::control}
-8 {type source line 1128 file info.test cmd {control y $script} proc ::datav level 1}
-7 {type source line 1172 file info.test cmd datav proc ::tcltest::RunTest}}
+} -result {* {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type eval line 3 cmd etrace proc ::control}
+* {type source line 1133 file info.test cmd {uplevel 1 $script} proc ::control}
+* {type source line 1148 file info.test cmd {control y $script} proc ::datav level 1}
+* {type source line 1192 file info.test cmd datav proc ::tcltest::RunTest}}
-test info-38.6 {location information for uplevel, ppl, proc-proc-literal} tip280 {
+test info-38.6 {location information for uplevel, ppl, proc-proc-literal} -constraints tip280 -match glob -body {
join [lrange [datal] 0 4] \n
-} {11 {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
-10 {type source line 1119 file info.test cmd etrace proc ::control}
-9 {type source line 1113 file info.test cmd {uplevel 1 $script} proc ::control}
-8 {type source line 1117 file info.test cmd control proc ::datal level 1}
-7 {type source line 1180 file info.test cmd datal proc ::tcltest::RunTest}}
+} -result {* {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type source line 1139 file info.test cmd etrace proc ::control}
+* {type source line 1133 file info.test cmd {uplevel 1 $script} proc ::control}
+* {type source line 1137 file info.test cmd control proc ::datal level 1}
+* {type source line 1200 file info.test cmd datal proc ::tcltest::RunTest}}
# -------------------------------------------------------------------------