Artifact 1d71b7b1818b1e6ee89a96f2c625b4e56161cddf:
- File
packages/knit/lib/knit.test.tcl
— part of check-in
[7f8a8ea012]
at
2021-05-22 09:54:07
on branch trunk
— update various things to reflect changes in other packages
add new files and packages (user: pooryorick size: 7157)
#! /bin/env tclsh package require fileutil package require {ycl proc} [yclprefix] proc alias [yclprefix]::proc::alias [yclprefix] proc alias aliases [yclprefix] proc aliases package require {ycl ns ensemble} aliases { {ycl list} { sl } {ycl knit} { auto knar knit knead knot } {ycl ns} { ensemble } } #package require {ycl test data} package require {ycl test} [yclprefix]::test::init namespace import [yclprefix] if {[yclprefix] ne {::ycl}} { rename [namespace tail [yclprefix]] ycl } proc suite_main {} { set setup1 { set res {} } set cleanup1 { catch {set res {}} apply {{} { foreach name {p1 p2} { catch rename $name {} } }} } # knit utilized knar, so test knar, first. test knar {} -setup $setup1 -body { knit p1 {} { [` defdo n1 {} { lappend res 1 }] [` do n1] } p1 knit p1 {} { [` def n1 {} { lappend res 2 }] [` do n1] [` do n1] } p1 set res } -cleanup $cleanup1 -result [sl { 1 1 2 2 }] # Todo: these test results are sensitive to whitespace. Find a more # robust way to compare the results test knar_nospace {} -setup $setup1 -body { lappend res {*}[knar { [`foreach x {a b} { lappend res x }] }] set res } -cleanup $cleanup1 -result [sl { # What's tested is the missing whitespace after [` {} { [`foreach x {a b} { lappend res x }] } }] test knar_var {} -setup $setup1 -body { knit p1 {} { set num1 val1 set num2 4 set var0 val0 } { [` defdo n1 {var1 var2} { #test that bareword literals in expr's are safe lappend res [expr {${var1}}] lappend res ${var1} lappend res #{var2} } $num1 {5 7}][` script {incr num2}] [` do n1 $num1 $num2] [` auto {lappend res ${var0}}] } p1 set res } -cleanup $cleanup1 -result [sl { val1 val1 5 7 val1 val1 5 val0 }] test knar_recursive {} -setup $setup1 -body { knit p1 {} { [` defdo n1 {} { lappend res 1 }] [` defdo n2 {} { lappend res 2 [` do n1] }] } p1 } -cleanup $cleanup1 -result [sl { 1 2 1 }] test knar_ensemble_duplicate {} -setup $setup1 -body { ensemble duplicate [yclprefix]::knit ns1 set namespace [namespace ensemble configure ns1 -namespace]::cmds namespace eval ns1::cmds { proc macro1 cmdargs { lindex {lappend res 13} } } ns1 knit p1 {} { [` macro1] } p1 set res } -cleanup $cleanup1 -result 13 knit empty {} { } knit double x {expr {${x} * 2}} knit exp2 x {::tcl::mathop::* ${x} ${x}} knit clear arg1 {unset ${arg1}} knit first list {lindex ${list} 0} knit rest list {lrange ${list} 1 end} knit last list {lindex ${list} end} knit drop list {lrange ${list} 0 end-1} knit greeting? x {expr {${x} in {hello hi}}} knit charcount {x {char { }}} { regexp -all ***=${char} ${x} } knit K {x y} { first [list ${x} ${y}] } knit yank varname { K [set ${varname}] [set ${varname} {}] } knit lremove {varname idx} { set ${varname} [lreplace [yank ${varname}] ${idx} ${idx}] } knit lpop listname { K [lindex [set ${listname}] end] [lremove ${listname} end] } knit lpop2 listname { K [lindex !{listname} end] [lremove ${listname} end] } foreach cmdname {* + - /} { knit $cmdname args " expr \[join \${args} [list $cmdname]] " } knit sete {varname exp} { set ${varname} [expr {#{exp}}] } knit until {expr body} { while {!(#{expr})} ${body} } knit ?: {cond val1 val2} { if {#{cond}} {lindex ${val1}} else {lindex ${val2}} } knit finally {init finally do} { #{init} try ${do} finally ${finally} } test knit {} -setup $setup1 -body { lappend res [empty] lappend res [double 8] lappend res [exp2 5] set var1 18 clear var1 lappend res [info exists var1] set var1 {one two three} lappend res [first $var1] lappend res [rest $var1] lappend res [last $var1] lappend res [drop $var1] lappend res [greeting? hi] set var1 {one two three} lappend res [K [last $var1] [set var1 {}]] set var1 four lappend res [yank var1] lappend res $var1 set var1 {one two three} lappend res [lremove var1 1] lappend res $var1 set var1 {one two three} lappend res [lpop var1] lappend res $var1 set var1 {four five six} lappend res [lpop2 var1] lappend res $var1 lappend res [+ 2 2 3] lappend res [sete var1 {(2+18)/5}] set var1 0 until {$var1 > 10} { incr var1 5 } lappend res $var1 lappend res [charcount {one two three four five}] lappend res [charcount {one two three four} o] lappend res [apply [knead x {expr {${x} * ${x}}}] 5] lappend res [?: {1 < 0} yup nope] finally {lappend res starting} {lappend res finally} {lappend res doing} return $res } -cleanup $cleanup1 -result [sl { {} 16 25 0 one [list two three] three {one two} 1 three four {} {one three} {one three} three {one two} six {four five} 7 4 15 4 3 25 nope starting doing finally }] test knit_level {} -setup $setup1 -body { knit p1 {} { set var1 3 } set var1 1 p1 set var1 } -cleanup $cleanup1 -result {3} test knead_scripted {} -setup $setup1 -body { set script [knead {} { set x {1 2} set y {3 4} } { [` foreach x $x y $y { lappend res ${x} ${y} }] set res }] apply [list {*}$script [namespace current]] set script [knead {} { set res {} [` foreach x {{lappend res 1} {lappend res 2}} \ y {{lappend res 3} {lappend res 4}} { #{x} #{y} }][` foreach x {{lappend res 5} {lappend res 6}} { #{x} } ] return $res }] apply [list {*}$script [namespace current]] } -cleanup $cleanup1 -result [sl { 1 3 2 4 5 6 }] test knead_scripted_2 {} -setup $setup1 -body { set script [knead {} { set res {} [` foreach x {{lappend res 1} {lappend res 2}} \ y {{lappend res 3} {lappend res 4}} { #{x} #{y} }] return $res }] apply [list {*}$script [namespace current]] } -cleanup $cleanup1 -result [sl { 1 3 2 4 }] test knot {} -setup $setup1 -body { set var1 one set var2 two set var3 three lappend res [knot { set b [list ${var1} ${var2} ${var3} ${var4}] } var4 howdy] lappend res [knot { lindex "${var3} ${var1} ${var2}" }] } -cleanup $cleanup1 -result [sl { {one two three howdy} {three one two} }] test prescript {} -setup $setup1 -body { knit p1 {var1 var2} { set var1 [expr {$var1 * 2}] set var2 hello } { lappend res ${var1} ${var2} } p1 3 5 set res } -cleanup $cleanup1 -result [sl { 6 hello }] cleanupTests }