diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/breakcont.test (renamed from tests/breakcontinue.test) | 0 | ||||
| -rw-r--r-- | tests/event.test | 23 | ||||
| -rw-r--r-- | tests/expr.test | 7 | ||||
| -rw-r--r-- | tests/forget-test.tcl | 3 | ||||
| -rw-r--r-- | tests/io.test | 26 | ||||
| -rw-r--r-- | tests/jimsh.test | 30 | ||||
| -rw-r--r-- | tests/package.test | 12 | ||||
| -rw-r--r-- | tests/try.test | 9 |
8 files changed, 80 insertions, 30 deletions
diff --git a/tests/breakcontinue.test b/tests/breakcont.test index ddf9438..ddf9438 100644 --- a/tests/breakcontinue.test +++ b/tests/breakcont.test diff --git a/tests/event.test b/tests/event.test index 4f0b3c7..a81128e 100644 --- a/tests/event.test +++ b/tests/event.test @@ -78,18 +78,24 @@ test event-7.4 {bgerror throws an error} -constraints jim -body { } after 0 {error err1} update - } + } 2>gorp.err + set f [open gorp.err] + set err [read $f] + close $f + set err } -result {stdin:3: Error: inside bgerror Traceback (most recent call last): File "stdin", line 6 bgerror err1 File "stdin", line 3, in bgerror - error {inside bgerror}} + error {inside bgerror} +} -cleanup { + file delete gorp.err +} # end of bgerror tests catch {rename bgerror {}} - test event-10.1 {Tcl_Exit procedure} exec { set cmd [list exec [info nameofexecutable] "<<exit 3"] list [catch $cmd msg] [lindex $errorCode 0] \ @@ -170,9 +176,10 @@ test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {s list $x $y $z } {3 3 done} -test event-12.1 {Tcl_UpdateCmd procedure} { - list [catch {update a b} msg] $msg -} {1 {wrong # args: should be "update ?idletasks?"}} +test event-12.1 {Tcl_UpdateCmd procedure - usage} -body { + update a b +} -returnCodes error -result {wrong # args: should be "update ?idletasks?"} + test event-12.3 {Tcl_UpdateCmd procedure} { foreach i [after info] { after cancel $i @@ -211,8 +218,8 @@ test event-13.1 "vwait/signal" signal { signal handle ALRM list [catch -signal { alarm 0.1 - # This is just to prevent the vwait from exiting immediately - stdin readable { format test } + # prevent the vwait from exiting immediately + after 1000 { } vwait forever } msg] $msg } {5 SIGALRM} diff --git a/tests/expr.test b/tests/expr.test index 7e26c0a..bc52afd 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -154,5 +154,12 @@ test expr-5.3 {boolean in expression} { expr {true ? 4 : 5} } {4} +test expr-6.1 "Unary negation on boolean - should return error" -body { + expr {-true} +} -returnCodes error -result {can't use non-numeric string as operand of "-"} + +test expr-6.2 "Unary plus on boolean - should return error" -body { + expr {+true} +} -returnCodes error -result {can't use non-numeric string as operand of "+"} testreport diff --git a/tests/forget-test.tcl b/tests/forget-test.tcl new file mode 100644 index 0000000..8d4289b --- /dev/null +++ b/tests/forget-test.tcl @@ -0,0 +1,3 @@ +# This is a dummy package used for testing package forget + +set forgotten 1 diff --git a/tests/io.test b/tests/io.test new file mode 100644 index 0000000..1b06439 --- /dev/null +++ b/tests/io.test @@ -0,0 +1,26 @@ +source [file dirname [info script]]/testing.tcl + +# This is a proxy for tcl || tclcompat +constraint cmd fconfigure + +# The tests in this file are intended to test Tcl-compatible I/O features + +test io-1.1 {translation binary} -body { + # write a file via stdout in binary mode + # This will always work on Unix + set script { + fconfigure stdout -translation binary + puts line1 + puts line2 + } + exec [info nameofexecutable] << $script >binary.out + # Read it back in binary mode + set f [open binary.out rb] + set buf [read $f] + close $f + set buf +} -cleanup { + file delete binary.out +} -result "line1\nline2\n" + +testreport diff --git a/tests/jimsh.test b/tests/jimsh.test index a02ed9f..8faf2d8 100644 --- a/tests/jimsh.test +++ b/tests/jimsh.test @@ -28,29 +28,17 @@ test jimsh-1.5 {jimsh --version} { test jimsh-1.6 {jimsh -e with error} -body { exec [info nameofexecutable] -e blah -} -returnCodes error -result {invalid command name "blah"} +} -returnCodes error -match glob -result {invalid command name "blah"*} -test jimsh-1.7 {jimsh prompt} -body { - exec [info nameofexecutable] << "set x 3\nincr x\nexit \$x\n" -} -returnCodes error -match glob -result {Welcome to Jim version * -. 3 -. 4 -. } +test jimsh-1.7 {jimsh exit code} -body { + set script "set x 3\nincr x\nexit \$x\n" + set rc [catch {exec [info nameofexecutable] << $script} msg opts] + lassign [dict get $opts -errorcode] status pid exitcode + list $rc $status $exitcode +} -result {1 CHILDSTATUS 4} -test jimsh-1.8 {jimsh prompt - error} -body { +test jimsh-1.8 {jimsh error} -body { exec [info nameofexecutable] << "blah\n" -} -match glob -result {Welcome to Jim version * -. invalid command name "blah" -\[error\] . } - -test jimsh-1.9 {jimsh prompt - error} -body { - exec [info nameofexecutable] << "throw 99\n" -} -match glob -result {Welcome to Jim version * -. \[99\] . } - -test jimsh-1.10 {jimsh prompt - continuation} -body { - exec [info nameofexecutable] << "set x {\nabc\n}\n" -} -match glob -result "Welcome to Jim version *\n. {> {> \nabc\n\n. " - +} -returnCodes error -match glob -result {stdin:1: Error: invalid command name "blah"*} testreport diff --git a/tests/package.test b/tests/package.test index b8afa18..1484bd6 100644 --- a/tests/package.test +++ b/tests/package.test @@ -20,5 +20,17 @@ test package-1.3 {package names} -body { expr {"stdlib" in [package names]} } -result 1 +test package-2.1 {package forget} -body { + # First pretend the package was loaded + package provide forget-test + # Now it won't load anything + package require forget-test + # Now forget it and another unloaded test + package forget forget-test missing + # And load the local package + package require forget-test + info exists forgotten +} -result 1 + testreport diff --git a/tests/try.test b/tests/try.test index 0d76865..36a9bf9 100644 --- a/tests/try.test +++ b/tests/try.test @@ -104,7 +104,7 @@ test try-2.1 "try ... trap" -body { try { a } trap CUSTOM {msg opts} { - list $msg $opts(-code) $opts(-errorcode) + list $msg [dict get $opts -code] [dict get $opts -errorcode] } } -result {{custom errorcode} 1 {CUSTOM RESULT}} @@ -140,6 +140,13 @@ test try-2.5 "trap match first but not second" -body { } } -returnCodes error -result failed +test try-2.6 "trap match too long" -body { + try { + apply {{} {return -code error -errorcode {FOO BAR} failed}} + } trap {FOO BAR BAZ} {msg opts} { + list trapped + } +} -returnCodes error -result failed proc c {} { try { |