Tests for the tcltest package

1 files changed, 296 insertions, 0 deletions

diff --git a/tests/tcltest.test b/tests/tcltest.test
new file mode 100755
index 0000000..74c5b1b
--- /dev/null
+++ b/tests/tcltest.test
@@ -0,0 +1,296 @@
+# Command line options covered:
+#  -help, -verbose, -match, -skip, -file, -notfile, -relateddir, -asidefromdir
+#  -constraints, -limitconstraints, -preservecore, -tmpdir, -debug, -outfile,
+#  -errfile 
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id: tcltest.test,v 1.1 1999/07/26 17:59:12 jenn Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest
+    namespace import ::tcltest::*
+}
+
+makeFile {
+    package require tcltest
+    namespace import ::tcltest::*
+    test a-1.0 {test a} {
+	list 0
+    } {0}
+    test b-1.0 {test b} {
+	list 1
+    } {0}
+    test c-1.0 {test c} {knownBug} {
+    } {}
+    ::tcltest::cleanupTests
+    return
+} test.tcl
+
+# test -help
+test tcltest-1.1 {tcltest -help} {
+    set result [catch {exec $::tcltest::tcltest test.tcl -help} msg]
+    list $result [regexp Usage $msg]
+} {0 1} 
+test tcltest-1.2 {tcltest -help -something} {
+    set result [catch {exec $::tcltest::tcltest test.tcl -help -something} msg]
+    list $result [regexp Usage $msg]
+} {0 1}
+test tcltest-1.3 {tcltest -h} {
+    set result [catch {exec $::tcltest::tcltest test.tcl -h} msg]
+    list $result [regexp Usage $msg]
+} {0 1} 
+
+# -verbose
+test tcltest-2.0 {tcltest (verbose default - 'b')} {
+    set result [catch {exec $::tcltest::tcltest test.tcl} msg]
+    list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
+	    [regexp c-1.0 $msg] \
+	    [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+} {0 1 0 0 1}
+test tcltest-2.1 {tcltest -v 'b'} {
+    set result [catch {exec $::tcltest::tcltest test.tcl -v 'b'} msg]
+    list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
+	    [regexp c-1.0 $msg] \
+	    [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+} {0 1 0 0 1}
+test tcltest-2.2 {tcltest -v 'p'} {
+    set result [catch {exec $::tcltest::tcltest test.tcl -v 'p'} msg]
+    list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
+	    [regexp c-1.0 $msg] \
+	    [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+} {0 0 1 0 1}
+test tcltest-2.3 {tcltest -v 's'} {
+    set result [catch {exec $::tcltest::tcltest test.tcl -v 's'} msg]
+    list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
+	    [regexp c-1.0 $msg] \
+	    [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+} {0 0 0 1 1}
+test tcltest-2.4 {tcltest -v 'ps'} {
+    set result [catch {exec $::tcltest::tcltest test.tcl -verbose 'ps'} msg]
+    list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
+	    [regexp c-1.0 $msg] \
+	    [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+} {0 0 1 1 1}
+test tcltest-2.5 {tcltest -v 'psb'} {
+    set result [catch {exec $::tcltest::tcltest test.tcl -v 'psb'} msg]
+    list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
+	    [regexp c-1.0 $msg] \
+	    [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+} {0 1 1 1 1}
+
+# -match
+test tcltest-3.1 {tcltest -match 'a*'} {
+    set result [catch {exec $::tcltest::tcltest test.tcl -match a* -v 'ps'} msg]
+    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
+	    [regexp "Total.+3.+Passed.+1.+Skipped.+2.+Failed.+0" $msg]
+} {0 1 0 0 1}
+test tcltest-3.2 {tcltest -match 'b*'} {
+    set result [catch {exec $::tcltest::tcltest test.tcl -m b* -v 'ps'} msg]
+    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
+	    [regexp "Total.+3.+Passed.+0.+Skipped.+2.+Failed.+1" $msg]
+} {0 0 1 0 1}
+test tcltest-3.3 {tcltest -match 'c*'} {
+    set result [catch {exec $::tcltest::tcltest test.tcl -match c* -v 'ps'} msg]
+    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
+	    [regexp "Total.+3.+Passed.+0.+Skipped.+3.+Failed.+0" $msg]
+} {0 0 0 1 1}
+test tcltest-3.4 {tcltest -match 'a* b*'} {
+    set result [catch {exec $::tcltest::tcltest test.tcl -match {a* b*} -v 'ps'} msg]
+    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
+	    [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+} {0 1 1 0 1}
+    
+# -skip
+test tcltest-4.1 {tcltest -skip 'a*'} {
+    set result [catch {exec $::tcltest::tcltest test.tcl -skip a* -v 'ps'} msg]
+    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
+	    [regexp "Total.+3.+Passed.+0.+Skipped.+2.+Failed.+1" $msg]
+} {0 0 1 1 1}
+test tcltest-4.2 {tcltest -skip 'b*'} {
+    set result [catch {exec $::tcltest::tcltest test.tcl -s b* -v 'ps'} msg]
+    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
+	    [regexp "Total.+3.+Passed.+1.+Skipped.+2.+Failed.+0" $msg]
+} {0 1 0 1 1}
+test tcltest-4.3 {tcltest -skip 'c*'} {
+    set result [catch {exec $::tcltest::tcltest test.tcl -skip c* -v 'ps'} msg]
+    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
+	    [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+} {0 1 1 0 1}
+test tcltest-4.4 {tcltest -skip 'a* b*'} {
+    set result [catch {exec $::tcltest::tcltest test.tcl -skip {a* b*} -v 'ps'} msg]
+    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
+	    [regexp "Total.+3.+Passed.+0.+Skipped.+3.+Failed.+0" $msg]
+} {0 0 0 1 1}
+test tcltest-4.5 {tcltest -match 'a* b*' -skip 'b*'} {
+    set result [catch {exec $::tcltest::tcltest test.tcl -match {a* b*} -skip b* -v 'ps'} msg]
+    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
+	    [regexp "Total.+3.+Passed.+1.+Skipped.+2.+Failed.+0" $msg]
+} {0 1 0 0 1}
+    
+# -constraints, -limitconstraints
+test tcltest-5.1 {tcltest -constraints 'knownBug'} {
+    set result [catch {exec $::tcltest::tcltest test.tcl -constraints knownBug -v 'ps'} msg]
+    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
+	    [regexp "Total.+3.+Passed.+2.+Skipped.+0.+Failed.+1" $msg]
+} {0 1 1 1 1}
+test tcltest-5.1 {tcltest -constraints 'knownBug'} {
+    set result [catch {exec $::tcltest::tcltest test.tcl -constraints knownBug -v 'p' -limitconstraints 1} msg]
+    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
+	    [regexp "Total.+3.+Passed.+1.+Skipped.+2.+Failed.+0" $msg]
+} {0 0 0 1 1}
+
+makeFile {
+    package require tcltest
+    namespace import ::tcltest::*
+    puts $::tcltest::outputChannel "a test"
+    ::tcltest::PrintError "a really short string"
+    ::tcltest::PrintError "a really really really really really really long \
+	    string containing \"quotes\" and other bad bad stuff"
+    ::tcltest::PrintError "a really really long string containing a \
+	    \"Path/that/is/really/long/and/contains/no/spaces\""
+    ::tcltest::PrintError "a really really long string containing a \
+	    \"Really/Long/Path/that/contains/no/spaces/and/is/longer/than/eighty/characters/to/see/what/happens\"" 
+} printerror.tcl
+
+# -outfile, -errfile
+test tcltest-6.1 {tcltest -outfile, -errfile defaults} {
+    catch {exec $::tcltest::tcltest printerror.tcl} msg
+    list [regexp "a test" $msg] [regexp "a really" $msg]
+} {1 1}
+test tcltest-6.2 {tcltest -outfile a.tmp} {
+    catch {exec $::tcltest::tcltest printerror.tcl -outfile a.tmp} msg
+    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} {
+    catch {exec $::tcltest::tcltest printerror.tcl -errfile a.tmp} msg
+    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} {
+    catch {exec $::tcltest::tcltest printerror.tcl -o a.tmp -e b.tmp} msg
+    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] \
+	    $result1 $result2 \
+	    [file exists a.tmp] [file delete a.tmp] \
+	    [file exists b.tmp] [file delete b.tmp]
+} {0 0 0 0 1 {} 1 {}}
+
+# -debug
+test tcltest-7.1 {tcltest test.tcl -d 0} {
+    catch {exec $::tcltest::tcltest test.tcl -d 0} msg
+    regexp "Flags passed into tcltest" $msg
+} {0}
+test tcltest-7.2 {tcltest test.tcl -d 1} {
+    catch {exec $::tcltest::tcltest test.tcl -d 1 -s b*} msg
+    list [regexp userSpecifiedSkip $msg] \
+	    [regexp "Flags passed into tcltest" $msg]
+} {1 0}
+test tcltest-7.3 {tcltest test.tcl -d 1} {
+    catch {exec $::tcltest::tcltest test.tcl -d 1 -m b*} msg
+    list [regexp userSpecifiedNonMatch $msg] \
+	    [regexp "Flags passed into tcltest" $msg]
+} {1 0}
+test tcltest-7.4 {tcltest test.tcl -d 2} {
+    catch {exec $::tcltest::tcltest test.tcl -d 2} msg
+    list [regexp "Flags passed into tcltest" $msg] [regexp "Running" $msg]
+} {1 0}
+test tcltest-7.5 {tcltest test.tcl -d 3} {
+    catch {exec $::tcltest::tcltest test.tcl -d 3} msg
+    list [regexp "Flags passed into tcltest" $msg] [regexp "Running" $msg]
+} {1 1}
+
+makeFile {
+    package require tcltest
+    namespace import ::tcltest::*
+    makeFile {} a.tmp
+    return
+} a.tcl
+
+makeFile {} thisdirectoryisafile
+
+# -tmpdir
+test tcltest-8.1 {tcltest a.tcl -tmpdir a} {
+    file delete -force thisdirectorydoesnotexist
+    exec $::tcltest::tcltest 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} {
+    catch {exec $::tcltest::tcltest a.tcl -tmpdir thisdirectoryisafile} msg
+    list [regexp "not a directory" $msg]
+} {1}
+
+# Platform-specific attribute testing still needs to be set up
+# (non-writeable directories, non-readable directories) as tmpdir -- jlh
+
+# -file -notfile
+test tcltest-9.1 {-file a*.tcl} {
+    catch {exec $::tcltest::tcltest \
+	    [file join $::tcltest::testsDirectory all.tcl] -file a*.test} msg
+    list [regexp assocd\.test $msg]
+} {1}
+test tcltest-9.2 {-file a*.tcl} {
+    catch {exec $::tcltest::tcltest \
+	    [file join $::tcltest::testsDirectory all.tcl] \
+	    -file a*.test -notfile assocd*} msg
+    list [regexp assocd\.test $msg]
+} {0}
+
+makeFile {
+    package require tcltest
+    namespace import ::tcltest::*
+    test makecore {make a core file} {
+	open core w
+    } {}
+    ::tcltest::cleanupTests
+    return
+} makecore.tcl
+# -preservecore 
+test tcltest-10.1 {-preservecore 0} {
+    catch {exec $::tcltest::tcltest makecore.tcl -preservecore 0} msg
+    file delete core
+    regexp "produced core file" $msg
+} {0}
+test tcltest-10.2 {-preservecore 1} {
+    catch {exec $::tcltest::tcltest makecore.tcl -preservecore 1} msg
+    file delete core
+    regexp "produced core file" $msg
+} {1}
+test tcltest-10.3 {-preservecore 2} {
+    catch {exec $::tcltest::tcltest makecore.tcl -preservecore 2} msg
+    file delete core
+    list [regexp "==== makecore produced core file" $msg] [regexp "Moving file to" $msg] \
+	    [regexp "core-" $msg] [file delete core-makecore]
+} {1 1 1 {}}
+test tcltest-10.4 {-preservecore 3} {
+    catch {exec $::tcltest::tcltest makecore.tcl -preservecore 3} msg
+    file delete core
+    list [regexp "produced core file" $msg] [regexp "Moving file to" $msg] \
+	    [regexp "core-" $msg] [file delete core-makecore]
+} {1 1 1 {}}
+
+# Begin testing of tcltest procs ...
+
+# PrintError
+test tcltest-11.1 {PrintError} {
+    set result [catch {exec $::tcltest::tcltest printerror.tcl} msg]
+    list $result [regexp "Error:  a really short string" $msg] \
+	    [regexp "     \"quotes\"" $msg] [regexp "    \"Path" $msg] \
+	    [regexp "    \"Really" $msg] 
+} {1 1 1 1 1}
+
+# cleanup
+::tcltest::cleanupTests
+return