diff options
| -rw-r--r-- | ChangeLog | 3 | ||||
| -rwxr-xr-x | tests/tcltest.test | 136 |
2 files changed, 82 insertions, 57 deletions
@@ -1,5 +1,8 @@ 2003-01-31 Don Porter <dgp@users.sourceforge.net> + * tests/tcltest.test: Cleaned up management of file/directory + creation/deletion to improve "-debug 1" output. [Bug 675614] + * tests/main.test: Stopped main.test from deleting existing file. Test suite should not delete files that already exist. [Bug 675660] diff --git a/tests/tcltest.test b/tests/tcltest.test index 0c0edbc..7992985 100755 --- a/tests/tcltest.test +++ b/tests/tcltest.test @@ -6,7 +6,7 @@ # Copyright (c) 2000 by Ajuba Solutions # All rights reserved. # -# RCS: @(#) $Id: tcltest.test,v 1.35 2002/09/22 18:19:26 dgp Exp $ +# RCS: @(#) $Id: tcltest.test,v 1.36 2003/01/31 22:10:24 dgp Exp $ # Note that there are several places where the value of # tcltest::currentFailure is stored/reset in the -setup/-cleanup @@ -70,8 +70,8 @@ proc slave {msgVar args} { interp create [namespace current]::i # Fake the slave interp into dumping output to a file i eval {namespace eval ::tcltest {}} - i eval "set tcltest::outputChannel \[open [makeFile {} output] w]" - i eval "set tcltest::errorChannel \[open [makeFile {} error] w]" + i eval "set tcltest::outputChannel \[open [set of [makeFile {} output]] w]" + i eval "set tcltest::errorChannel \[open [set ef [makeFile {} error]] w]" i eval [list set argv0 [lindex $args 0]] i eval [list set argv [lrange $args 1 end]] i eval [list package ifneeded tcltest [package provide tcltest] \ @@ -86,12 +86,14 @@ if $code { } i eval {close $tcltest::outputChannel} interp delete [namespace current]::i - set f [open [file join [temporaryDirectory] output]] + set f [open $of] set msg [read -nonewline $f] close $f - set f [open [file join [temporaryDirectory] error]] + set f [open $ef] set err [read -nonewline $f] close $f + removeFile output + removeFile error if {[string length $err]} { set code 1 append msg \n$err @@ -380,7 +382,7 @@ test tcltest-6.3 {tcltest -errfile a.tmp} {unixOrPc unixExecs} { $result1 $result2 [file exists a.tmp] [file delete a.tmp] } {1 0 1 0 1 {}} test tcltest-6.4 {tcltest -outfile a.tmp -errfile b.tmp} {unixOrPc unixExecs} { - slave msg printerror.tcl -outfile a.tmp -errfile b.tmp + slave msg $printerror -outfile a.tmp -errfile b.tmp set result1 [catch {exec grep "a test" a.tmp}] set result2 [catch {exec grep "a really" b.tmp}] list [regexp "a test" $msg] [regexp "a really" $msg] \ @@ -422,6 +424,7 @@ test tcltest-6.6 {tcltest::errorFile (implicit errorChannel)} { -match regexp -cleanup { errorFile $of + removeFile efile } } test tcltest-6.7 {tcltest::outputChannel - retrieval} { @@ -457,6 +460,7 @@ test tcltest-6.8 {tcltest::outputFile (implicit outputFile)} { -match regexp -cleanup { outputFile $of + removeFile efile } } @@ -505,17 +509,18 @@ test tcltest-7.6 {tcltest::debug} { set ::tcltest::debug $old } } +removeFile test.tcl # directory tests -makeFile { +set a [makeFile { package require tcltest tcltest::makeFile {} a.tmp puts [tcltest::outputChannel] "testdir: [tcltest::testsDirectory]" exit -} a.tcl +} a.tcl] -makeFile {} thisdirectoryisafile +set tdiaf [makeFile {} thisdirectoryisafile] set normaldirectory [makeDirectory normaldirectory] if {$::tcl_platform(platform) == "macintosh"} { @@ -525,14 +530,14 @@ set normaldirectory [file normalize $normaldirectory] # -tmpdir, [temporaryDirectory] test tcltest-8.1 {tcltest a.tcl -tmpdir a} {unixOrPc} { file delete -force thisdirectorydoesnotexist - slave msg a.tcl -tmpdir thisdirectorydoesnotexist + slave msg $a -tmpdir thisdirectorydoesnotexist list [file exists [file join thisdirectorydoesnotexist a.tmp]] \ [file delete -force thisdirectorydoesnotexist] } {1 {}} test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} { -constraints unixOrPc -body { - slave msg a.tcl -tmpdir thisdirectoryisafile + slave msg $a -tmpdir $tdiaf set msg } -result {*not a directory*} @@ -557,17 +562,17 @@ switch $tcl_platform(platform) { } test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {unixOnly nonRoot} { - slave msg a.tcl -tmpdir $notReadableDir + slave msg $a -tmpdir $notReadableDir string match {*not readable*} $msg } {1} test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {unixOrPc nonRoot} { - slave msg a.tcl -tmpdir $notWriteableDir + slave msg $a -tmpdir $notWriteableDir string match {*not writeable*} $msg } {1} test tcltest-8.5 {tcltest a.tcl -tmpdir normaldirectory} {unixOrPc} { - slave msg a.tcl -tmpdir $normaldirectory + slave msg $a -tmpdir $normaldirectory # The join is necessary because the message can be split on multiple lines list [file exists [file join $normaldirectory a.tmp]] \ [file delete [file join $normaldirectory a.tmp]] @@ -607,23 +612,23 @@ cd [temporaryDirectory] # -testdir, [testsDirectory] test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} {unixOrPc} { file delete -force thisdirectorydoesnotexist - slave msg a.tcl -testdir thisdirectorydoesnotexist + slave msg $a -testdir thisdirectorydoesnotexist string match "*does not exist*" $msg } {1} test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} {unixOrPc} { - slave msg a.tcl -testdir thisdirectoryisafile + slave msg $a -testdir $tdiaf string match "*not a directory*" $msg } {1} test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} {unixOnly nonRoot} { - slave msg a.tcl -testdir $notReadableDir + slave msg $a -testdir $notReadableDir string match {*not readable*} $msg } {1} test tcltest-8.13 {tcltest a.tcl -testdir normaldirectory} {unixOrPc} { - slave msg a.tcl -testdir $normaldirectory + slave msg $a -testdir $normaldirectory # The join is necessary because the message can be split on multiple lines list [string first "testdir: $normaldirectory" [join $msg]] \ [file exists [file join [temporaryDirectory] a.tmp]] \ @@ -689,6 +694,9 @@ switch $tcl_platform(platform) { } file delete -force $notReadableDir $notWriteableDir +removeFile a.tcl +removeFile thisdirectoryisafile +removeDirectory normaldirectory # -file, -notfile, [matchFiles], [skipFiles] test tcltest-9.1 {-file a*.tcl} {unixOrPc} { @@ -728,7 +736,7 @@ test tcltest-9.4 {skipFiles} { } # -preservecore, [preserveCore] -makeFile { +set mc [makeFile { package require tcltest namespace import ::tcltest::test test makecore {make a core file} { @@ -737,27 +745,27 @@ makeFile { } {} ::tcltest::cleanupTests return -} makecore.tcl +} makecore.tcl] cd [temporaryDirectory] test tcltest-10.1 {-preservecore 0} {unixOrPc} { - slave msg makecore.tcl -preservecore 0 + slave msg $mc -preservecore 0 file delete core regexp "Core file produced" $msg } {0} test tcltest-10.2 {-preservecore 1} {unixOrPc} { - slave msg makecore.tcl -preservecore 1 + slave msg $mc -preservecore 1 file delete core regexp "Core file produced" $msg } {1} test tcltest-10.3 {-preservecore 2} {unixOrPc} { - slave msg makecore.tcl -preservecore 2 + slave msg $mc -preservecore 2 file delete core list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \ [regexp "core-" $msg] [file delete core-makecore] } {1 1 1 {}} test tcltest-10.4 {-preservecore 3} {unixOrPc} { - slave msg makecore.tcl -preservecore 3 + slave msg $mc -preservecore 3 file delete core list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \ [regexp "core-" $msg] [file delete core-makecore] @@ -776,6 +784,7 @@ test tcltest-10.4 {-preservecore 3} {unixOrPc} { # } # -result {foo foo} #} +removeFile makecore.tcl # -load, -loadfile, [loadScript], [loadFile] set contents { @@ -787,13 +796,13 @@ set contents { set loadfile [makeFile $contents load.tcl] test tcltest-12.1 {-load xxx} {unixOrPc} { - slave msg load.tcl -load xxx + slave msg $loadfile -load xxx set msg } {xxx} # Using child process because of -debug usage. test tcltest-12.2 {-loadfile load.tcl} {unixOrPc} { - catch {exec [interpreter] load.tcl -debug 2 -loadfile load.tcl} msg + catch {exec [interpreter] $loadfile -debug 2 -loadfile $loadfile} msg list \ [regexp {tcltest} [join [list $msg] [split $msg \n]]] \ [regexp {loadScript} [join [list $msg] [split $msg \n]]] @@ -824,7 +833,7 @@ test tcltest-12.4 {loadFile} { -body { set f1 [loadScript] set f2 [loadFile] - set f3 [loadFile load.tcl] + set f3 [loadFile $loadfile] set f4 [loadScript] set f5 [loadFile] list $f1 $f2 $f3 $f4 $f5 @@ -835,6 +844,7 @@ test tcltest-12.4 {loadFile} { set ::tcltest::loadFile $oldf } } +removeFile load.tcl # [interpreter] test tcltest-13.1 {interpreter} { @@ -855,21 +865,21 @@ test tcltest-13.1 {interpreter} { } # -singleproc, [singleProcess] -makeDirectory singleprocdir +set spd [makeDirectory singleprocdir] makeFile { set foo 1 -} [file join singleprocdir single1.test] +} single1.test $spd makeFile { unset foo -} [file join singleprocdir single2.test] +} single2.test $spd set allfile [makeFile { package require tcltest namespace import tcltest::* testsDirectory [file join [temporaryDirectory] singleprocdir] runAllTests -} [file join singleprocdir all-single.tcl]] +} all-single.tcl $spd] cd [workingDirectory] test tcltest-14.1 {-singleproc - single process} { @@ -908,46 +918,49 @@ test tcltest-14.3 {singleProcess} { set ::tcltest::singleProcess $old } } +removeFile single1.test $spd +removeFile single2.test $spd +removeDirectory singleprocdir # -asidefromdir, -relateddir, [matchDirectories], [skipDirectories] # Before running these tests, need to set up test subdirectories with their own # all.tcl files. -makeDirectory dirtestdir -makeDirectory [file join dirtestdir dirtestdir2.1] -makeDirectory [file join dirtestdir dirtestdir2.2] -makeDirectory [file join dirtestdir dirtestdir2.3] +set dtd [makeDirectory dirtestdir] +set dtd1 [makeDirectory dirtestdir2.1 $dtd] +set dtd2 [makeDirectory dirtestdir2.2 $dtd] +set dtd3 [makeDirectory dirtestdir2.3 $dtd] makeFile { package require tcltest namespace import -force tcltest::* testsDirectory [file join [temporaryDirectory] dirtestdir] runAllTests -} [file join dirtestdir all.tcl] +} all.tcl $dtd makeFile { package require tcltest namespace import -force tcltest::* testsDirectory [file join [temporaryDirectory] dirtestdir dirtestdir2.1] runAllTests -} [file join dirtestdir dirtestdir2.1 all.tcl] +} all.tcl $dtd1 makeFile { package require tcltest namespace import -force tcltest::* testsDirectory [file join [temporaryDirectory] dirtestdir dirtestdir2.2] runAllTests -} [file join dirtestdir dirtestdir2.2 all.tcl] +} all.tcl $dtd2 makeFile { package require tcltest namespace import -force tcltest::* testsDirectory [file join [temporaryDirectory] dirtestdir dirtestdir2.3] runAllTests -} [file join dirtestdir dirtestdir2.3 all.tcl] +} all.tcl $dtd3 test tcltest-15.1 {basic directory walking} { -constraints {unixOrPc} -body { if {[slave msg \ - [file join [temporaryDirectory] dirtestdir all.tcl] \ + [file join $dtd all.tcl] \ -tmpdir [temporaryDirectory]] == 1} { error $msg } @@ -961,7 +974,7 @@ test tcltest-15.2 {-asidefromdir} { -constraints {unixOrPc} -body { if {[slave msg \ - [file join [temporaryDirectory] dirtestdir all.tcl] \ + [file join $dtd all.tcl] \ -asidefromdir dirtestdir2.3 \ -tmpdir [temporaryDirectory]] == 1} { error $msg @@ -979,7 +992,7 @@ test tcltest-15.3 {-relateddir, non-existent dir} { -constraints {unixOrPc} -body { if {[slave msg \ - [file join [temporaryDirectory] dirtestdir all.tcl] \ + [file join $dtd all.tcl] \ -relateddir [file join [temporaryDirectory] dirtestdir0] \ -tmpdir [temporaryDirectory]] == 1} { error $msg @@ -994,7 +1007,7 @@ test tcltest-15.4 {-relateddir, subdir} { -constraints {unixOrPc} -body { if {[slave msg \ - [file join [temporaryDirectory] dirtestdir all.tcl] \ + [file join $dtd all.tcl] \ -relateddir dirtestdir2.1 -tmpdir [temporaryDirectory]] == 1} { error $msg } @@ -1007,7 +1020,7 @@ test tcltest-15.5 {-relateddir, -asidefromdir} { -constraints {unixOrPc} -body { if {[slave msg \ - [file join [temporaryDirectory] dirtestdir all.tcl] \ + [file join $dtd all.tcl] \ -relateddir "dirtestdir2.1 dirtestdir2.2" \ -asidefromdir dirtestdir2.2 \ -tmpdir [temporaryDirectory]] == 1} { @@ -1052,6 +1065,10 @@ test tcltest-15.7 {skipDirectories} { } -result {{} foo foo} } +removeDirectory dirtestdir2.3 $dtd +removeDirectory dirtestdir2.2 $dtd +removeDirectory dirtestdir2.1 $dtd +removeDirectory dirtestdir # TCLTEST_OPTIONS test tcltest-19.1 {TCLTEST_OPTIONS default} { @@ -1092,12 +1109,13 @@ test tcltest-19.1 {TCLTEST_OPTIONS default} { cd [temporaryDirectory] # PrintError test tcltest-20.1 {PrintError} {unixOrPc} { - set result [slave msg printerror.tcl] + set result [slave msg $printerror] list $result [regexp "Error: a really short string" $msg] \ [regexp " \"quotes\"" $msg] [regexp " \"Path" $msg] \ [regexp " \"Really" $msg] [regexp Problem $msg] } {1 1 1 1 1 1} cd [workingDirectory] +removeFile printerror.tcl # test::test test tcltest-21.0 {name and desc but no args specified} -setup { @@ -1300,19 +1318,19 @@ test tcltest-21.12 { # test all.tcl usage (runAllTests); simulate .test file failure, as well as # crashes to determine whether or not these errors are logged. -makeDirectory alltestdir +set atd [makeDirectory alltestdir] makeFile { package require tcltest namespace import -force tcltest::* testsDirectory [file join [temporaryDirectory] alltestdir] runAllTests -} [file join alltestdir all.tcl] +} all.tcl $atd makeFile { exit 1 -} [file join alltestdir exit.test] +} exit.test $atd makeFile { error "throw an error" -} [file join alltestdir error.test] +} error.test $atd makeFile { package require tcltest namespace import -force tcltest::* @@ -1321,7 +1339,7 @@ makeFile { -result {1} } cleanupTests -} [file join alltestdir test.test] +} test.test $atd # Must use a child process because stdout/stderr parsing can't be # duplicated in slave interp. @@ -1329,12 +1347,13 @@ test tcltest-22.1 {runAllTests} { -constraints {unixOrPc} -body { exec [interpreter] \ - [file join [temporaryDirectory] alltestdir all.tcl] \ + [file join $atd all.tcl] \ -verbose t -tmpdir [temporaryDirectory] } -match regexp -result "Test files exiting with errors:.*error.test.*exit.test" } +removeDirectory alltestdir # makeFile, removeFile, makeDirectory, removeDirectory, viewFile test tcltest-23.1 {makeFile} { @@ -1392,15 +1411,16 @@ test tcltest-23.3 {makeDirectory} { -result {1 1} } test tcltest-23.4 {removeDirectory} { - -body { - set mfdir [file join [temporaryDirectory] mfdir] - file mkdir $mfdir - file mkdir [file join [temporaryDirectory] t1] - file mkdir [file join [temporaryDirectory] $mfdir t2] + -setup { + set mfdir [makeDirectory mfdir] + makeDirectory t1 + makeDirectory t2 $mfdir if {![file exists $mfdir] || \ ![file exists [file join [temporaryDirectory] $mfdir t2]]} { - return "setup failed - directory not created" + error "setup failed - directory not created" } + } + -body { removeDirectory t1 removeDirectory t2 $mfdir list [file exists [file join [temporaryDirectory] t1]] \ @@ -1419,6 +1439,7 @@ test tcltest-23.5 {viewFile} { -result {foobar foobarbaz} -cleanup { file delete -force $mfdir + removeFile t1.tmp } } @@ -1702,6 +1723,7 @@ test tcltest-25.3 { } } -match glob -output {*generated error; Return code was: 1*} + cleanupTests } |