From ad1ccfdeba286542f72f1f58a8387d32a66eae80 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 1 Jul 2002 07:52:02 +0000
Subject: 	* Updated the instructions on running and adding to the test
 suite. 	Also updated several tests, mostly to correctly create and
 destroy 	any temporary files in the [temporaryDirectory] of tcltest.

---
 ChangeLog           |   7 ++++
 tests/README        | 104 +++++++++++-----------------------------------------
 tests/cmdMZ.test    |  24 +++++++-----
 tests/encoding.test |  93 ++++++++++++++++++++++++++--------------------
 tests/fCmd.test     |  11 ++++--
 tests/info.test     |   3 +-
 tests/interp.test   |  54 ++++++++++++++-------------
 7 files changed, 133 insertions(+), 163 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index b672f8e..235e336 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,12 @@
 2002-06-30  Don Porter  <dgp@users.sourceforge.net>
 
+	* tests/README:		Updated the instructions on running and
+	* tests/cmdMZ.test:	adding to the test suite.  Also updated
+	* tests/encoding.test:	several tests, mostly to correctly create
+	* tests/fCmd.test:	and destroy any temporary files in the
+	* tests/info.test:	[temporaryDirectory] of tcltest.
+	* tests/interp.test:
+
 	* library/tcltest/tcltest.tcl:	Stopped checking for writeability
 	of -tmpdir value because no default directory can be guaranteed to
 	be writeable.
diff --git a/tests/README b/tests/README
index 8b2fa4f..4a82e91 100644
--- a/tests/README
+++ b/tests/README
@@ -1,6 +1,6 @@
 README -- Tcl test suite design document.
 
-RCS: @(#) $Id: README,v 1.8 1999/08/31 21:49:27 jenn Exp $
+RCS: @(#) $Id: README,v 1.9 2002/07/01 07:52:02 dgp Exp $
 
 Contents:
 ---------
@@ -23,75 +23,16 @@ You can run the tests in three ways:
     (a) type "make test" in ../unix; this will run all of the tests.
 
     (b) type "tcltest <testFile> ?<option> <value>?
-	Command line options include:
-
-	-help                display usage information
-
-	-verbose <level>     set the level of verbosity to a substring
-			     of "bps".  See the "Test output" section
-			     of the tcltest man page for an
-			     explanation of this option. 
-
-	-match <matchList>   only run tests that match one or more of
-			     the glob patterns in <matchList>
-
-	-skip <skipList>     do not run tests that match one or more
-			     of the glob patterns in <skipList>
-
-	-file <globPatternList>  
-		             only source test files that match one or
-		             more of the glob patterns in
-		             <globPatternList> (relative to the
-		             "tests" directory).  This option only
-		             applies when you run the test suite with
-		             the "all.tcl" file.
-
-	-notfile <globPatternList>  
-	                     do not source test files that match one
-	                     or more of the patterns in
-	                     <globPatternList> (relative to the
-	                     "tests" directory).  This option only
-	                     applies when you run the test suite with
-	                     the "all.tcl" file.
-
-	-constraints <list>  tests with any constraints in <list> will
-			     not be skipped.  Not that elements of
-			     <list> must exactly match the existing
-			     constraints.
-
-        -limitconstraints <bool>
-                             If 1, limit test runs to those tests that
-                             match the constraints listed using the
-                             -constraints flag.  Use of this flag
-                             requires use of the -constraints flag.
-                             The default value is 0.
-
-        -tmpdir <dirname>    put temporary files created by
-                             ::tcltest::makeFile and
-                             ::tcltest::makeDirectory in the named
-                             directory.  The default location is
-                             ::tcltest::workingDirectory.
-
-        -preservecore <level>
-                             check for core files.  If level is 0,
-                             check for core files only when
-                             cleanupTests is called from an all.tcl
-                             file.  If 1, also check at the end of
-                             every test command.  If 2, also save core
-                             files in ::tcltest::temporaryDirectory.
-                             The default level is 0.
+
+	where the options and values are the configuration options
+	of the tcltest package.
  
     (c) start up tcltest in this directory, then "source" the test
         file (for example, type "source parse.test").  To run all
 	of the tests, type "source all.tcl".  To use the options in
-	interactive mode, you can set their corresponding tcltest
-	namespace variables after loading the tcltest package.
-	For example, some of the tcltest variables are:
-		  ::tcltest::match
-		  ::tcltest::skip
-		  ::tcltest::testConstraints(nonPortable)
-		  ::tcltest::testConstraints(knownBug)
-		  ::tcltest::testConstraints(userInteractive)
+	interactive mode, you can set them with the tcltest::configure
+	command.  Set constraints with the tcltest::testConstraints
+	command.
 
 Please see the tcltest man page for more information regarding how to
 write and run tests.
@@ -108,25 +49,25 @@ correspond to any Tcl or C code file so they should match the pattern
 Be sure your new test file can be run from any working directory.
 
 Be sure no temporary files are left behind by your test file.
+Use [tcltest::makeFile], [tcltest::removeFile], and [tcltest::cleanupTests]
+properly to be sure of this.
 
 Be sure your tests can run cross-platform in both a build environment
 as well as an installation environment.  If your test file contains
 tests that should not be run in one or more of those cases, please use
 the constraints mechanism to skip those tests.
 
-2. Incompatibilities with prior Tcl versions:
----------------------------------------------
-
-1) Global variables such as VERBOSE, TESTS, and testConfig are now
-   renamed to use the new "tcltest" namespace.
+2. Incompatibilities of package tcltest 2.1 with 
+   testing machinery of very old versions of Tcl:
+------------------------------------------------
 
-   old name   new name
-   --------   --------
-   VERBOSE    ::tcltest::verbose
-   TESTS      ::tcltest::match
-   testConfig ::tcltest::testConstraints
+1) Global variables such as VERBOSE, TESTS, and testConfig of the
+   old machinery correspond to the [configure -verbose], 
+   [configure -match], and [testConstraint] commands of tcltest 2.1,
+   respectively.
 
-2) VERBOSE values are no longer numeric.  
+2) VERBOSE values were longer numeric.  [configure -verbose] values
+   are lists of keywords.
 
 3) When you run "make test", the working dir for the test suite is now
    the one from which you called "make test", rather than the "tests"
@@ -135,13 +76,12 @@ the constraints mechanism to skip those tests.
    other or with existing files.  All tests must now run independently
    of their working directory.
 
-4) The "all" and "visual" files are now called "all.tcl" and
-   "visual_bb.test".
+4) The "all" file is now called "all.tcl"
 
 5) The "defs" file no longer exists.
 
 6) Instead of creating a doAllTests file in the tests directory, to
    run all nonPortable tests, just use the "-constraints nonPortable"
-   command line flag.  If you are running interactively, you can set
-   the ::tcltest::testConstraints(nonPortable) variable to 1 (after
-   loading the tcltest package).
+   command line flag.  If you are running interactively, you can run
+   [tcltest::testConstraint nonPortable 1] (after loading the tcltest
+   package).
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test
index d2a57f9..cf7a1a9 100644
--- a/tests/cmdMZ.test
+++ b/tests/cmdMZ.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: cmdMZ.test,v 1.9 2001/11/23 01:25:54 das Exp $
+# RCS: @(#) $Id: cmdMZ.test,v 1.10 2002/07/01 07:52:02 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -85,22 +85,26 @@ test cmdMZ-3.3 {Tcl_SourceObjCmd: error conditions} {unixOrPc} {
 test cmdMZ-3.4 {Tcl_SourceObjCmd: error conditions} {unixOrPc} {
     list [catch {source a b} msg] $msg
 } {1 {wrong # args: should be "source fileName"}}
-test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} {
-    makeFile {
+test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} -body {
+    set file [makeFile {
 	set x 146
 	error "error in sourced file"
 	set y $x
-    } source.file
-    list [catch {source source.file} msg] $msg $errorInfo
-} {1 {error in sourced file} {error in sourced file
+    } source.file]
+    set result [list [catch {source $file} msg] $msg $errorInfo]
+    removeFile source.file
+    set result
+} -match glob -result {1 {error in sourced file} {error in sourced file
     while executing
 "error "error in sourced file""
-    (file "source.file" line 3)
+    (file "*" line 3)
     invoked from within
-"source source.file"}}
+"source $file"}}
 test cmdMZ-3.6 {Tcl_SourceObjCmd: simple script} {
-    makeFile {list result} source.file
-    source source.file
+    set file [makeFile {list result} source.file]
+    set result [source $file]
+    removeFile source.file
+    set result
 } result
 
 # Tcl_SplitObjCmd
diff --git a/tests/encoding.test b/tests/encoding.test
index fb6f0c3..cf0392b 100644
--- a/tests/encoding.test
+++ b/tests/encoding.test
@@ -8,7 +8,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: encoding.test,v 1.13 2002/06/22 04:19:47 dgp Exp $
+# RCS: @(#) $Id: encoding.test,v 1.14 2002/07/01 07:52:02 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -90,10 +90,10 @@ test encoding-3.2 {Tcl_GetEncodingName, non-null} {
 } {jis0208}
 
 test encoding-4.1 {Tcl_GetEncodingNames} {testencoding} {
-    file mkdir tmp/encoding
-    close [open tmp/encoding/junk.enc w]
-    close [open tmp/encoding/junk2.enc w]
-    cd tmp
+    cd [makeDirectory tmp]
+    makeDirectory [file join tmp encoding]
+    makeFile {} [file join tmp encoding junk.enc]
+    makeFile {} [file join tmp encoding junk2.enc]
     set path [testencoding path]
     testencoding path {}
     catch {unset encodings}
@@ -108,8 +108,11 @@ test encoding-4.1 {Tcl_GetEncodingNames} {testencoding} {
 	}
     }
     testencoding path $path
-    cd ..
-    file delete -force tmp
+    cd [workingDirectory]
+    removeFile [file join tmp encoding junk2.enc]
+    removeFile [file join tmp encoding junk.enc]
+    removeDirectory [file join tmp encoding]
+    removeDirectory tmp
     lsort $x
 } {junk junk2}
 
@@ -158,15 +161,15 @@ test encoding-7.2 {Tcl_UtfToExternalDString: big buffer} {
 } "512 \u4e4e"
 
 test encoding-8.1 {Tcl_ExternalToUtf} {
-    set f [open dummy w]
+    set f [open [file join [temporaryDirectory] dummy] w]
     fconfigure $f -translation binary -encoding iso8859-1
     puts -nonewline $f "ab\x8c\xc1g"
     close $f
-    set f [open dummy r]
+    set f [open [file join [temporaryDirectory] dummy] r]
     fconfigure $f -translation binary -encoding shiftjis    
     set x [read $f]
     close $f
-    file delete dummy
+    file delete [file join [temporaryDirectory] dummy]
     set x
 } "ab\u4e4eg"
 
@@ -186,15 +189,15 @@ test encoding-9.2 {Tcl_UtfToExternalDString: big buffer} {
 } "1024 8C"
 
 test encoding-10.1 {Tcl_UtfToExternal} {
-    set f [open dummy w]
+    set f [open [file join [temporaryDirectory] dummy] w]
     fconfigure $f -translation binary -encoding shiftjis
     puts -nonewline $f "ab\u4e4eg"
     close $f
-    set f [open dummy r]
+    set f [open [file join [temporaryDirectory] dummy] r]
     fconfigure $f -translation binary -encoding iso8859-1
     set x [read $f]
     close $f
-    file delete dummy
+    file delete [file join [temporaryDirectory] dummy]
     set x
 } "ab\x8c\xc1g"
 
@@ -239,15 +242,19 @@ test encoding-11.6 {LoadEncodingFile: invalid file} {testencoding} {
     set system [encoding system]
     set path [testencoding path]
     encoding system identity
+    cd [temporaryDirectory]
     testencoding path tmp
-    file mkdir tmp/encoding
-    set f [open tmp/encoding/splat.enc w]
+    makeDirectory tmp
+    makeDirectory [file join tmp encoding]
+    set f [open [file join tmp encoding splat.enc] w]
     fconfigure $f -translation binary 
     puts $f "abcdefghijklmnop"
     close $f
     set x [list [catch {encoding convertto splat \u4e4e} msg] $msg]
-    file delete -force tmp
-    catch {file delete encoding}
+    file delete [file join [temporaryDirectory] tmp encoding splat.enc]
+    removeDirectory [file join tmp encoding]
+    removeDirectory tmp
+    cd [workingDirectory]
     testencoding path $path
     encoding system $system
     set x
@@ -325,6 +332,7 @@ set ::iso2022uniData2 "\u79c1\u3069\u3082\u3067\u306f\u3001\u30c1\u30c3\u30d7\u3
 \u0063\u0061\u0073\u0069\u006e\u006f\u005f\u006a\u0061\u0070\u0061\u006e\u0065\u0073\u0065\u0040\u005f\u005f\u005f\u002e\u0063\u006f\u006d\u0020\uff09\u307e\u3067\u3054\u4f4f\u6240\u5909\u66f4\u6e08\u306e\u9023\u7d61\u3092\u3044\u305f\u3060\u3051\u306a\u3044\u3067
 \u3057\u3087\u3046\u304b\uff1f"
 
+cd [temporaryDirectory]
 set fid [open iso2022.txt w]
 fconfigure $fid -encoding binary
 puts -nonewline $fid $::iso2022encData
@@ -362,50 +370,55 @@ test encoding-23.3 {iso2022-jp escape encoding test} {
     close $fid
     set data
 } [string range $::iso2022uniData 0 49] ; # 0 .. 49 inclusive == 50
+cd [workingDirectory]
 
-test encoding-24.1 {EscapeFreeProc on open channels} {exec} {
+test encoding-24.1 {EscapeFreeProc on open channels} -constraints {
+	exec
+} -setup {
     # Bug #524674 input
-    set f [open iso2022.tcl w]
-    puts $f {
-	set f [open iso2022.txt]
+    set file [makeFile {
+	set f [open [file join [file dirname [info script]] iso2022.txt]]
 	fconfigure $f -encoding iso2022-jp
 	gets $f
-    }
-    close $f
-    exec $::tcltest::tcltest iso2022.tcl
-} {}
-
-test encoding-24.2 {EscapeFreeProc on open channels} {exec} {
+    } iso2022.tcl]
+} -body {
+    exec $::tcltest::tcltest $file
+} -cleanup {
+    removeFile iso2022.tcl
+} -result {}
+
+test encoding-24.2 {EscapeFreeProc on open channels} -constraints {
+	exec
+} -setup {
     # Bug #524674 output
-    set f [open iso2022.tcl w]
-    puts $f {
+    set file [makeFile {
 	fconfigure stdout -encoding iso2022-jp
 	puts ab\u4e4e\u68d9g
 	exit
-    }
-    close $f
-    viewable [exec $::tcltest::tcltest iso2022.tcl]
-} "ab\x1b\$B8C\x1b\$(DD%\x1b(Bg (ab\\u001b\$B8C\\u001b\$(DD%\\u001b(Bg)"
+    } iso2022.tcl]
+} -body {
+    viewable [exec $::tcltest::tcltest $file]
+} -cleanup {
+    removeFile iso2022.tcl
+} -result "ab\x1b\$B8C\x1b\$(DD%\x1b(Bg (ab\\u001b\$B8C\\u001b\$(DD%\\u001b(Bg)"
 
 test encoding-24.3 {EscapeFreeProc on open channels} {exec} {
     # Bug #219314 - if we don't free escape encodings correctly on
     # channel closure, we go boom
-    set f [open iso2022.tcl w]
-    puts $f {
+    set file [makeFile {
 	encoding system iso2022-jp
 	set a "\u4e4e\u4e5e\u4e5f"; # 3 Japanese Kanji letters
 	puts $a
-    }
-    close $f
-    set f [open "|[list $::tcltest::tcltest iso2022.tcl]"]
+    } iso2022.tcl]
+    set f [open "|[list $::tcltest::tcltest $file]"]
     fconfigure $f -encoding iso2022-jp
     set count [gets $f line]
     close $f
+    removeFile iso2022.tcl
     list $count [viewable $line]
 } [list 3 "\u4e4e\u4e5e\u4e5f (\\u4e4e\\u4e5e\\u4e5f)"]
 
-::tcltest::removeFile iso2022.txt
-::tcltest::removeFile iso2022.tcl
+file delete [file join [temporaryDirectory] iso2022.txt]
 
 # EscapeFreeProc, GetTableEncoding, unilen
 # are fully tested by the rest of this file
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 94db157..131ace5 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.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: fCmd.test,v 1.15 2002/06/22 04:19:47 dgp Exp $
+# RCS: @(#) $Id: fCmd.test,v 1.16 2002/07/01 07:52:02 dgp Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -2195,13 +2195,12 @@ test fCmd-28.4 {file link} {hasLinks} {
     list [catch {file link -abc b c} msg] $msg
 } {1 {bad switch "-abc": must be -symbolic or -hard}}
 
-catch {file delete -force abc.dir}
-catch {file delete -force abc2.dir}
 makeDirectory abc.dir
 makeDirectory abc2.dir
 makeFile contents abc.file
 makeFile contents abc2.file
 
+cd [temporaryDirectory]
 test fCmd-28.5 {file link: source already exists} {linkDirectory} {
     list [catch {file link abc.dir abc2.dir} msg] $msg
 } {1 {could not create new link "abc.dir": that path already exists}}
@@ -2295,6 +2294,12 @@ test fCmd-28.18 {file link: glob -type d} {linkDirectory} {
 } [lsort [list abc.link abc.dir abc2.dir]]
 
 file delete -force abc.link
+cd [workingDirectory]
+
+removeFile abc2.file
+removeFile abc.file
+removeDirectory abc2.dir
+removeDirectory abc.dir
 
 # cleanup
 cleanup
diff --git a/tests/info.test b/tests/info.test
index db20d58..4f87e99 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: info.test,v 1.23 2002/06/11 13:56:20 dkf Exp $
+# RCS: @(#) $Id: info.test,v 1.24 2002/07/01 07:52:03 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -521,7 +521,6 @@ test info-16.1 {info script option} {
 test info-16.2 {info script option} {
     file tail [info sc]
 } "info.test"
-removeFile gorp.info
 set gorpfile [makeFile "info script\n" gorp.info]
 test info-16.3 {info script option} {
     list [source $gorpfile] [file tail [info script]]
diff --git a/tests/interp.test b/tests/interp.test
index 43eb266..f82151e 100644
--- a/tests/interp.test
+++ b/tests/interp.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: interp.test,v 1.14 2002/03/07 20:17:23 dgp Exp $
+# RCS: @(#) $Id: interp.test,v 1.15 2002/07/01 07:52:03 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -481,74 +481,74 @@ test interp-15.1 {testing file sharing} {
     z eval close stdout
     list [catch {z eval puts hello} msg] $msg
 } {1 {can not find channel named "stdout"}}
-catch {removeFile file-15.2}
-test interp-15.2 {testing file sharing} {
+test interp-15.2 {testing file sharing} -body {
     catch {interp delete z}
     interp create z
-    set f [open file-15.2 w]
+    set f [open [makeFile {} file-15.2] w]
     interp share "" $f z
     z eval puts $f hello
     z eval close $f
     close $f
-} ""
-catch {removeFile file-15.2}
+} -cleanup {
+    removeFile file-15.2
+} -result ""
 test interp-15.3 {testing file sharing} {
     catch {interp delete xsafe}
     interp create xsafe -safe
     list [catch {xsafe eval puts hello} msg] $msg
 } {1 {can not find channel named "stdout"}}
-catch {removeFile file-15.4}
-test interp-15.4 {testing file sharing} {
+test interp-15.4 {testing file sharing} -body {
     catch {interp delete xsafe}
     interp create xsafe -safe
-    set f [open file-15.4 w]
+    set f [open [makeFile {} file-15.4] w]
     interp share "" $f xsafe
     xsafe eval puts $f hello
     xsafe eval close $f
     close $f
-} ""
-catch {removeFile file-15.4}
+} -cleanup {
+    removeFile file-15.4
+} -result ""
 test interp-15.5 {testing file sharing} {
     catch {interp delete xsafe}
     interp create xsafe -safe
     interp share "" stdout xsafe
     list [catch {xsafe eval gets stdout} msg] $msg
 } {1 {channel "stdout" wasn't opened for reading}}
-catch {removeFile file-15.6}
-test interp-15.6 {testing file sharing} {
+test interp-15.6 {testing file sharing} -body {
     catch {interp delete xsafe}
     interp create xsafe -safe
-    set f [open file-15.6 w]
+    set f [open [makeFile {} file-15.6] w]
     interp share "" $f xsafe
     set x [list [catch [list xsafe eval gets $f] msg] $msg]
     xsafe eval close $f
     close $f
     string compare [string tolower $x] \
 		[list 1 [format "channel \"%s\" wasn't opened for reading" $f]]
-} 0
-catch {removeFile file-15.6}
-catch {removeFile file-15.7}
-test interp-15.7 {testing file transferring} {
+} -cleanup {
+    removeFile file-15.6
+} -result 0
+test interp-15.7 {testing file transferring} -body {
     catch {interp delete xsafe}
     interp create xsafe -safe
-    set f [open file-15.7 w]
+    set f [open [makeFile {} file-15.7] w]
     interp transfer "" $f xsafe
     xsafe eval puts $f hello
     xsafe eval close $f
-} ""
-catch {removeFile file-15.7}
-catch {removeFile file-15.8}
-test interp-15.8 {testing file transferring} {
+} -cleanup {
+    removeFile file-15.7
+} -result ""
+test interp-15.8 {testing file transferring} -body {
     catch {interp delete xsafe}
     interp create xsafe -safe
-    set f [open file-15.8 w]
+    set f [open [makeFile {} file-15.8] w]
     interp transfer "" $f xsafe
     xsafe eval close $f
     set x [list [catch {close $f} msg] $msg]
     string compare [string tolower $x] \
 		[list 1 [format "can not find channel named \"%s\"" $f]]
-} 0
-catch {removeFile file-15.8}
+} -cleanup {
+    removeFile file-15.8
+} -result 0
 
 #
 # Torture tests for interpreter deletion order
@@ -2868,6 +2868,7 @@ test interp-31.1 {alias invocation scope} {
 
 test interp-32.1 { parent's working directory should
                    be inherited by a child interp } {
+    cd [temporaryDirectory]
     set parent [pwd]
     set i [interp create]
     set child [$i eval pwd]
@@ -2880,6 +2881,7 @@ test interp-32.1 { parent's working directory should
     cd ..
     file delete cwd_test
     interp delete $i
+    cd [workingDirectory]
     expr {[string equal $parent $child] ? 1 :
              "\{$parent\} != \{$child\}"}
 } 1
-- 
cgit v0.12