Merge trunk

1 files changed, 111 insertions, 58 deletions

diff --git a/tests/lseq.test b/tests/lseq.test
index 2b6f286..a4055b1 100644
--- a/tests/lseq.test
+++ b/tests/lseq.test
@@ -32,11 +32,13 @@ test lseq-1.2 {step magnitude} {
     lseq 10 .. 1 by -2 ;# or this could be an error - or not
 } {10 8 6 4 2}
 
-test lseq-1.3 {synergy between int and double} {
+test lseq-1.3 {synergy between int and double} -body {
     set rl [lseq 25. to 5. by -5]
     set il [lseq 25  to 5  by -5]
     lmap r $rl i $il { if {$r ne "" && $i ne ""} {expr {int($r) == $i}} else {list $r $i} }
-} {1 1 1 1 1}
+} -cleanup {
+    unset rl il
+} -result {1 1 1 1 1}
 
 test lseq-1.4 {integer decreasing} {
     lseq 10 .. 1
@@ -208,7 +210,7 @@ test lseq-2.18 {signs} {
 
 } {{-10 -8 -6 -4 -2} {} {} {10 6 2} {-10 -7 -4 -1} {10 5}}
 
-test lseq-3.1 {experiement} {
+test lseq-3.1 {experiement} -body {
     set ans {}
     foreach factor [lseq 2.0 10.0] {
 	set start 1
@@ -225,10 +227,10 @@ test lseq-3.1 {experiement} {
     if {$ans eq {}} {
 	set ans OK
     }
-    unset factor
-    unset l
     set ans
-} {OK}
+} -cleanup {
+    unset ans step end start factor l
+} -result {OK}
 
 test lseq-3.2 {error case} -body {
     lseq foo
@@ -242,39 +244,43 @@ test lseq-3.4 {error case} -body {
     lseq 25 or 6
 } -returnCodes 1 -result {bad operation "or": must be .., to, count, or by}
 
-test lseq-3.5 {simple count and step arguments} {
+test lseq-3.5 {simple count and step arguments} -body {
     set s [lseq 25 by 6]
     list $s length=[llength $s]
-} {{0 6 12 18 24 30 36 42 48 54 60 66 72 78 84 90 96 102 108 114 120 126 132 138 144} length=25}
+} -cleanup {
+    unset s
+} -result {{0 6 12 18 24 30 36 42 48 54 60 66 72 78 84 90 96 102 108 114 120 126 132 138 144} length=25}
 
 test lseq-3.6 {error case} -body {
     lseq 1 7 or 3
 } -returnCodes 1  -result {bad operation "or": must be .., to, count, or by}
 
-test lseq-3.7 {lmap lseq} {
+test lseq-3.7 {lmap lseq} -body {
     lmap x [lseq 5] { expr {$x * $x} }
-} {0 1 4 9 16}
+} -cleanup {unset x} -result {0 1 4 9 16}
 
-test lseq-3.8 {lrange lseq} {
+test lseq-3.8 {lrange lseq} -body {
     set r [lrange [lseq 1 100] 10 20]
     set empty [lrange [lseq 1 100] 20 10]
     list $r $empty [lindex [tcl::unsupported::representation $r] 3]
-} {{11 12 13 14 15 16 17 18 19 20 21} {} arithseries}
+} -cleanup {
+    unset r empty
+} -result {{11 12 13 14 15 16 17 18 19 20 21} {} arithseries}
 
-test lseq-3.9 {lassign lseq} arithSeriesShimmer {
+test lseq-3.9 {lassign lseq} -constraints arithSeriesShimmer -body {
     set r [lseq 15]
     set r2 [lassign $r a b]
     list [lindex [tcl::unsupported::representation $r] 3] $a $b \
 	[lindex [tcl::unsupported::representation $r2] 3]
-} {arithseries 0 1 arithseries}
+} -cleanup {unset r r2 a b} -result {arithseries 0 1 arithseries}
 
-test lseq-3.10 {lsearch lseq must shimmer?} arithSeriesShimmer {
+test lseq-3.10 {lsearch lseq must shimmer?} -constraints arithSeriesShimmer -body {
     set r [lseq 15 0]
     set a [lsearch $r 9]
     list [lindex [tcl::unsupported::representation $r] 3] $a
-} {arithseries 6}
+} -cleanup {unset r a} -result {arithseries 6}
 
-test lseq-3.11 {lreverse lseq} {
+test lseq-3.11 {lreverse lseq} -body {
     set r [lseq 15 0]
     set a [lreverse $r]
     join [list \
@@ -282,30 +288,34 @@ test lseq-3.11 {lreverse lseq} {
 	      $r \
 	      [lindex [tcl::unsupported::representation $a] 3] \
 	      $a] \n
-} {arithseries
+} -cleanup {unset r a} -result {arithseries
 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0
 arithseries
 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15}
 
-test lseq-3.12 {in operator} {
+test lseq-3.12 {in operator} -body {
     set r [lseq 9]
     set i [expr {7 in $r}]
     set j [expr {10 ni $r}]
     set k [expr {-1 in $r}]
     set l [expr {4 ni $r}]
     list $i $j $k $l [lindex [tcl::unsupported::representation $r] 3]
-} {1 1 0 0 arithseries}
+} -cleanup {
+    unset r i j k l
+} -result {1 1 0 0 arithseries}
 
-test lseq-3.13 {lmap lseq shimmer} arithSeriesShimmer {
+test lseq-3.13 {lmap lseq shimmer} -constraints arithSeriesShimmer -body {
     set r [lseq 15]
     set rep-before [lindex [tcl::unsupported::representation $r] 3]
     set m [lmap i $r { expr {$i * 7} }]
     set rep-after [lindex [tcl::unsupported::representation $r] 3]
     set rep-m [lindex [tcl::unsupported::representation $m] 3]
     list $r ${rep-before} ${rep-after} ${rep-m} $m
-} {{0 1 2 3 4 5 6 7 8 9 10 11 12 13 14} arithseries arithseries list {0 7 14 21 28 35 42 49 56 63 70 77 84 91 98}}
+} -cleanup {
+    unset r rep-before m rep-after rep-m
+} -result {{0 1 2 3 4 5 6 7 8 9 10 11 12 13 14} arithseries arithseries list {0 7 14 21 28 35 42 49 56 63 70 77 84 91 98}}
 
-test lseq-3.14 {array for shimmer} arithSeriesShimmerOk {
+test lseq-3.14 {array for shimmer} -constraints arithSeriesShimmerOk -body {
     array set testarray {a Test for This great Function}
     set vars [lseq 2]
     set vars-rep [lindex [tcl::unsupported::representation $vars] 3]
@@ -318,15 +328,19 @@ test lseq-3.14 {array for shimmer} arithSeriesShimmerOk {
     set valv [lmap v $vals {expr {$v in {Test This Function}}}]
     set vars-after [lindex [tcl::unsupported::representation $vars] 3]
     list ${vars-rep} $valk $valv ${vars-after}
-} {arithseries {1 1 1} {1 1 1} arithseries}
+} -cleanup {
+    unset testarray vars vars-rep 0 valk k  valv v vars-after
+} -result {arithseries {1 1 1} {1 1 1} arithseries}
 
-test lseq-3.15 {join for shimmer} arithSeriesShimmer {
+test lseq-3.15 {join for shimmer} -constraints arithSeriesShimmer -body {
     set r [lseq 3]
     set rep-before [lindex [tcl::unsupported::representation $r] 3]
     set str [join $r :]
     set rep-after [lindex [tcl::unsupported::representation $r] 3]
     list ${rep-before} $str ${rep-after}
-} {arithseries 0:1:2 arithseries}
+} -cleanup {
+    unset r rep-before str rep-after
+} -result {arithseries 0:1:2 arithseries}
 
 test lseq-3.16 {error case} -body {
     lseq 16 to
@@ -373,13 +387,15 @@ test lseq-3.25 {edge case} {
     llength [lseq 1 to 1 by 1]
 } {1}
 
-test lseq-3.26 {lsort shimmer} arithSeriesShimmer {
+test lseq-3.26 {lsort shimmer} -constraints arithSeriesShimmer -body {
     set r [lseq 15 0]
     set rep-before [lindex [tcl::unsupported::representation $r] 3]
     set lexical_sort [lsort $r]
     set rep-after [lindex [tcl::unsupported::representation $r] 3]
     list ${rep-before} $lexical_sort ${rep-after}
-} {arithseries {0 1 10 11 12 13 14 15 2 3 4 5 6 7 8 9} arithseries}
+} -cleanup {
+    unset r rep-before lexical_sort rep-after
+} -result {arithseries {0 1 10 11 12 13 14 15 2 3 4 5 6 7 8 9} arithseries}
 
 test lseq-3.27 {lreplace shimmer} -constraints arithSeriesShimmer -body {
     set r [lseq 15 0]
@@ -394,17 +410,19 @@ test lseq-3.27 {lreplace shimmer} -constraints arithSeriesShimmer -body {
     unset rep-after
 } -result {arithseries {15 14 13 A B C 9 8 7 6 5 4 3 2 1 0} arithseries}
 
-test lseq-3.28 {lreverse bug in ArithSeries} {} {
+test lseq-3.28 {lreverse bug in ArithSeries} -body {
     set r [lseq -5 17 3]
     set rr [lreverse $r]
     list $r $rr [string equal $r [lreverse $rr]]
-} {{-5 -2 1 4 7 10 13 16} {16 13 10 7 4 1 -2 -5} 1}
+} -cleanup {
+    unset r rr
+} -result {{-5 -2 1 4 7 10 13 16} {16 13 10 7 4 1 -2 -5} 1}
 
 test lseq-3.29 {edge case: negative count} {
     lseq -15
 } {}
 
-test lseq-3.30 {lreverse with double values} arithSeriesDouble {
+test lseq-3.30 {lreverse with double values} -constraints arithSeriesDouble -body {
     set r [lseq 3.5 18.5 1.5]
     set a [lreverse $r]
     join [list \
@@ -412,7 +430,9 @@ test lseq-3.30 {lreverse with double values} arithSeriesDouble {
 	      $r \
 	      [lindex [tcl::unsupported::representation $a] 3] \
 	      $a] \n
-} {arithseries
+} -cleanup {
+    unset r a
+} -result {arithseries
 3.5 5.0 6.5 8.0 9.5 11.0 12.5 14.0 15.5 17.0 18.5
 arithseries
 18.5 17.0 15.5 14.0 12.5 11.0 9.5 8.0 6.5 5.0 3.5}
@@ -436,16 +456,32 @@ test lseq-3.32 {lsearch nested lists of lseq} arithSeriesShimmer {
 } {list {{20 23 26 29 32 35 38}} arithseries arithseries}
 
 
-test lseq-4.1 {end expressions} {
+# lsearch -
+#  -- should not shimmer lseq  list
+#  -- should not leak lseq elements
+test lseq-3.32 {lsearch nested lists of lseq} -constraints arithSeriesShimmer -body {
+    set srchlist {}
+    for {set i 5} {$i < 25} {incr i} {
+	lappend srchlist [lseq $i count 7 by 3]
+    }
+    set a [lsearch -all -inline -index 1 $srchlist 23]
+    set b [lmap i $a {lindex [tcl::unsupported::representation $i] 3}]
+    list [lindex [tcl::unsupported::representation $a] 3] $a $b \
+        [lindex [tcl::unsupported::representation [lindex $srchlist 15]] 3]
+} -cleanup {
+    unset srchlist i a b
+} -result {list {{20 23 26 29 32 35 38}} arithseries arithseries}
+
+test lseq-4.1 {end expressions} -body {
     set start 7
     lseq $start $start+11
-} {7 8 9 10 11 12 13 14 15 16 17 18}
+} -cleanup {unset start} -result {7 8 9 10 11 12 13 14 15 16 17 18}
 
-test lseq-4.2 {start expressions} {
+test lseq-4.2 {start expressions} -body {
     set base [clock seconds]
     set tl [lseq $base-60 $base 10]
     lmap t $tl {expr {$t - $base + 60}}
-} {0 10 20 30 40 50 60}
+} -cleanup {unset base tl t} -result {0 10 20 30 40 50 60}
 
 ##	lseq 1 to 10 by -2
 ##	# -> lseq: invalid step = -2 with a = 1 and b = 10
@@ -496,7 +532,7 @@ test lseq-4.3 {TIP examples} -body {
     }
     set res
 } -cleanup {
-    unset res
+    unset res cmd status ans expect expected examples
 } -result {{10 9 8 7 6 5 4 3 2 1} {1 2 3 4 5 6 7 8 9 10} {} {10 8 6 4 2} {5.0 6.0 7.0 8.0 9.0 10.0 11.0 12.0 13.0 14.0 15.0} {5.0 10.0 15.0 20.0 25.0} {} {25.0 20.0 15.0 10.0 5.0} {1 3 5 7 9} {25.0 20.0 15.0 10.0 5.0 0.0 -5.0 -10.0 -15.0 -20.0 -25.0} 5 5 5}
 
 #
@@ -517,7 +553,7 @@ test lseq-4.4 {lseq corner case} -constraints has64BitLengths -body {
     }
     eval $tcmd
 } -cleanup {
-    unset res
+    unset res s e tcmd
 } -result {0 10 0 10 0 9223372036854774991 0 10 0 2147483638}
 
 # Ticket 99e834bf33 - lseq, lindex end off by one
@@ -540,8 +576,7 @@ test lseq-4.6 {lindex flat} -body {
     set f [$cmd [lseq 2 10] $i]
     list $c $d $e $f
 } -cleanup {
-    unset l
-    unset e
+    unset l cmd i c d e f
 } -result [lrepeat 4 6]
 
 test lseq-4.7 {empty list} {
@@ -550,21 +585,23 @@ test lseq-4.7 {empty list} {
 
 test lseq-4.8 {error case lrange} -body {
     lrange [lseq 1 5] fred ginger
-} -returnCodes 1 \
-    -result {bad index "fred": must be integer?[+-]integer? or end?[+-]integer?}
+} -cleanup {
+    unset -nocomplain fred ginger
+} -returnCodes 1 -result {bad index "fred": must be integer?[+-]integer? or end?[+-]integer?}
 
 test lseq-4.9 {lrange empty/partial sets} -body {
+    set res {}
     foreach {fred ginger} {7 8 4 9 0 15 9 9 4 2} {
         lappend res [lrange [lseq 1 5] $fred $ginger]
     }
     set res
-} -result {{} 5 {1 2 3 4 5} {} {}}
+} -cleanup {unset res fred ginger} -result {{} 5 {1 2 3 4 5} {} {}}
 
 # Panic when using variable value?
-test lseq-4.10 {panic using variable index} {
+test lseq-4.10 {panic using variable index} -body {
     set i 0
     lindex [lseq 10] $i
-} {0}
+} -cleanup {unset i} -result {0}
 
 test lseq-4.11 {bug lseq / lindex discrepancies} -constraints has64BitLengths -body {
     lindex [lseq 0x7fffffff] 0x80000000
@@ -580,7 +617,7 @@ test lseq-4.13 {bug lseq} -constraints has64BitLengths -body {
     [llength $l] \
     [lindex $l end] \
         [lindex $l 9223372036854775800]
-} -result {9223372036854775807 9223372036854775806 9223372036854775800}
+} -cleanup {unset l} -result {9223372036854775807 9223372036854775806 9223372036854775800}
 
 
 test lseq-4.14 {bug lseq - inconsistent rounding} has64BitLengths {
@@ -603,32 +640,48 @@ test lseq-4.16 {bug lseq - inconsistent rounding} {
 # Test abstract list in a concat
 #  -- lseq list should not shimmer
 #  -- lseq elements should not leak
-test lseq-4.17 {concat?} {
+test lseq-4.17 {concat shimmer} -body {
     set rng [lseq 8 15 2]
     set pre [list A b C]
     set pst [list x Y z]
-    concat $pre $rng $pst
-} {A b C 8 10 12 14 x Y z}
+    list [concat $pre $rng $pst] \
+         [lindex [tcl::unsupported::representation $pre] 3] \
+         [lindex [tcl::unsupported::representation $rng] 3] \
+         [lindex [tcl::unsupported::representation $pst] 3]
+} -cleanup {unset rng pre pst} -result  {{A b C 8 10 12 14 x Y z} list arithseries list}
 
-test lseq-4.18 {concat?} {
+test lseq-4.18 {concat shimmer} -body {
     set rng [lseq 8 15 2]
     set pre [list A b C]
     set pst [list x Y z]
-    concat $rng $pre $pst
-} {8 10 12 14 A b C x Y z}
+    list [concat $rng $pre $pst] \
+         [lindex [tcl::unsupported::representation $rng] 3] \
+         [lindex [tcl::unsupported::representation $pre] 3] \
+         [lindex [tcl::unsupported::representation $pst] 3]
+} -cleanup {unset rng pre pst} -result {{8 10 12 14 A b C x Y z} arithseries list list}
 
 # Test lseq elements as var names
-test lseq-4.19 {varnames} {
-set plist {}
-    foreach v [info proc auto_*] {
+test lseq-4.19 {varnames} -body {
+    set plist {}
+    foreach v {auto_execok auto_load auto_qualify} {
 	lappend plist proc $v [info args $v] [info body $v]
     }
     set res {}
-    foreach [lseq 1 to 4] $plist {
+    set varlist [lseq 1 to 4]
+    foreach $varlist $plist {
 	lappend res $2 [llength $3]
     }
-    set res
-} {auto_import 1 auto_execok 1 auto_load_index 0 auto_qualify 2 auto_load 2}
+    lappend res [lindex [tcl::unsupported::representation $varlist] 3]
+} -cleanup {
+    unset {*}$varlist res varlist v plist
+} -result {auto_execok 1 auto_load 2 auto_qualify 2 arithseries}
+
+test lseq-convertToList {does not result in a memory error} -body {
+	trace add variable var1 write [list ::apply [list args {
+		error {this is an error}
+	} [namespace current]]]
+	list [catch {set var1 [lindex [lreplace [lseq 1 2] 1 1 hello] 0]} cres] $cres
+} -cleanup {unset var1 cres} -result {1 {can't set "var1": this is an error}}
 
 # cleanup
 ::tcltest::cleanupTests