Browse Source

adhoc tests (not a proper test suite)

master
Julian Noble 2 years ago
parent
commit
64d73031c7
  1. 21
      scriptlib/tests/curry_assign.tcl
  2. 17
      scriptlib/tests/linetest.tcl
  3. 44
      scriptlib/tests/listbuilder.tcl
  4. 39
      scriptlib/tests/multireturn.tcl
  5. 19
      scriptlib/tests/pipeindex.tcl
  6. 57
      scriptlib/tests/pipeline1.tcl
  7. 9
      scriptlib/tests/unbalanced.tcl

21
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-"

17
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
}

44
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-

39
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-"

19
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-"

57
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
} \
<args| a b c
#-----------------------------------------------------------
set input [list a b c d e f g]
a.=val $input |> {
.=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

9
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
Loading…
Cancel
Save