summaryrefslogtreecommitdiffstats
path: root/tests/tcltest.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/tcltest.test')
-rwxr-xr-xtests/tcltest.test199
1 files changed, 124 insertions, 75 deletions
diff --git a/tests/tcltest.test b/tests/tcltest.test
index 7edc67a..5babf5c 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.31 2002/07/10 11:56:45 dgp Exp $
+# RCS: @(#) $Id: tcltest.test,v 1.32 2002/07/10 18:51:54 dgp Exp $
# Note that there are several places where the value of
# tcltest::currentFailure is stored/reset in the -setup/-cleanup
@@ -16,12 +16,7 @@
#
# It would be better to have the -body of the tests run the tcltest
# commands in a slave interp so the [test] being tested would not
-# interfere with the [test] doing the testing. Use of a slave
-# interp might also be able to replace the [exec] of child processes
-# that make this test file take so long to complete.
-#
-# Anyone reading this who has some time, a patch making that change
-# would be welcome.
+# interfere with the [test] doing the testing.
#
if {[catch {package require tcltest 2.1}]} {
@@ -57,7 +52,6 @@ testConstraint exec [llength [info commands exec]]
# Child processes because -help [exit]s.
test tcltest-1.1 {tcltest -help} {exec} {
set result [catch {exec [interpreter] test.tcl -help} msg]
- set result [catch {runCmd $cmd}]
list $result [regexp Usage $msg]
} {1 1}
test tcltest-1.2 {tcltest -help -something} {exec} {
@@ -70,45 +64,81 @@ test tcltest-1.3 {tcltest -h} {exec} {
} {1 0}
# -verbose, implicit & explicit testing of [verbose]
+proc slave {msgVar args} {
+ upvar 1 $msgVar msg
+
+ 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 [list set argv0 [lindex $args 0]]
+ i eval [list set argv [lrange $args 1 end]]
+ i eval [list package ifneeded tcltest [package provide tcltest] \
+ [package ifneeded tcltest [package provide tcltest]]]
+ i eval {proc exit args {}}
+
+ # Need to capture output in msg
+
+ set code [catch {i eval {source $argv0}} foo]
+if $code {
+#puts "$code: $foo\n$::errorInfo"
+}
+ i eval {close $tcltest::outputChannel}
+ interp delete [namespace current]::i
+ set f [open [file join [temporaryDirectory] output]]
+ set msg [read -nonewline $f]
+ close $f
+ set f [open [file join [temporaryDirectory] error]]
+ set err [read -nonewline $f]
+ close $f
+ if {[string length $err]} {
+ set code 1
+ append msg \n$err
+ }
+ return $code
+
+# return [catch {uplevel 1 [linsert $args 0 exec [interpreter]]} msg]
+}
test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrPc} {
- set result [catch {exec [interpreter] test.tcl} msg]
+ set result [slave msg test.tcl]
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 0 0 1}
test tcltest-2.1 {tcltest -verbose 'b'} {unixOrPc} {
- set result [catch {exec [interpreter] test.tcl -verbose 'b'} msg]
+ set result [slave msg test.tcl -verbose 'b']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 0 0 1}
test tcltest-2.2 {tcltest -verbose 'p'} {unixOrPc} {
- set result [catch {exec [interpreter] test.tcl -verbose 'p'} msg]
+ set result [slave msg test.tcl -verbose 'p']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 0 1 0 1}
test tcltest-2.3 {tcltest -verbose 's'} {unixOrPc} {
- set result [catch {exec [interpreter] test.tcl -verbose 's'} msg]
+ set result [slave msg test.tcl -verbose 's']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 0 0 1 1}
test tcltest-2.4 {tcltest -verbose 'ps'} {unixOrPc} {
- set result [catch {exec [interpreter] test.tcl -verbose 'ps'} msg]
+ set result [slave msg test.tcl -verbose 'ps']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 0 1 1 1}
test tcltest-2.5 {tcltest -verbose 'psb'} {unixOrPc} {
- set result [catch {exec [interpreter] test.tcl -verbose 'psb'} msg]
+ set result [slave msg test.tcl -verbose 'psb']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 1 1 1}
test tcltest-2.5a {tcltest -verbose 'pass skip body'} {unixOrPc} {
- set result [catch {exec [interpreter] test.tcl -verbose "pass skip body"} msg]
+ set result [slave msg test.tcl -verbose "pass skip body"]
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
@@ -117,7 +147,7 @@ test tcltest-2.5a {tcltest -verbose 'pass skip body'} {unixOrPc} {
test tcltest-2.6 {tcltest -verbose 't'} {
-constraints {unixOrPc}
-body {
- set result [catch {exec [interpreter] test.tcl -verbose 't'} msg]
+ set result [slave msg test.tcl -verbose 't']
list $result $msg
}
-result {^0 .*a-1.0 start.*b-1.0 start}
@@ -127,7 +157,7 @@ test tcltest-2.6 {tcltest -verbose 't'} {
test tcltest-2.6a {tcltest -verbose 'start'} {
-constraints {unixOrPc}
-body {
- set result [catch {exec [interpreter] test.tcl -verbose start} msg]
+ set result [slave msg test.tcl -verbose start]
list $result $msg
}
-result {^0 .*a-1.0 start.*b-1.0 start}
@@ -150,7 +180,7 @@ test tcltest-2.7 {tcltest::verbose} {
test tcltest-2.8 {tcltest -verbose 'error'} {
-constraints {unixOrPc}
-body {
- set result [catch {exec [interpreter] test.tcl -verbose error} msg]
+ set result [slave msg test.tcl -verbose error]
list $result $msg
}
-result {errorInfo: foo.*errorCode: 9}
@@ -158,22 +188,22 @@ test tcltest-2.8 {tcltest -verbose 'error'} {
}
# -match, [match]
test tcltest-3.1 {tcltest -match 'a*'} {unixOrPc} {
- set result [catch {exec [interpreter] test.tcl -match a* -verbose 'ps'} msg]
+ set result [slave msg test.tcl -match a* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
} {0 1 0 0 1}
test tcltest-3.2 {tcltest -match 'b*'} {unixOrPc} {
- set result [catch {exec [interpreter] test.tcl -match b* -verbose 'ps'} msg]
+ set result [slave msg test.tcl -match b* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg]
} {0 0 1 0 1}
test tcltest-3.3 {tcltest -match 'c*'} {unixOrPc} {
- set result [catch {exec [interpreter] test.tcl -match c* -verbose 'ps'} msg]
+ set result [slave msg test.tcl -match c* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+0.+Skipped.+4.+Failed.+0" $msg]
} {0 0 0 1 1}
test tcltest-3.4 {tcltest -match 'a* b*'} {unixOrPc} {
- set result [catch {exec [interpreter] test.tcl -match {a* b*} -verbose 'ps'} msg]
+ set result [slave msg test.tcl -match {a* b*} -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg]
} {0 1 1 0 1}
@@ -193,27 +223,27 @@ test tcltest-3.5 {tcltest::match} {
# -skip, [skip]
test tcltest-4.1 {tcltest -skip 'a*'} {unixOrPc} {
- set result [catch {exec [interpreter] test.tcl -skip a* -verbose 'ps'} msg]
+ set result [slave msg test.tcl -skip a* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+0.+Skipped.+2.+Failed.+1" $msg]
} {0 0 1 1 1}
test tcltest-4.2 {tcltest -skip 'b*'} {unixOrPc} {
- set result [catch {exec [interpreter] test.tcl -skip b* -verbose 'ps'} msg]
+ set result [slave msg test.tcl -skip b* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg]
} {0 1 0 1 1}
test tcltest-4.3 {tcltest -skip 'c*'} {unixOrPc} {
- set result [catch {exec [interpreter] test.tcl -skip c* -verbose 'ps'} msg]
+ set result [slave msg test.tcl -skip c* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 1 0 1}
test tcltest-4.4 {tcltest -skip 'a* b*'} {unixOrPc} {
- set result [catch {exec [interpreter] test.tcl -skip {a* b*} -verbose 'ps'} msg]
+ set result [slave msg test.tcl -skip {a* b*} -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg]
} {0 0 0 1 1}
test tcltest-4.5 {tcltest -match 'a* b*' -skip 'b*'} {unixOrPc} {
- set result [catch {exec [interpreter] test.tcl -match {a* b*} -skip b* -verbose 'ps'} msg]
+ set result [slave msg test.tcl -match {a* b*} -skip b* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
} {0 1 0 0 1}
@@ -234,12 +264,12 @@ test tcltest-4.6 {tcltest::skip} {
# -constraints, -limitconstraints, [testConstraint],
# $constraintsSpecified, [limitConstraints]
test tcltest-5.1 {tcltest -constraints 'knownBug'} {unixOrPc} {
- set result [catch {exec [interpreter] test.tcl -constraints knownBug -verbose 'ps'} msg]
+ set result [slave msg test.tcl -constraints knownBug -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+2.+Skipped.+0.+Failed.+2" $msg]
} {0 1 1 1 1}
test tcltest-5.2 {tcltest -constraints 'knownBug' -limitconstraints 1} {unixOrPc} {
- set result [catch {exec [interpreter] test.tcl -constraints knownBug -verbose 'p' -limitconstraints 1} msg]
+ set result [slave msg test.tcl -constraints knownBug -verbose 'p' -limitconstraints 1]
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
} {0 0 0 1 1}
@@ -329,28 +359,28 @@ set printerror [makeFile {
test tcltest-6.1 {tcltest -outfile, -errfile defaults} {
-constraints unixOrPc
-body {
- catch {exec [interpreter] $printerror} msg
+ slave msg $printerror
return $msg
}
-result {a test.*a really}
-match regexp
}
test tcltest-6.2 {tcltest -outfile a.tmp} {unixOrPc unixExecs} {
- catch {exec [interpreter] printerror.tcl -outfile a.tmp} msg
+ slave msg $printerror -outfile a.tmp
set result1 [catch {exec grep "a test" a.tmp}]
set result2 [catch {exec grep "a really" a.tmp}]
list [regexp "a test" $msg] [regexp "a really" $msg] \
$result1 $result2 [file exists a.tmp] [file delete a.tmp]
} {0 1 0 1 1 {}}
test tcltest-6.3 {tcltest -errfile a.tmp} {unixOrPc unixExecs} {
- catch {exec [interpreter] printerror.tcl -errfile a.tmp} msg
+ slave msg $printerror -errfile a.tmp
set result1 [catch {exec grep "a test" a.tmp}]
set result2 [catch {exec grep "a really" a.tmp}]
list [regexp "a test" $msg] [regexp "a really" $msg] \
$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} {
- catch {exec [interpreter] printerror.tcl -outfile a.tmp -errfile b.tmp} msg
+ slave msg printerror.tcl -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] \
@@ -431,6 +461,9 @@ test tcltest-6.8 {tcltest::outputFile (implicit outputFile)} {
}
# -debug, [debug]
+# Must use child processes to test -debug because it always writes
+# messages to stdout, and we have no way to capture stdout of a
+# slave interp
test tcltest-7.1 {tcltest test.tcl -debug 0} {unixOrPc} {
catch {exec [interpreter] test.tcl -debug 0} msg
regexp "Flags passed into tcltest" $msg
@@ -478,7 +511,7 @@ test tcltest-7.6 {tcltest::debug} {
makeFile {
package require tcltest
tcltest::makeFile {} a.tmp
- puts "testdir: [tcltest::testsDirectory]"
+ puts [tcltest::outputChannel] "testdir: [tcltest::testsDirectory]"
exit
} a.tcl
@@ -492,14 +525,14 @@ set normaldirectory [file normalize $normaldirectory]
# -tmpdir, [temporaryDirectory]
test tcltest-8.1 {tcltest a.tcl -tmpdir a} {unixOrPc} {
file delete -force thisdirectorydoesnotexist
- exec [interpreter] a.tcl -tmpdir thisdirectorydoesnotexist
+ slave msg a.tcl -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 {
- catch {exec [interpreter] a.tcl -tmpdir thisdirectoryisafile} msg
+ slave msg a.tcl -tmpdir thisdirectoryisafile
set msg
}
-result {*not a directory*}
@@ -524,17 +557,17 @@ switch $tcl_platform(platform) {
}
test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {unixOnly} {
- catch {exec [interpreter] a.tcl -tmpdir $notReadableDir} msg
+ slave msg a.tcl -tmpdir $notReadableDir
string match {*not readable*} $msg
} {1}
test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {unixOrPc} {
- catch {exec [interpreter] a.tcl -tmpdir $notWriteableDir} msg
+ slave msg a.tcl -tmpdir $notWriteableDir
string match {*not writeable*} $msg
} {1}
test tcltest-8.5 {tcltest a.tcl -tmpdir normaldirectory} {unixOrPc} {
- catch {exec [interpreter] a.tcl -tmpdir $normaldirectory} msg
+ slave msg a.tcl -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]]
@@ -574,23 +607,23 @@ cd [temporaryDirectory]
# -testdir, [testsDirectory]
test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} {unixOrPc} {
file delete -force thisdirectorydoesnotexist
- catch {exec [interpreter] a.tcl -testdir thisdirectorydoesnotexist} msg
+ slave msg a.tcl -testdir thisdirectorydoesnotexist
string match "*does not exist*" $msg
} {1}
test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} {unixOrPc} {
- catch {exec [interpreter] a.tcl -testdir thisdirectoryisafile} msg
+ slave msg a.tcl -testdir thisdirectoryisafile
string match "*not a directory*" $msg
} {1}
test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} {unixOnly} {
- catch {exec [interpreter] a.tcl -testdir $notReadableDir} msg
+ slave msg a.tcl -testdir $notReadableDir
string match {*not readable*} $msg
} {1}
test tcltest-8.13 {tcltest a.tcl -testdir normaldirectory} {unixOrPc} {
- catch {exec [interpreter] a.tcl -testdir $normaldirectory} msg
+ slave msg a.tcl -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]] \
@@ -659,14 +692,12 @@ file delete -force $notReadableDir $notWriteableDir
# -file, -notfile, [matchFiles], [skipFiles]
test tcltest-9.1 {-file a*.tcl} {unixOrPc} {
- catch {exec [interpreter] \
- [file join [testsDirectory] all.tcl] -file a*.test} msg
+ slave msg [file join [testsDirectory] all.tcl] -file a*.test
list [regexp assocd\.test $msg]
} {1}
test tcltest-9.2 {-file a*.tcl} {unixOrPc} {
- catch {exec [interpreter] \
- [file join [testsDirectory] all.tcl] \
- -file a*.test -notfile assocd*} msg
+ slave msg [file join [testsDirectory] all.tcl] \
+ -file a*.test -notfile assocd*
list [regexp assocd\.test $msg]
} {0}
@@ -710,23 +741,23 @@ makeFile {
cd [temporaryDirectory]
test tcltest-10.1 {-preservecore 0} {unixOrPc} {
- catch {exec [interpreter] makecore.tcl -preservecore 0} msg
+ slave msg makecore.tcl -preservecore 0
file delete core
regexp "Core file produced" $msg
} {0}
test tcltest-10.2 {-preservecore 1} {unixOrPc} {
- catch {exec [interpreter] makecore.tcl -preservecore 1} msg
+ slave msg makecore.tcl -preservecore 1
file delete core
regexp "Core file produced" $msg
} {1}
test tcltest-10.3 {-preservecore 2} {unixOrPc} {
- catch {exec [interpreter] makecore.tcl -preservecore 2} msg
+ slave msg makecore.tcl -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} {
- catch {exec [interpreter] makecore.tcl -preservecore 3} msg
+ slave msg makecore.tcl -preservecore 3
file delete core
list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \
[regexp "core-" $msg] [file delete core-makecore]
@@ -734,7 +765,7 @@ test tcltest-10.4 {-preservecore 3} {unixOrPc} {
# Removing this test. It makes no sense to test the ability of
# [preserveCore] to accept an invalid value that will cause errors
-# in other parts of tcltests' operation.
+# in other parts of tcltest's operation.
#test tcltest-10.5 {preserveCore} {
# -body {
# set old [preserveCore]
@@ -747,17 +778,20 @@ test tcltest-10.4 {-preservecore 3} {unixOrPc} {
#}
# -load, -loadfile, [loadScript], [loadFile]
-set loadfile [makeFile {
+set contents {
package require tcltest
- puts $::tcltest::loadScript
+ namespace import tcltest::*
+ puts [outputChannel] $::tcltest::loadScript
exit
-} load.tcl]
+}
+set loadfile [makeFile $contents load.tcl]
test tcltest-12.1 {-load xxx} {unixOrPc} {
- catch {exec [interpreter] load.tcl -load xxx} msg
+ slave msg load.tcl -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
list \
@@ -795,11 +829,7 @@ test tcltest-12.4 {loadFile} {
set f5 [loadFile]
list $f1 $f2 $f3 $f4 $f5
}
- -result "[list {} {} $loadfile {
- package require tcltest
- puts $::tcltest::loadScript
- exit
-} $loadfile]\n"
+ -result "[list {} {} $loadfile $contents $loadfile]\n"
-cleanup {
set ::tcltest::loadScript $olds
set ::tcltest::loadFile $oldf
@@ -845,7 +875,8 @@ cd [workingDirectory]
test tcltest-14.1 {-singleproc - single process} {
-constraints {unixOrPc}
-body {
- exec [interpreter] $allfile -singleproc 0 -tmpdir [temporaryDirectory]
+ slave msg $allfile -singleproc 0 -tmpdir [temporaryDirectory]
+ set msg
}
-result {Test file error: can't unset .foo.: no such variable}
-match regexp
@@ -854,7 +885,8 @@ test tcltest-14.1 {-singleproc - single process} {
test tcltest-14.2 {-singleproc - multiple process} {
-constraints {unixOrPc}
-body {
- exec [interpreter] $allfile -singleproc 1 -tmpdir [temporaryDirectory]
+ slave msg $allfile -singleproc 1 -tmpdir [temporaryDirectory]
+ set msg
}
-result {single1.test.*single2.test.*all\-single.tcl:.*Total.*0.*Passed.*0.*Skipped.*0.*Failed.*0}
-match regexp
@@ -914,7 +946,11 @@ makeFile {
test tcltest-15.1 {basic directory walking} {
-constraints {unixOrPc}
-body {
- exec [interpreter] [file join [temporaryDirectory] dirtestdir all.tcl] -tmpdir [temporaryDirectory]
+ if {[slave msg \
+ [file join [temporaryDirectory] dirtestdir all.tcl] \
+ -tmpdir [temporaryDirectory]] == 1} {
+ error $msg
+ }
}
-match regexp
-returnCodes 1
@@ -924,9 +960,12 @@ test tcltest-15.1 {basic directory walking} {
test tcltest-15.2 {-asidefromdir} {
-constraints {unixOrPc}
-body {
- exec [interpreter] \
+ if {[slave msg \
[file join [temporaryDirectory] dirtestdir all.tcl] \
- -asidefromdir dirtestdir2.3 -tmpdir [temporaryDirectory]
+ -asidefromdir dirtestdir2.3 \
+ -tmpdir [temporaryDirectory]] == 1} {
+ error $msg
+ }
}
-match regexp
-returnCodes 1
@@ -939,10 +978,12 @@ Error: No test files remain after applying your match and skip patterns!$}
test tcltest-15.3 {-relateddir, non-existent dir} {
-constraints {unixOrPc}
-body {
- exec [interpreter] \
+ if {[slave msg \
[file join [temporaryDirectory] dirtestdir all.tcl] \
-relateddir [file join [temporaryDirectory] dirtestdir0] \
- -tmpdir [temporaryDirectory]
+ -tmpdir [temporaryDirectory]] == 1} {
+ error $msg
+ }
}
-returnCodes 1
-match regexp
@@ -952,9 +993,11 @@ test tcltest-15.3 {-relateddir, non-existent dir} {
test tcltest-15.4 {-relateddir, subdir} {
-constraints {unixOrPc}
-body {
- exec [interpreter] \
+ if {[slave msg \
[file join [temporaryDirectory] dirtestdir all.tcl] \
- -relateddir dirtestdir2.1 -tmpdir [temporaryDirectory]
+ -relateddir dirtestdir2.1 -tmpdir [temporaryDirectory]] == 1} {
+ error $msg
+ }
}
-returnCodes 1
-match regexp
@@ -963,11 +1006,13 @@ test tcltest-15.4 {-relateddir, subdir} {
test tcltest-15.5 {-relateddir, -asidefromdir} {
-constraints {unixOrPc}
-body {
- exec [interpreter] \
+ if {[slave msg \
[file join [temporaryDirectory] dirtestdir all.tcl] \
-relateddir "dirtestdir2.1 dirtestdir2.2" \
-asidefromdir dirtestdir2.2 \
- -tmpdir [temporaryDirectory]
+ -tmpdir [temporaryDirectory]] == 1} {
+ error $msg
+ }
}
-match regexp
-returnCodes 1
@@ -1047,7 +1092,7 @@ test tcltest-19.1 {TCLTEST_OPTIONS default} {
cd [temporaryDirectory]
# PrintError
test tcltest-20.1 {PrintError} {unixOrPc} {
- set result [catch {exec [interpreter] printerror.tcl} msg]
+ set result [slave msg printerror.tcl]
list $result [regexp "Error: a really short string" $msg] \
[regexp " \"quotes\"" $msg] [regexp " \"Path" $msg] \
[regexp " \"Really" $msg] [regexp Problem $msg]
@@ -1278,10 +1323,14 @@ makeFile {
cleanupTests
} [file join alltestdir test.test]
+# Must use a child process because stdout/stderr parsing can't be
+# duplicated in slave interp.
test tcltest-22.1 {runAllTests} {
-constraints {unixOrPc}
-body {
- exec [interpreter] [file join [temporaryDirectory] alltestdir all.tcl] -verbose t -tmpdir [temporaryDirectory]
+ exec [interpreter] \
+ [file join [temporaryDirectory] alltestdir all.tcl] \
+ -verbose t -tmpdir [temporaryDirectory]
}
-match regexp
-result "Test files exiting with errors:.*error.test.*exit.test"