From a407e1e0a4496d94823146e2bacf89ba0d5634f5 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Fri, 5 Jul 2002 10:38:42 +0000
Subject: Made many tests work properly when the current directory is not
 writable. Added targets to unix/Makefile.in to facilitate testing of this
 situation.

---
 ChangeLog             | 26 ++++++++++++++++
 tests/env.test        | 14 ++++-----
 tests/event.test      | 50 +++++++++++++-----------------
 tests/fileName.test   | 24 ++++++++++++---
 tests/http.test       | 39 +++++++++++++----------
 tests/httpold.test    | 85 ++++++++++++++++++++++++++-------------------------
 tests/ioUtil.test     | 24 ++++++---------
 tests/macFCmd.test    | 20 +++++-------
 tests/regexp.test     |  5 ++-
 tests/regexpComp.test |  3 +-
 tests/source.test     | 61 +++++++++++++++---------------------
 tests/unixFCmd.test   | 20 +++++-------
 tests/unixFile.test   | 25 +++++----------
 tests/unixNotfy.test  | 31 +++++--------------
 unix/Makefile.in      | 33 ++++++++++++++++++--
 15 files changed, 238 insertions(+), 222 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 25da014..6f93b24 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,29 @@
+2002-07-05  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
+
+	* unix/Makefile.in (ro-test,ddd,GDB,DDD): Created new targets to
+	allow running the test suite with a read-only current directory,
+	running under ddd instead of gdb, and factored out some executable
+	names for broken sites (like mine) where gdb and ddd are installed
+	with non-standard names...
+
+	* tests/httpold.test: Altered test names to httpold-* to avoid
+	clashes with http.test, and stopped tests from failing when the
+	current directory is not writable...
+
+	* tests/event.test:		Stop these tests from failing
+	* tests/ioUtil.test:		when the current directory is
+	* tests/regexp.test:		not writable...
+	* tests/regexpComp.test: 
+	* tests/source.test: 
+	* tests/unixFile.test: 
+	* tests/unixNotfy.test: 
+
+	* tests/unixFCmd.test:		Trying to make these test-files
+	* tests/macFCmd.test:		not bomb out with an error when
+	* tests/http.test:		the current directory is not
+	* tests/fileName.test:		writable...
+	* tests/env.test:
+
 2002-07-05  Jeff Hobbs  <jeffh@ActiveState.com>
 
 	*** 8.4b1 TAGGED FOR RELEASE ***
diff --git a/tests/env.test b/tests/env.test
index ce14fed..1fbec90 100644
--- a/tests/env.test
+++ b/tests/env.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: env.test,v 1.14 2002/06/22 04:19:47 dgp Exp $
+# RCS: @(#) $Id: env.test,v 1.15 2002/07/05 10:38:42 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -60,8 +60,7 @@ test env-1.3 {reflection of env by "array names"} {
 # Skip them if exec is not defined.
 ::tcltest::testConstraint execCommandExists [expr {[info commands exec] != ""}]
 
-set f [open printenv w]
-puts $f {
+set printenvScript [makeFile {
     proc lrem {listname name} {
 	upvar $listname list
 	set i [lsearch $list $name]
@@ -85,12 +84,11 @@ puts $f {
 	puts "$p=$env($p)"
     }
     exit
-}
-close $f
+} printenv]
 	
 proc getenv {} {
-    global printenv tcltest
-    catch {exec $::tcltest::tcltest printenv} out
+    global printenvScript tcltest
+    catch {exec $::tcltest::tcltest $printenvScript} out
     if {$out == "child process exited abnormally"} {
 	set out {}
     }
@@ -244,7 +242,7 @@ foreach name [array names env2] {
 }
 
 # cleanup
-file delete printenv
+removeFile $printenvScript
 ::tcltest::cleanupTests
 return
 
diff --git a/tests/event.test b/tests/event.test
index 927a5d8..4278ba7 100644
--- a/tests/event.test
+++ b/tests/event.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: event.test,v 1.18 2002/07/02 19:10:57 dgp Exp $
+# RCS: @(#) $Id: event.test,v 1.19 2002/07/05 10:38:42 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -197,10 +197,12 @@ test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} {
 test event-6.1 {BgErrorDeleteProc procedure} {
     catch {interp delete foo}
     interp create foo
+    set erroutfile [makeFile Unmodified err.out]
+    foo eval [list set erroutfile $erroutfile]
     foo eval {
 	proc bgerror args {
-	    global errorInfo
-	    set f [open err.out r+]
+	    global errorInfo erroutfile
+	    set f [open $erroutfile r+]
 	    seek $f 0 end
 	    puts $f "$args $errorInfo"
 	    close $f
@@ -208,14 +210,13 @@ test event-6.1 {BgErrorDeleteProc procedure} {
 	after 100 {error "first error"}
 	after 100 {error "second error"}
     }
-    makeFile Unmodified err.out
     after 100 {interp delete foo}
     after 200
     update
-    set f [open err.out r]
+    set f [open $erroutfile r]
     set result [read $f]
     close $f
-    removeFile err.out
+    removeFile $erroutfile
     set result
 } {Unmodified
 }
@@ -405,7 +406,8 @@ foreach i [after info] {
 }
 
 test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {socket} {
-    set f1 [open test1 w]
+    set test1file [makeFile "" test1]
+    set f1 [open $test1file w]
     proc accept {s args} {
 	puts $s foobar
 	close $s
@@ -417,30 +419,32 @@ test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {soc
     set x 0
     set y 0
     set z 0
-    fileevent $s2 readable { incr z }
+    fileevent $s2 readable {incr z}
     vwait z
-    fileevent $f1 writable { incr x; if { $y == 3 } { set z done } }
-    fileevent $s2 readable { incr y; if { $x == 3 } { set z done } }
+    fileevent $f1 writable {incr x; if {$y == 3} {set z done}}
+    fileevent $s2 readable {incr y; if {$x == 3} {set z done}}
     vwait z
     close $f1
     close $s2
-    file delete test1 test2
+    removeFile $test1file
     list $x $y $z
 } {3 3 done}
 test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {
-    file delete test1 test2
-    set f1 [open test1 w]
-    set f2 [open test2 w]
+    set test1file [makeFile "" test1]
+    set test2file [makeFile "" test2]
+    set f1 [open $test1file w]
+    set f2 [open $test2file w]
     set x 0
     set y 0
     set z 0
     update
-    fileevent $f1 writable { incr x; if { $y == 3 } { set z done } }
-    fileevent $f2 writable { incr y; if { $x == 3 } { set z done } }
+    fileevent $f1 writable {incr x; if {$y == 3} {set z done}}
+    fileevent $f2 writable {incr y; if {$x == 3} {set z done}}
     vwait z
     close $f1
     close $f2
-    file delete test1 test2
+    removeFile $test1file
+    removeFile $test2file
     list $x $y $z
 } {3 3 done}
 
@@ -593,15 +597,3 @@ foreach i [after info] {
 }
 ::tcltest::cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/fileName.test b/tests/fileName.test
index 5ded8c5..9089f93 100644
--- a/tests/fileName.test
+++ b/tests/fileName.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: fileName.test,v 1.23 2002/06/21 14:22:29 vincentdarley Exp $
+# RCS: @(#) $Id: fileName.test,v 1.24 2002/07/05 10:38:42 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -312,6 +312,7 @@ if {[tcltest::testConstraint testsetplatform]} {
 test filename-4.19 {Tcl_SplitPath} {
     set oldDir [pwd]
     set res [catch {
+	cd [temporaryDirectory]
 	file mkdir tildetmp
 	set nastydir [file join tildetmp ./~tilde]
 	file mkdir $nastydir
@@ -1125,7 +1126,9 @@ test filename-11.13 {Tcl_GlobCmd} {
     list [catch {file join [lindex [glob ~] 0]} msg] $msg
 } [list 0 [file join $env(HOME)]]
 
+set oldpwd [pwd]
 set oldhome $env(HOME)
+cd [temporaryDirectory]
 set env(HOME) [pwd]
 file delete -force globTest
 file mkdir globTest/a1/b1
@@ -1487,9 +1490,9 @@ test filename-12.3 {simple globbing} {
 } {0 {}}
 
 if {$tcl_platform(platform) == "macintosh"} {
-  set globPreResult :globTest:
+    set globPreResult :globTest:
 } else {
-  set globPreResult globTest/
+    set globPreResult globTest/
 }
 set x1 x1.c
 set y1 y1.c
@@ -1582,12 +1585,25 @@ test filename-14.3 {asterisks, question marks, and brackets} {unixOrPc} {
 test filename-14.4 {asterisks, question marks, and brackets} {macOnly} {
     lsort [glob globTest/?1.c]
 } {:globTest:x1.c :globTest:y1.c :globTest:z1.c}
+
+# The current directory could be anywhere; do this to stop spurious matches
+file mkdir globTestContext
+file rename globTest [file join globTestContext globTest]
+set savepwd [pwd]
+cd globTestContext
+
 test filename-14.5 {asterisks, question marks, and brackets} {unixOrPc} {
     lsort [glob */*/*/*.c]
 } {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
 test filename-14.6 {asterisks, question marks, and brackets} {macOnly} {
     lsort [glob */*/*/*.c]
 } {:globTest:a1:b1:x2.c :globTest:a1:b2:y2.c}
+
+# Reset to where we were
+cd $savepwd
+file rename [file join globTestContext globTest] globTest
+file delete globTestContext
+
 test filename-14.7 {asterisks, question marks, and brackets} {unixOnly} {
     lsort [glob globTest/*]
 } {globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
@@ -1792,7 +1808,7 @@ test filename-16.16 {windows specific globbing} {pcOnly} {
 
 # cleanup
 catch {file delete -force C:/globTest}
-cd $oldDir
+cd $oldpwd
 file delete -force globTest
 set env(HOME) $oldhome
 if {[tcltest::testConstraint testsetplatform]} {
diff --git a/tests/http.test b/tests/http.test
index 04e3781..3901ebe 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -12,7 +12,7 @@
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
 #
-# RCS: @(#) $Id: http.test,v 1.28 2002/07/02 19:10:57 dgp Exp $
+# RCS: @(#) $Id: http.test,v 1.29 2002/07/05 10:38:42 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -48,16 +48,17 @@ catch {unset data}
 # Ensure httpd file exists
 
 set origFile [file join $::tcltest::testsDirectory httpd]
-set newFile [file join $::tcltest::workingDirectory httpd]
-if {![file exists $newFile]} {
-    file copy $origFile $newFile
+set httpdFile [file join [temporaryDirectory] httpd_[pid]]
+if {![file exists $httpdFile]} {
+    makeFile "" $httpdFile
+    file delete $httpdFile
+    file copy $origFile $httpdFile
     set removeHttpd 1
 }
-set httpdFile [file join $::tcltest::workingDirectory httpd]
 
 if {[info commands testthread] == "testthread" && [file exists $httpdFile]} {
     set httpthread [testthread create "
-	source $httpdFile
+	source [list $httpdFile]
 	testthread wait
     "]
     testthread send $httpthread [list set port $port]
@@ -65,16 +66,19 @@ if {[info commands testthread] == "testthread" && [file exists $httpdFile]} {
     testthread send $httpthread {httpd_init $port}
     puts "Running httpd in thread $httpthread"
 } else {
-    if ![file exists $httpdFile] {
+    if {![file exists $httpdFile]} {
 	puts "Cannot read $httpdFile script, http test skipped"
 	unset port
 	return
     }
     source $httpdFile
-    if [catch {httpd_init $port} listen] {
+    # Let the OS pick the port; that's much more flexible
+    if {[catch {httpd_init 0} listen]} {
 	puts "Cannot start http server, http test skipped"
 	unset port
 	return
+    } else {
+	set port [lindex [fconfigure $listen -sockname] 2]
     }
 }
 
@@ -323,13 +327,14 @@ test http-4.3 {http::Event} {
 } {HTTP/1.0 200 Data follows}
 
 test http-4.4 {http::Event} {
-    set out [open testfile w]
+    set testfile [makeFile "" testfile]
+    set out [open $testfile w]
     set token [http::geturl $url -channel $out]
     close $out
-    set in [open testfile]
+    set in [open $testfile]
     set x [read $in]
     close $in
-    file delete testfile
+    removeFile $testfile
     set x
 } "<html><head><title>HTTP/1.0 TEST</title></head><body>
 <h1>Hello, World!</h1>
@@ -337,23 +342,25 @@ test http-4.4 {http::Event} {
 </body></html>"
 
 test http-4.5 {http::Event} {
-    set out [open testfile w]
+    set testfile [makeFile "" testfile]
+    set out [open $testfile w]
     set token [http::geturl $url -channel $out]
     close $out
     upvar #0 $token data
-    file delete testfile
+    removeFile $testfile
     expr $data(currentsize) == $data(totalsize)
 } 1
 
 test http-4.6 {http::Event} {
-    set out [open testfile w]
+    set testfile [makeFile "" testfile]
+    set out [open $testfile w]
     set token [http::geturl $binurl -channel $out]
     close $out
-    set in [open testfile]
+    set in [open $testfile]
     fconfigure $in -translation binary
     set x [read $in]
     close $in
-    file delete testfile
+    removeFile $testfile
     set x
 } "$bindata$binurl"
 
diff --git a/tests/httpold.test b/tests/httpold.test
index 8cdb9d8..feb555a 100644
--- a/tests/httpold.test
+++ b/tests/httpold.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: httpold.test,v 1.9 2002/06/22 04:19:47 dgp Exp $
+# RCS: @(#) $Id: httpold.test,v 1.10 2002/07/05 10:38:42 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -51,19 +51,19 @@ if [catch {httpd_init $port} listen] {
     return
 }
 
-test http-1.1 {http_config} {
+test httpold-1.1 {http_config} {
     http_config
 } {-accept */* -proxyfilter httpProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 1.0}}
 
-test http-1.2 {http_config} {
+test httpold-1.2 {http_config} {
     http_config -proxyfilter
 } httpProxyRequired
 
-test http-1.3 {http_config} {
+test httpold-1.3 {http_config} {
     catch {http_config -junk}
 } 1
 
-test http-1.4 {http_config} {
+test httpold-1.4 {http_config} {
     http_config -proxyhost nowhere.come -proxyport 8080 -proxyfilter myFilter -useragent "Tcl Test Suite"
     set x [http_config]
     http_config -proxyhost {} -proxyport {} -proxyfilter httpProxyRequired \
@@ -71,24 +71,24 @@ test http-1.4 {http_config} {
     set x
 } {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -useragent {Tcl Test Suite}}
 
-test http-1.5 {http_config} {
+test httpold-1.5 {http_config} {
     catch {http_config -proxyhost {} -junk 8080}
 } 1
 
-test http-2.1 {http_reset} {
+test httpold-2.1 {http_reset} {
     catch {http_reset http#1}
 } 0
 
-test http-3.1 {http_get} {
+test httpold-3.1 {http_get} {
     catch {http_get -bogus flag}
 } 1
-test http-3.2 {http_get} {
+test httpold-3.2 {http_get} {
     catch {http_get http:junk} err
     set err
 } {Unsupported URL: http:junk}
 
 set url [info hostname]:$port
-test http-3.3 {http_get} {
+test httpold-3.3 {http_get} {
     set token [http_get $url]
     http_data $token
 } "<html><head><title>HTTP/1.0 TEST</title></head><body>
@@ -100,7 +100,7 @@ set tail /a/b/c
 set url [info hostname]:$port/a/b/c
 set binurl [info hostname]:$port/binary
 
-test http-3.4 {http_get} {
+test httpold-3.4 {http_get} {
     set token [http_get $url]
     http_data $token
 } "<html><head><title>HTTP/1.0 TEST</title></head><body>
@@ -112,7 +112,7 @@ proc selfproxy {host} {
     global port
     return [list [info hostname] $port]
 }
-test http-3.5 {http_get} {
+test httpold-3.5 {http_get} {
     http_config -proxyfilter selfproxy
     set token [http_get $url]
     http_config -proxyfilter httpProxyRequired
@@ -122,7 +122,7 @@ test http-3.5 {http_get} {
 <h2>GET http://$url</h2>
 </body></html>"
 
-test http-3.6 {http_get} {
+test httpold-3.6 {http_get} {
     http_config -proxyfilter bogus
     set token [http_get $url]
     http_config -proxyfilter httpProxyRequired
@@ -132,7 +132,7 @@ test http-3.6 {http_get} {
 <h2>GET $tail</h2>
 </body></html>"
 
-test http-3.7 {http_get} {
+test httpold-3.7 {http_get} {
     set token [http_get $url -headers {Pragma no-cache}]
     http_data $token
 } "<html><head><title>HTTP/1.0 TEST</title></head><body>
@@ -140,7 +140,7 @@ test http-3.7 {http_get} {
 <h2>GET $tail</h2>
 </body></html>"
 
-test http-3.8 {http_get} {
+test httpold-3.8 {http_get} {
     set token [http_get $url -query Name=Value&Foo=Bar]
     http_data $token
 } "<html><head><title>HTTP/1.0 TEST</title></head><body>
@@ -153,63 +153,66 @@ test http-3.8 {http_get} {
 </dl>
 </body></html>"
 
-test http-3.9 {http_get} {
+test httpold-3.9 {http_get} {
     set token [http_get $url -validate 1]
     http_code $token
 } "HTTP/1.0 200 OK"
 
 
-test http-4.1 {httpEvent} {
+test httpold-4.1 {httpEvent} {
     set token [http_get $url]
     upvar #0 $token data
     array set meta $data(meta)
     expr ($data(totalsize) == $meta(Content-Length))
 } 1
 
-test http-4.2 {httpEvent} {
+test httpold-4.2 {httpEvent} {
     set token [http_get $url]
     upvar #0 $token data
     array set meta $data(meta)
     string compare $data(type) [string trim $meta(Content-Type)]
 } 0
 
-test http-4.3 {httpEvent} {
+test httpold-4.3 {httpEvent} {
     set token [http_get $url]
     http_code $token
 } {HTTP/1.0 200 Data follows}
 
-test http-4.4 {httpEvent} {
-    set out [open testfile w]
+test httpold-4.4 {httpEvent} {
+    set testfile [makeFile "" testfile]
+    set out [open $testfile w]
     set token [http_get $url -channel $out]
     close $out
-    set in [open testfile]
+    set in [open $testfile]
     set x [read $in]
     close $in
-    file delete testfile
+    removeFile $testfile
     set x
 } "<html><head><title>HTTP/1.0 TEST</title></head><body>
 <h1>Hello, World!</h1>
 <h2>GET $tail</h2>
 </body></html>"
 
-test http-4.5 {httpEvent} {
-    set out [open testfile w]
+test httpold-4.5 {httpEvent} {
+    set testfile [makeFile "" testfile]
+    set out [open $testfile w]
     set token [http_get $url -channel $out]
     close $out
     upvar #0 $token data
-    file delete testfile
+    removeFile $testfile
     expr $data(currentsize) == $data(totalsize)
 } 1
 
-test http-4.6 {httpEvent} {
-    set out [open testfile w]
+test httpold-4.6 {httpEvent} {
+    set testfile [makeFile "" testfile]
+    set out [open $testfile w]
     set token [http_get $binurl -channel $out]
     close $out
-    set in [open testfile]
+    set in [open $testfile]
     fconfigure $in -translation binary
     set x [read $in]
     close $in
-    file delete testfile
+    removeFile $testfile
     set x
 } "$bindata$binurl"
 
@@ -223,33 +226,33 @@ proc myProgress {token total current} {
 if 0 {
     # This test hangs on Windows95 because the client never gets EOF
     set httpLog 1
-    test http-4.6 {httpEvent} {
+    test httpold-4.6 {httpEvent} {
 	set token [http_get $url -blocksize 50 -progress myProgress]
 	set progress
     } {111 111}
 }
-test http-4.7 {httpEvent} {
+test httpold-4.7 {httpEvent} {
     set token [http_get $url -progress myProgress]
     set progress
 } {111 111}
-test http-4.8 {httpEvent} {
+test httpold-4.8 {httpEvent} {
     set token [http_get $url]
     http_status $token
 } {ok}
-test http-4.9 {httpEvent} {
+test httpold-4.9 {httpEvent} {
     set token [http_get $url -progress myProgress]
     http_code $token
 } {HTTP/1.0 200 Data follows}
-test http-4.10 {httpEvent} {
+test httpold-4.10 {httpEvent} {
     set token [http_get $url -progress myProgress]
     http_size $token
 } {111}
-test http-4.11 {httpEvent} {
+test httpold-4.11 {httpEvent} {
     set token [http_get $url -timeout 1 -command {#}]
     http_reset $token
     http_status $token
 } {reset}
-test http-4.12 {httpEvent} {
+test httpold-4.12 {httpEvent} {
     update
     set x {}
     after 500 {lappend x ok}
@@ -258,19 +261,19 @@ test http-4.12 {httpEvent} {
     list [http_status $token] $x
 } {timeout ok}
 
-test http-5.1 {http_formatQuery} {
+test httpold-5.1 {http_formatQuery} {
     http_formatQuery name1 value1 name2 "value two"
 } {name1=value1&name2=value+two}
 
-test http-5.2 {http_formatQuery} {
+test httpold-5.2 {http_formatQuery} {
     http_formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
 } {name1=%7ebwelch&name2=%a1%a2%a2}
 
-test http-5.3 {http_formatQuery} {
+test httpold-5.3 {http_formatQuery} {
     http_formatQuery lines "line1\nline2\nline3"
 } {lines=line1%0d%0aline2%0d%0aline3}
 
-test http-6.1 {httpProxyRequired} {
+test httpold-6.1 {httpProxyRequired} {
     update
     http_config -proxyhost [info hostname] -proxyport $port
     set token [http_get $url]
diff --git a/tests/ioUtil.test b/tests/ioUtil.test
index 01bd593..ef583bb 100644
--- a/tests/ioUtil.test
+++ b/tests/ioUtil.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: ioUtil.test,v 1.11 2002/06/22 04:19:47 dgp Exp $
+# RCS: @(#) $Id: ioUtil.test,v 1.12 2002/07/05 10:38:42 dkf Exp $
  
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -186,6 +186,10 @@ test ioUtil-2.8 {TclAccessDeleteProc: Verify that all procs have been deleted.}
     list $err9 $err10 $err11
 } {{"TestAccessProc1": could not be deleteed} {"TestAccessProc2": could not be deleteed} {"TestAccessProc3": could not be deleteed}}
 
+# Some of the following tests require a writable current directory
+set oldpwd [pwd]
+cd [temporaryDirectory]
+
 test ioUtil-3.1 {TclOpenFileChannel: Check that none of the test procs are there.} {testopenfilechannelproc} {
     catch {eval [list file delete -force] [glob *testOpenFileChannel*]}
     catch {file exists testOpenFileChannel1%.fil} err1
@@ -223,12 +227,12 @@ test ioUtil-3.3 {TclOpenFileChannel: Use "file openfilechannel ?" to invoke each
     set err
 } {}
 
-test ioUtil-3.4 {TclOpenFileChannelDeleteProc: "TclpOpenFileChannel" function should not be deletedable.} {testopenfilechannelproc} {
+test ioUtil-3.4 {TclOpenFileChannelDeleteProc: "TclpOpenFileChannel" function should not be deletable.} {testopenfilechannelproc} {
     catch {testopenfilechannelproc delete TclpOpenFileChannel} err2
     set err2
 } {"TclpOpenFileChannel": could not be deleteed}
 
-test openfilechannelt-1.5 {TclOpenFileChannelDeleteProc: Delete the 2nd TclOpenFileChannel procedure.} {testopenfilechannelproc} {
+test ioUtil-3.5 {TclOpenFileChannelDeleteProc: Delete the 2nd TclOpenFileChannel procedure.} {testopenfilechannelproc} {
     # Delete the 2nd procedure and test that it longer exists but that
     #   the others do actually return a result.
 
@@ -299,18 +303,8 @@ test ioUtil-3.8 {TclOpenFileChannelDeleteProc: Verify that all procs have been d
     list $err9 $err10 $err11
 } {{"TestOpenFileChannelProc1": could not be deleteed} {"TestOpenFileChannelProc2": could not be deleteed} {"TestOpenFileChannelProc3": could not be deleteed}}
 
+cd $oldpwd
+
 # cleanup
 ::tcltest::cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/macFCmd.test b/tests/macFCmd.test
index dbe1fef..a6c7fa0 100644
--- a/tests/macFCmd.test
+++ b/tests/macFCmd.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: macFCmd.test,v 1.9 2002/06/05 11:59:21 das Exp $
+# RCS: @(#) $Id: macFCmd.test,v 1.10 2002/07/05 10:38:43 dkf Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -18,6 +18,11 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
     namespace import -force ::tcltest::*
 }
 
+# These tests really need to be run from a writable directory, which
+# it is assumed [temporaryDirectory] is.
+set oldcwd [pwd]
+cd [temporaryDirectory]
+
 catch {file delete -force foo.dir}
 file mkdir foo.dir
 if {[catch {file attributes foo.dir -readonly 1}]} {
@@ -193,17 +198,6 @@ test macFCmd-4.7 {SetFileReadOnly - directory readonly} {macOnly notFileSharing}
 } {1 {cannot set a directory to read-only when File Sharing is turned off} {}}
 
 # cleanup
+cd $oldcwd
 ::tcltest::cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/regexp.test b/tests/regexp.test
index 895b44c..c907b87 100644
--- a/tests/regexp.test
+++ b/tests/regexp.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: regexp.test,v 1.20 2002/03/01 06:24:07 hobbs Exp $
+# RCS: @(#) $Id: regexp.test,v 1.21 2002/07/05 10:38:43 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -436,8 +436,7 @@ test regexp-14.2 {CompileRegexp: regexp cache, different flags} {
 # There is no exec on the Mac ...
 
 test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} {unixOrPc} {
-    makeFile {puts [regexp {} foo]} junk.tcl
-    exec $::tcltest::tcltest junk.tcl
+    exec $::tcltest::tcltest [makeFile {puts [regexp {} foo]} junk.tcl]
 } 1
 
 test regexp-15.1 {regexp -start} {
diff --git a/tests/regexpComp.test b/tests/regexpComp.test
index cc17af5..20492c9 100644
--- a/tests/regexpComp.test
+++ b/tests/regexpComp.test
@@ -595,8 +595,7 @@ test regexp-14.2 {CompileRegexp: regexp cache, different flags} {
 # There is no exec on the Mac ...
 
 test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} {unixOrPc} {
-    makeFile {puts [regexp {} foo]} junk.tcl
-    exec $::tcltest::tcltest junk.tcl
+    exec $::tcltest::tcltest [makeFile {puts [regexp {} foo]} junk.tcl]
 } 1
 
 test regexp-15.1 {regexp -start} {
diff --git a/tests/source.test b/tests/source.test
index 1718aa6..f245d05 100644
--- a/tests/source.test
+++ b/tests/source.test
@@ -11,13 +11,14 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: source.test,v 1.7 2000/05/11 00:16:53 hobbs Exp $
+# RCS: @(#) $Id: source.test,v 1.8 2002/07/05 10:38:43 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
+set sourcefile [makeFile "" source.file]
 test source-1.1 {source command} {
     set x "old x value"
     set y "old y value"
@@ -27,24 +28,24 @@ test source-1.1 {source command} {
 	set y 33
 	set z 44
     } source.file
-    source source.file
+    source $sourcefile
     list $x $y $z
 } {22 33 44}
 test source-1.2 {source command} {
     makeFile {list result} source.file
-    source source.file
+    source $sourcefile
 } result
 test source-1.3 {source command} {
     set y {\ }
 
-    set fd [open source.file w]
+    set fd [open $sourcefile w]
     fconfigure $fd -translation lf
     puts -nonewline $fd "list a b c "
     puts $fd [string index $y 0]
     puts $fd "d e f"
     close $fd
 
-    source source.file
+    source $sourcefile
 } {a b c d e f}
 
 test source-2.3 {source error conditions} {
@@ -53,20 +54,20 @@ test source-2.3 {source error conditions} {
 	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
+    list [catch {source $sourcefile} msg] $msg $errorInfo
+} [list 1 {error in sourced file} "error in sourced file
     while executing
-"error "error in sourced file""
-    (file "source.file" line 3)
+\"error \"error in sourced file\"\"
+    (file \"$sourcefile\" line 3)
     invoked from within
-"source source.file"}}
+\"source \$sourcefile\""]
 test source-2.4 {source error conditions} {
     makeFile {break} source.file
-    catch {source source.file}
+    catch {source $sourcefile}
 } 3
 test source-2.5 {source error conditions} {
     makeFile {continue} source.file
-    catch {source source.file}
+    catch {source $sourcefile}
 } 4
 test source-2.6 {source error conditions} {
     normalizeMsg [list [catch {source _non_existent_} msg] $msg $errorCode]
@@ -80,7 +81,7 @@ test source-3.1 {return in middle of source file} {
     } source.file
     set x old-x
     set y old-y
-    set z [source source.file]
+    set z [source $sourcefile]
     list $x $y $z
 } {new-x old-y allDone}
 test source-3.2 {return with special code etc.} {
@@ -89,7 +90,7 @@ test source-3.2 {return with special code etc.} {
 	return -code break "Silly result"
 	set y new-y
     } source.file
-    list [catch {source source.file} msg] $msg
+    list [catch {source $sourcefile} msg] $msg
 } {3 {Silly result}}
 test source-3.3 {return with special code etc.} {
     makeFile {
@@ -97,20 +98,20 @@ test source-3.3 {return with special code etc.} {
 	return -code error "Simulated error"
 	set y new-y
     } source.file
-    list [catch {source source.file} msg] $msg $errorInfo $errorCode
+    list [catch {source $sourcefile} msg] $msg $errorInfo $errorCode
 } {1 {Simulated error} {Simulated error
     while executing
-"source source.file"} NONE}
+"source $sourcefile"} NONE}
 test source-3.4 {return with special code etc.} {
     makeFile {
 	set x new-x
 	return -code error -errorinfo "Simulated errorInfo stuff"
 	set y new-y
     } source.file
-    list [catch {source source.file} msg] $msg $errorInfo $errorCode
+    list [catch {source $sourcefile} msg] $msg $errorInfo $errorCode
 } {1 {} {Simulated errorInfo stuff
     invoked from within
-"source source.file"} NONE}
+"source $sourcefile"} NONE}
 test source-3.5 {return with special code etc.} {
     makeFile {
 	set x new-x
@@ -118,10 +119,10 @@ test source-3.5 {return with special code etc.} {
 		-errorcode {a b c}
 	set y new-y
     } source.file
-    list [catch {source source.file} msg] $msg $errorInfo $errorCode
+    list [catch {source $sourcefile} msg] $msg $errorInfo $errorCode
 } {1 {} {Simulated errorInfo stuff
     invoked from within
-"source source.file"} {a b c}}
+"source $sourcefile"} {a b c}}
 
 # Test for the Macintosh specfic features of the source command
 test source-4.1 {source error conditions} {macOnly} {
@@ -144,8 +145,8 @@ test source-5.1 {source resource files} {macOnly} {
 } [list 1 "Error finding the file: \"bad_file\"."]
 test source-5.2 {source resource files} {macOnly} {
     makeFile {return} source.file
-    list [catch {source -rsrc rsrcName source.file} msg] $msg
-} [list 1 "Error reading the file: \"source.file\"."]
+    list [catch {source -rsrc rsrcName $sourcefile} msg] $msg
+} [list 1 "Error reading the file: \"$sourcefile\"."]
 test source-5.3 {source resource files} {macOnly} {
     testWriteTextResource -rsrc rsrcName -file rsrc.file {set msg2 ok; return}
     set result [catch {source -rsrc rsrcName rsrc.file} msg]
@@ -176,13 +177,13 @@ test source-5.6 {source resource files} {macOnly} {
 test source-6.1 {source is binary ok} {
     set x {}
     makeFile [list set x "a b\0c"] source.file
-    source source.file
+    source $sourcefile
     string length $x
 } 5
 test source-6.2 {source skips everything after Ctrl-Z: Bug 2040} {
     set x {}
     makeFile [list set x "ab\32c"] source.file
-    source source.file
+    source $sourcefile
     string length $x
 } 2
 
@@ -190,15 +191,3 @@ test source-6.2 {source skips everything after Ctrl-Z: Bug 2040} {
 catch {::tcltest::removeFile source.file}
 ::tcltest::cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test
index d2d8f9d..8cccb51 100644
--- a/tests/unixFCmd.test
+++ b/tests/unixFCmd.test
@@ -9,13 +9,18 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: unixFCmd.test,v 1.12 2001/07/31 19:12:07 vincentdarley Exp $
+# RCS: @(#) $Id: unixFCmd.test,v 1.13 2002/07/05 10:38:43 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
+# These tests really need to be run from a writable directory, which
+# it is assumed [temporaryDirectory] is.
+set oldcwd [pwd]
+cd [temporaryDirectory]
+
 # Several tests require need to match results against the unix username
 set user {}
 if {$tcl_platform(platform) == "unix"} {
@@ -312,17 +317,6 @@ test unixFCmd-18.1 {Unix pwd} {nonPortable unixOnly notRoot} {
 
 # cleanup
 cleanup
+cd $oldcwd
 ::tcltest::cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/unixFile.test b/tests/unixFile.test
index c046e71..cc3b9b4 100644
--- a/tests/unixFile.test
+++ b/tests/unixFile.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: unixFile.test,v 1.6 2000/04/10 17:19:05 ericm Exp $
+# RCS: @(#) $Id: unixFile.test,v 1.7 2002/07/05 10:38:43 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -23,12 +23,14 @@ if {[info commands testobj] == {}} {
     return
 }
 
+set oldpwd [pwd]
+cd [temporaryDirectory]
+
 catch {
     set oldPath $env(PATH)
-    close [open junk w]
-    file attributes junk -perm 0777
+    file attributes [makeFile "" junk] -perm 0777
 }
-set absPath [file join [pwd] junk]
+set absPath [file join [temporaryDirectory] junk]
 
 test unixFile-1.1 {Tcl_FindExecutable} {unixOnly} {
     set env(PATH) ""
@@ -61,18 +63,7 @@ test unixFile-1.7 {Tcl_FindExecutable} {unixOnly} {
 
 # cleanup
 catch {set env(PATH) $oldPath}
-file delete junk
+removeFile junk
+cd $oldpwd
 ::tcltest::cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/unixNotfy.test b/tests/unixNotfy.test
index a12a27e..e8c90c8 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.9 2000/04/10 17:19:05 ericm Exp $
+# RCS: @(#) $Id: unixNotfy.test,v 1.10 2002/07/05 10:38:43 dkf 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
@@ -36,7 +36,7 @@ set ::tcltest::testConstraints(testthread) \
 
 test unixNotfy-1.1 {Tcl_DeleteFileHandler} {unixOnly && !testthread} {
     catch {vwait x}
-    set f [open foo w]
+    set f [open [makeFile "" foo] w]
     fileevent $f writable {set x 1}
     vwait x
     close $f
@@ -44,8 +44,8 @@ test unixNotfy-1.1 {Tcl_DeleteFileHandler} {unixOnly && !testthread} {
 } {1 {can't wait for variable "x":  would wait forever}}
 test unixNotfy-1.2 {Tcl_DeleteFileHandler} {unixOnly && !testthread} {
     catch {vwait x}
-    set f1 [open foo w]
-    set f2 [open foo2 w]
+    set f1 [open [makeFile "" foo] w]
+    set f2 [open [makeFile "" foo2] w]
     fileevent $f1 writable {set x 1}
     fileevent $f2 writable {set y 1}
     vwait x
@@ -58,7 +58,7 @@ test unixNotfy-1.2 {Tcl_DeleteFileHandler} {unixOnly && !testthread} {
 
 test unixNotfy-2.1 {Tcl_DeleteFileHandler} {unixOnly testthread} {
     update
-    set f [open foo w]
+    set f [open [makeFile "" foo] w]
     fileevent $f writable {set x 1}
     vwait x
     close $f
@@ -68,10 +68,10 @@ test unixNotfy-2.1 {Tcl_DeleteFileHandler} {unixOnly testthread} {
     vwait x
     set x
 } {ok}
-test unixNotfy-1.2 {Tcl_DeleteFileHandler} {unixOnly testthread} {
+test unixNotfy-2.2 {Tcl_DeleteFileHandler} {unixOnly testthread} {
     update
-    set f1 [open foo w]
-    set f2 [open foo2 w]
+    set f1 [open [makeFile "" foo] w]
+    set f2 [open [makeFile "" foo2] w]
     fileevent $f1 writable {set x 1}
     fileevent $f2 writable {set y 1}
     vwait x
@@ -86,21 +86,6 @@ test unixNotfy-1.2 {Tcl_DeleteFileHandler} {unixOnly testthread} {
 } {ok}
 
 
-
 # cleanup
-file delete foo
-file delete foo2
 ::tcltest::cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/unix/Makefile.in b/unix/Makefile.in
index ec21c7e..bb2b999 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -5,7 +5,7 @@
 # "autoconf" program (constructs like "@foo@" will get replaced in the
 # actual Makefile.
 #
-# RCS: @(#) $Id: Makefile.in,v 1.104 2002/07/04 01:20:38 dgp Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.105 2002/07/05 10:38:43 dkf Exp $
 
 VERSION 		= @TCL_VERSION@
 
@@ -243,6 +243,15 @@ CC			= @CC@
 MKLINKS_FLAGS           = @MKLINKS_FLAGS@
 
 #----------------------------------------------------------------
+# The information below is usually usable as is.  The configure
+# script won't modify it and it only exists to make working
+# around selected rare system configurations easier.
+#----------------------------------------------------------------
+
+GDB			= gdb
+DDD			= ddd
+
+#----------------------------------------------------------------
 # The information below should be usable as is.  The configure
 # script won't modify it and you shouldn't need to modify it
 # either.
@@ -485,6 +494,16 @@ runtest: tcltest
 	TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \
 	./tcltest
 
+# Useful target for running the test suite with an unwritable current
+# directory...
+ro-test: tcltest
+	LD_LIBRARY_PATH=`pwd`:${LD_LIBRARY_PATH}; export LD_LIBRARY_PATH; \
+	DYLD_LIBRARY_PATH=`pwd`:${DYLD_LIBRARY_PATH}; export DYLD_LIBRARY_PATH; \
+	LIBPATH=`pwd`:${LIBPATH}; export LIBPATH; \
+	SHLIB_PATH=`pwd`:${SHLIB_PATH}; export SHLIB_PATH; \
+	TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \
+	echo 'exec chmod -w .;package require tcltest;tcltest::temporaryDirectory /tmp;source ../tests/all.tcl;exec chmod +w .' | ./tcltest
+
 # This target can be used to run tclsh from the build directory
 # via `make shell SCRIPT=/tmp/foo.tcl`
 shell: tclsh
@@ -502,7 +521,17 @@ gdb: tclsh
 	@echo "set env LIBPATH=`pwd`:${LIBPATH}" >> gdb.run
 	@echo "set env SHLIB_PATH=`pwd`:${SHLIB_PATH}" >> gdb.run
 	@echo "set env TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> gdb.run
-	gdb ./tclsh --command=gdb.run
+	$(GDB) ./tclsh --command=gdb.run
+	rm gdb.run
+
+# This target can be used to run tclsh inside ddd
+ddd: tclsh
+	@echo "set env LD_LIBRARY_PATH=`pwd`:${LD_LIBRARY_PATH}" > gdb.run
+	@echo "set env DYLD_LIBRARY_PATH=`pwd`:${DYLD_LIBRARY_PATH}" > gdb.run
+	@echo "set env LIBPATH=`pwd`:${LIBPATH}" >> gdb.run
+	@echo "set env SHLIB_PATH=`pwd`:${SHLIB_PATH}" >> gdb.run
+	@echo "set env TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> gdb.run
+	$(DDD) -command=gdb.run ./tclsh
 	rm gdb.run
 
 # The following target outputs the name of the top-level source directory
-- 
cgit v0.12