diff options
| -rw-r--r-- | generic/tclExecute.c | 5 | ||||
| -rw-r--r-- | tests/abstractlist.test | 30 |
2 files changed, 32 insertions, 3 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 336815d..2be02c6 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -6451,7 +6451,9 @@ TEBCresume( varListPtr = infoPtr->varLists[i]; numVars = varListPtr->numVars; listPtr = OBJ_AT_DEPTH(listTmpDepth); + DECACHE_STACK_INFO(); if (TclListObjLengthM(interp, listPtr, &listLen) != TCL_OK) { + CACHE_STACK_INFO(); TRACE_APPEND(("ERROR converting list %" TCL_Z_MODIFIER "d, \"%s\": %s", i, O2S(listPtr), O2S(Tcl_GetObjResult(interp)))); goto gotError; @@ -6537,11 +6539,14 @@ TEBCresume( numVars = varListPtr->numVars; listPtr = OBJ_AT_DEPTH(listTmpDepth); + DECACHE_STACK_INFO(); status = TclListObjGetElementsM( interp, listPtr, &listLen, &elements); if (status != TCL_OK) { + CACHE_STACK_INFO(); goto gotError; } + CACHE_STACK_INFO(); valIndex = (iterNum * numVars); diff --git a/tests/abstractlist.test b/tests/abstractlist.test index cca24c5..f78c3e6 100644 --- a/tests/abstractlist.test +++ b/tests/abstractlist.test @@ -519,10 +519,13 @@ testConstraint [format "%sShimmer" [string totitle $not]] 1 # This example abstract list (lgen) causes a rescursive call in TEBC, # stack management was not included for these instructions in TEBC. # -test abstractlist-lgen-bug {} -setup { +test abstractlist-lgen-bug {bug in str concat and list operations} -setup { set lgenfile [makeFile { # Test TIP 192 - Lazy Lists + + set res {} set cntr 0 + # Fatal error here when [source]'d -- It is a refcounting problem... lappend res Index*2:[lgen 1 expr 2* ]:-- set x [lseq 17] @@ -563,7 +566,7 @@ test abstractlist-lgen-bug {} -setup { unset x lappend res Good-Bye! set res - } lgen.tcl] + } source.file] } -body { set tcl_traceExec 0 set tcl_traceCompile 0 @@ -572,7 +575,28 @@ test abstractlist-lgen-bug {} -setup { set script [format "source %s" $f] #puts stderr "eval $script" eval $script -} -result {lstring {V i z z i n i : { } H E { } a l m o s t { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring ' none {V i z z i n i : { } H E { } a l m o s t { } D I D N T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring Index*2:0:-- {0 -> 0} {1 -> 6} {2 -> 12} {3 -> 18} {4 -> 24} {5 -> 30} {6 -> 36} {7 -> 42} {8 -> 48} {9 -> 54} {10 -> 60} {11 -> 66} {12 -> 72} {13 -> 78} {14 -> 84} {15 -> 90} {16 -> 96} my_expr(3):3 {7 8 9 10 11 12 13 14 15 16 17 18 19 20 21} {s2:Index+7: {7 8 9 10 11 12 13 14 15 16 17 18 19 20 21} :--} {foo:Index-8: {-8 -7 -6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6} :--} 9len=15 9(3)=10 {bar:Index+7: {7 8 9 10 11 12 13 14 15 16 17 18 19 20 21} :--} {Index+7:7 8 9 10 11 12 13 14 15 16 17 18 19 20 21:--} {Index+7:7 8 9 10 11 12 13 14 15 16 17 18 19 20 21:--} {fib:0 1 1 2 3} {First 20 fibbinacci:0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181} {First 20 fibbinacci from x :0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181} Good-Bye!} +} -cleanup { + removeFile source.file + unset res +} -result {Index*2:0:-- {0 -> 0} {1 -> 6} {2 -> 12} {3 -> 18} {4 -> 24} {5 -> 30} {6 -> 36} {7 -> 42} {8 -> 48} {9 -> 54} {10 -> 60} {11 -> 66} {12 -> 72} {13 -> 78} {14 -> 84} {15 -> 90} {16 -> 96} my_expr(3):3 {7 8 9 10 11 12 13 14 15 16 17 18 19 20 21} {s2:Index+7: {7 8 9 10 11 12 13 14 15 16 17 18 19 20 21} :--} {foo:Index-8: {-8 -7 -6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6} :--} 9len=15 9(3)=10 {bar:Index+7: {7 8 9 10 11 12 13 14 15 16 17 18 19 20 21} :--} {Index+7:7 8 9 10 11 12 13 14 15 16 17 18 19 20 21:--} {Index+7:7 8 9 10 11 12 13 14 15 16 17 18 19 20 21:--} {fib:0 1 1 2 3} {First 20 fibbinacci:0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181} {First 20 fibbinacci from x :0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181} Good-Bye!} + +test abstractlist-lgen-bug2 {bug in foreach} -body { + + set x [lseq 17] + set y [lgen 17 expr 6*] + + lappend res x-[lrange [tcl::unsupported::representation $x] 0 3] + lappend res y-[lrange [tcl::unsupported::representation $y] 0 3] + foreach i $x n $y { + lappend res "$i -> $n" + } + lappend res x-[lrange [tcl::unsupported::representation $x] 0 3] + lappend res y-[lrange [tcl::unsupported::representation $y] 0 3] + +} -cleanup { + unset res +} -result {{x-value is a arithseries} {y-value is a lgenseries} {0 -> 0} {1 -> 6} {2 -> 12} {3 -> 18} {4 -> 24} {5 -> 30} {6 -> 36} {7 -> 42} {8 -> 48} {9 -> 54} {10 -> 60} {11 -> 66} {12 -> 72} {13 -> 78} {14 -> 84} {15 -> 90} {16 -> 96} {x-value is a arithseries} {y-value is a lgenseries}} + # lsort |