sl@0: # This file contains a collection of tests for one or more of the Tcl
sl@0: # built-in commands.  Sourcing this file into Tcl runs the tests and
sl@0: # generates output for errors.  No output means no errors were found.
sl@0: #
sl@0: # Copyright (c) 1998-1999 by Scriptics Corporation. 
sl@0: # Copyright (c) 2000 by Ajuba Solutions
sl@0: # All rights reserved.
sl@0: #
sl@0: # RCS: @(#) $Id: tcltest.test,v 1.37.2.11 2006/03/19 22:47:30 vincentdarley Exp $
sl@0: 
sl@0: # Note that there are several places where the value of 
sl@0: # tcltest::currentFailure is stored/reset in the -setup/-cleanup
sl@0: # of a test that has a body that runs [test] that will fail.
sl@0: # This is a workaround of using the same tcltest code that we are
sl@0: # testing to run the test itself.  Ditto on things like [verbose].
sl@0: #
sl@0: # It would be better to have the -body of the tests run the tcltest
sl@0: # commands in a slave interp so the [test] being tested would not
sl@0: # interfere with the [test] doing the testing.  
sl@0: #
sl@0: 
sl@0: if {[catch {package require tcltest 2.1}]} {
sl@0:     puts stderr "Skipping tests in [info script].  tcltest 2.1 required."
sl@0:     return
sl@0: }
sl@0: 
sl@0: namespace eval ::tcltest::test {
sl@0: 
sl@0: namespace import ::tcltest::*
sl@0: 
sl@0: makeFile {
sl@0:     package require tcltest
sl@0:     namespace import ::tcltest::test
sl@0:     test a-1.0 {test a} {
sl@0: 	list 0
sl@0:     } {0}
sl@0:     test b-1.0 {test b} {
sl@0: 	list 1
sl@0:     } {0}
sl@0:     test c-1.0 {test c} {knownBug} {
sl@0:     } {}
sl@0:     test d-1.0 {test d} {
sl@0: 	error "foo" foo 9
sl@0:     } {}
sl@0:     tcltest::cleanupTests
sl@0:     exit
sl@0: } test.tcl
sl@0: 
sl@0: cd [temporaryDirectory]
sl@0: testConstraint exec [llength [info commands exec]]
sl@0: # test -help
sl@0: # Child processes because -help [exit]s.
sl@0: test tcltest-1.1 {tcltest -help} {exec} {
sl@0:     set result [catch {exec [interpreter] test.tcl -help} msg]
sl@0:     list $result [regexp Usage $msg]
sl@0: } {1 1} 
sl@0: test tcltest-1.2 {tcltest -help -something} {exec} {
sl@0:     set result [catch {exec [interpreter] test.tcl -help -something} msg]
sl@0:     list $result [regexp Usage $msg]
sl@0: } {1 1}
sl@0: test tcltest-1.3 {tcltest -h} {exec} {
sl@0:     set result [catch {exec [interpreter] test.tcl -h} msg]
sl@0:     list $result [regexp Usage $msg]
sl@0: } {1 0} 
sl@0: 
sl@0: # -verbose, implicit & explicit testing of [verbose]
sl@0: proc slave {msgVar args} {
sl@0:     upvar 1 $msgVar msg
sl@0: 
sl@0:     interp create [namespace current]::i
sl@0:     # Fake the slave interp into dumping output to a file
sl@0:     i eval {namespace eval ::tcltest {}}
sl@0:     i eval "set tcltest::outputChannel\
sl@0: 	    \[[list open [set of [makeFile {} output]] w]]"
sl@0:     i eval "set tcltest::errorChannel\
sl@0: 	    \[[list open [set ef [makeFile {} error]] w]]"
sl@0:     i eval [list set argv0 [lindex $args 0]]
sl@0:     i eval [list set argv [lrange $args 1 end]]
sl@0:     i eval [list package ifneeded tcltest [package provide tcltest] \
sl@0: 	    [package ifneeded tcltest [package provide tcltest]]]
sl@0:     i eval {proc exit args {}}
sl@0: 
sl@0:     # Need to capture output in msg
sl@0: 
sl@0:     set code [catch {i eval {source $argv0}} foo]
sl@0: if $code {
sl@0: #puts "$code: $foo\n$::errorInfo"
sl@0: }
sl@0:     i eval {close $tcltest::outputChannel}
sl@0:     interp delete [namespace current]::i
sl@0:     set f [open $of]
sl@0:     set msg [read -nonewline $f]
sl@0:     close $f
sl@0:     set f [open $ef]
sl@0:     set err [read -nonewline $f]
sl@0:     close $f
sl@0:     removeFile output
sl@0:     removeFile error
sl@0:     if {[string length $err]} {
sl@0: 	set code 1
sl@0: 	append msg \n$err
sl@0:     }
sl@0:     return $code
sl@0: 
sl@0: #    return [catch {uplevel 1 [linsert $args 0  exec [interpreter]]} msg]
sl@0: }
sl@0: test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrPc} {
sl@0:     set result [slave msg test.tcl]
sl@0:     list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
sl@0: 	    [regexp c-1.0 $msg] \
sl@0: 	    [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
sl@0: } {0 1 0 0 1}
sl@0: test tcltest-2.1 {tcltest -verbose 'b'} {unixOrPc} {
sl@0:     set result [slave msg test.tcl -verbose 'b']
sl@0:     list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
sl@0: 	    [regexp c-1.0 $msg] \
sl@0: 	    [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
sl@0: } {0 1 0 0 1}
sl@0: test tcltest-2.2 {tcltest -verbose 'p'} {unixOrPc} {
sl@0:     set result [slave msg test.tcl -verbose 'p']
sl@0:     list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
sl@0: 	    [regexp c-1.0 $msg] \
sl@0: 	    [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
sl@0: } {0 0 1 0 1}
sl@0: test tcltest-2.3 {tcltest -verbose 's'} {unixOrPc} {
sl@0:     set result [slave msg test.tcl -verbose 's']
sl@0:     list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
sl@0: 	    [regexp c-1.0 $msg] \
sl@0: 	    [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
sl@0: } {0 0 0 1 1}
sl@0: test tcltest-2.4 {tcltest -verbose 'ps'} {unixOrPc} {
sl@0:     set result [slave msg test.tcl -verbose 'ps']
sl@0:     list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
sl@0: 	    [regexp c-1.0 $msg] \
sl@0: 	    [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
sl@0: } {0 0 1 1 1}
sl@0: test tcltest-2.5 {tcltest -verbose 'psb'} {unixOrPc} {
sl@0:     set result [slave msg test.tcl -verbose 'psb']
sl@0:     list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
sl@0: 	    [regexp c-1.0 $msg] \
sl@0: 	    [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
sl@0: } {0 1 1 1 1}
sl@0: 
sl@0: test tcltest-2.5a {tcltest -verbose 'pass skip body'} {unixOrPc} {
sl@0:     set result [slave msg test.tcl -verbose "pass skip body"]
sl@0:     list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
sl@0: 	    [regexp c-1.0 $msg] \
sl@0: 	    [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
sl@0: } {0 1 1 1 1}
sl@0: 
sl@0: test tcltest-2.6 {tcltest -verbose 't'}  {
sl@0:     -constraints {unixOrPc} 
sl@0:     -body {
sl@0: 	set result [slave msg test.tcl -verbose 't']
sl@0: 	list $result $msg
sl@0:     }
sl@0:     -result {^0 .*a-1.0 start.*b-1.0 start}
sl@0:     -match regexp
sl@0: }
sl@0: 
sl@0: test tcltest-2.6a {tcltest -verbose 'start'}  {
sl@0:     -constraints {unixOrPc} 
sl@0:     -body {
sl@0: 	set result [slave msg test.tcl -verbose start]
sl@0: 	list $result $msg
sl@0:     }
sl@0:     -result {^0 .*a-1.0 start.*b-1.0 start}
sl@0:     -match regexp
sl@0: }
sl@0: 
sl@0: test tcltest-2.7 {tcltest::verbose}  {
sl@0:     -body {
sl@0: 	set oldVerbosity [verbose]
sl@0: 	verbose bar
sl@0: 	set currentVerbosity [verbose]
sl@0: 	verbose foo
sl@0: 	set newVerbosity [verbose]
sl@0: 	verbose $oldVerbosity
sl@0: 	list $currentVerbosity $newVerbosity 
sl@0:     }
sl@0:     -result {body {}}
sl@0: }
sl@0: 
sl@0: test tcltest-2.8 {tcltest -verbose 'error'} {
sl@0:     -constraints {unixOrPc}
sl@0:     -body {
sl@0: 	set result [slave msg test.tcl -verbose error]
sl@0: 	list $result $msg
sl@0:     }
sl@0:     -result {errorInfo: foo.*errorCode: 9}
sl@0:     -match regexp
sl@0: }
sl@0: # -match, [match]
sl@0: test tcltest-3.1 {tcltest -match 'a*'} {unixOrPc} {
sl@0:     set result [slave msg test.tcl -match a* -verbose 'ps']
sl@0:     list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
sl@0: 	    [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
sl@0: } {0 1 0 0 1}
sl@0: test tcltest-3.2 {tcltest -match 'b*'} {unixOrPc} {
sl@0:     set result [slave msg test.tcl -match b* -verbose 'ps']
sl@0:     list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
sl@0: 	    [regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg]
sl@0: } {0 0 1 0 1}
sl@0: test tcltest-3.3 {tcltest -match 'c*'} {unixOrPc} {
sl@0:     set result [slave msg test.tcl -match c* -verbose 'ps']
sl@0:     list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
sl@0: 	    [regexp "Total.+4.+Passed.+0.+Skipped.+4.+Failed.+0" $msg]
sl@0: } {0 0 0 1 1}
sl@0: test tcltest-3.4 {tcltest -match 'a* b*'} {unixOrPc} {
sl@0:     set result [slave msg test.tcl -match {a* b*} -verbose 'ps']
sl@0:     list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
sl@0: 	    [regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg]
sl@0: } {0 1 1 0 1}
sl@0: 
sl@0: test tcltest-3.5 {tcltest::match}  {
sl@0:     -body {
sl@0: 	set oldMatch [match]
sl@0: 	match foo
sl@0: 	set currentMatch [match]
sl@0: 	match bar
sl@0: 	set newMatch [match]
sl@0: 	match $oldMatch
sl@0: 	list $currentMatch $newMatch
sl@0:     }
sl@0:     -result {foo bar}
sl@0: }
sl@0: 	
sl@0: # -skip, [skip]
sl@0: test tcltest-4.1 {tcltest -skip 'a*'} {unixOrPc} {
sl@0:     set result [slave msg test.tcl -skip a* -verbose 'ps']
sl@0:     list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
sl@0: 	    [regexp "Total.+4.+Passed.+0.+Skipped.+2.+Failed.+1" $msg]
sl@0: } {0 0 1 1 1}
sl@0: test tcltest-4.2 {tcltest -skip 'b*'} {unixOrPc} {
sl@0:     set result [slave msg test.tcl -skip b* -verbose 'ps']
sl@0:     list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
sl@0: 	    [regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg]
sl@0: } {0 1 0 1 1}
sl@0: test tcltest-4.3 {tcltest -skip 'c*'} {unixOrPc} {
sl@0:     set result [slave msg test.tcl -skip c* -verbose 'ps']
sl@0:     list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
sl@0: 	    [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
sl@0: } {0 1 1 0 1}
sl@0: test tcltest-4.4 {tcltest -skip 'a* b*'} {unixOrPc} {
sl@0:     set result [slave msg test.tcl -skip {a* b*} -verbose 'ps']
sl@0:     list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
sl@0: 	    [regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg]
sl@0: } {0 0 0 1 1}
sl@0: test tcltest-4.5 {tcltest -match 'a* b*' -skip 'b*'} {unixOrPc} {
sl@0:     set result [slave msg test.tcl -match {a* b*} -skip b* -verbose 'ps']
sl@0:     list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
sl@0: 	    [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
sl@0: } {0 1 0 0 1}
sl@0: 
sl@0: test tcltest-4.6 {tcltest::skip} {
sl@0:     -body {
sl@0: 	set oldSkip [skip]
sl@0: 	skip foo
sl@0: 	set currentSkip [skip]
sl@0: 	skip bar
sl@0: 	set newSkip [skip]
sl@0: 	skip $oldSkip
sl@0: 	list $currentSkip $newSkip
sl@0:     }
sl@0:     -result {foo bar}
sl@0: }
sl@0: 
sl@0: # -constraints, -limitconstraints, [testConstraint],
sl@0: # $constraintsSpecified, [limitConstraints]
sl@0: test tcltest-5.1 {tcltest -constraints 'knownBug'} {unixOrPc} {
sl@0:     set result [slave msg test.tcl -constraints knownBug -verbose 'ps']
sl@0:     list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
sl@0: 	    [regexp "Total.+4.+Passed.+2.+Skipped.+0.+Failed.+2" $msg]
sl@0: } {0 1 1 1 1}
sl@0: test tcltest-5.2 {tcltest -constraints 'knownBug' -limitconstraints 1} {unixOrPc} {
sl@0:     set result [slave msg test.tcl -constraints knownBug -verbose 'p' -limitconstraints 1]
sl@0:     list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
sl@0: 	    [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
sl@0: } {0 0 0 1 1}
sl@0: 
sl@0: test tcltest-5.3 {testConstraint - constraint empty (tcltest::safeFetch)}  {
sl@0:     -body {
sl@0: 	set r1 [testConstraint tcltestFakeConstraint]
sl@0: 	set r2 [testConstraint tcltestFakeConstraint 4]
sl@0: 	set r3 [testConstraint tcltestFakeConstraint]
sl@0: 	list $r1 $r2 $r3
sl@0:     }
sl@0:     -result {0 4 4}
sl@0:     -cleanup {unset ::tcltest::testConstraints(tcltestFakeConstraint)}
sl@0: }
sl@0: 
sl@0: # Removed this test of internals of tcltest.  Those internals have changed.
sl@0: #test tcltest-5.4 {tcltest::constraintsSpecified} {
sl@0: #    -setup {
sl@0: #	set constraintlist $::tcltest::constraintsSpecified
sl@0: #	set ::tcltest::constraintsSpecified {}
sl@0: #    }
sl@0: #    -body {
sl@0: #	set r1 $::tcltest::constraintsSpecified
sl@0: #	testConstraint tcltestFakeConstraint1 1
sl@0: #	set r2 $::tcltest::constraintsSpecified
sl@0: #	testConstraint tcltestFakeConstraint2 1
sl@0: #	set r3 $::tcltest::constraintsSpecified
sl@0: #	list $r1 $r2 $r3
sl@0: #    }
sl@0: #    -result {{} tcltestFakeConstraint1 {tcltestFakeConstraint1 tcltestFakeConstraint2}}
sl@0: #    -cleanup {
sl@0: #	set ::tcltest::constraintsSpecified $constraintlist
sl@0: #	unset ::tcltest::testConstraints(tcltestFakeConstraint1) 
sl@0: #	unset ::tcltest::testConstraints(tcltestFakeConstraint2) 
sl@0: #    }
sl@0: #}
sl@0: 
sl@0: test tcltest-5.5 {InitConstraints: list of built-in constraints} \
sl@0: 	-constraints {!singleTestInterp} \
sl@0: 	-setup {tcltest::InitConstraints} \
sl@0: 	-body { lsort [array names ::tcltest::testConstraints] } \
sl@0: 	-result [lsort {
sl@0:     95 98 asyncPipeClose eformat emptyTest exec hasIsoLocale interactive
sl@0:     knownBug mac macCrash macOnly macOrPc macOrUnix macOrWin nonBlockFiles
sl@0:     nonPortable notRoot nt pc pcCrash pcOnly root singleTestInterp socket
sl@0:     stdio tempNotMac tempNotPc tempNotUnix tempNotWin unix unixCrash unixExecs
sl@0:     unixOnly unixOrPc unixOrWin userInteraction win winCrash winOnly
sl@0: }]
sl@0: 
sl@0: # Removed this broken test.  Its usage of [limitConstraints] was not
sl@0: # in agreement with the documentation.  [limitConstraints] is supposed
sl@0: # to take an optional boolean argument, and "knownBug" ain't no boolean!
sl@0: #test tcltest-5.6 {tcltest::limitConstraints} {
sl@0: #    -setup {
sl@0: #        set keeplc $::tcltest::limitConstraints
sl@0: #        set keepkb [testConstraint knownBug]
sl@0: #    }
sl@0: #    -body {
sl@0: #        set r1 [limitConstraints]
sl@0: #        set r2 [limitConstraints knownBug]
sl@0: #        set r3 [limitConstraints]
sl@0: #        list $r1 $r2 $r3
sl@0: #    }
sl@0: #    -cleanup {
sl@0: #        limitConstraints $keeplc
sl@0: #        testConstraint knownBug $keepkb
sl@0: #    }
sl@0: #    -result {false knownBug knownBug}
sl@0: #}
sl@0: 
sl@0: # -outfile, -errfile, [outputChannel], [outputFile], [errorChannel], [errorFile]
sl@0: set printerror [makeFile {
sl@0:     package require tcltest
sl@0:     namespace import ::tcltest::*
sl@0:     puts [outputChannel] "a test"
sl@0:     ::tcltest::PrintError "a really short string"
sl@0:     ::tcltest::PrintError "a really really really really really really long \
sl@0: 	    string containing \"quotes\" and other bad bad stuff"
sl@0:     ::tcltest::PrintError "a really really long string containing a \
sl@0: 	    \"Path/that/is/really/long/and/contains/no/spaces\""
sl@0:     ::tcltest::PrintError "a really really long string containing a \
sl@0: 	    \"Really/Long/Path/that/contains/no/spaces/and/is/longer/than/eighty/characters/to/see/what/happens\"" 
sl@0:     ::tcltest::PrintError "Problem renaming file: error renaming \"Z:/ws/tcl8.2/win32-ix86/tests/core\" to \"Z:/ws/tcl8.2/win32-ix86/tests/movecore-core\""
sl@0:     exit
sl@0: } printerror.tcl]
sl@0: 
sl@0: test tcltest-6.1 {tcltest -outfile, -errfile defaults} {
sl@0:     -constraints unixOrPc
sl@0:     -body {
sl@0: 	slave msg $printerror
sl@0: 	return $msg
sl@0:     }
sl@0:     -result {a test.*a really}
sl@0:     -match regexp
sl@0: }
sl@0: test tcltest-6.2 {tcltest -outfile a.tmp} {unixOrPc unixExecs} {
sl@0:     slave msg $printerror -outfile a.tmp
sl@0:     set result1 [catch {exec grep "a test" a.tmp}]
sl@0:     set result2 [catch {exec grep "a really" a.tmp}]
sl@0:     list [regexp "a test" $msg] [regexp "a really" $msg] \
sl@0: 	    $result1 $result2 [file exists a.tmp] [file delete a.tmp] 
sl@0: } {0 1 0 1 1 {}}
sl@0: test tcltest-6.3 {tcltest -errfile a.tmp} {unixOrPc unixExecs} {
sl@0:     slave msg $printerror -errfile a.tmp
sl@0:     set result1 [catch {exec grep "a test" a.tmp}]
sl@0:     set result2 [catch {exec grep "a really" a.tmp}]
sl@0:     list [regexp "a test" $msg] [regexp "a really" $msg] \
sl@0: 	    $result1 $result2 [file exists a.tmp] [file delete a.tmp]
sl@0: } {1 0 1 0 1 {}}
sl@0: test tcltest-6.4 {tcltest -outfile a.tmp -errfile b.tmp} {unixOrPc unixExecs} {
sl@0:     slave msg $printerror -outfile a.tmp -errfile b.tmp
sl@0:     set result1 [catch {exec grep "a test" a.tmp}]
sl@0:     set result2 [catch {exec grep "a really" b.tmp}]
sl@0:     list [regexp "a test" $msg] [regexp "a really" $msg] \
sl@0: 	    $result1 $result2 \
sl@0: 	    [file exists a.tmp] [file delete a.tmp] \
sl@0: 	    [file exists b.tmp] [file delete b.tmp]
sl@0: } {0 0 0 0 1 {} 1 {}}
sl@0: 
sl@0: test tcltest-6.5 {tcltest::errorChannel - retrieval} {
sl@0:     -setup {
sl@0: 	set of [errorChannel]
sl@0: 	set ::tcltest::errorChannel stderr
sl@0:     }
sl@0:     -body {
sl@0: 	errorChannel
sl@0:     }
sl@0:     -result {stderr}
sl@0:     -cleanup {
sl@0: 	set ::tcltest::errorChannel $of
sl@0:     }
sl@0: }
sl@0: 
sl@0: test tcltest-6.6 {tcltest::errorFile (implicit errorChannel)} {
sl@0:     -setup {
sl@0: 	set ef [makeFile {} efile]
sl@0: 	set of [errorFile]
sl@0: 	set ::tcltest::errorChannel stderr
sl@0: 	set ::tcltest::errorFile stderr
sl@0:     }
sl@0:     -body {
sl@0: 	set f0 [errorChannel]
sl@0: 	set f1 [errorFile]
sl@0: 	set f2 [errorFile $ef]
sl@0: 	set f3 [errorChannel]
sl@0: 	set f4 [errorFile]
sl@0: 	subst {$f0;$f1;$f2;$f3;$f4} 
sl@0:     }
sl@0:     -result {stderr;stderr;.*efile;file[0-9a-f]+;.*efile}
sl@0:     -match regexp
sl@0:     -cleanup {
sl@0: 	errorFile $of
sl@0: 	removeFile efile
sl@0:     }
sl@0: }
sl@0: test tcltest-6.7 {tcltest::outputChannel - retrieval} {
sl@0:     -setup {
sl@0: 	set of [outputChannel]
sl@0: 	set ::tcltest::outputChannel stdout
sl@0:     }
sl@0:     -body {
sl@0: 	outputChannel
sl@0:     }
sl@0:     -result {stdout}
sl@0:     -cleanup {
sl@0: 	set tcltest::outputChannel $of
sl@0:     }
sl@0: }
sl@0: 
sl@0: test tcltest-6.8 {tcltest::outputFile (implicit outputFile)} {
sl@0:     -setup {
sl@0: 	set ef [makeFile {} efile]
sl@0: 	set of [outputFile]
sl@0: 	set ::tcltest::outputChannel stdout
sl@0: 	set ::tcltest::outputFile stdout
sl@0:     }
sl@0:     -body {
sl@0: 	set f0 [outputChannel]
sl@0: 	set f1 [outputFile]
sl@0: 	set f2 [outputFile $ef]
sl@0: 	set f3 [outputChannel]
sl@0: 	set f4 [outputFile]
sl@0: 	subst {$f0;$f1;$f2;$f3;$f4} 
sl@0:     }
sl@0:     -result {stdout;stdout;.*efile;file[0-9a-f]+;.*efile}
sl@0:     -match regexp
sl@0:     -cleanup {
sl@0: 	outputFile $of
sl@0: 	removeFile efile
sl@0:     }
sl@0: }
sl@0: 
sl@0: # -debug, [debug]
sl@0: # Must use child processes to test -debug because it always writes
sl@0: # messages to stdout, and we have no way to capture stdout of a
sl@0: # slave interp
sl@0: test tcltest-7.1 {tcltest test.tcl -debug 0} {unixOrPc} {
sl@0:     catch {exec [interpreter] test.tcl -debug 0} msg
sl@0:     regexp "Flags passed into tcltest" $msg
sl@0: } {0}
sl@0: test tcltest-7.2 {tcltest test.tcl -debug 1} {unixOrPc} {
sl@0:     catch {exec [interpreter] test.tcl -debug 1 -skip b*} msg
sl@0:     list [regexp userSpecifiedSkip $msg] \
sl@0: 	    [regexp "Flags passed into tcltest" $msg]
sl@0: } {1 0}
sl@0: test tcltest-7.3 {tcltest test.tcl -debug 1} {unixOrPc} {
sl@0:     catch {exec [interpreter] test.tcl -debug 1 -match b*} msg
sl@0:     list [regexp userSpecifiedNonMatch $msg] \
sl@0: 	    [regexp "Flags passed into tcltest" $msg]
sl@0: } {1 0}
sl@0: test tcltest-7.4 {tcltest test.tcl -debug 2} {unixOrPc} {
sl@0:     catch {exec [interpreter] test.tcl -debug 2} msg
sl@0:     list [regexp "Flags passed into tcltest" $msg] [regexp "Running" $msg]
sl@0: } {1 0}
sl@0: test tcltest-7.5 {tcltest test.tcl -debug 3} {unixOrPc} {
sl@0:     catch {exec [interpreter] test.tcl -debug 3} msg
sl@0:     list [regexp "Flags passed into tcltest" $msg] [regexp "Running" $msg]
sl@0: } {1 1}
sl@0: 
sl@0: test tcltest-7.6 {tcltest::debug} {
sl@0:     -setup {
sl@0: 	set old $::tcltest::debug
sl@0: 	set ::tcltest::debug 0
sl@0:     }
sl@0:     -body {
sl@0: 	set f1 [debug]
sl@0: 	set f2 [debug 1]
sl@0: 	set f3 [debug]
sl@0: 	set f4 [debug 2]
sl@0: 	set f5 [debug]
sl@0: 	list $f1 $f2 $f3 $f4 $f5
sl@0:     }
sl@0:     -result {0 1 1 2 2}
sl@0:     -cleanup {
sl@0: 	set ::tcltest::debug $old
sl@0:     }
sl@0: }
sl@0: removeFile test.tcl
sl@0: 
sl@0: # directory tests
sl@0: 
sl@0: set a [makeFile {
sl@0:     package require tcltest
sl@0:     tcltest::makeFile {} a.tmp
sl@0:     puts [tcltest::outputChannel] "testdir: [tcltest::testsDirectory]"
sl@0:     exit
sl@0: } a.tcl]
sl@0: 
sl@0: set tdiaf [makeFile {} thisdirectoryisafile]
sl@0: 
sl@0: set normaldirectory [makeDirectory normaldirectory]
sl@0: normalizePath normaldirectory
sl@0: 
sl@0: # -tmpdir, [temporaryDirectory]
sl@0: test tcltest-8.1 {tcltest a.tcl -tmpdir a} {unixOrPc} {
sl@0:     file delete -force thisdirectorydoesnotexist
sl@0:     slave msg $a -tmpdir thisdirectorydoesnotexist
sl@0:     list [file exists [file join thisdirectorydoesnotexist a.tmp]] \
sl@0: 	    [file delete -force thisdirectorydoesnotexist] 
sl@0: } {1 {}}
sl@0: test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} {
sl@0:     -constraints unixOrPc
sl@0:     -body {
sl@0: 	slave msg $a -tmpdir $tdiaf
sl@0: 	set msg
sl@0:     }
sl@0:     -result {*not a directory*}
sl@0:     -match glob
sl@0: }
sl@0: 
sl@0: # Test non-writeable directories, non-readable directories with directory flags
sl@0: set notReadableDir [file join [temporaryDirectory] notreadable]
sl@0: set notWriteableDir [file join [temporaryDirectory] notwriteable]
sl@0: 
sl@0: makeDirectory notreadable
sl@0: makeDirectory notwriteable
sl@0: 
sl@0: switch $tcl_platform(platform) {
sl@0:     "unix" {
sl@0: 	file attributes $notReadableDir -permissions 00333
sl@0: 	file attributes $notWriteableDir -permissions 00555
sl@0:     }
sl@0:     default {
sl@0: 	catch {file attributes $notWriteableDir -readonly 1}
sl@0: 	catch {testchmod 000 $notWriteableDir}
sl@0:     }
sl@0: }
sl@0: 
sl@0: test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {unix notRoot} {
sl@0:     slave msg $a -tmpdir $notReadableDir 
sl@0:     string match {*not readable*} $msg
sl@0: } {1}
sl@0: 
sl@0: test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {unixOrPc notRoot} {
sl@0:     slave msg $a -tmpdir $notWriteableDir
sl@0:     string match {*not writeable*} $msg
sl@0: } {1}
sl@0: 
sl@0: test tcltest-8.5 {tcltest a.tcl -tmpdir normaldirectory} {unixOrPc} {
sl@0:     slave msg $a -tmpdir $normaldirectory
sl@0:     # The join is necessary because the message can be split on multiple lines
sl@0:     list [file exists [file join $normaldirectory a.tmp]] \
sl@0: 	    [file delete [file join $normaldirectory a.tmp]] 
sl@0: } {1 {}}   
sl@0: cd [workingDirectory]
sl@0: 
sl@0: test tcltest-8.6 {temporaryDirectory}  {
sl@0:     -setup {
sl@0: 	set old $::tcltest::temporaryDirectory
sl@0: 	set ::tcltest::temporaryDirectory $normaldirectory
sl@0:     }
sl@0:     -body {
sl@0: 	set f1 [temporaryDirectory]
sl@0: 	set f2 [temporaryDirectory [workingDirectory]]
sl@0: 	set f3 [temporaryDirectory]
sl@0: 	list $f1 $f2 $f3
sl@0:     }
sl@0:     -result "[list $normaldirectory [workingDirectory] [workingDirectory]]"
sl@0:     -cleanup {
sl@0: 	set ::tcltest::temporaryDirectory $old
sl@0:     }
sl@0: }
sl@0: 
sl@0: test tcltest-8.6a {temporaryDirectory - test format 2} -setup {
sl@0:     set old $::tcltest::temporaryDirectory
sl@0:     set ::tcltest::temporaryDirectory $normaldirectory
sl@0: } -body {
sl@0:     set f1 [temporaryDirectory]
sl@0:     set f2 [temporaryDirectory [workingDirectory]]
sl@0:     set f3 [temporaryDirectory]
sl@0:     list $f1 $f2 $f3
sl@0: } -cleanup {
sl@0:     set ::tcltest::temporaryDirectory $old
sl@0: } -result [list $normaldirectory [workingDirectory] [workingDirectory]]
sl@0: 
sl@0: cd [temporaryDirectory]
sl@0: # -testdir, [testsDirectory]
sl@0: test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} {unixOrPc} {
sl@0:     file delete -force thisdirectorydoesnotexist
sl@0:     slave msg $a -testdir thisdirectorydoesnotexist
sl@0:     string match "*does not exist*" $msg
sl@0: } {1}
sl@0: 
sl@0: test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} {unixOrPc} {
sl@0:     slave msg $a -testdir $tdiaf
sl@0:     string match "*not a directory*" $msg 
sl@0: } {1}
sl@0: 
sl@0: test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} {unix notRoot} {
sl@0:     slave msg $a -testdir $notReadableDir 
sl@0:     string match {*not readable*} $msg
sl@0: } {1}
sl@0: 
sl@0: 
sl@0: test tcltest-8.13 {tcltest a.tcl -testdir normaldirectory} {unixOrPc} {
sl@0:     slave msg $a -testdir $normaldirectory
sl@0:     # The join is necessary because the message can be split on multiple lines
sl@0:     list [string first "testdir: $normaldirectory" [join $msg]] \
sl@0: 	    [file exists [file join [temporaryDirectory] a.tmp]] \
sl@0: 	    [file delete [file join [temporaryDirectory] a.tmp]] 
sl@0: } {0 1 {}} 
sl@0: cd [workingDirectory]
sl@0: 
sl@0: set current [pwd]
sl@0: test tcltest-8.14 {testsDirectory} {
sl@0:     -setup {
sl@0: 	set old $::tcltest::testsDirectory
sl@0: 	set ::tcltest::testsDirectory $normaldirectory
sl@0:     }
sl@0:     -body {
sl@0: 	set f1 [testsDirectory]
sl@0: 	set f2 [testsDirectory $current]
sl@0: 	set f3 [testsDirectory]
sl@0: 	list $f1 $f2 $f3
sl@0:     }
sl@0:     -result "[list $normaldirectory $current $current]"
sl@0:     -cleanup {
sl@0: 	set ::tcltest::testsDirectory $old
sl@0:     }
sl@0: }
sl@0: 
sl@0: # [workingDirectory]
sl@0: test tcltest-8.60 {::workingDirectory}  {
sl@0:     -setup {
sl@0: 	set old $::tcltest::workingDirectory
sl@0: 	set current [pwd]
sl@0: 	set ::tcltest::workingDirectory $normaldirectory
sl@0: 	cd $normaldirectory
sl@0:     }
sl@0:     -body {
sl@0: 	set f1 [workingDirectory]
sl@0: 	set f2 [pwd]
sl@0: 	set f3 [workingDirectory $current]
sl@0: 	set f4 [pwd] 
sl@0: 	set f5 [workingDirectory]
sl@0: 	list $f1 $f2 $f3 $f4 $f5
sl@0:     }
sl@0:     -result "[list $normaldirectory \
sl@0:                    $normaldirectory \
sl@0:                    $current \
sl@0:                    $current \
sl@0:                    $current]"
sl@0:     -cleanup {
sl@0: 	set ::tcltest::workingDirectory $old
sl@0: 	cd $current
sl@0:     }
sl@0: }
sl@0: 
sl@0: # clean up from directory testing
sl@0: 
sl@0: switch $tcl_platform(platform) {
sl@0:     "unix" {
sl@0: 	file attributes $notReadableDir -permissions 777
sl@0: 	file attributes $notWriteableDir -permissions 777
sl@0:     }
sl@0:     default {
sl@0: 	catch {file attributes $notWriteableDir -readonly 0}
sl@0:     }
sl@0: }
sl@0: 
sl@0: file delete -force $notReadableDir $notWriteableDir
sl@0: removeFile a.tcl
sl@0: removeFile thisdirectoryisafile
sl@0: removeDirectory normaldirectory
sl@0: 
sl@0: # -file, -notfile, [matchFiles], [skipFiles]
sl@0: test tcltest-9.1 {-file d*.tcl} -constraints {unixOrPc} -setup {
sl@0:     set old [testsDirectory]
sl@0:     testsDirectory [file dirname [info script]]
sl@0: } -body {
sl@0:     slave msg [file join [testsDirectory] all.tcl] -file d*.test
sl@0:     set msg
sl@0: } -cleanup {
sl@0:     testsDirectory $old
sl@0: } -match regexp -result {dstring\.test}
sl@0: 
sl@0: test tcltest-9.2 {-file d*.tcl} -constraints {unixOrPc} -setup {
sl@0:     set old [testsDirectory]
sl@0:     testsDirectory [file dirname [info script]]
sl@0: } -body {
sl@0:     slave msg [file join [testsDirectory] all.tcl] \
sl@0: 	    -file d*.test -notfile dstring*
sl@0:     regexp {dstring\.test} $msg
sl@0: } -cleanup {
sl@0:     testsDirectory $old
sl@0: } -result 0
sl@0: 
sl@0: test tcltest-9.3 {matchFiles}  {
sl@0:     -body {
sl@0: 	set old [matchFiles]
sl@0: 	matchFiles foo
sl@0: 	set current [matchFiles]
sl@0: 	matchFiles bar
sl@0: 	set new [matchFiles]
sl@0: 	matchFiles $old
sl@0: 	list $current $new
sl@0:     } 
sl@0:     -result {foo bar}
sl@0: }
sl@0: 
sl@0: test tcltest-9.4 {skipFiles} {
sl@0:     -body {
sl@0: 	set old [skipFiles]
sl@0: 	skipFiles foo
sl@0: 	set current [skipFiles]
sl@0: 	skipFiles bar
sl@0: 	set new [skipFiles]
sl@0: 	skipFiles $old
sl@0: 	list $current $new
sl@0:     } 
sl@0:     -result {foo bar}
sl@0: }
sl@0: 
sl@0: test tcltest-9.5 {GetMatchingFiles: Bug 1119798} -setup {
sl@0:     set d [makeDirectory tmp]
sl@0:     makeDirectory foo $d
sl@0:     makeFile {} fee $d
sl@0:     file copy [file join [file dirname [info script]] all.tcl] $d
sl@0: } -body {
sl@0:     slave msg [file join [temporaryDirectory] all.tcl] -file f*
sl@0:     regexp {exiting with errors:} $msg
sl@0: } -cleanup {
sl@0:     file delete [file join $d all.tcl]
sl@0:     removeFile fee $d
sl@0:     removeDirectory foo $d
sl@0:     removeDirectory tmp
sl@0: } -result 0
sl@0: 
sl@0: # -preservecore, [preserveCore]
sl@0: set mc [makeFile {
sl@0:     package require tcltest
sl@0:     namespace import ::tcltest::test
sl@0:     test makecore {make a core file} {
sl@0: 	set f [open core w]
sl@0: 	close $f
sl@0:     } {}
sl@0:     ::tcltest::cleanupTests
sl@0:     return
sl@0: } makecore.tcl]
sl@0: 
sl@0: cd [temporaryDirectory]
sl@0: test tcltest-10.1 {-preservecore 0} {unixOrPc} {
sl@0:     slave msg $mc -preservecore 0
sl@0:     file delete core
sl@0:     regexp "Core file produced" $msg
sl@0: } {0}
sl@0: test tcltest-10.2 {-preservecore 1} {unixOrPc} {
sl@0:     slave msg $mc -preservecore 1
sl@0:     file delete core
sl@0:     regexp "Core file produced" $msg
sl@0: } {1}
sl@0: test tcltest-10.3 {-preservecore 2} {unixOrPc} {
sl@0:     slave msg $mc -preservecore 2
sl@0:     file delete core
sl@0:     list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \
sl@0: 	    [regexp "core-" $msg] [file delete core-makecore]
sl@0: } {1 1 1 {}}
sl@0: test tcltest-10.4 {-preservecore 3} {unixOrPc} {
sl@0:     slave msg $mc -preservecore 3
sl@0:     file delete core
sl@0:     list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \
sl@0: 	    [regexp "core-" $msg] [file delete core-makecore]
sl@0: } {1 1 1 {}}
sl@0: 
sl@0: # Removing this test.  It makes no sense to test the ability of
sl@0: # [preserveCore] to accept an invalid value that will cause errors
sl@0: # in other parts of tcltest's operation.
sl@0: #test tcltest-10.5 {preserveCore} {
sl@0: #    -body {
sl@0: #	set old [preserveCore]
sl@0: #	set result [preserveCore foo]
sl@0: #	set result2 [preserveCore]
sl@0: #	preserveCore $old
sl@0: #	list $result $result2
sl@0: #    }
sl@0: #    -result {foo foo}
sl@0: #}
sl@0: removeFile makecore.tcl
sl@0: 
sl@0: # -load, -loadfile, [loadScript], [loadFile]
sl@0: set contents { 
sl@0:     package require tcltest
sl@0:     namespace import tcltest::*
sl@0:     puts [outputChannel] $::tcltest::loadScript
sl@0:     exit
sl@0: } 
sl@0: set loadfile [makeFile $contents load.tcl]
sl@0: 
sl@0: test tcltest-12.1 {-load xxx} {unixOrPc} {
sl@0:     slave msg $loadfile -load xxx
sl@0:     set msg
sl@0: } {xxx}
sl@0: 
sl@0: # Using child process because of -debug usage.
sl@0: test tcltest-12.2 {-loadfile load.tcl} {unixOrPc} {
sl@0:     catch {exec [interpreter] $loadfile -debug 2 -loadfile $loadfile} msg
sl@0:     list \
sl@0: 	    [regexp {tcltest} [join [list $msg] [split $msg \n]]] \
sl@0: 	    [regexp {loadScript} [join [list $msg] [split $msg \n]]]
sl@0: } {1 1}
sl@0: 
sl@0: test tcltest-12.3 {loadScript} {
sl@0:     -setup {
sl@0: 	set old $::tcltest::loadScript
sl@0: 	set ::tcltest::loadScript {}
sl@0:     }
sl@0:     -body {
sl@0: 	set f1 [loadScript]
sl@0: 	set f2 [loadScript xxx]
sl@0: 	set f3 [loadScript]
sl@0: 	list $f1 $f2 $f3
sl@0:     }
sl@0:     -result {{} xxx xxx}
sl@0:     -cleanup {
sl@0: 	set ::tcltest::loadScript $old
sl@0:     }
sl@0: }
sl@0: 
sl@0: test tcltest-12.4 {loadFile} {
sl@0:     -setup {
sl@0: 	set olds $::tcltest::loadScript
sl@0: 	set ::tcltest::loadScript {}
sl@0: 	set oldf $::tcltest::loadFile
sl@0: 	set ::tcltest::loadFile {}
sl@0:     }
sl@0:     -body {
sl@0: 	set f1 [loadScript]
sl@0: 	set f2 [loadFile]
sl@0: 	set f3 [loadFile $loadfile]
sl@0: 	set f4 [loadScript]
sl@0: 	set f5 [loadFile]
sl@0: 	list $f1 $f2 $f3 $f4 $f5
sl@0:     }
sl@0:     -result "[list {} {} $loadfile $contents $loadfile]\n"
sl@0:     -cleanup {
sl@0: 	set ::tcltest::loadScript $olds
sl@0: 	set ::tcltest::loadFile $oldf
sl@0:     }
sl@0: }
sl@0: removeFile load.tcl
sl@0: 
sl@0: # [interpreter]
sl@0: test tcltest-13.1 {interpreter} {
sl@0:     -setup {
sl@0: 	set old $::tcltest::tcltest
sl@0: 	set ::tcltest::tcltest tcltest
sl@0:     }
sl@0:     -body {
sl@0: 	set f1 [interpreter]
sl@0: 	set f2 [interpreter tclsh]
sl@0: 	set f3 [interpreter]
sl@0: 	list $f1 $f2 $f3
sl@0:     }
sl@0:     -result {tcltest tclsh tclsh}
sl@0:     -cleanup {
sl@0: 	set ::tcltest::tcltest $old
sl@0:     }
sl@0: }
sl@0: 
sl@0: # -singleproc, [singleProcess]
sl@0: set spd [makeDirectory singleprocdir]
sl@0: makeFile {
sl@0:     set foo 1
sl@0: } single1.test $spd
sl@0: 
sl@0: makeFile {
sl@0:     unset foo
sl@0: } single2.test $spd
sl@0: 
sl@0: set allfile [makeFile {
sl@0:     package require tcltest
sl@0:     namespace import tcltest::*
sl@0:     testsDirectory [file join [temporaryDirectory] singleprocdir]
sl@0:     runAllTests
sl@0: } all-single.tcl $spd]
sl@0: cd [workingDirectory]
sl@0: 
sl@0: test tcltest-14.1 {-singleproc - single process} {
sl@0:     -constraints {unixOrPc}
sl@0:     -body {
sl@0: 	slave msg $allfile -singleproc 0 -tmpdir [temporaryDirectory]
sl@0: 	set msg
sl@0:     }
sl@0:     -result {Test file error: can't unset .foo.: no such variable}
sl@0:     -match regexp
sl@0: }
sl@0: 
sl@0: test tcltest-14.2 {-singleproc - multiple process} {
sl@0:     -constraints {unixOrPc}
sl@0:     -body {
sl@0: 	slave msg $allfile -singleproc 1 -tmpdir [temporaryDirectory]
sl@0: 	set msg
sl@0:     }
sl@0:     -result {single1.test.*single2.test.*all\-single.tcl:.*Total.*0.*Passed.*0.*Skipped.*0.*Failed.*0}
sl@0:     -match regexp
sl@0: }
sl@0: 
sl@0: test tcltest-14.3 {singleProcess} {
sl@0:     -setup {
sl@0: 	set old $::tcltest::singleProcess
sl@0: 	set ::tcltest::singleProcess 0
sl@0:     }
sl@0:     -body {
sl@0: 	set f1 [singleProcess]
sl@0: 	set f2 [singleProcess 1]
sl@0: 	set f3 [singleProcess]
sl@0: 	list $f1 $f2 $f3
sl@0:     }
sl@0:     -result {0 1 1}
sl@0:     -cleanup {
sl@0: 	set ::tcltest::singleProcess $old
sl@0:     }
sl@0: }
sl@0: removeFile single1.test $spd
sl@0: removeFile single2.test $spd
sl@0: removeDirectory singleprocdir
sl@0: 
sl@0: # -asidefromdir, -relateddir, [matchDirectories], [skipDirectories]
sl@0: 
sl@0: # Before running these tests, need to set up test subdirectories with their own
sl@0: # all.tcl files.
sl@0: 
sl@0: set dtd [makeDirectory dirtestdir]
sl@0: set dtd1 [makeDirectory dirtestdir2.1 $dtd]
sl@0: set dtd2 [makeDirectory dirtestdir2.2 $dtd]
sl@0: set dtd3 [makeDirectory dirtestdir2.3 $dtd]
sl@0: makeFile {
sl@0:     package require tcltest
sl@0:     namespace import -force tcltest::*
sl@0:     testsDirectory [file join [temporaryDirectory] dirtestdir]
sl@0:     runAllTests
sl@0: } all.tcl $dtd
sl@0: makeFile {
sl@0:     package require tcltest
sl@0:     namespace import -force tcltest::*
sl@0:     testsDirectory [file join [temporaryDirectory] dirtestdir dirtestdir2.1]
sl@0:     runAllTests
sl@0: } all.tcl $dtd1
sl@0: makeFile {
sl@0:     package require tcltest
sl@0:     namespace import -force tcltest::*
sl@0:     testsDirectory [file join [temporaryDirectory]  dirtestdir dirtestdir2.2]
sl@0:     runAllTests
sl@0: } all.tcl $dtd2
sl@0: makeFile {
sl@0:     package require tcltest
sl@0:     namespace import -force tcltest::*
sl@0:     testsDirectory [file join [temporaryDirectory] dirtestdir dirtestdir2.3]
sl@0:     runAllTests
sl@0: } all.tcl $dtd3
sl@0: 
sl@0: test tcltest-15.1 {basic directory walking} {
sl@0:     -constraints {unixOrPc}
sl@0:     -body {
sl@0: 	if {[slave msg \
sl@0: 		[file join $dtd all.tcl] \
sl@0: 		-tmpdir [temporaryDirectory]] == 1} {
sl@0: 	    error $msg
sl@0: 	}
sl@0:     }
sl@0:     -match regexp
sl@0:     -returnCodes 1
sl@0:     -result {Tests located in:.*dirtestdir.*Tests located in:.*dirtestdir2.[123].*Tests located in:.*dirtestdir2.[123].*Tests located in:.*dirtestdir2.[123]}
sl@0: }
sl@0: 
sl@0: test tcltest-15.2 {-asidefromdir} {
sl@0:     -constraints {unixOrPc}
sl@0:     -body {
sl@0: 	if {[slave msg \
sl@0: 		[file join $dtd all.tcl] \
sl@0: 		-asidefromdir dirtestdir2.3 \
sl@0: 		-tmpdir [temporaryDirectory]] == 1} {
sl@0: 	    error $msg
sl@0: 	}
sl@0:     }
sl@0:     -match regexp
sl@0:     -returnCodes 1
sl@0:     -result {Tests located in:.*dirtestdir.*Tests located in:.*dirtestdir2.[12].*Tests located in:.*dirtestdir2.[12].*dirtestdir2.[12] test ended at .*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sl@0: Error:  No test files remain after applying your match and skip patterns!
sl@0: Error:  No test files remain after applying your match and skip patterns!
sl@0: Error:  No test files remain after applying your match and skip patterns!$}
sl@0: }
sl@0: 
sl@0: test tcltest-15.3 {-relateddir, non-existent dir} {
sl@0:     -constraints {unixOrPc}
sl@0:     -body {
sl@0: 	if {[slave msg \
sl@0: 		[file join $dtd all.tcl] \
sl@0: 		-relateddir [file join [temporaryDirectory] dirtestdir0] \
sl@0: 		-tmpdir [temporaryDirectory]] == 1} {
sl@0: 	    error $msg
sl@0: 	}
sl@0:     }
sl@0:     -returnCodes 1
sl@0:     -match regexp
sl@0:     -result {[^~]|dirtestdir[^2]}
sl@0: }
sl@0: 
sl@0: test tcltest-15.4 {-relateddir, subdir} {
sl@0:     -constraints {unixOrPc}
sl@0:     -body {
sl@0: 	if {[slave msg \
sl@0: 		[file join $dtd all.tcl] \
sl@0: 		-relateddir dirtestdir2.1 -tmpdir [temporaryDirectory]] == 1} {
sl@0: 	    error $msg
sl@0: 	}
sl@0:     }
sl@0:     -returnCodes 1
sl@0:     -match regexp
sl@0:     -result {Tests located in:.*dirtestdir2.[^23]}
sl@0: }
sl@0: test tcltest-15.5 {-relateddir, -asidefromdir} {
sl@0:     -constraints {unixOrPc}
sl@0:     -body {
sl@0: 	if {[slave msg \
sl@0: 		[file join $dtd all.tcl] \
sl@0: 		-relateddir "dirtestdir2.1 dirtestdir2.2" \
sl@0: 		-asidefromdir dirtestdir2.2 \
sl@0: 		-tmpdir [temporaryDirectory]] == 1} {
sl@0: 	    error $msg
sl@0: 	}
sl@0:     }
sl@0:     -match regexp
sl@0:     -returnCodes 1
sl@0:     -result {Tests located in:.*dirtestdir2.[^23]}
sl@0: }
sl@0: 
sl@0: test tcltest-15.6 {matchDirectories} {
sl@0:     -setup {
sl@0: 	set old [matchDirectories]
sl@0: 	set ::tcltest::matchDirectories {}
sl@0:     }
sl@0:     -body {
sl@0: 	set r1 [matchDirectories]
sl@0: 	set r2 [matchDirectories foo]
sl@0: 	set r3 [matchDirectories]
sl@0: 	list $r1 $r2 $r3
sl@0:     }
sl@0:     -cleanup {
sl@0: 	set ::tcltest::matchDirectories $old
sl@0:     }
sl@0:     -result {{} foo foo}
sl@0: }
sl@0: 
sl@0: test tcltest-15.7 {skipDirectories} {
sl@0:     -setup {
sl@0: 	set old [skipDirectories]
sl@0: 	set ::tcltest::skipDirectories {}
sl@0:     }
sl@0:     -body {
sl@0: 	set r1 [skipDirectories]
sl@0: 	set r2 [skipDirectories foo]
sl@0: 	set r3 [skipDirectories]
sl@0: 	list $r1 $r2 $r3
sl@0:     }
sl@0:     -cleanup {
sl@0: 	set ::tcltest::skipDirectories $old
sl@0:     }
sl@0:     -result {{} foo foo}
sl@0: }
sl@0: removeDirectory dirtestdir2.3 $dtd
sl@0: removeDirectory dirtestdir2.2 $dtd
sl@0: removeDirectory dirtestdir2.1 $dtd
sl@0: removeDirectory dirtestdir
sl@0: 
sl@0: # TCLTEST_OPTIONS
sl@0: test tcltest-19.1 {TCLTEST_OPTIONS default} -setup {
sl@0: 	if {[info exists ::env(TCLTEST_OPTIONS)]} {
sl@0: 	    set oldoptions $::env(TCLTEST_OPTIONS)
sl@0: 	} else {
sl@0: 	    set oldoptions none
sl@0: 	}
sl@0: 	# set this to { } instead of just {} to get around quirk in
sl@0: 	# Windows env handling that removes empty elements from env array.
sl@0: 	set ::env(TCLTEST_OPTIONS) { }
sl@0: 	interp create slave1
sl@0: 	slave1 eval [list set argv {-debug 2}]
sl@0: 	slave1 alias puts puts
sl@0: 	interp create slave2
sl@0: 	slave2 alias puts puts
sl@0:     } -cleanup {
sl@0: 	interp delete slave2
sl@0: 	interp delete slave1
sl@0: 	if {$oldoptions == "none"} {
sl@0: 	    unset ::env(TCLTEST_OPTIONS) 
sl@0: 	} else {
sl@0: 	    set ::env(TCLTEST_OPTIONS) $oldoptions
sl@0: 	}
sl@0:     } -body {
sl@0: 	slave1 eval [package ifneeded tcltest [package provide tcltest]]
sl@0: 	slave1 eval tcltest::debug
sl@0: 	set ::env(TCLTEST_OPTIONS) "-debug 3"
sl@0: 	slave2 eval [package ifneeded tcltest [package provide tcltest]]
sl@0: 	slave2 eval tcltest::debug
sl@0:     } -result {^3$} -match regexp -output\
sl@0: {tcltest::debug\s+= 2.*tcltest::debug\s+= 3}
sl@0: 
sl@0: # Begin testing of tcltest procs ...
sl@0: 
sl@0: cd [temporaryDirectory]
sl@0: # PrintError
sl@0: test tcltest-20.1 {PrintError} {unixOrPc} {
sl@0:     set result [slave msg $printerror]
sl@0:     list $result [regexp "Error:  a really short string" $msg] \
sl@0: 	    [regexp "     \"quotes\"" $msg] [regexp "    \"Path" $msg] \
sl@0: 	    [regexp "    \"Really" $msg] [regexp Problem $msg]
sl@0: } {1 1 1 1 1 1}
sl@0: cd [workingDirectory]
sl@0: removeFile printerror.tcl
sl@0: 
sl@0: # test::test
sl@0: test tcltest-21.0 {name and desc but no args specified} -setup {
sl@0:     set v [verbose]
sl@0: } -cleanup {
sl@0:     verbose $v
sl@0: } -body {
sl@0:    verbose {}
sl@0:    test tcltest-21.0.0 bar
sl@0: } -result {}
sl@0: 
sl@0: test tcltest-21.1 {expect with glob} {
sl@0:     -body {
sl@0: 	list a b c d e
sl@0:     }
sl@0:     -match glob
sl@0:     -result {[ab] b c d e}
sl@0: }
sl@0: 
sl@0: test tcltest-21.2 {force a test command failure} {
sl@0:     -body {
sl@0: 	test tcltest-21.2.0 {
sl@0: 	    return 2
sl@0: 	} {1}
sl@0:     }
sl@0:     -returnCodes 1
sl@0:     -result {bad option "1": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
sl@0: }
sl@0: 
sl@0: test tcltest-21.3 {test command with setup} {
sl@0:     -setup {
sl@0: 	set foo 1
sl@0:     }
sl@0:     -body {
sl@0: 	set foo
sl@0:     }
sl@0:     -cleanup {unset foo}
sl@0:     -result {1}
sl@0: }
sl@0: 
sl@0: test tcltest-21.4 {test command with cleanup failure} {
sl@0:     -setup {
sl@0: 	if {[info exists foo]} {
sl@0: 	    unset foo
sl@0: 	}
sl@0: 	set fail $::tcltest::currentFailure
sl@0: 	set v [verbose]
sl@0:     }
sl@0:     -body {
sl@0: 	verbose {}
sl@0: 	test tcltest-21.4.0 {foo-1} {
sl@0: 	    -cleanup {unset foo}
sl@0: 	}
sl@0:     }
sl@0:     -result {^$}
sl@0:     -match regexp
sl@0:     -cleanup {verbose $v; set ::tcltest::currentFailure $fail}
sl@0:     -output "Test cleanup failed:.*can't unset \"foo\": no such variable"
sl@0: }
sl@0: 
sl@0: test tcltest-21.5 {test command with setup failure} {
sl@0:     -setup {
sl@0: 	if {[info exists foo]} {
sl@0: 	    unset foo
sl@0: 	}
sl@0: 	set fail $::tcltest::currentFailure
sl@0:     }
sl@0:     -body {
sl@0: 	test tcltest-21.5.0 {foo-2} {
sl@0: 	    -setup {unset foo}
sl@0: 	}
sl@0:     }
sl@0:     -result {^$}
sl@0:     -match regexp
sl@0:     -cleanup {set ::tcltest::currentFailure $fail}
sl@0:     -output "Test setup failed:.*can't unset \"foo\": no such variable"
sl@0: }
sl@0: 
sl@0: test tcltest-21.6 {test command - setup occurs before cleanup & before script} {
sl@0:     -setup {set v [verbose]; set fail $::tcltest::currentFailure}
sl@0:     -body {
sl@0: 	verbose {}
sl@0: 	test tcltest-21.6.0 {foo-3} {
sl@0: 	    -setup {
sl@0: 		if {[info exists foo]} {
sl@0: 		    unset foo
sl@0: 		}
sl@0: 		set foo 1
sl@0: 		set expected 2
sl@0: 	    } 
sl@0: 	    -body {
sl@0: 		incr foo
sl@0: 		set foo
sl@0: 	    }
sl@0: 	    -cleanup {
sl@0: 		if {$foo != 2} {
sl@0: 		    puts [outputChannel] "foo is wrong"
sl@0: 		} else {
sl@0: 		    puts [outputChannel] "foo is 2"
sl@0: 		}
sl@0: 	    }
sl@0: 	    -result {$expected}
sl@0: 	}
sl@0:     }
sl@0:     -cleanup {verbose $v; set ::tcltest::currentFailure $fail}
sl@0:     -result {^$}
sl@0:     -match regexp
sl@0:     -output "foo is 2"
sl@0: }
sl@0: 
sl@0: test tcltest-21.7 {test command - bad flag} {
sl@0:     -setup {set fail $::tcltest::currentFailure}
sl@0:     -cleanup {set ::tcltest::currentFailure $fail}
sl@0:     -body {
sl@0: 	test tcltest-21.7.0 {foo-4} {
sl@0: 	    -foobar {}
sl@0: 	}
sl@0:     }
sl@0:     -returnCodes 1
sl@0:     -result {bad option "-foobar": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
sl@0: }
sl@0: 
sl@0: # alternate test command format (these are the same as 21.1-21.6, with the
sl@0: # exception of being in the all-inline format)
sl@0: 
sl@0: test tcltest-21.7a {expect with glob} \
sl@0: 	-body {list a b c d e} \
sl@0: 	-result {[ab] b c d e} \
sl@0: 	-match glob
sl@0: 
sl@0: test tcltest-21.8 {force a test command failure} \
sl@0:     -setup {set fail $::tcltest::currentFailure} \
sl@0:     -body {
sl@0:         test tcltest-21.8.0 {
sl@0:             return 2
sl@0:         } {1}
sl@0:     } \
sl@0:     -returnCodes 1 \
sl@0:     -cleanup {set ::tcltest::currentFailure $fail} \
sl@0:     -result {bad option "1": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
sl@0: 
sl@0: test tcltest-21.9 {test command with setup} \
sl@0: 	-setup {set foo 1} \
sl@0: 	-body {set foo} \
sl@0: 	-cleanup {unset foo} \
sl@0: 	-result {1}
sl@0: 
sl@0: test tcltest-21.10 {test command with cleanup failure} -setup {
sl@0:     if {[info exists foo]} {
sl@0: 	unset foo
sl@0:     }
sl@0:     set fail $::tcltest::currentFailure
sl@0:     set v [verbose]
sl@0: } -cleanup {
sl@0:     verbose $v
sl@0:     set ::tcltest::currentFailure $fail
sl@0: } -body {
sl@0:     verbose {}
sl@0:     test tcltest-21.10.0 {foo-1} -cleanup {unset foo}
sl@0: } -result {^$} -match regexp \
sl@0: 	-output {Test cleanup failed:.*can't unset \"foo\": no such variable}
sl@0: 
sl@0: test tcltest-21.11 {test command with setup failure} -setup {
sl@0:     if {[info exists foo]} {
sl@0: 	unset foo
sl@0:     }
sl@0:     set fail $::tcltest::currentFailure
sl@0: } -cleanup {set ::tcltest::currentFailure $fail} -body {
sl@0:     test tcltest-21.11.0 {foo-2} -setup {unset foo}
sl@0: } -result {^$} -output {Test setup failed:.*can't unset \"foo\": no such variable} -match regexp
sl@0: 
sl@0: test tcltest-21.12 {
sl@0: 	test command - setup occurs before cleanup & before script
sl@0: } -setup {
sl@0: 	set fail $::tcltest::currentFailure
sl@0: 	set v [verbose]
sl@0: } -cleanup {
sl@0: 	verbose $v
sl@0: 	set ::tcltest::currentFailure $fail
sl@0: } -body {
sl@0:     verbose {}
sl@0:     test tcltest-21.12.0 {foo-3} -setup {
sl@0: 	if {[info exists foo]} {
sl@0: 	    unset foo
sl@0: 	}
sl@0: 	set foo 1
sl@0: 	set expected 2
sl@0:     }  -body {
sl@0: 	incr foo
sl@0: 	set foo
sl@0:     }  -cleanup {
sl@0: 	if {$foo != 2} {
sl@0: 	    puts [outputChannel] "foo is wrong"
sl@0: 	} else {
sl@0: 	    puts [outputChannel] "foo is 2"
sl@0: 	}
sl@0:     }  -result {$expected}
sl@0: } -result {^$} -output {foo is 2} -match regexp
sl@0: 
sl@0: # test all.tcl usage (runAllTests); simulate .test file failure, as well as
sl@0: # crashes to determine whether or not these errors are logged.
sl@0: 
sl@0: set atd [makeDirectory alltestdir]
sl@0: makeFile {
sl@0:     package require tcltest
sl@0:     namespace import -force tcltest::*
sl@0:     testsDirectory [file join [temporaryDirectory] alltestdir]
sl@0:     runAllTests
sl@0: } all.tcl $atd
sl@0: makeFile {
sl@0:     exit 1
sl@0: } exit.test $atd
sl@0: makeFile {
sl@0:     error "throw an error"
sl@0: } error.test $atd
sl@0: makeFile {
sl@0:     package require tcltest
sl@0:     namespace import -force tcltest::*
sl@0:     test foo-1.1 {foo} {
sl@0: 	-body { return 1 }
sl@0: 	-result {1}
sl@0:     }
sl@0:     cleanupTests
sl@0: } test.test $atd
sl@0: 
sl@0: # Must use a child process because stdout/stderr parsing can't be
sl@0: # duplicated in slave interp.
sl@0: test tcltest-22.1 {runAllTests} {
sl@0:     -constraints {unixOrPc}
sl@0:     -body {
sl@0: 	exec [interpreter] \
sl@0: 		[file join $atd all.tcl] \
sl@0: 		-verbose t -tmpdir [temporaryDirectory]
sl@0:     }
sl@0:     -match regexp
sl@0:     -result "Test files exiting with errors:.*error.test.*exit.test"
sl@0: }
sl@0: removeDirectory alltestdir
sl@0: 
sl@0: # makeFile, removeFile, makeDirectory, removeDirectory, viewFile
sl@0: test tcltest-23.1 {makeFile} {
sl@0:     -setup {
sl@0: 	set mfdir [file join [temporaryDirectory] mfdir]
sl@0: 	file mkdir $mfdir
sl@0:     }
sl@0:     -body {
sl@0: 	makeFile {} t1.tmp
sl@0: 	makeFile {} et1.tmp $mfdir
sl@0: 	list [file exists [file join [temporaryDirectory] t1.tmp]] \
sl@0: 		[file exists [file join $mfdir et1.tmp]]
sl@0:     }
sl@0:     -cleanup {
sl@0: 	file delete -force $mfdir \
sl@0: 		[file join [temporaryDirectory] t1.tmp] 
sl@0:     }
sl@0:     -result {1 1}
sl@0: }
sl@0: test tcltest-23.2 {removeFile} {
sl@0:     -setup {
sl@0: 	set mfdir [file join [temporaryDirectory] mfdir]
sl@0: 	file mkdir $mfdir
sl@0: 	makeFile {} t1.tmp
sl@0: 	makeFile {} et1.tmp $mfdir
sl@0: 	if  {![file exists [file join [temporaryDirectory] t1.tmp]] || \
sl@0: 		![file exists [file join $mfdir et1.tmp]]} {
sl@0: 	    error "file creation didn't work"
sl@0: 	}
sl@0:     }
sl@0:     -body {
sl@0: 	removeFile t1.tmp
sl@0: 	removeFile et1.tmp $mfdir
sl@0: 	list [file exists [file join [temporaryDirectory] t1.tmp]] \
sl@0: 		[file exists [file join $mfdir et1.tmp]]
sl@0:     }
sl@0:     -cleanup {
sl@0: 	file delete -force $mfdir \
sl@0: 		[file join [temporaryDirectory] t1.tmp] 
sl@0:     }
sl@0:     -result {0 0}
sl@0: }
sl@0: test tcltest-23.3 {makeDirectory} {
sl@0:     -body {
sl@0: 	set mfdir [file join [temporaryDirectory] mfdir]
sl@0: 	file mkdir $mfdir
sl@0: 	makeDirectory d1
sl@0: 	makeDirectory d2 $mfdir
sl@0: 	list [file exists [file join [temporaryDirectory] d1]] \
sl@0: 		[file exists [file join $mfdir d2]]
sl@0:     }
sl@0:     -cleanup {
sl@0: 	file delete -force [file join [temporaryDirectory] d1] $mfdir
sl@0:     }
sl@0:     -result {1 1}
sl@0: }
sl@0: test tcltest-23.4 {removeDirectory} {
sl@0:     -setup {
sl@0: 	set mfdir [makeDirectory mfdir]
sl@0: 	makeDirectory t1
sl@0: 	makeDirectory t2 $mfdir
sl@0: 	if {![file exists $mfdir] || \
sl@0: 		![file exists [file join [temporaryDirectory] $mfdir t2]]} {
sl@0: 	    error "setup failed - directory not created"
sl@0: 	}
sl@0:     }
sl@0:     -body {
sl@0: 	removeDirectory t1
sl@0: 	removeDirectory t2 $mfdir
sl@0: 	list [file exists [file join [temporaryDirectory] t1]] \
sl@0: 		[file exists [file join $mfdir t2]]
sl@0:     }
sl@0:     -result {0 0}
sl@0: }
sl@0: test tcltest-23.5 {viewFile} {
sl@0:     -body {
sl@0: 	set mfdir [file join [temporaryDirectory] mfdir]
sl@0: 	file mkdir $mfdir
sl@0: 	makeFile {foobar} t1.tmp
sl@0: 	makeFile {foobarbaz} t2.tmp $mfdir
sl@0: 	list [viewFile t1.tmp] [viewFile t2.tmp $mfdir]
sl@0:     }
sl@0:     -result {foobar foobarbaz}
sl@0:     -cleanup {
sl@0: 	file delete -force $mfdir
sl@0: 	removeFile t1.tmp
sl@0:     }
sl@0: }
sl@0: 
sl@0: # customMatch
sl@0: proc matchNegative { expected actual } {
sl@0:    set match 0
sl@0:    foreach a $actual e $expected {
sl@0:       if { $a != $e } {
sl@0:          set match 1
sl@0:         break
sl@0:       }
sl@0:    }
sl@0:    return $match
sl@0: }
sl@0: 
sl@0: test tcltest-24.0 {
sl@0: 	customMatch: syntax
sl@0: } -body {
sl@0: 	list [catch {customMatch} result] $result
sl@0: } -result [list 1 "wrong # args: should be \"customMatch mode script\""]
sl@0: 
sl@0: test tcltest-24.1 {
sl@0: 	customMatch: syntax
sl@0: } -body {
sl@0: 	list [catch {customMatch foo} result] $result
sl@0: } -result [list 1 "wrong # args: should be \"customMatch mode script\""]
sl@0: 
sl@0: test tcltest-24.2 {
sl@0: 	customMatch: syntax
sl@0: } -body {
sl@0: 	list [catch {customMatch foo bar baz} result] $result
sl@0: } -result [list 1 "wrong # args: should be \"customMatch mode script\""]
sl@0: 
sl@0: test tcltest-24.3 {
sl@0: 	customMatch: argument checking
sl@0: } -body {
sl@0: 	list [catch {customMatch bad "a \{ b"} result] $result
sl@0: } -result [list 1 "invalid customMatch script; can't evaluate after completion"]
sl@0: 
sl@0: test tcltest-24.4 {
sl@0: 	test: valid -match values
sl@0: } -body {
sl@0: 	list [catch {
sl@0: 		test tcltest-24.4.0 {} \
sl@0: 			-match [namespace current]::noSuchMode
sl@0: 	} result] $result
sl@0: } -match glob -result {1 *bad -match value*}
sl@0: 
sl@0: test tcltest-24.5 {
sl@0: 	test: valid -match values
sl@0: } -setup {
sl@0: 	customMatch [namespace current]::alwaysMatch "format 1 ;#"
sl@0: } -body {
sl@0: 	list [catch {
sl@0: 		test tcltest-24.5.0 {} \
sl@0: 			-match [namespace current]::noSuchMode
sl@0: 	} result] $result
sl@0: } -match glob -result {1 *bad -match value*: must be *alwaysMatch,*}
sl@0: 
sl@0: test tcltest-24.6 {
sl@0: 	customMatch: -match script that always matches
sl@0: } -setup {
sl@0: 	customMatch [namespace current]::alwaysMatch "format 1 ;#"
sl@0: 	set v [verbose]
sl@0: } -body {
sl@0: 	verbose {}
sl@0: 	test tcltest-24.6.0 {} -match [namespace current]::alwaysMatch \
sl@0: 		-body {format 1} -result 0
sl@0: } -cleanup {
sl@0: 	verbose $v
sl@0: } -result {} -output {} -errorOutput {}
sl@0: 
sl@0: test tcltest-24.7 {
sl@0: 	customMatch: replace default -exact matching
sl@0: } -setup {
sl@0: 	set saveExactMatchScript $::tcltest::CustomMatch(exact)
sl@0: 	customMatch exact "format 1 ;#"
sl@0: 	set v [verbose]
sl@0: } -body {
sl@0: 	verbose {}
sl@0: 	test tcltest-24.7.0 {} -body {format 1} -result 0
sl@0: } -cleanup {
sl@0: 	verbose $v
sl@0: 	customMatch exact $saveExactMatchScript
sl@0: 	unset saveExactMatchScript
sl@0: } -result {} -output {}
sl@0: 
sl@0: test tcltest-24.9 {
sl@0: 	customMatch: error during match
sl@0: } -setup {
sl@0: 	proc errorDuringMatch args {return -code error "match returned error"}
sl@0: 	customMatch [namespace current]::errorDuringMatch \
sl@0: 		[namespace code errorDuringMatch]
sl@0: 	set v [verbose]
sl@0: 	set fail $::tcltest::currentFailure
sl@0: } -body {
sl@0: 	verbose {}
sl@0: 	test tcltest-24.9.0 {} -match [namespace current]::errorDuringMatch
sl@0: } -cleanup {
sl@0: 	verbose $v
sl@0: 	set ::tcltest::currentFailure $fail
sl@0: } -match glob -result {} -output {*FAILED*match returned error*}
sl@0: 
sl@0: test tcltest-24.10 {
sl@0: 	customMatch: bad return from match command
sl@0: } -setup {
sl@0: 	proc nonBooleanReturn args {return foo}
sl@0: 	customMatch nonBooleanReturn [namespace code nonBooleanReturn]
sl@0: 	set v [verbose]
sl@0: 	set fail $::tcltest::currentFailure
sl@0: } -body {
sl@0: 	verbose {}
sl@0: 	test tcltest-24.10.0 {} -match nonBooleanReturn
sl@0: } -cleanup {
sl@0: 	verbose $v
sl@0: 	set ::tcltest::currentFailure $fail
sl@0: } -match glob -result {} -output {*FAILED*expected boolean value*}
sl@0: 
sl@0: test tcltest-24.11 {
sl@0: 	test: -match exact
sl@0: } -body {
sl@0: 	set result {A B C}
sl@0: } -match exact -result {A B C}
sl@0: 
sl@0: test tcltest-24.12 {
sl@0: 	test: -match exact	match command eval in ::, not caller namespace
sl@0: } -setup {
sl@0: 	set saveExactMatchScript $::tcltest::CustomMatch(exact)
sl@0: 	customMatch exact [list string equal]
sl@0: 	set v [verbose]
sl@0: 	proc string args {error {called [string] in caller namespace}}
sl@0: } -body {
sl@0: 	verbose {}
sl@0: 	test tcltest-24.12.0 {} -body {format 1} -result 1
sl@0: } -cleanup {
sl@0: 	rename string {}
sl@0: 	verbose $v
sl@0: 	customMatch exact $saveExactMatchScript
sl@0: 	unset saveExactMatchScript
sl@0: } -match exact -result {} -output {}
sl@0: 
sl@0: test tcltest-24.13 {
sl@0: 	test: -match exact	failure
sl@0: } -setup {
sl@0: 	set saveExactMatchScript $::tcltest::CustomMatch(exact)
sl@0: 	customMatch exact [list string equal]
sl@0: 	set v [verbose]
sl@0: 	set fail $::tcltest::currentFailure
sl@0: } -body {
sl@0: 	verbose {}
sl@0: 	test tcltest-24.13.0 {} -body {format 1} -result 0
sl@0: } -cleanup {
sl@0: 	set ::tcltest::currentFailure $fail
sl@0: 	verbose $v
sl@0: 	customMatch exact $saveExactMatchScript
sl@0: 	unset saveExactMatchScript
sl@0: } -match glob -result {} -output {*FAILED*Result was:
sl@0: 1*(exact matching):
sl@0: 0*}
sl@0: 
sl@0: test tcltest-24.14 {
sl@0: 	test: -match glob
sl@0: } -body {
sl@0: 	set result {A B C}
sl@0: } -match glob -result {A B*}
sl@0: 
sl@0: test tcltest-24.15 {
sl@0: 	test: -match glob	failure
sl@0: } -setup {
sl@0: 	set v [verbose]
sl@0: 	set fail $::tcltest::currentFailure
sl@0: } -body {
sl@0: 	verbose {}
sl@0: 	test tcltest-24.15.0 {} -match glob -body {format {A B C}} \
sl@0: 		-result {A B* }
sl@0: } -cleanup {
sl@0: 	set ::tcltest::currentFailure $fail
sl@0: 	verbose $v
sl@0: } -match glob -result {} -output {*FAILED*Result was:
sl@0: *(glob matching):
sl@0: *}
sl@0: 
sl@0: test tcltest-24.16 {
sl@0: 	test: -match regexp
sl@0: } -body {
sl@0: 	set result {A B C}
sl@0: } -match regexp -result {A B.*}
sl@0: 
sl@0: test tcltest-24.17 {
sl@0: 	test: -match regexp	failure
sl@0: } -setup {
sl@0: 	set fail $::tcltest::currentFailure
sl@0: 	set v [verbose]
sl@0: } -body {
sl@0: 	verbose {}
sl@0: 	test tcltest-24.17.0 {} -match regexp -body {format {A B C}} \
sl@0: 		-result {A B.* X}
sl@0: } -cleanup {
sl@0: 	set ::tcltest::currentFailure $fail
sl@0: 	verbose $v
sl@0: } -match glob -result {} -output {*FAILED*Result was:
sl@0: *(regexp matching):
sl@0: *}
sl@0: 
sl@0: test tcltest-24.18 {
sl@0: 	test: -match custom	forget namespace qualification
sl@0: } -setup {
sl@0: 	set fail $::tcltest::currentFailure
sl@0: 	set v [verbose]
sl@0: 	customMatch negative matchNegative
sl@0: } -body {
sl@0: 	verbose {}
sl@0: 	test tcltest-24.18.0 {} -match negative -body {format {A B C}} \
sl@0: 		-result {A B X}
sl@0: } -cleanup {
sl@0: 	set ::tcltest::currentFailure $fail
sl@0: 	verbose $v
sl@0: } -match glob -result {} -output {*FAILED*Error testing result:*}
sl@0: 
sl@0: test tcltest-24.19 {
sl@0: 	test: -match custom
sl@0: } -setup {
sl@0: 	set v [verbose]
sl@0: 	customMatch negative [namespace code matchNegative]
sl@0: } -body {
sl@0: 	verbose {}
sl@0: 	test tcltest-24.19.0 {} -match negative -body {format {A B C}} \
sl@0: 		-result {A B X}
sl@0: } -cleanup {
sl@0: 	verbose $v
sl@0: } -match exact -result {} -output {}
sl@0: 
sl@0: test tcltest-24.20 {
sl@0: 	test: -match custom	failure
sl@0: } -setup {
sl@0: 	set fail $::tcltest::currentFailure
sl@0: 	set v [verbose]
sl@0: 	customMatch negative [namespace code matchNegative]
sl@0: } -body {
sl@0: 	verbose {}
sl@0: 	test tcltest-24.20.0 {} -match negative -body {format {A B C}} \
sl@0: 		-result {A B C}
sl@0: } -cleanup {
sl@0: 	set ::tcltest::currentFailure $fail
sl@0: 	verbose $v
sl@0: } -match glob -result {} -output {*FAILED*Result was:
sl@0: *(negative matching):
sl@0: *}
sl@0: 
sl@0: test tcltest-25.1 {
sl@0: 	constraint of setup/cleanup (Bug 589859)
sl@0: } -setup {
sl@0: 	set foo 0
sl@0: } -body {
sl@0: 	# Buggy tcltest will generate result of 2
sl@0: 	test tcltest-25.1.0 {} -constraints knownBug -setup {
sl@0: 	    incr foo
sl@0: 	} -body {
sl@0: 	    incr foo
sl@0: 	} -cleanup {
sl@0: 	    incr foo
sl@0: 	} -match glob -result *
sl@0: 	set foo
sl@0: } -cleanup {
sl@0: 	unset foo
sl@0: } -result 0
sl@0: 
sl@0: test tcltest-25.2 {
sl@0: 	puts -nonewline (Bug 612786)
sl@0: } -body {
sl@0: 	puts -nonewline stdout bla
sl@0: 	puts -nonewline stdout bla
sl@0: } -output {blabla}
sl@0: 
sl@0: test tcltest-25.3 {
sl@0: 	reported return code (Bug 611922)
sl@0: } -setup {
sl@0: 	set fail $::tcltest::currentFailure
sl@0: 	set v [verbose]
sl@0: } -body {
sl@0: 	verbose {}
sl@0: 	test tcltest-25.3.0 {} -body {
sl@0: 	    error foo
sl@0: 	}
sl@0: } -cleanup {
sl@0: 	set ::tcltest::currentFailure $fail
sl@0: 	verbose $v
sl@0: } -match glob -output {*generated error; Return code was: 1*}
sl@0: 
sl@0: test tcltest-26.1 {Bug/RFE 1017151} -setup {
sl@0:     makeFile {
sl@0: 	package require tcltest
sl@0: 	set errorInfo "Should never see this"
sl@0: 	tcltest::test tcltest-26.1.0 {
sl@0: 	    no errorInfo when only return code mismatch
sl@0: 	} -body {
sl@0: 	    set x 1
sl@0: 	} -returnCodes error -result 1
sl@0: 	tcltest::cleanupTests
sl@0:     } test.tcl
sl@0: } -body {
sl@0:     slave msg [file join [temporaryDirectory] test.tcl]
sl@0:     set msg
sl@0: } -cleanup {
sl@0:     removeFile test.tcl
sl@0: } -match glob -result {*
sl@0: ---- Return code should have been one of: 1
sl@0: ==== tcltest-26.1.0 FAILED*}
sl@0: 
sl@0: test tcltest-26.2 {Bug/RFE 1017151} -setup {
sl@0:     makeFile {
sl@0: 	package require tcltest
sl@0: 	set errorInfo "Should never see this"
sl@0: 	tcltest::test tcltest-26.2.0 {do not mask body errorInfo} -body {
sl@0: 	    error "body error"
sl@0: 	} -cleanup {
sl@0: 	    error "cleanup error"
sl@0: 	} -result 1
sl@0: 	tcltest::cleanupTests
sl@0:     } test.tcl
sl@0: } -body {
sl@0:     slave msg [file join [temporaryDirectory] test.tcl]
sl@0:     set msg
sl@0: } -cleanup {
sl@0:     removeFile test.tcl
sl@0: } -match glob -result {*
sl@0: ---- errorInfo: body error
sl@0: *
sl@0: ---- errorInfo(cleanup): cleanup error*}
sl@0: 
sl@0: cleanupTests
sl@0: }
sl@0: 
sl@0: namespace delete ::tcltest::test
sl@0: return