diff options
author | jenn <jenn> | 1999-08-27 01:17:01 (GMT) |
---|---|---|
committer | jenn <jenn> | 1999-08-27 01:17:01 (GMT) |
commit | 0d3afa4a15d5f42159aca14b4ebd4cca85b91dfe (patch) | |
tree | 6ae58e358e0f7740049d30a1d2e5db4aa0c8bda0 /tests | |
parent | 5091b794329105b393227690593b14fbfa6e37bc (diff) | |
download | tcl-0d3afa4a15d5f42159aca14b4ebd4cca85b91dfe.zip tcl-0d3afa4a15d5f42159aca14b4ebd4cca85b91dfe.tar.gz tcl-0d3afa4a15d5f42159aca14b4ebd4cca85b91dfe.tar.bz2 |
* tests/tcltest.test:
* library/tcltest1.0/tcltest.tcl: Added a -args flag that sets a
variable named ::tcltest::parameters based on whatever's being
sent in as the argument to the -args flag.
Diffstat (limited to 'tests')
-rw-r--r-- | tests/event.test | 17 | ||||
-rw-r--r-- | tests/io.test | 32 | ||||
-rwxr-xr-x | tests/tcltest.test | 29 |
3 files changed, 58 insertions, 20 deletions
diff --git a/tests/event.test b/tests/event.test index 073d96d..d237a86 100644 --- a/tests/event.test +++ b/tests/event.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: event.test,v 1.8 1999/07/01 17:36:17 jenn Exp $ +# RCS: @(#) $Id: event.test,v 1.9 1999/08/27 01:17:05 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -23,8 +23,15 @@ set ::tcltest::testConstraints(testexithandler) \ set ::tcltest::testConstraints(testfilewait) \ [expr {[info commands testfilewait] != {}}] +set ::tcltest::testConstraints(knownBugThreadedLinux) [expr \ + {($tcl_platform(os) != "Linux") \ + && ([info commands testthread] != {})}] -test event-1.1 {Tcl_CreateFileHandler, reading} {testfilehandler} { +set ::tcltest::testConstraints(knownBugThreadedSolaris) [expr \ + {($tcl_platform(os) != "SunOS") \ + && ([info commands testthread] != {})}] + +test event-1.1 {Tcl_CreateFileHandler, reading} {testfilehandler knownBugThreadedLinux knownBugThreadedSolaris} { testfilehandler close testfilehandler create 0 readable off testfilehandler clear 0 @@ -368,7 +375,7 @@ test event-11.3 {Tcl_VwaitCmd procedure} { set x 1 list [catch {vwait x(1)} msg] $msg } {1 {can't trace "x(1)": variable isn't array}} -test event-11.4 {Tcl_VwaitCmd procedure} { +test event-11.4 {Tcl_VwaitCmd procedure} {knownBugThreadedLinux} { foreach i [after info] { after cancel $i } @@ -394,9 +401,9 @@ test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {soc puts $s foobar close $s } - set s1 [socket -server accept 5001] + catch {set s1 [socket -server accept 5001]} after 1000 - set s2 [socket 127.0.0.1 5001] + catch {set s2 [socket 127.0.0.1 5001]} close $s1 set x 0 set y 0 diff --git a/tests/io.test b/tests/io.test index b2716de..1e82b26 100644 --- a/tests/io.test +++ b/tests/io.test @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: io.test,v 1.10 1999/07/01 17:36:18 jenn Exp $ +# RCS: @(#) $Id: io.test,v 1.11 1999/08/27 01:17:05 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -27,6 +27,14 @@ if {"[info commands testchannel]" != "testchannel"} { ::tcltest::saveState +set ::tcltest::testConstraints(knownBugThreadedLinux) [expr \ + {($tcl_platform(os) != "Linux") \ + && ([info commands testthread] != {})}] + +set ::tcltest::testConstraints(knownBugThreadedSolaris) [expr \ + {($tcl_platform(os) != "SunOS") \ + && ([info commands testthread] != {})}] + removeFile test1 removeFile pipe @@ -1025,7 +1033,7 @@ test io-6.55 {Tcl_GetsObj: overconverted} { close $f set x } [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"] -test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio} { +test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio knownBugThreadedSolaris knownBugThreadedLinux} { update set f [open "|[list $::tcltest::tcltest cat]" w+] fconfigure $f -buffering none @@ -1419,7 +1427,7 @@ test io-12.5 {ReadChars: fileevents on partial characters} {stdio} { set x } "{} timeout {} timeout \u7266 {} eof 0 {}" -test io-13.1 {TranslateInputEOL: cr mode} { +test io-13.1 {TranslateInputEOL: cr mode} {knownBugThreadedLinux} { set f [open test1 w] fconfigure $f -translation lf puts -nonewline $f "abcd\rdef\r" @@ -1480,7 +1488,7 @@ test io-13.5 {TranslateInputEOL: crlf mode: naked lf} { close $f set x } "abcd\ndef\nfgh" -test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio} { +test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio knownBugThreadedSolaris knownBugThreadedLinux} { # (chanPtr->flags & INPUT_SAW_CR) # This test may fail on slower machines. @@ -2040,7 +2048,7 @@ test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \ set l } {0 60 72} test io-27.6 {FlushChannel, async flushing, async close} \ - {stdio asyncPipeClose} { + {stdio asyncPipeClose knownBugThreadedLinux} { removeFile pipe removeFile output set f [open pipe w] @@ -5455,7 +5463,7 @@ test io-45.3 {DeleteFileEvent, cleanup on close} { if {[info commands testfevent] == "testfevent"} { -test io-46.1 {Tcl event loop vs multiple interpreters} { + test io-46.1 {Tcl event loop vs multiple interpreters} {knownBugThreadedLinux} { testfevent create testfevent cmd { set f [open foo r] @@ -6110,7 +6118,7 @@ test io-49.5 {testing crlf reading, leftover cr disgorgment} { set l } [list 7 a\rb\rc 7 {} 7 1] -test io-50.1 {testing handler deletion} { +test io-50.1 {testing handler deletion} {knownBugThreadedSolaris knownBugThreadedLinux} { removeFile test1 set f [open test1 w] close $f @@ -6126,7 +6134,7 @@ test io-50.1 {testing handler deletion} { close $f set z } called -test io-50.2 {testing handler deletion with multiple handlers} { +test io-50.2 {testing handler deletion with multiple handlers} {knownBugThreadedSolaris knownBugThreadedLinux} { removeFile test1 set f [open test1 w] close $f @@ -6144,7 +6152,7 @@ test io-50.2 {testing handler deletion with multiple handlers} { string compare [string tolower $z] \ [list [list called delhandler $f 0] [list called delhandler $f 1]] } 0 -test io-50.3 {testing handler deletion with multiple handlers} { +test io-50.3 {testing handler deletion with multiple handlers} {knownBugThreadedSolaris knownBugThreadedLinux} { removeFile test1 set f [open test1 w] close $f @@ -6170,7 +6178,7 @@ test io-50.3 {testing handler deletion with multiple handlers} { [list [list delhandler $f 0 called] \ [list delhandler $f 0 deleted myself]] } 0 -test io-50.4 {testing handler deletion vs reentrant calls} { +test io-50.4 {testing handler deletion vs reentrant calls} {knownBugThreadedSolaris knownBugThreadedLinux} { removeFile test1 set f [open test1 w] close $f @@ -6194,7 +6202,7 @@ test io-50.4 {testing handler deletion vs reentrant calls} { string compare [string tolower $z] \ {{delrecursive calling recursive} {delrecursive deleting recursive}} } 0 -test io-50.5 {testing handler deletion vs reentrant calls} { +test io-50.5 {testing handler deletion vs reentrant calls} {knownBugThreadedSolaris knownBugThreadedLinux} { removeFile test1 set f [open test1 w] close $f @@ -6227,7 +6235,7 @@ test io-50.5 {testing handler deletion vs reentrant calls} { [list {del calling recursive} {del deleted notcalled} \ {del deleted myself} {del after update}] } 0 -test io-50.6 {testing handler deletion vs reentrant calls} { +test io-50.6 {testing handler deletion vs reentrant calls} {knownBugThreadedSolaris knownBugThreadedLinux} { removeFile test1 set f [open test1 w] close $f diff --git a/tests/tcltest.test b/tests/tcltest.test index 855e433..b87b830 100755 --- a/tests/tcltest.test +++ b/tests/tcltest.test @@ -1,7 +1,7 @@ # Command line options covered: # -help, -verbose, -match, -skip, -file, -notfile, -constraints, # -limitconstraints, -preservecore, -tmpdir, -debug, -outfile, -# -errfile +# -errfile, -args # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and @@ -10,7 +10,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: tcltest.test,v 1.6 1999/08/23 17:54:59 jenn Exp $ +# RCS: @(#) $Id: tcltest.test,v 1.7 1999/08/27 01:17:06 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -323,10 +323,33 @@ test tcltest-10.4 {-preservecore 3} {unixOrPc} { [regexp "core-" $msg] [file delete core-makecore] } {1 1 1 {}} +makeFile { + package require tcltest + namespace import ::tcltest::* + puts "=$::tcltest::parameters=" + return +} args.tcl + +# -args +test tcltest-11.1 {-args foo} {unixOrPc} { + catch {exec $::tcltest::tcltest args.tcl -args foo} msg + list $msg +} {=foo=} + +test tcltest-11.2 {-args {}} {unixOrPc} { + catch {exec $::tcltest::tcltest args.tcl -args {}} msg + list $msg +} {==} + +test tcltest-11.3 {-args {-foo bar -baz}} {unixOrPc} { + catch {exec $::tcltest::tcltest args.tcl -args {-foo bar -baz}} msg + list $msg +} {{=-foo bar -baz=}} + # Begin testing of tcltest procs ... # PrintError -test tcltest-11.1 {PrintError} {unixOrPc} { +test tcltest-20.1 {PrintError} {unixOrPc} { set result [catch {exec $::tcltest::tcltest printerror.tcl} msg] list $result [regexp "Error: a really short string" $msg] \ [regexp " \"quotes\"" $msg] [regexp " \"Path" $msg] \ |