* 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]

7 files changed, 77 insertions, 23 deletions

diff --git a/tests/autoMkindex.test b/tests/autoMkindex.test
index b034077..27de741 100644
--- a/tests/autoMkindex.test
+++ b/tests/autoMkindex.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: autoMkindex.test,v 1.6 1999/06/26 03:54:10 jenn Exp $
+# RCS: @(#) $Id: autoMkindex.test,v 1.7 1999/10/19 18:08:44 jenn Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -41,6 +41,9 @@ proc AutoMkindexTestReset {} {
 
 set result ""
 
+set origDir [pwd]
+cd $::tcltest::testsDirectory
+
 test autoMkindex-1.1 {remove any existing tclIndex file} {
     file delete tclIndex
     file exists tclIndex
@@ -188,4 +191,7 @@ if {[info exists removeAutoMkindex]} {
 if {[file exists tclIndex]} {
     file delete -force tclIndex
 }
+
+cd $origDir
+
 ::tcltest::cleanupTests
diff --git a/tests/basic.test b/tests/basic.test
index 3d9588b..66c7551 100644
--- a/tests/basic.test
+++ b/tests/basic.test
@@ -15,7 +15,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: basic.test,v 1.8 1999/10/13 00:32:29 hobbs Exp $
+# RCS: @(#) $Id: basic.test,v 1.9 1999/10/19 18:08:44 jenn Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -494,10 +494,10 @@ test basic-39.1 {Tcl_CreateTrace, correct command and argc/argv arguments of tra
 } {{expr 14 + 16} {expr 14 + 16} {set stuff [expr 14 + 16]} {set stuff 30}}
 test basic-39.2 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {
     testcmdtrace tracetest {set stuff [info tclversion]}
-} {{info tclversion} {info tclversion} {set stuff [info tclversion]} {set stuff 8.3}}
+} [list {info tclversion} {info tclversion} {set stuff [info tclversion]} "set stuff $::tcltest::version"]
 test basic-39.3 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {
     testcmdtrace deletetest {set stuff [info tclversion]}
-} 8.3
+} $::tcltest::version
 }
 
 test basic-40.1 {Tcl_DeleteTrace} {emptyTest} {
diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test
index 52eb048..7fbb909 100644
--- a/tests/pkgMkIndex.test
+++ b/tests/pkgMkIndex.test
@@ -8,13 +8,16 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: pkgMkIndex.test,v 1.11 1999/07/01 17:36:19 jenn Exp $
+# RCS: @(#) $Id: pkgMkIndex.test,v 1.12 1999/10/19 18:08:44 jenn Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import ::tcltest::*
 }
 
+set origDir [pwd]
+cd $::tcltest::testsDirectory
+
 set fullPkgPath [file join $::tcltest::testsDirectory pkg]
 
 # Add the pkg1 directory to auto_path, so that its packages can be found.
@@ -158,6 +161,8 @@ proc pkgtest::createIndex { args } {
     set dirPath [lindex $parsed 1]
     set patternList [lindex $parsed 2]
 
+    file mkdir $dirPath
+ 
     if {[catch {
 	file delete [file join $dirPath pkgIndex.tcl]
 	eval pkg_mkIndex $options $dirPath $patternList
@@ -243,7 +248,7 @@ proc pkgtest::runIndex { args } {
 	    set result [list 0 [makePkgList [parseIndex $idxFile]]]
 	} err]} {
 	    set result [list 1 $err]
-	}
+	} 
 	file delete $idxFile
     } else {
 	set result $rv
@@ -342,16 +347,7 @@ test pkgMkIndex-11.1 {conflicting namespace imports} {
 # cleanup
 
 namespace delete pkgtest
+cd $origDir
 ::tcltest::cleanupTests
 return
 
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/socket.test b/tests/socket.test
index 6856026..59a3173 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: socket.test,v 1.12 1999/07/01 17:36:19 jenn Exp $
+# RCS: @(#) $Id: socket.test,v 1.13 1999/10/19 18:08:44 jenn Exp $
 
 # Running socket tests with a remote server:
 # ------------------------------------------
@@ -1385,6 +1385,7 @@ test socket-12.1 {testing inheritance of server sockets} \
     set f [open script2 w]
     puts $f [list set tcltest $::tcltest::tcltest]
     puts $f {
+	package require tcltest
 	set f [socket -server accept 2828]
 	proc accept { file addr port } {
 	    close $file
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
diff --git a/tests/unixInit.test b/tests/unixInit.test
index 7073cc6..77a6bb4 100644
--- a/tests/unixInit.test
+++ b/tests/unixInit.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: unixInit.test,v 1.10 1999/07/08 17:29:30 jenn Exp $
+# RCS: @(#) $Id: unixInit.test,v 1.11 1999/10/19 18:08:44 jenn Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -27,7 +27,7 @@ set env(LANG) C
 # Some tests will fail if they are run on a machine that doesn't have
 # this Tcl version installed (as opposed to built) on it.
 if {[catch {
-    set f [open "|[list $::tcltest::tcltest]" w+]
+    set f [open "|[list $::tcltest::tcltest exit]" w+]
     exec kill -PIPE [pid $f]
     close $f
 }]} {
@@ -35,6 +35,7 @@ if {[catch {
 } else {
     set ::tcltest::testConstraints(installedTcl) 1
 }
+
 test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unixOnly installedTcl} {
     set x {}
 
diff --git a/tests/unixNotfy.test b/tests/unixNotfy.test
index ac0f169..2552d2a 100644
--- a/tests/unixNotfy.test
+++ b/tests/unixNotfy.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: unixNotfy.test,v 1.7 1999/07/01 17:36:20 jenn Exp $
+# RCS: @(#) $Id: unixNotfy.test,v 1.8 1999/10/19 18:08:44 jenn Exp $
 
 # The tests should not be run if you have a notifier which is unable to
 # detect infinite vwaits, as the tests below will hang. The presence of
@@ -21,6 +21,12 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
     namespace import ::tcltest::*
 }
 
+if {[info exists tk_version]} {
+    puts "When run in a Tk shell, these tests run hang.  Skipping tests ..."
+    ::tcltest::cleanupTests
+    return
+}
+
 set ::tcltest::testConstraints(testthread) \
 	[expr {[info commands testthread] != {}}]