diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | tests/README | 104 | ||||
| -rw-r--r-- | tests/cmdMZ.test | 24 | ||||
| -rw-r--r-- | tests/encoding.test | 93 | ||||
| -rw-r--r-- | tests/fCmd.test | 11 | ||||
| -rw-r--r-- | tests/info.test | 3 | ||||
| -rw-r--r-- | tests/interp.test | 54 |
7 files changed, 133 insertions, 163 deletions
@@ -1,5 +1,12 @@ 2002-06-30 Don Porter <dgp@users.sourceforge.net> + * tests/README: Updated the instructions on running and + * tests/cmdMZ.test: adding to the test suite. Also updated + * tests/encoding.test: several tests, mostly to correctly create + * tests/fCmd.test: and destroy any temporary files in the + * tests/info.test: [temporaryDirectory] of tcltest. + * tests/interp.test: + * library/tcltest/tcltest.tcl: Stopped checking for writeability of -tmpdir value because no default directory can be guaranteed to be writeable. diff --git a/tests/README b/tests/README index 8b2fa4f..4a82e91 100644 --- a/tests/README +++ b/tests/README @@ -1,6 +1,6 @@ README -- Tcl test suite design document. -RCS: @(#) $Id: README,v 1.8 1999/08/31 21:49:27 jenn Exp $ +RCS: @(#) $Id: README,v 1.9 2002/07/01 07:52:02 dgp Exp $ Contents: --------- @@ -23,75 +23,16 @@ You can run the tests in three ways: (a) type "make test" in ../unix; this will run all of the tests. (b) type "tcltest <testFile> ?<option> <value>? - Command line options include: - - -help display usage information - - -verbose <level> set the level of verbosity to a substring - of "bps". See the "Test output" section - of the tcltest man page for an - explanation of this option. - - -match <matchList> only run tests that match one or more of - the glob patterns in <matchList> - - -skip <skipList> do not run tests that match one or more - of the glob patterns in <skipList> - - -file <globPatternList> - only source test files that match one or - more of the glob patterns in - <globPatternList> (relative to the - "tests" directory). This option only - applies when you run the test suite with - the "all.tcl" file. - - -notfile <globPatternList> - do not source test files that match one - or more of the patterns in - <globPatternList> (relative to the - "tests" directory). This option only - applies when you run the test suite with - the "all.tcl" file. - - -constraints <list> tests with any constraints in <list> will - not be skipped. Not that elements of - <list> must exactly match the existing - constraints. - - -limitconstraints <bool> - If 1, limit test runs to those tests that - match the constraints listed using the - -constraints flag. Use of this flag - requires use of the -constraints flag. - The default value is 0. - - -tmpdir <dirname> put temporary files created by - ::tcltest::makeFile and - ::tcltest::makeDirectory in the named - directory. The default location is - ::tcltest::workingDirectory. - - -preservecore <level> - check for core files. If level is 0, - check for core files only when - cleanupTests is called from an all.tcl - file. If 1, also check at the end of - every test command. If 2, also save core - files in ::tcltest::temporaryDirectory. - The default level is 0. + + where the options and values are the configuration options + of the tcltest package. (c) start up tcltest in this directory, then "source" the test file (for example, type "source parse.test"). To run all of the tests, type "source all.tcl". To use the options in - interactive mode, you can set their corresponding tcltest - namespace variables after loading the tcltest package. - For example, some of the tcltest variables are: - ::tcltest::match - ::tcltest::skip - ::tcltest::testConstraints(nonPortable) - ::tcltest::testConstraints(knownBug) - ::tcltest::testConstraints(userInteractive) + interactive mode, you can set them with the tcltest::configure + command. Set constraints with the tcltest::testConstraints + command. Please see the tcltest man page for more information regarding how to write and run tests. @@ -108,25 +49,25 @@ correspond to any Tcl or C code file so they should match the pattern Be sure your new test file can be run from any working directory. Be sure no temporary files are left behind by your test file. +Use [tcltest::makeFile], [tcltest::removeFile], and [tcltest::cleanupTests] +properly to be sure of this. Be sure your tests can run cross-platform in both a build environment as well as an installation environment. If your test file contains tests that should not be run in one or more of those cases, please use the constraints mechanism to skip those tests. -2. Incompatibilities with prior Tcl versions: ---------------------------------------------- - -1) Global variables such as VERBOSE, TESTS, and testConfig are now - renamed to use the new "tcltest" namespace. +2. Incompatibilities of package tcltest 2.1 with + testing machinery of very old versions of Tcl: +------------------------------------------------ - old name new name - -------- -------- - VERBOSE ::tcltest::verbose - TESTS ::tcltest::match - testConfig ::tcltest::testConstraints +1) Global variables such as VERBOSE, TESTS, and testConfig of the + old machinery correspond to the [configure -verbose], + [configure -match], and [testConstraint] commands of tcltest 2.1, + respectively. -2) VERBOSE values are no longer numeric. +2) VERBOSE values were longer numeric. [configure -verbose] values + are lists of keywords. 3) When you run "make test", the working dir for the test suite is now the one from which you called "make test", rather than the "tests" @@ -135,13 +76,12 @@ the constraints mechanism to skip those tests. other or with existing files. All tests must now run independently of their working directory. -4) The "all" and "visual" files are now called "all.tcl" and - "visual_bb.test". +4) The "all" file is now called "all.tcl" 5) The "defs" file no longer exists. 6) Instead of creating a doAllTests file in the tests directory, to run all nonPortable tests, just use the "-constraints nonPortable" - command line flag. If you are running interactively, you can set - the ::tcltest::testConstraints(nonPortable) variable to 1 (after - loading the tcltest package). + command line flag. If you are running interactively, you can run + [tcltest::testConstraint nonPortable 1] (after loading the tcltest + package). diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test index d2a57f9..cf7a1a9 100644 --- a/tests/cmdMZ.test +++ b/tests/cmdMZ.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: cmdMZ.test,v 1.9 2001/11/23 01:25:54 das Exp $ +# RCS: @(#) $Id: cmdMZ.test,v 1.10 2002/07/01 07:52:02 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -85,22 +85,26 @@ test cmdMZ-3.3 {Tcl_SourceObjCmd: error conditions} {unixOrPc} { test cmdMZ-3.4 {Tcl_SourceObjCmd: error conditions} {unixOrPc} { list [catch {source a b} msg] $msg } {1 {wrong # args: should be "source fileName"}} -test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} { - makeFile { +test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} -body { + set file [makeFile { set x 146 error "error in sourced file" set y $x - } source.file - list [catch {source source.file} msg] $msg $errorInfo -} {1 {error in sourced file} {error in sourced file + } source.file] + set result [list [catch {source $file} msg] $msg $errorInfo] + removeFile source.file + set result +} -match glob -result {1 {error in sourced file} {error in sourced file while executing "error "error in sourced file"" - (file "source.file" line 3) + (file "*" line 3) invoked from within -"source source.file"}} +"source $file"}} test cmdMZ-3.6 {Tcl_SourceObjCmd: simple script} { - makeFile {list result} source.file - source source.file + set file [makeFile {list result} source.file] + set result [source $file] + removeFile source.file + set result } result # Tcl_SplitObjCmd diff --git a/tests/encoding.test b/tests/encoding.test index fb6f0c3..cf0392b 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: encoding.test,v 1.13 2002/06/22 04:19:47 dgp Exp $ +# RCS: @(#) $Id: encoding.test,v 1.14 2002/07/01 07:52:02 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -90,10 +90,10 @@ test encoding-3.2 {Tcl_GetEncodingName, non-null} { } {jis0208} test encoding-4.1 {Tcl_GetEncodingNames} {testencoding} { - file mkdir tmp/encoding - close [open tmp/encoding/junk.enc w] - close [open tmp/encoding/junk2.enc w] - cd tmp + cd [makeDirectory tmp] + makeDirectory [file join tmp encoding] + makeFile {} [file join tmp encoding junk.enc] + makeFile {} [file join tmp encoding junk2.enc] set path [testencoding path] testencoding path {} catch {unset encodings} @@ -108,8 +108,11 @@ test encoding-4.1 {Tcl_GetEncodingNames} {testencoding} { } } testencoding path $path - cd .. - file delete -force tmp + cd [workingDirectory] + removeFile [file join tmp encoding junk2.enc] + removeFile [file join tmp encoding junk.enc] + removeDirectory [file join tmp encoding] + removeDirectory tmp lsort $x } {junk junk2} @@ -158,15 +161,15 @@ test encoding-7.2 {Tcl_UtfToExternalDString: big buffer} { } "512 \u4e4e" test encoding-8.1 {Tcl_ExternalToUtf} { - set f [open dummy w] + set f [open [file join [temporaryDirectory] dummy] w] fconfigure $f -translation binary -encoding iso8859-1 puts -nonewline $f "ab\x8c\xc1g" close $f - set f [open dummy r] + set f [open [file join [temporaryDirectory] dummy] r] fconfigure $f -translation binary -encoding shiftjis set x [read $f] close $f - file delete dummy + file delete [file join [temporaryDirectory] dummy] set x } "ab\u4e4eg" @@ -186,15 +189,15 @@ test encoding-9.2 {Tcl_UtfToExternalDString: big buffer} { } "1024 8C" test encoding-10.1 {Tcl_UtfToExternal} { - set f [open dummy w] + set f [open [file join [temporaryDirectory] dummy] w] fconfigure $f -translation binary -encoding shiftjis puts -nonewline $f "ab\u4e4eg" close $f - set f [open dummy r] + set f [open [file join [temporaryDirectory] dummy] r] fconfigure $f -translation binary -encoding iso8859-1 set x [read $f] close $f - file delete dummy + file delete [file join [temporaryDirectory] dummy] set x } "ab\x8c\xc1g" @@ -239,15 +242,19 @@ test encoding-11.6 {LoadEncodingFile: invalid file} {testencoding} { set system [encoding system] set path [testencoding path] encoding system identity + cd [temporaryDirectory] testencoding path tmp - file mkdir tmp/encoding - set f [open tmp/encoding/splat.enc w] + makeDirectory tmp + makeDirectory [file join tmp encoding] + set f [open [file join tmp encoding splat.enc] w] fconfigure $f -translation binary puts $f "abcdefghijklmnop" close $f set x [list [catch {encoding convertto splat \u4e4e} msg] $msg] - file delete -force tmp - catch {file delete encoding} + file delete [file join [temporaryDirectory] tmp encoding splat.enc] + removeDirectory [file join tmp encoding] + removeDirectory tmp + cd [workingDirectory] testencoding path $path encoding system $system set x @@ -325,6 +332,7 @@ set ::iso2022uniData2 "\u79c1\u3069\u3082\u3067\u306f\u3001\u30c1\u30c3\u30d7\u3 \u0063\u0061\u0073\u0069\u006e\u006f\u005f\u006a\u0061\u0070\u0061\u006e\u0065\u0073\u0065\u0040\u005f\u005f\u005f\u002e\u0063\u006f\u006d\u0020\uff09\u307e\u3067\u3054\u4f4f\u6240\u5909\u66f4\u6e08\u306e\u9023\u7d61\u3092\u3044\u305f\u3060\u3051\u306a\u3044\u3067 \u3057\u3087\u3046\u304b\uff1f" +cd [temporaryDirectory] set fid [open iso2022.txt w] fconfigure $fid -encoding binary puts -nonewline $fid $::iso2022encData @@ -362,50 +370,55 @@ test encoding-23.3 {iso2022-jp escape encoding test} { close $fid set data } [string range $::iso2022uniData 0 49] ; # 0 .. 49 inclusive == 50 +cd [workingDirectory] -test encoding-24.1 {EscapeFreeProc on open channels} {exec} { +test encoding-24.1 {EscapeFreeProc on open channels} -constraints { + exec +} -setup { # Bug #524674 input - set f [open iso2022.tcl w] - puts $f { - set f [open iso2022.txt] + set file [makeFile { + set f [open [file join [file dirname [info script]] iso2022.txt]] fconfigure $f -encoding iso2022-jp gets $f - } - close $f - exec $::tcltest::tcltest iso2022.tcl -} {} - -test encoding-24.2 {EscapeFreeProc on open channels} {exec} { + } iso2022.tcl] +} -body { + exec $::tcltest::tcltest $file +} -cleanup { + removeFile iso2022.tcl +} -result {} + +test encoding-24.2 {EscapeFreeProc on open channels} -constraints { + exec +} -setup { # Bug #524674 output - set f [open iso2022.tcl w] - puts $f { + set file [makeFile { fconfigure stdout -encoding iso2022-jp puts ab\u4e4e\u68d9g exit - } - close $f - viewable [exec $::tcltest::tcltest iso2022.tcl] -} "ab\x1b\$B8C\x1b\$(DD%\x1b(Bg (ab\\u001b\$B8C\\u001b\$(DD%\\u001b(Bg)" + } iso2022.tcl] +} -body { + viewable [exec $::tcltest::tcltest $file] +} -cleanup { + removeFile iso2022.tcl +} -result "ab\x1b\$B8C\x1b\$(DD%\x1b(Bg (ab\\u001b\$B8C\\u001b\$(DD%\\u001b(Bg)" test encoding-24.3 {EscapeFreeProc on open channels} {exec} { # Bug #219314 - if we don't free escape encodings correctly on # channel closure, we go boom - set f [open iso2022.tcl w] - puts $f { + set file [makeFile { encoding system iso2022-jp set a "\u4e4e\u4e5e\u4e5f"; # 3 Japanese Kanji letters puts $a - } - close $f - set f [open "|[list $::tcltest::tcltest iso2022.tcl]"] + } iso2022.tcl] + set f [open "|[list $::tcltest::tcltest $file]"] fconfigure $f -encoding iso2022-jp set count [gets $f line] close $f + removeFile iso2022.tcl list $count [viewable $line] } [list 3 "\u4e4e\u4e5e\u4e5f (\\u4e4e\\u4e5e\\u4e5f)"] -::tcltest::removeFile iso2022.txt -::tcltest::removeFile iso2022.tcl +file delete [file join [temporaryDirectory] iso2022.txt] # EscapeFreeProc, GetTableEncoding, unilen # are fully tested by the rest of this file diff --git a/tests/fCmd.test b/tests/fCmd.test index 94db157..131ace5 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: fCmd.test,v 1.15 2002/06/22 04:19:47 dgp Exp $ +# RCS: @(#) $Id: fCmd.test,v 1.16 2002/07/01 07:52:02 dgp Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -2195,13 +2195,12 @@ test fCmd-28.4 {file link} {hasLinks} { list [catch {file link -abc b c} msg] $msg } {1 {bad switch "-abc": must be -symbolic or -hard}} -catch {file delete -force abc.dir} -catch {file delete -force abc2.dir} makeDirectory abc.dir makeDirectory abc2.dir makeFile contents abc.file makeFile contents abc2.file +cd [temporaryDirectory] test fCmd-28.5 {file link: source already exists} {linkDirectory} { list [catch {file link abc.dir abc2.dir} msg] $msg } {1 {could not create new link "abc.dir": that path already exists}} @@ -2295,6 +2294,12 @@ test fCmd-28.18 {file link: glob -type d} {linkDirectory} { } [lsort [list abc.link abc.dir abc2.dir]] file delete -force abc.link +cd [workingDirectory] + +removeFile abc2.file +removeFile abc.file +removeDirectory abc2.dir +removeDirectory abc.dir # cleanup cleanup diff --git a/tests/info.test b/tests/info.test index db20d58..4f87e99 100644 --- a/tests/info.test +++ b/tests/info.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: info.test,v 1.23 2002/06/11 13:56:20 dkf Exp $ +# RCS: @(#) $Id: info.test,v 1.24 2002/07/01 07:52:03 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -521,7 +521,6 @@ test info-16.1 {info script option} { test info-16.2 {info script option} { file tail [info sc] } "info.test" -removeFile gorp.info set gorpfile [makeFile "info script\n" gorp.info] test info-16.3 {info script option} { list [source $gorpfile] [file tail [info script]] diff --git a/tests/interp.test b/tests/interp.test index 43eb266..f82151e 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: interp.test,v 1.14 2002/03/07 20:17:23 dgp Exp $ +# RCS: @(#) $Id: interp.test,v 1.15 2002/07/01 07:52:03 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -481,74 +481,74 @@ test interp-15.1 {testing file sharing} { z eval close stdout list [catch {z eval puts hello} msg] $msg } {1 {can not find channel named "stdout"}} -catch {removeFile file-15.2} -test interp-15.2 {testing file sharing} { +test interp-15.2 {testing file sharing} -body { catch {interp delete z} interp create z - set f [open file-15.2 w] + set f [open [makeFile {} file-15.2] w] interp share "" $f z z eval puts $f hello z eval close $f close $f -} "" -catch {removeFile file-15.2} +} -cleanup { + removeFile file-15.2 +} -result "" test interp-15.3 {testing file sharing} { catch {interp delete xsafe} interp create xsafe -safe list [catch {xsafe eval puts hello} msg] $msg } {1 {can not find channel named "stdout"}} -catch {removeFile file-15.4} -test interp-15.4 {testing file sharing} { +test interp-15.4 {testing file sharing} -body { catch {interp delete xsafe} interp create xsafe -safe - set f [open file-15.4 w] + set f [open [makeFile {} file-15.4] w] interp share "" $f xsafe xsafe eval puts $f hello xsafe eval close $f close $f -} "" -catch {removeFile file-15.4} +} -cleanup { + removeFile file-15.4 +} -result "" test interp-15.5 {testing file sharing} { catch {interp delete xsafe} interp create xsafe -safe interp share "" stdout xsafe list [catch {xsafe eval gets stdout} msg] $msg } {1 {channel "stdout" wasn't opened for reading}} -catch {removeFile file-15.6} -test interp-15.6 {testing file sharing} { +test interp-15.6 {testing file sharing} -body { catch {interp delete xsafe} interp create xsafe -safe - set f [open file-15.6 w] + set f [open [makeFile {} file-15.6] w] interp share "" $f xsafe set x [list [catch [list xsafe eval gets $f] msg] $msg] xsafe eval close $f close $f string compare [string tolower $x] \ [list 1 [format "channel \"%s\" wasn't opened for reading" $f]] -} 0 -catch {removeFile file-15.6} -catch {removeFile file-15.7} -test interp-15.7 {testing file transferring} { +} -cleanup { + removeFile file-15.6 +} -result 0 +test interp-15.7 {testing file transferring} -body { catch {interp delete xsafe} interp create xsafe -safe - set f [open file-15.7 w] + set f [open [makeFile {} file-15.7] w] interp transfer "" $f xsafe xsafe eval puts $f hello xsafe eval close $f -} "" -catch {removeFile file-15.7} -catch {removeFile file-15.8} -test interp-15.8 {testing file transferring} { +} -cleanup { + removeFile file-15.7 +} -result "" +test interp-15.8 {testing file transferring} -body { catch {interp delete xsafe} interp create xsafe -safe - set f [open file-15.8 w] + set f [open [makeFile {} file-15.8] w] interp transfer "" $f xsafe xsafe eval close $f set x [list [catch {close $f} msg] $msg] string compare [string tolower $x] \ [list 1 [format "can not find channel named \"%s\"" $f]] -} 0 -catch {removeFile file-15.8} +} -cleanup { + removeFile file-15.8 +} -result 0 # # Torture tests for interpreter deletion order @@ -2868,6 +2868,7 @@ test interp-31.1 {alias invocation scope} { test interp-32.1 { parent's working directory should be inherited by a child interp } { + cd [temporaryDirectory] set parent [pwd] set i [interp create] set child [$i eval pwd] @@ -2880,6 +2881,7 @@ test interp-32.1 { parent's working directory should cd .. file delete cwd_test interp delete $i + cd [workingDirectory] expr {[string equal $parent $child] ? 1 : "\{$parent\} != \{$child\}"} } 1 |