* generic/tclBasic.c (Tcl_CreateInterp, Tcl_EvalTokensStandard,

	EvalTokensStandard, Tcl_EvalEx, EvalEx, TclAdvanceContinuations,
	TclEvalObjEx):
	* generic/tclCmdMZ.c (Tcl_SwitchObjCmd, ListLines):
	* generic/tclCompCmds.c (*):
	* generic/tclCompile.c (TclSetByteCodeFromAny, TclInitCompileEnv,
	TclFreeCompileEnv, TclCompileScript):
	* generic/tclCompile.h (CompileEnv):
	* generic/tclInt.h (ContLineLoc, Interp):
	* generic/tclObj.c (ThreadSpecificData, ContLineLocFree,
	TclThreadFinalizeObjects, TclInitObjSubsystem,
	TclContinuationsEnter, TclContinuationsEnterDerived,
	TclContinuationsCopy, TclContinuationsGet, TclFreeObj):
	* generic/tclProc.c (TclCreateProc):
	* generic/tclVar.c (TclPtrSetVar):
	* tests/info.test (info-30.0-22):

	Extended parser, compiler, and execution with code and attendant
	data structures tracking the positions of continuation lines which
	are not visible in script's, to properly account for them while
	counting lines for #280, during direct and compiled execution.


FossilOrigin-Name: 9fa7a1ee78b8d615101ff67e210dde680136589f

1 files changed, 251 insertions, 12 deletions

diff --git a/tests/info.test b/tests/info.test
index b655e30..21e4f75 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.12 2009/07/14 16:31:49 andreas_kupries Exp $
+# RCS: @(#) $Id: info.test,v 1.24.2.13 2009/08/25 20:59:11 andreas_kupries Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -790,7 +790,7 @@ 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.0 {eval'd info frame} {tip280 && !singleTestInterp} {
     eval {info frame}
 } 8
@@ -835,7 +835,7 @@ test info-23.6 {eval'd info frame, trace} -constraints {tip280} -match glob -bod
 } -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
+
 # -------------------------------------------------------------------------
 
 # Procedures defined in scripts which are arguments to control
@@ -945,20 +945,20 @@ test info-25.1 {info frame, regular proc} tip280 {
 rename bar {}
 
 
-
-test info-30.0 {bs+nl in literal words} {tip280 knownBug} {
+# More info-30.x test cases at the end of the file.
+test info-30.0 {bs+nl in literal words} {tip280} {
     if {1} {
 	set res \
-	    [reduce [info frame 0]]
+	    [reduce [info frame 0]];# line 952
     }
     set res
-    # This is reporting line 3 instead of the correct 4 because the
+    # 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 the bcc sees the word. To fix record the
-    # offsets of all bs+nl sequences in literal words, then use the
-    # information in the bcc to bump line numbers when parsing over
-    # the location. Also affected: testcases 22.8 and 23.6.
-} {type eval line 4 cmd {info frame 0} proc ::tcltest::RunTest}
+    # 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.
+} {type source line 952 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
 
 
 
@@ -1223,6 +1223,245 @@ type source line 1214 file info.test cmd {info frame 0} proc ::foo::bar level 0
 type source line 1215 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} {tip280} {
+    proc abra {} {
+	if {1} \
+	    {
+		return \
+		    [reduce [info frame 0]];# line 1233
+	    }
+    }
+    set res [abra]
+    rename abra {}
+    set res
+} {type source line 1233 file info.test cmd {info frame 0} proc ::abra level 0}
+
+test info-30.2 {bs+nl in literal words, namespace script} {tip280} {
+    namespace eval xxx {
+	set res \
+	    [reduce [info frame 0]];# line 1244
+    }
+    set res
+} {type source line 1244 file info.test cmd {info frame 0} level 0}
+
+test info-30.3 {bs+nl in literal words, namespace multi-word script} {tip280} {
+    namespace eval xxx set res \
+	[list [reduce [info frame 0]]];# line 1251
+    set res
+} {type source line 1251 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.4 {bs+nl in literal words, eval script} {tip280} {
+    eval {
+	set ::res \
+	    [reduce [info frame 0]];# line 1258
+    }
+    set res
+} {type source line 1258 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.5 {bs+nl in literal words, eval script, with nested words} {tip280} {
+    eval {
+	if {1} \
+	    {
+		set ::res \
+		    [reduce [info frame 0]];# line 1268
+	    }
+    }
+    set res
+} {type source line 1268 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.6 {bs+nl in computed word} {tip280} {
+    set res "\
+[reduce [info frame 0]]";# line 1276
+} { type source line 1276 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.7 {bs+nl in computed word, in proc} {tip280} {
+    proc abra {} {
+	return "\
+[reduce [info frame 0]]";# line 1282
+    }
+    set res [abra]
+    rename abra {}
+    set res
+} { type source line 1282 file info.test cmd {info frame 0} proc ::abra level 0}
+
+test info-30.8 {bs+nl in computed word, nested eval} {tip280} {
+    eval {
+	set \
+	    res "\
+[reduce [info frame 0]]";# line 1293
+}
+} { type source line 1293 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.9 {bs+nl in computed word, nested eval} {tip280} {
+    eval {
+	set \
+	    res "\
+[reduce \
+     [info frame 0]]";# line 1302
+}
+} { type source line 1302 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.10 {bs+nl in computed word, key to array} {tip280} {
+    set tmp([set \
+	    res "\
+[reduce \
+     [info frame 0]]"]) x ; #1310
+    unset tmp
+    set res
+} { type source line 1310 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.11 {bs+nl in subst arguments, no true counting} {tip280} {
+    subst {[set \
+	    res "\
+[reduce \
+     [info frame 0]]"]}
+} { type eval line 2 cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.12 {bs+nl in computed word, nested eval} {tip280} {
+    eval {
+	set \
+	    res "\
+[set x {}] \
+[reduce \
+     [info frame 0]]";# line 1328
+}
+} {   type source line 1328 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.13 {bs+nl in literal words, uplevel script, with nested words} {tip280} {
+    uplevel #0 {
+	if {1} \
+	    {
+		set ::res \
+		    [reduce [info frame 0]];# line 1337
+	    }
+    }
+    set res
+} {type source line 1337 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.14 {bs+nl, literal word, uplevel through proc} {tip280} {
+    proc abra {script} {
+	uplevel 1 $script
+    }
+    set res [abra {
+	return "\
+[reduce [info frame 0]]";# line 1349
+    }]
+    rename abra {}
+    set res
+} { type source line 1349 file info.test cmd {info frame 0} proc ::abra}
+
+test info-30.15 {bs+nl in literal words, nested proc body, compiled} {tip280} {
+    proc a {} {
+	proc b {} {
+	    if {1} \
+		{
+		    return \
+			[reduce [info frame 0]];# line 1361
+		}
+	}
+    }
+    a ; set res [b]
+    rename a {}
+    rename b {}
+    set res
+} {type source line 1361 file info.test cmd {info frame 0} proc ::b level 0}
+
+test info-30.16 {bs+nl in multi-body switch, compiled} {tip280} {
+    proc a {value} {
+	switch -regexp -- $value \
+	    ^key     { info frame 0; # 1374 } \
+	    \t       { info frame 0; # 1375 } \
+	    {[0-9]*} { info frame 0; # 1376 }
+    }
+    set res {}
+    lappend res [reduce [a {key   }]]
+    lappend res [reduce [a {1alpha}]]
+    set res "\n[join $res \n]"
+} {
+type source line 1374 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1376 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.17 {bs+nl in multi-body switch, direct} {tip280} {
+    switch -regexp -- {key    } \
+	^key     { reduce [info frame 0] ;# 1388 } \
+        \t###    { } \
+        {[0-9]*} { }
+} {type source line 1388 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} {tip280} {
+    proc abra {script} {
+	append script "\n# end of script"
+	uplevel 1 $script
+    }
+    set res [abra {
+	return "\
+[reduce [info frame 0]]";# line 1400, still line of 3 appended script
+    }]
+    rename abra {}
+    set res
+} { type eval line 3 cmd {info frame 0} proc ::abra}
+# { type source line 1400 file info.test cmd {info frame 0} proc ::abra}
+
+test info-30.19 {bs+nl in single-body switch, compiled} {tip280} {
+    proc a {value} {
+	switch -regexp -- $value {
+	    ^key     { reduce \
+			   [info frame 0] }
+	    \t       { reduce \
+			   [info frame 0] }
+	    {[0-9]*} { reduce \
+			   [info frame 0] }
+	}
+    }
+    set res {}
+    lappend res [a {key   }]
+    lappend res [a {1alpha}]
+    set res "\n[join $res \n]"
+} {
+type source line 1411 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1415 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.20 {bs+nl in single-body switch, direct} {tip280} {
+    switch -regexp -- {key    } { \
+
+	^key     { reduce \
+		       [info frame 0] }
+	\t       { }
+        {[0-9]*} { }
+    }
+} {type source line 1430 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.21 {bs+nl in if, full compiled} {tip280} {
+    proc a {value} {
+	if {$value} \
+	    {info frame 0} \
+	    {info frame 0}
+    }
+    set res {}
+    lappend res [reduce [a 1]]
+    lappend res [reduce [a 0]]
+    set res "\n[join $res \n]"
+} {
+type source line 1439 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1440 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.22 {bs+nl in computed word, key to array, compiled} {tip280} {
+    proc a {} {
+	set tmp([set \
+		     res "\
+[reduce \
+     [info frame 0]]"]) x ; #1454
+    unset tmp
+    set res
+    }
+    set res [a]
+    rename a {}
+    set res
+} { type source line 1455 file info.test cmd {info frame 0} proc ::a level 0}
+
+# -------------------------------------------------------------------------
 
 # cleanup
 catch {namespace delete test_ns_info1 test_ns_info2}