diff options
author | andreas_kupries <akupries@shaw.ca> | 2009-08-25 21:01:05 (GMT) |
---|---|---|
committer | andreas_kupries <akupries@shaw.ca> | 2009-08-25 21:01:05 (GMT) |
commit | b323d4f47679f5fc047d6397a0c87f0768de644c (patch) | |
tree | 73bcc5c62cbf32fd6429c1116057e7803a5e2c6a /tests/info.test | |
parent | 07abfaa1257d10162ab31f3e2e113c192650e2d8 (diff) | |
download | tcl-b323d4f47679f5fc047d6397a0c87f0768de644c.zip tcl-b323d4f47679f5fc047d6397a0c87f0768de644c.tar.gz tcl-b323d4f47679f5fc047d6397a0c87f0768de644c.tar.bz2 |
* generic/tclBasic.c (Tcl_CreateInterp, Tcl_EvalTokensStandard,
EvalTokensStandard, Tcl_EvalEx, EvalEx, TclAdvanceContinuations,
TclEvalObjEx):
* generic/tclCmdMZ.c (Tcl_SwitchObjCmd, TclListLines):
* 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/tclParse.c (TclSubstTokens, Tcl_SubstObj):
* generic/tclProc.c (TclCreateProc):
* generic/tclVar.c (TclPtrSetVar):
* tests/info.test (info-30.0-24):
Extended parser, compiler, and execution with code and attendant
data structures tracking the positions of continuation lines which
are not visible in script Tcl_Obj*'s, to properly account for them
while counting lines for #280.
Diffstat (limited to 'tests/info.test')
-rw-r--r-- | tests/info.test | 293 |
1 files changed, 283 insertions, 10 deletions
diff --git a/tests/info.test b/tests/info.test index 5e1e43d..90cbb24 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.47.2.8 2009/07/14 16:33:12 andreas_kupries Exp $ +# RCS: @(#) $Id: info.test,v 1.47.2.9 2009/08/25 21:01:05 andreas_kupries Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -1012,20 +1012,20 @@ test info-25.1 {info frame, regular proc} { rename bar {} # ------------------------------------------------------------------------- - -test info-30.0 {bs+nl in literal words} knownBug { +# More info-30.x test cases at the end of the file. +test info-30.0 {bs+nl in literal words} { if {1} { set res \ - [reduce [info frame 0]] + [reduce [info frame 0]];# 1019 } 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 1019 file info.test cmd {info frame 0} proc ::tcltest::RunTest} # ------------------------------------------------------------------------- # See 24.0 - 24.5 for similar situations, using literal scripts. @@ -1429,6 +1429,279 @@ type source line 1420 file info.test cmd {info frame 0} proc ::foo::bar level 0 type source line 1421 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} { + proc abra {} { + if {1} \ + { + return \ + [reduce [info frame 0]];# line 1439 + } + } + set res [abra] + rename abra {} + set res +} {type source line 1439 file info.test cmd {info frame 0} proc ::abra level 0} + +test info-30.2 {bs+nl in literal words, namespace script} { + namespace eval xxx { + set res \ + [reduce [info frame 0]];# line 1450 + } + set res +} {type source line 1450 file info.test cmd {info frame 0} level 0} + +test info-30.3 {bs+nl in literal words, namespace multi-word script} { + namespace eval xxx set res \ + [list [reduce [info frame 0]]];# line 1457 + set res +} {type source line 1457 file info.test cmd {info frame 0} proc ::tcltest::RunTest} + +test info-30.4 {bs+nl in literal words, eval script} { + eval { + set ::res \ + [reduce [info frame 0]];# line 1464 + } + set res +} {type source line 1464 file info.test cmd {info frame 0} proc ::tcltest::RunTest} + +test info-30.5 {bs+nl in literal words, eval script, with nested words} { + eval { + if {1} \ + { + set ::res \ + [reduce [info frame 0]];# line 1474 + } + } + set res +} {type source line 1474 file info.test cmd {info frame 0} proc ::tcltest::RunTest} + +test info-30.6 {bs+nl in computed word} { + set res "\ +[reduce [info frame 0]]";# line 1482 +} { type source line 1482 file info.test cmd {info frame 0} proc ::tcltest::RunTest} + +test info-30.7 {bs+nl in computed word, in proc} { + proc abra {} { + return "\ +[reduce [info frame 0]]";# line 1488 + } + set res [abra] + rename abra {} + set res +} { type source line 1488 file info.test cmd {info frame 0} proc ::abra level 0} + +test info-30.8 {bs+nl in computed word, nested eval} { + eval { + set \ + res "\ +[reduce [info frame 0]]";# line 1499 +} +} { type source line 1499 file info.test cmd {info frame 0} proc ::tcltest::RunTest} + +test info-30.9 {bs+nl in computed word, nested eval} { + eval { + set \ + res "\ +[reduce \ + [info frame 0]]";# line 1508 +} +} { type source line 1508 file info.test cmd {info frame 0} proc ::tcltest::RunTest} + +test info-30.10 {bs+nl in computed word, key to array} { + set tmp([set \ + res "\ +[reduce \ + [info frame 0]]"]) x ; #1516 + unset tmp + set res +} { type source line 1516 file info.test cmd {info frame 0} proc ::tcltest::RunTest} + +test info-30.11 {bs+nl in subst arguments, no true counting} { + subst {[set \ + res "\ +[reduce \ + [info frame 0]]"]} +} { type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest} + +test info-30.12 {bs+nl in computed word, nested eval} { + eval { + set \ + res "\ +[set x {}] \ +[reduce \ + [info frame 0]]";# line 1534 +} +} { type source line 1534 file info.test cmd {info frame 0} proc ::tcltest::RunTest} + +test info-30.13 {bs+nl in literal words, uplevel script, with nested words} { + uplevel #0 { + if {1} \ + { + set ::res \ + [reduce [info frame 0]];# line 1543 + } + } + set res +} {type source line 1543 file info.test cmd {info frame 0} proc ::tcltest::RunTest} + +test info-30.14 {bs+nl, literal word, uplevel through proc} { + proc abra {script} { + uplevel 1 $script + } + set res [abra { + return "\ +[reduce [info frame 0]]";# line 1555 + }] + rename abra {} + set res +} { type source line 1555 file info.test cmd {info frame 0} proc ::abra} + +test info-30.15 {bs+nl in literal words, nested proc body, compiled} { + proc a {} { + proc b {} { + if {1} \ + { + return \ + [reduce [info frame 0]];# line 1567 + } + } + } + a ; set res [b] + rename a {} + rename b {} + set res +} {type source line 1567 file info.test cmd {info frame 0} proc ::b level 0} + +test info-30.16 {bs+nl in multi-body switch, compiled} { + proc a {value} { + switch -regexp -- $value \ + ^key { info frame 0; # 1580 } \ + \t### { info frame 0; # 1581 } \ + {[0-9]*} { info frame 0; # 1582 } + } + set res {} + lappend res [reduce [a {key }]] + lappend res [reduce [a {1alpha}]] + set res "\n[join $res \n]" +} { +type source line 1580 file info.test cmd {info frame 0} proc ::a level 0 +type source line 1582 file info.test cmd {info frame 0} proc ::a level 0} + +test info-30.17 {bs+nl in multi-body switch, direct} { + switch -regexp -- {key } \ + ^key { reduce [info frame 0] ;# 1594 } \ + \t### { } \ + {[0-9]*} { } +} {type source line 1594 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} { + proc abra {script} { + append script "\n# end of script" + uplevel 1 $script + } + set res [abra { + return "\ +[reduce [info frame 0]]";# line 1606, still line of 3 appended script + }] + rename abra {} + set res +} { type eval line 3 cmd {info frame 0} proc ::abra} +# { type source line 1606 file info.test cmd {info frame 0} proc ::abra} + +test info-30.19 {bs+nl in single-body switch, compiled} { + 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 1617 file info.test cmd {info frame 0} proc ::a level 0 +type source line 1621 file info.test cmd {info frame 0} proc ::a level 0} + +test info-30.20 {bs+nl in single-body switch, direct} { + switch -regexp -- {key } { \ + + ^key { reduce \ + [info frame 0] } + \t### { } + {[0-9]*} { } + } +} {type source line 1636 file info.test cmd {info frame 0} proc ::tcltest::RunTest} + +test info-30.21 {bs+nl in if, full compiled} { + 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 1645 file info.test cmd {info frame 0} proc ::a level 0 +type source line 1646 file info.test cmd {info frame 0} proc ::a level 0} + +test info-30.22 {bs+nl in computed word, key to array, compiled} { + proc a {} { + set tmp([set \ + res "\ +[reduce \ + [info frame 0]]"]) x ; #1661 + unset tmp + set res + } + set res [a] + rename a {} + set res +} { type source line 1661 file info.test cmd {info frame 0} proc ::a level 0} + +test info-30.23 {bs+nl in multi-body switch, full compiled} { + proc a {value} { + switch -exact -- $value \ + key { info frame 0; # 1673 } \ + xxx { info frame 0; # 1674 } \ + 000 { info frame 0; # 1675 } + } + set res {} + lappend res [reduce [a key]] + lappend res [reduce [a 000]] + set res "\n[join $res \n]" +} { +type source line 1673 file info.test cmd {info frame 0} proc ::a level 0 +type source line 1675 file info.test cmd {info frame 0} proc ::a level 0} + +test info-30.24 {bs+nl in single-body switch, full compiled} { + proc a {value} { + switch -exact -- $value { + key { reduce \ + [info frame 0] } + xxx { reduce \ + [info frame 0] } + 000 { reduce \ + [info frame 0] } + } + } + set res {} + lappend res [a key] + lappend res [a 000] + set res "\n[join $res \n]" +} { +type source line 1689 file info.test cmd {info frame 0} proc ::a level 0 +type source line 1693 file info.test cmd {info frame 0} proc ::a level 0} + +# ------------------------------------------------------------------------- # cleanup catch {namespace delete test_ns_info1 test_ns_info2} |