summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog26
-rw-r--r--tests/env.test14
-rw-r--r--tests/event.test50
-rw-r--r--tests/fileName.test24
-rw-r--r--tests/http.test39
-rw-r--r--tests/httpold.test85
-rw-r--r--tests/ioUtil.test24
-rw-r--r--tests/macFCmd.test20
-rw-r--r--tests/regexp.test5
-rw-r--r--tests/regexpComp.test3
-rw-r--r--tests/source.test61
-rw-r--r--tests/unixFCmd.test20
-rw-r--r--tests/unixFile.test25
-rw-r--r--tests/unixNotfy.test31
-rw-r--r--unix/Makefile.in33
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
generated by cgit v0.12 at 2024-11-05 13:01:55 (GMT)