* tests/tcltest.test:

* doc/tcltest.n:
* library/tcltest1.0/tcltest.tcl: Removed the extra return at the
  end of the tcltest.tcl file.

  Applied patches sent in by Andreas Kupries to add helper procs for
  debug output, add 3 new flags (-testsdir, -load, -loadfile), and
  internally refactors common code for dealing with paths into
  separate procedures. [Bug: 2838, 2842]

1 files changed, 47 insertions, 3 deletions

diff --git a/tests/tcltest.test b/tests/tcltest.test
index 13df747..b5d2b72 100755
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -10,7 +10,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: tcltest.test,v 1.8 1999/08/27 21:45:18 jenn Exp $
+# RCS: @(#) $Id: tcltest.test,v 1.9 1999/10/19 18:08:44 jenn Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -106,7 +106,7 @@ test tcltest-3.4 {tcltest -match 'a* b*'} {unixOrPc} {
     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*'} {unixOrPc} {
     set result [catch {exec $::tcltest::tcltest test.tcl -skip a* -v 'ps'} msg]
@@ -133,7 +133,7 @@ test tcltest-4.5 {tcltest -match 'a* b*' -skip 'b*'} {unixOrPc} {
     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'} {unixOrPc} {
     set result [catch {exec $::tcltest::tcltest test.tcl -constraints knownBug -v 'ps'} msg]
@@ -265,6 +265,26 @@ test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {unixOrPc} {
     list [regexp {not writeable} [join $msg]]
 } {1}
 
+# -testdir
+test tcltest-8.5 {tcltest a.tcl -testdir thisdirectorydoesnotexist} {
+    file delete -force thisdirectorydoesnotexist
+    catch {exec $::tcltest::tcltest a.tcl -testdir thisdirectorydoesnotexist}  msg
+    list [regexp "does not exist" [join $msg]]
+} {1}
+
+test tcltest-8.6 {tcltest a.tcl -testdir thisdirectoryisafile} {
+    catch {exec $::tcltest::tcltest a.tcl -testdir thisdirectoryisafile} msg
+    # The join is necessary because the message can be split on multiple lines
+    list [regexp "not a directory" [join $msg]] 
+} {1}
+
+test tcltest-8.7 {tcltest a.tcl -testdir notReadableDir} {unixOnly} {
+    catch {exec $::tcltest::tcltest a.tcl -testdir $notReadableDir} msg 
+    # The join is necessary because the message can be split on multiple lines
+    list [regexp {not readable} [join $msg]]
+} {1}
+
+
 switch $tcl_platform(platform) {
     "unix" {
 	file attributes $notReadableDir -permissions 777
@@ -290,9 +310,12 @@ test tcltest-9.2 {-file a*.tcl} {unixOrPc} {
     list [regexp assocd\.test $msg]
 } {0}
 
+
+
 makeFile {
     package require tcltest
     namespace import ::tcltest::*
+
     test makecore {make a core file} {
 	set f [open core w]
 	close $f
@@ -300,6 +323,7 @@ makeFile {
     ::tcltest::cleanupTests
     return
 } makecore.tcl
+
 # -preservecore 
 test tcltest-10.1 {-preservecore 0} {unixOrPc} {
     catch {exec $::tcltest::tcltest makecore.tcl -preservecore 0} msg
@@ -347,6 +371,26 @@ test tcltest-11.3 {-args {-foo bar -baz}} {unixOrPc} {
     list $msg
 } {{=-foo bar -baz=}}
 
+# -load -loadfile
+makeFile {
+    package require tcltest
+    namespace import ::tcltest::*
+    puts $::tcltest::loadScript
+    exit
+} load.tcl
+
+test tcltest-12.1 {-load xxx} {
+    catch {exec $::tcltest::tcltest load.tcl -load xxx} msg
+    set msg
+} {xxx}
+
+test tcltest-12.1 {-loadfile load.tcl} {
+    catch {exec $::tcltest::tcltest load.tcl -d 2 -loadfile load.tcl} msg
+    list \
+	    [regexp {tcltest} [join $msg [split $msg \n]]] \
+	    [regexp {loadScript} [join $msg [split $msg \n]]]
+} {1 1}
+
 # Begin testing of tcltest procs ...
 
 # PrintError