From 64d73031c743968124ba3aae6f6e036436b2d068 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Mon, 15 May 2023 14:38:31 +1000 Subject: [PATCH] adhoc tests (not a proper test suite) --- scriptlib/tests/curry_assign.tcl | 21 ++++++++++++ scriptlib/tests/linetest.tcl | 17 ++++++++++ scriptlib/tests/listbuilder.tcl | 44 ++++++++++++++++++++++++ scriptlib/tests/multireturn.tcl | 39 ++++++++++++++++++++++ scriptlib/tests/pipeindex.tcl | 19 +++++++++++ scriptlib/tests/pipeline1.tcl | 57 ++++++++++++++++++++++++++++++++ scriptlib/tests/unbalanced.tcl | 9 +++++ 7 files changed, 206 insertions(+) create mode 100644 scriptlib/tests/curry_assign.tcl create mode 100644 scriptlib/tests/linetest.tcl create mode 100644 scriptlib/tests/listbuilder.tcl create mode 100644 scriptlib/tests/multireturn.tcl create mode 100644 scriptlib/tests/pipeindex.tcl create mode 100644 scriptlib/tests/pipeline1.tcl create mode 100644 scriptlib/tests/unbalanced.tcl diff --git a/scriptlib/tests/curry_assign.tcl b/scriptlib/tests/curry_assign.tcl new file mode 100644 index 00000000..6e87c214 --- /dev/null +++ b/scriptlib/tests/curry_assign.tcl @@ -0,0 +1,21 @@ +puts stdout "test long pipeline can be curried with simple c=x.=d e |> f etc assignment (no space after =)" + +puts stdout "c=x.={5*3} |p1> y.= expr 3 * |p2> {set debug \"val is \$data\";set data} |debug> z.= 2 + |> { set data} |> {puts stderr \"debug:\$debug\n p1:\$p1\np2:\$p2\"; set data}" + +c=x.={5*3} |p1> y.= expr 3 * |p2> {set debug "val is $data";set data} |debug> z.= 2 + |> { set data} |> {puts stderr "debug:$debug\n p1:$p1\np2:$p2"; set data} + +puts stdout "method1 using \$c" +$c +set answer [$c] + +puts stdout "set answer \[\$c\]" +puts stdout " $answer" + +puts stdout "method2 using eval \$c" +eval $c + +set answer2 [eval $c] +puts stdout "set answer2 \[eval \$c\]" +puts stdout " $answer2" + +puts stdout "-done-" diff --git a/scriptlib/tests/linetest.tcl b/scriptlib/tests/linetest.tcl new file mode 100644 index 00000000..439656fc --- /dev/null +++ b/scriptlib/tests/linetest.tcl @@ -0,0 +1,17 @@ +set x [list \ +a b c\ +d e f\ +] +puts stdout $x + +if {[catch { + +y.=list\ +a b c\ +d e f + +} errmsg]} { + puts stderr "error: $errmsg" +} else { + puts stdout $y +} \ No newline at end of file diff --git a/scriptlib/tests/listbuilder.tcl b/scriptlib/tests/listbuilder.tcl new file mode 100644 index 00000000..4e4a72e6 --- /dev/null +++ b/scriptlib/tests/listbuilder.tcl @@ -0,0 +1,44 @@ + +set data1 d1 +set data2 [list a b c] + +x.=list " +item1 +[list $data1] +[list $data2] +[pwd] +" +puts stdout "4 element list built with x.=list \" (multiline) \" syntax" +puts stdout $x + + +x.=list " +{[set x aaa]} +{$x} +blah +" +puts stdout "strange but possibly useful" +puts stdout $x + +puts stdout "building a dict" + +d@0="list " +k1 + {[pwd]} +k2 + {[info patchlevel]} + +k3 + {something} +" +puts stdout "dict: $d" + +puts stdout "comment test" +x="# " +testing +comments +here +" +puts stdout "x:$x" + +puts stdout -done- diff --git a/scriptlib/tests/multireturn.tcl b/scriptlib/tests/multireturn.tcl new file mode 100644 index 00000000..d86648d2 --- /dev/null +++ b/scriptlib/tests/multireturn.tcl @@ -0,0 +1,39 @@ +package require punk + +a= {a b c d e f} +puts stdout "scriptline: a= {a b c d e f}" +puts stdout "a: $a" + +b@end= {a b c d e f} +puts stdout "scriptline: b@end= {a b c d e f}" +puts stdout "b: $b" + + +c@1-3= {a b c d e f} +puts stdout "scriptline: c@1-3= {a b c d e f}" +puts stdout "c: $c" + +d@end-3-end-1= {a b c d e f} +puts stdout "scriptline: d@end-3-end-1= {a b c d e f}" +puts stdout "d: $d" + +set dict {key0 000 key1 111 key2 222 key3 333 key4 444} +pipeline=.= e@@key1,f@@key3,g= $dict +puts stdout "pipeline: $pipeline" +$pipeline +puts stdout "e: $e" +punk::assert {$e eq 111} +puts stdout "f: $f" +punk::assert {$f eq 333} +puts stdout "g: $g" +punk::assert {[llength $g] eq [llength $dict]} + + +result,arr(a,2)@@key2,arr(a,4)@@key4= $dict +puts stdout "scriptline: result,arr(a,2)@key2,arr(a,4)@key4= {key0 000 key1 111 key2 222 key3 333 key4 444}" +puts stdout "parray arr :" +parray arr +puts stdout "result:$result" + + +puts stdout "-done-" diff --git a/scriptlib/tests/pipeindex.tcl b/scriptlib/tests/pipeindex.tcl new file mode 100644 index 00000000..60b0c119 --- /dev/null +++ b/scriptlib/tests/pipeindex.tcl @@ -0,0 +1,19 @@ +package require punk +catch {unset result} + +dict= {a aaa b {z zzz x xxx y yyy}} + +pipeline=result.= in.= val $dict |> string toupper |> @@B/X= +puts stdout "pipeline: $pipeline" +$pipeline +puts stdout "result: $result" +punk::assert {$result eq "XXX"} + +pipeline=result.= in.= val $dict |> string toupper |> @tail/end/not-head/not-tail/0/0= +puts stdout "pipeline: $pipeline" +$pipeline +puts stdout "result: $result" +punk::assert {$result eq "ZZZ"} + + +puts "-done-" \ No newline at end of file diff --git a/scriptlib/tests/pipeline1.tcl b/scriptlib/tests/pipeline1.tcl new file mode 100644 index 00000000..e0a8fc21 --- /dev/null +++ b/scriptlib/tests/pipeline1.tcl @@ -0,0 +1,57 @@ + +#----------------------------------------------------------- +# a formatting experiment +#----------------------------------------------------------- + +x.=val { +a +b c +d e f + g h i +} |> { + + + + set data} |> { + + + set data} |> { + + puts "raw: $data" + set data +} \ +|> \ + \ + \ +l.=linelist %data%\ + \ + |> \ + { + puts "linelist: $data" + puts "args: $args" + set data + } \ + { + + .=lrange $data 1 end-1 |>\ + b.=string toupper + + puts stdout "==================================" + puts stdout [info vars] + foreach v [info vars] { + puts stderr " '$v'" + } + puts stdout "==================================" + return $b +} |> b.=val + +puts $a +puts $b + + + diff --git a/scriptlib/tests/unbalanced.tcl b/scriptlib/tests/unbalanced.tcl new file mode 100644 index 00000000..8afad07e --- /dev/null +++ b/scriptlib/tests/unbalanced.tcl @@ -0,0 +1,9 @@ +#test of commands with unbalanced characters to see how they are handled in a script + +x=$$"} + +puts $x + +y=" + +puts $y