diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/abstractlist.test | 617 | ||||
| -rw-r--r-- | tests/dict.test | 36 | ||||
| -rw-r--r-- | tests/lseq.test | 19 |
3 files changed, 658 insertions, 14 deletions
diff --git a/tests/abstractlist.test b/tests/abstractlist.test new file mode 100644 index 0000000..f78c3e6 --- /dev/null +++ b/tests/abstractlist.test @@ -0,0 +1,617 @@ +# Exercise AbstractList via the "lstring" command defined in tclTestABSList.c +# +# Copyright © 2022 Brian Griffin +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +if {"::tcltest" ni [namespace children]} { + package require tcltest 2.5 + namespace import -force ::tcltest::* +} + +catch { + ::tcltest::loadTestedCommands + package require -exact tcl::test [info patchlevel] +} + +testConstraint testevalex [llength [info commands testevalex]] + +set abstractlisttestvars [info var *] + +proc value-cmp {vara varb} { + upvar $vara a + upvar $varb b + set ta [tcl::unsupported::representation $a] + set tb [tcl::unsupported::representation $b] + return [string compare $ta $tb] +} + +set str "My name is Inigo Montoya. You killed my father. Prepare to die!" +set str2 "Vizzini: HE DIDN'T FALL? INCONCEIVABLE. Inigo Montoya: You keep using that word. I do not think it means what you think it means." + +test abstractlist-1.0 {error cases} -body { + lstring +} \ + -returnCodes 1 \ + -result {wrong # args: should be "lstring string"} + +test abstractlist-1.1 {error cases} -body { + lstring a b c +} -returnCodes 1 \ + -result {wrong # args: should be "lstring string"} + +test abstractlist-2.0 {no shimmer llength} { + set l [lstring $str] + set l-isa [testobj objtype $l] + set len [llength $l] + set l-isa2 [testobj objtype $l] + list $l ${l-isa} ${len} ${l-isa2} +} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} lstring 63 lstring} + +test abstractlist-2.1 {no shimmer lindex} { + set l [lstring $str] + set l-isa [testobj objtype $l] + set ele [lindex $l 22] + set l-isa2 [testobj objtype $l] + list $l ${l-isa} ${ele} ${l-isa2} +} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} lstring y lstring} + +test abstractlist-2.2 {no shimmer lreverse} { + set l [lstring $str] + set l-isa [testobj objtype $l] + set r [lreverse $l] + set r-isa [testobj objtype $r] + set l-isa2 [testobj objtype $l] + list $r ${l-isa} ${r-isa} ${l-isa2} +} {{! e i d { } o t { } e r a p e r P { } . r e h t a f { } y m { } d e l l i k { } u o Y { } . a y o t n o M { } o g i n I { } s i { } e m a n { } y M} lstring lstring lstring} + +test abstractlist-2.3 {no shimmer lrange} { + set l [lstring $str] + set l-isa [testobj objtype $l] + set il [lsearch -all [lstring $str] { }] + set l-isa2 [testobj objtype $l] + lappend il [llength $l] + set start 0 + set words [lmap i $il { + set w [join [lrange $l $start $i-1] {} ] + set start [expr {$i+1}] + set w + }] + set l-isa3 [testobj objtype $l] + list ${l-isa} $il ${l-isa2} ${l-isa3} $words +} {lstring {2 7 10 16 25 29 36 39 47 55 58 63} lstring lstring {My name is Inigo Montoya. You killed my father. Prepare to die!}} + +test abstractlist-2.4 {no shimmer foreach} { + set l [lstring $str] + set l-isa [testobj objtype $l] + set word {} + set words {} + foreach c $l { + if {$c eq { }} { + lappend words $word + set word {} + } else { + append word $c + } + } + if {$word ne ""} { + lappend words $word + } + set l-isa2 [testobj objtype $l] + list ${l-isa} ${l-isa2} $words +} {lstring lstring {My name is Inigo Montoya. You killed my father. Prepare to die!}} + +# +# The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m list, not an lstring. +# +test abstractlist-2.5 {!no shimmer lreplace} { + set l [lstring $str2] + set l-isa [testobj objtype $l] + set m [lreplace $l 18 23 { } f a i l ?] + set m-isa [testobj objtype $m] + set l-isa1 [testobj objtype $l] + list ${l-isa} $m ${m-isa} ${l-isa1} +} {lstring {V i z z i n i : { } H E { } D I D N ' T { } f a i 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 lstring} + +test abstractlist-2.6 {no shimmer ledit} { + # "ledit m 9 8 S" + set l [lstring $str2] + set l-isa [testobj objtype $l] + set e [ledit l 9 8 S] + set e-isa [testobj objtype $e] + list ${l-isa} $e ${e-isa} +} {lstring {V i z z i n i : { } S H E { } 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} + +test abstractlist-2.7 {no shimmer linsert} { + # "ledit m 9 8 S" + set l [lstring $str2] + set l-isa [testobj objtype $l] + set i [linsert $l 12 {*}[split "almost " {}]] + set i-isa [testobj objtype $i] + set res [list ${l-isa} $i ${i-isa}] + set p [lpop i 23] + set p-isa [testobj objtype $p] + set i-isa2 [testobj objtype $i] + lappend res $p ${p-isa} $i ${i-isa2} +} {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} + +test abstractlist-2.8 {shimmer lassign} { + set l [lstring Inconceivable] + set l-isa [testobj objtype $l] + set l2 [lassign $l i n c] + set l-isa2 [testobj objtype $l] + set l2-isa [testobj objtype $l2] + list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} +} {{I n c o n c e i v a b l e} lstring {o n c e i v a b l e} lstring lstring} + +test abstractlist-2.9 {no shimmer lremove} { + set l [lstring Inconceivable] + set l-isa [testobj objtype $l] + set l2 [lremove $l 0 1] + set l-isa2 [testobj objtype $l] + set l2-isa [testobj objtype $l2] + list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} +} {{I n c o n c e i v a b l e} lstring {c o n c e i v a b l e} lstring lstring} + +test abstractlist-2.10 {shimmer lreverse} { + set l [lstring Inconceivable] + set l-isa [testobj objtype $l] + set l2 [lreverse $l] + set l-isa2 [testobj objtype $l] + set l2-isa [testobj objtype $l2] + list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} +} {{I n c o n c e i v a b l e} lstring {e l b a v i e c n o c n I} lstring lstring} + +test abstractlist-2.11 {shimmer lset} { + set l [lstring Inconceivable] + set l-isa [testobj objtype $l] + set m [lset l 2 k] + set m-isa [testobj objtype $m] + list $l ${l-isa} $m ${m-isa} [value-cmp l m] +} {{I n k o n c e i v a b l e} lstring {I n k o n c e i v a b l e} lstring 0} + +# lrepeat +test abstractlist-2.12 {shimmer lrepeat} { + set l [lstring Inconceivable] + set l-isa [testobj objtype $l] + set m [lrepeat 3 $l] + set m-isa [testobj objtype $m] + set n [lindex $m 1] + list $l ${l-isa} $m ${m-isa} [testobj objtype $n] [value-cmp l n] +} {{I n c o n c e i v a b l e} lstring {{I n c o n c e i v a b l e} {I n c o n c e i v a b l e} {I n c o n c e i v a b l e}} list lstring 0} + +test abstractlist-2.13 {no shimmer join llength==1} { + set l [lstring G] + set l-isa [testobj objtype $l] + set j [join $l :] + set j-isa [testobj objtype $j] + list ${l-isa} $l ${j-isa} $j +} {lstring G none G} + +test abstractlist-2.14 {error case lset multiple indicies} -body { + set l [lstring Inconceivable] + set l-isa [testobj objtype $l] + set m [lset l 2 0 1 k] + set m-isa [testobj objtype $m] + list $l ${l-isa} $m ${m-isa} [value-cmp l m] +} -returnCodes 1 \ + -result {Multiple indicies not supported by lstring.} + +# lsort + +test abstractlist-3.0 {no shimmer llength} { + set l [lstring -not SLICE $str] + set l-isa [testobj objtype $l] + set len [llength $l] + set l-isa2 [testobj objtype $l] + list $l ${l-isa} ${len} ${l-isa2} +} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} lstring 63 lstring} + +test abstractlist-3.1 {no shimmer lindex} { + set l [lstring -not SLICE $str] + set l-isa [testobj objtype $l] + set n 22 + set ele [lindex $l $n] ;# exercise INST_LIST_INDEX + set l-isa2 [testobj objtype $l] + list $l ${l-isa} ${ele} ${l-isa2} +} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} lstring y lstring} + +test abstractlist-3.2 {no shimmer lreverse} { + set l [lstring -not SLICE $str] + set l-isa [testobj objtype $l] + set r [lreverse $l] + set r-isa [testobj objtype $r] + set l-isa2 [testobj objtype $l] + list $r ${l-isa} ${r-isa} ${l-isa2} +} {{! e i d { } o t { } e r a p e r P { } . r e h t a f { } y m { } d e l l i k { } u o Y { } . a y o t n o M { } o g i n I { } s i { } e m a n { } y M} lstring lstring lstring} + +test abstractlist-3.3 {shimmer lrange} { + set l [lstring -not SLICE $str] + set l-isa [testobj objtype $l] + set il [lsearch -all [lstring -not SLICE $str] { }] + set l-isa2 [testobj objtype $l] + lappend il [llength $l] + set start 0 + set words [lmap i $il { + set w [join [lrange $l $start $i-1] {} ] + set start [expr {$i+1}] + set w + }] + set l-isa3 [testobj objtype $l]; # lrange defaults to list behavior + list ${l-isa} $il ${l-isa2} ${l-isa3} $words +} {lstring {2 7 10 16 25 29 36 39 47 55 58 63} lstring list {My name is Inigo Montoya. You killed my father. Prepare to die!}} + +test abstractlist-3.4 {no shimmer foreach} { + set l [lstring -not SLICE $str] + set l-isa [testobj objtype $l] + set word {} + set words {} + foreach c $l { + if {$c eq { }} { + lappend words $word + set word {} + } else { + append word $c + } + } + if {$word ne ""} { + lappend words $word + } + set l-isa2 [testobj objtype $l] + list ${l-isa} ${l-isa2} $words +} {lstring lstring {My name is Inigo Montoya. You killed my father. Prepare to die!}} + +# +# The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m list, not an lstring. +# +test abstractlist-3.5 {!no shimmer lreplace} { + set l [lstring -not SLICE $str2] + set l-isa [testobj objtype $l] + set m [lreplace $l 18 23 { } f a i l ?] + set m-isa [testobj objtype $m] + set l-isa1 [testobj objtype $l] + list ${l-isa} $m ${m-isa} ${l-isa1} +} {lstring {V i z z i n i : { } H E { } D I D N ' T { } f a i 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 lstring} + +test abstractlist-3.6 {no shimmer ledit} { + # "ledit m 9 8 S" + set l [lstring -not SLICE $str2] + set l-isa [testobj objtype $l] + set e [ledit l 9 8 S] + set e-isa [testobj objtype $e] + list ${l-isa} $e ${e-isa} +} {lstring {V i z z i n i : { } S H E { } 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} + +test abstractlist-3.7 {no shimmer linsert} { + # "ledit m 9 8 S" + set res {} + set l [lstring -not SLICE $str2] + set l-isa [testobj objtype $l] + set i [linsert $l 12 {*}[split "almost " {}]] + set i-isa [testobj objtype $i] + set res [list ${l-isa} $i ${i-isa}] + set p [lpop i 23] + set p-isa [testobj objtype $p] + set i-isa2 [testobj objtype $i] + lappend res $p ${p-isa} $i ${i-isa2} +} {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} + +test abstractlist-3.8 {shimmer lassign} { + set l [lstring -not SLICE Inconceivable] + set l-isa [testobj objtype $l] + set l2 [lassign $l i n c] ;# must be using lrange internally + set l-isa2 [testobj objtype $l] + set l2-isa [testobj objtype $l2] + list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} +} {{I n c o n c e i v a b l e} lstring {o n c e i v a b l e} list list} + +test abstractlist-3.9 {no shimmer lremove} { + set l [lstring -not SLICE Inconceivable] + set l-isa [testobj objtype $l] + set l2 [lremove $l 0 1] + set l-isa2 [testobj objtype $l] + set l2-isa [testobj objtype $l2] + list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} +} {{I n c o n c e i v a b l e} lstring {c o n c e i v a b l e} lstring lstring} + +test abstractlist-3.10 {shimmer lreverse} { + set l [lstring -not SLICE Inconceivable] + set l-isa [testobj objtype $l] + set l2 [lreverse $l] + set l-isa2 [testobj objtype $l] + set l2-isa [testobj objtype $l2] + list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} +} {{I n c o n c e i v a b l e} lstring {e l b a v i e c n o c n I} lstring lstring} + +test abstractlist-3.11 {shimmer lset} { + set l [lstring -not SLICE Inconceivable] + set l-isa [testobj objtype $l] + set four 4 + set m [lset l $four-2 k] + set m-isa [testobj objtype $m] + list $l ${l-isa} $m ${m-isa} [value-cmp l m] +} {{I n k o n c e i v a b l e} lstring {I n k o n c e i v a b l e} lstring 0} + +# lrepeat +test abstractlist-3.12 {shimmer lrepeat} { + set l [lstring -not SLICE Inconceivable] + set l-isa [testobj objtype $l] + set m [lrepeat 3 $l] + set m-isa [testobj objtype $m] + set n [lindex $m 1] + list $l ${l-isa} $m ${m-isa} [testobj objtype $n] [value-cmp l n] +} {{I n c o n c e i v a b l e} lstring {{I n c o n c e i v a b l e} {I n c o n c e i v a b l e} {I n c o n c e i v a b l e}} list lstring 0} + +# lsort +foreach not {{} REVERSE SLICE SETELEMENT REPLACE GETELEMENTS} { + + testConstraint [format "%sShimmer" [string totitle $not]] [expr {$not eq ""}] + set options [expr {$not ne "" ? "-not $not" : ""}] + +test abstractlist-$not-4.0 {no shimmer llength} { + set l [lstring {*}$options $str] + set l-isa [testobj objtype $l] + set len [llength $l] + set l-isa2 [testobj objtype $l] + list $l ${l-isa} ${len} ${l-isa2} +} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} lstring 63 lstring} + +test abstractlist-$not-4.1 {no shimmer lindex} { + set l [lstring {*}$options $str] + set l-isa [testobj objtype $l] + set ele [lindex $l 22] + set l-isa2 [testobj objtype $l] + list $l ${l-isa} ${ele} ${l-isa2} +} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} lstring y lstring} + +test abstractlist-$not-4.2 {lreverse} ReverseShimmer { + set l [lstring {*}$options $str] + set l-isa [testobj objtype $l] + set r [lreverse $l] + set r-isa [testobj objtype $r] + set l-isa2 [testobj objtype $l] + list $r ${l-isa} ${r-isa} ${l-isa2} +} {{! e i d { } o t { } e r a p e r P { } . r e h t a f { } y m { } d e l l i k { } u o Y { } . a y o t n o M { } o g i n I { } s i { } e m a n { } y M} lstring lstring lstring} + +test abstractlist-$not-4.3 {no shimmer lrange} RangeShimmer { + set l [lstring {*}$options $str] + set l-isa [testobj objtype $l] + set il [lsearch -all [lstring {*}$options $str] { }] + set l-isa2 [testobj objtype $l] + lappend il [llength $l] + set start 0 + set words [lmap i $il { + set w [join [lrange $l $start $i-1] {} ] + set start [expr {$i+1}] + set w + }] + set l-isa3 [testobj objtype $l] + list ${l-isa} $il ${l-isa2} ${l-isa3} $words +} {lstring {2 7 10 16 25 29 36 39 47 55 58 63} lstring lstring {My name is Inigo Montoya. You killed my father. Prepare to die!}} + +test abstractlist-$not-4.4 {no shimmer foreach} { + set l [lstring {*}$options $str] + set l-isa [testobj objtype $l] + set word {} + set words {} + foreach c $l { + if {$c eq { }} { + lappend words $word + set word {} + } else { + append word $c + } + } + if {$word ne ""} { + lappend words $word + } + set l-isa2 [testobj objtype $l] + list ${l-isa} ${l-isa2} $words +} {lstring lstring {My name is Inigo Montoya. You killed my father. Prepare to die!}} + +# +# The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m list, not an lstring. +# +test abstractlist-$not-4.5 {!no shimmer lreplace} RangeShimmer { + set l [lstring {*}$options $str2] + set l-isa [testobj objtype $l] + set m [lreplace $l 18 23 { } f a i l ?] + set m-isa [testobj objtype $m] + set l-isa1 [testobj objtype $l] + list ${l-isa} $m ${m-isa} ${l-isa1} +} {lstring {V i z z i n i : { } H E { } D I D N ' T { } f a i 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 .} list lstring} + +test abstractlist-$not-4.6 {no shimmer ledit} {SetelementShimmer ReplaceShimmer} { + # "ledit m 9 8 S" + set l [lstring {*}$options $str2] + set l-isa [testobj objtype $l] + set e [ledit l 9 8 S] + set e-isa [testobj objtype $e] + list ${l-isa} $e ${e-isa} +} {lstring {V i z z i n i : { } S H E { } 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} + +test abstractlist-$not-4.7 {no shimmer linsert} {ReplaceShimmer GetelementsShimmer} { + # "ledit m 9 8 S" + set l [lstring {*}$options $str2] + set l-isa [testobj objtype $l] + set i [linsert $l 12 {*}[split "almost " {}]] + set i-isa [testobj objtype $i] + set res [list ${l-isa} $i ${i-isa}] + set p [lpop i 23] + set p-isa [testobj objtype $p] + set i-isa2 [testobj objtype $i] + lappend res $p ${p-isa} $i ${i-isa2} +} {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} + +# lassign probably uses lrange internally +test abstractlist-$not-4.8 {shimmer lassign} RangeShimmer { + set l [lstring {*}$options Inconceivable] + set l-isa [testobj objtype $l] + set l2 [lassign $l i n c] + set l-isa2 [testobj objtype $l] + set l2-isa [testobj objtype $l2] + list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} +} {{I n c o n c e i v a b l e} lstring {o n c e i v a b l e} lstring lstring} + +test abstractlist-$not-4.9 {no shimmer lremove} ReplaceShimmer { + set l [lstring {*}$options Inconceivable] + set l-isa [testobj objtype $l] + set l2 [lremove $l 0 1] + set l-isa2 [testobj objtype $l] + set l2-isa [testobj objtype $l2] + list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} +} {{I n c o n c e i v a b l e} lstring {c o n c e i v a b l e} lstring lstring} + +test abstractlist-$not-4.10 {shimmer lreverse} ReverseShimmer { + set l [lstring {*}$options Inconceivable] + set l-isa [testobj objtype $l] + set l2 [lreverse $l] + set l-isa2 [testobj objtype $l] + set l2-isa [testobj objtype $l2] + list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} +} {{I n c o n c e i v a b l e} lstring {e l b a v i e c n o c n I} lstring lstring} + +test abstractlist-$not-4.11 {shimmer lset} SetelementShimmer { + set l [lstring {*}$options Inconceivable] + set l-isa [testobj objtype $l] + set m [lset l 2 k] + set m-isa [testobj objtype $m] + list $l ${l-isa} $m ${m-isa} [value-cmp l m] +} {{I n k o n c e i v a b l e} lstring {I n k o n c e i v a b l e} lstring 0} + +test abstractlist-$not-4.11x {lset not compiled} {SetelementShimmer testevalex} { + set l [lstring {*}$options Inconceivable] + set l-isa [testobj objtype $l] + set m [testevalex {lset l 2 k}] + set m-isa [testobj objtype $m] + list $l ${l-isa} $m ${m-isa} [value-cmp l m] +} {{I n k o n c e i v a b l e} lstring {I n k o n c e i v a b l e} lstring 0} + +test abstractlist-$not-4.11e {error case lset multiple indicies} \ + -constraints {SetelementShimmer testevalex} -body { + set l [lstring Inconceivable] + set l-isa [testobj objtype $l] + set m [testevalex {lset l 2 0 1 k}] + set m-isa [testobj objtype $m] + list $l ${l-isa} $m ${m-isa} [value-cmp l m] +} -returnCodes 1 \ + -result {Multiple indicies not supported by lstring.} + +# lrepeat +test abstractlist-$not-4.12 {shimmer lrepeat} { + set l [lstring {*}$options Inconceivable] + set l-isa [testobj objtype $l] + set m [lrepeat 3 $l] + set m-isa [testobj objtype $m] + set n [lindex $m 1] + list $l ${l-isa} $m ${m-isa} [testobj objtype $n] [value-cmp l n] +} {{I n c o n c e i v a b l e} lstring {{I n c o n c e i v a b l e} {I n c o n c e i v a b l e} {I n c o n c e i v a b l e}} list lstring 0} + +# Disable constraint +testConstraint [format "%sShimmer" [string totitle $not]] 1 + +} + +# +# Test fix for bug in TEBC for STR CONCAT, and LIST INDEX +# instructions. +# 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 {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] + set y [lgen 17 apply {{index} {expr {$index * 6}}}] ;# expr * 6 + foreach i $x n $y { + lappend res "$i -> $n" + } + proc my_expr {offset index} { + expr {$index + $offset} + } + lappend res my_expr(3):[my_expr 3 0] + + lappend res [set ss [lgen 15 my_expr 7]] + lappend res s2:[list "Index+7:" $ss ":--"] + + lappend res foo:[list "Index-8:" [lgen 15 my_expr -8] ":--"] + + set 9 [lgen 15 my_expr 7] + lappend res 9len=[llength $9] + lappend res 9(3)=[lindex $9 3] + lappend res bar:[list "Index+7:" $9 ":--"] + + lappend res Index+7:$9:-- + + lappend res Index+7:[lgen 15 my_expr 7]:-- + + proc fib {phi n} { + set d [expr {round(pow($phi, $n) / sqrt(5.0))}] + return $d + } + set phi [expr {(1 + sqrt(5.0)) / 2.0}] + + lappend res fib:[lmap n [lseq 5] {fib $phi $n}] + + set x [lgen 20 fib $phi] + lappend res "First 20 fibbinacci:[lgen 20 fib $phi]" + lappend res "First 20 fibbinacci from x :$x" + unset x + lappend res Good-Bye! + set res + } source.file] +} -body { + set tcl_traceExec 0 + set tcl_traceCompile 0 + set f $lgenfile + #set script [format "puts ====-%s-====\nsource %s\nputs ====-done-====\n" $f $f] + set script [format "source %s" $f] + #puts stderr "eval $script" + eval $script +} -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 + +# cleanup +::tcltest::cleanupTests + +proc my_abstl_cleanup {vars} { + set nowvars [uplevel info vars] + foreach var $nowvars { + if {$var ni $vars} { + uplevel unset $var + lappend clean-list $var + } + } + return ${clean-list} +} + +my_abstl_cleanup $abstractlisttestvars diff --git a/tests/dict.test b/tests/dict.test index 1515675..f0e11fb 100644 --- a/tests/dict.test +++ b/tests/dict.test @@ -14,6 +14,11 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } +catch { + ::tcltest::loadTestedCommands + package require -exact tcl::test [info patchlevel] +} + # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] if {[testConstraint memory]} { @@ -27,6 +32,7 @@ if {[testConstraint memory]} { expr {$end - $tmp} } } + test dict-1.1 {dict command basic syntax} -returnCodes error -body { dict @@ -138,8 +144,16 @@ test dict-3.15 {compiled dict get error cleanliness - Bug 2431847} -body { dict get $a(z) d }} } -returnCodes error -result {key "d" not known in dictionary} -test dict-3.16 {dict/list shimmering - Bug 3004007} {set l [list p 1 p 2 q 3];dict get $l q;set l} {p 1 p 2 q 3} -test dict-3.17 {dict/list shimmering - Bug 3004007} {set l [list p 1 p 2 q 3];dict get $l q;llength $l} 6 +test dict-3.16 {dict/list shimmering - Bug 3004007} { + set l [list p 1 p 2 q 3] + dict get $l q + list $l [testobj objtype $l] +} {{p 1 p 2 q 3} dict} +test dict-3.17 {dict/list shimmering - Bug 3004007} { + set l [list p 1 p 2 q 3] + dict get $l q + list [llength $l] [testobj objtype $l] +} {6 dict} test dict-4.1 {dict replace command} { dict replace {a b c d} @@ -662,15 +676,15 @@ test dict-14.14 {dict for command: handle representation loss} -body { set keys {} set values {} dict for {k v} $dictVar { - if {[llength $dictVar]} { + if {[string length $dictVar]} { lappend keys $k lappend values $v } } - list [lsort $keys] [lsort $values] + list [lsort $keys] [lsort $values] [testobj objtype $dictVar] } -cleanup { unset dictVar keys values k v -} -result {{a c e g} {b d f h}} +} -result {{a c e g} {b d f h} string} test dict-14.15 {dict for command: keys are unique and iterated over once only} -setup { unset -nocomplain accum array set accum {} @@ -1808,27 +1822,27 @@ test dict-24.14 {dict map command: handle representation loss} -setup { } -body { set dictVar {a b c d e f g h} list [dict size [dict map {k v} $dictVar { - if {[llength $dictVar]} { + if {[string length $dictVar]} { lappend keys $k lappend values $v return -level 0 $k } - }]] [lsort $keys] [lsort $values] + }]] [lsort $keys] [lsort $values] [testobj objtype $dictVar] } -cleanup { unset dictVar keys values k v -} -result {4 {a c e g} {b d f h}} +} -result {4 {a c e g} {b d f h} string} test dict-24.14a {dict map command: handle representation loss} -body { apply {{} { set dictVar {a b c d e f g h} list [dict size [dict map {k v} $dictVar { - if {[llength $dictVar]} { + if {[string length $dictVar]} { lappend keys $k lappend values $v return -level 0 $k } - }]] [lsort $keys] [lsort $values] + }]] [lsort $keys] [lsort $values] [testobj objtype $dictVar] }} -} -result {4 {a c e g} {b d f h}} +} -result {4 {a c e g} {b d f h} string} test dict-24.15 {dict map command: keys are unique and iterated over once only} -setup { unset -nocomplain accum array set accum {} diff --git a/tests/lseq.test b/tests/lseq.test index 3561d44..6ec9bb2 100644 --- a/tests/lseq.test +++ b/tests/lseq.test @@ -17,6 +17,7 @@ if {"::tcltest" ni [namespace children]} { testConstraint arithSeriesDouble 1 testConstraint arithSeriesShimmer 1 testConstraint arithSeriesShimmerOk 1 +testConstraint knownBug 0 testConstraint has64BitLengths [expr {$tcl_platform(pointerSize) == 8}] testConstraint has32BitLengths [expr {$tcl_platform(pointerSize) == 4}] @@ -444,6 +445,21 @@ test lseq-3.31 {lreverse inplace with doubles} {arithSeriesDouble} { # lsearch - # -- should not shimmer lseq list # -- should not leak lseq elements +test lseq-3.32 {lsearch nested lists of lseq} arithSeriesShimmer { + 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] +} {list {{20 23 26 29 32 35 38}} arithseries arithseries} + + +# 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} { @@ -565,9 +581,6 @@ test lseq-4.4.32 {lseq corner case} -constraints has32BitLengths -body { test lseq-4.5 {lindex off by one} -body { lappend res [eval {lindex [lseq 1 4] end}] lappend res [eval {lindex [lseq 1 4] end-1}] -} -setup { - # Since 4.3 does not clean up and 4.4 may not run under constraint - set res {} } -cleanup { unset res } -result {4 3} |