summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-06-05 16:05:36 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-06-05 16:05:36 (GMT)
commite6d8763bc8e167637a136b863e0728665471eff3 (patch)
treedcd63dcfb36e95741a3c4c89b7a852034b2a9011 /tests
parentc69794cc05d5ab01537ede052537fa25613c01c4 (diff)
parent7d602745337ea00ec3bd5cbb4efcd1c0e3379fbb (diff)
downloadtcl-e6d8763bc8e167637a136b863e0728665471eff3.zip
tcl-e6d8763bc8e167637a136b863e0728665471eff3.tar.gz
tcl-e6d8763bc8e167637a136b863e0728665471eff3.tar.bz2
merge trunk
Diffstat (limited to 'tests')
-rw-r--r--tests/fCmd.test132
-rw-r--r--tests/io.test6
-rw-r--r--tests/safe.test5
-rw-r--r--tests/socket.test1
-rw-r--r--tests/zlib.test16
5 files changed, 98 insertions, 62 deletions
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 410e610..f2adcef 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -15,6 +15,8 @@ if {"::tcltest" ni [namespace children]} {
namespace import -force ::tcltest::*
}
+cd [temporaryDirectory]
+
testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testchmod [llength [info commands testchmod]]
testConstraint winVista 0
@@ -46,6 +48,15 @@ if {[testConstraint unix]} {
set group [lindex $groupList 0]
testConstraint foundGroup 1
}
+
+ proc dev dir {
+ file stat $dir stat
+ return $stat(dev)
+ }
+
+ if {[catch {makeDirectory tcl[pid] /tmp} tmpspace] == 0} {
+ testConstraint xdev [expr {([dev .] != [dev $tmpspace])}]
+ }
}
# Also used in winFCmd...
@@ -149,13 +160,6 @@ proc contents {file} {
return $r
}
-cd [temporaryDirectory]
-
-proc dev dir {
- file stat $dir stat
- return $stat(dev)
-}
-testConstraint xdev [expr {[testConstraint unix] && ([dev .] != [dev /tmp])}]
set root [lindex [file split [pwd]] 0]
@@ -586,12 +590,12 @@ test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} -setup {
} -returnCodes error -match glob -result \
[subst {error renaming "td2" to "[file join td1 td2]": file *}]
test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} -setup {
- cleanup /tmp
-} -constraints {unix notRoot} -body {
+ cleanup $tmpspace
+} -constraints {xdev notRoot} -body {
createfile tf1
- file rename tf1 /tmp
- glob -nocomplain tf* /tmp/tf1
-} -result {/tmp/tf1}
+ file rename tf1 $tmpspace
+ glob -nocomplain tf* [file join $tmpspace tf1]
+} -result [file join $tmpspace tf1]
test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup {
catch {file delete -force c:/tcl8975@ d:/tcl8975@}
} -body {
@@ -605,28 +609,29 @@ test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup {
catch {file delete -force d:/tcl8975@}
} -result {d:/tcl8975@}
test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} -setup {
- cleanup /tmp
-} -constraints {unix notRoot} -body {
+ cleanup $tmpspace
+} -constraints {xdev notRoot} -body {
file mkdir td1
- file rename td1 /tmp
- glob -nocomplain td* /tmp/td*
-} -result {/tmp/td1}
+ file rename td1 $tmpspace
+ glob -nocomplain td* [file join $tmpspace td*]
+} -result [file join $tmpspace td1]
test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} -setup {
- cleanup /tmp
-} -constraints {unix notRoot} -body {
+ cleanup $tmpspace
+} -constraints {xdev notRoot} -body {
createfile tf1
- file rename tf1 /tmp
- glob -nocomplain tf* /tmp/tf*
-} -result {/tmp/tf1}
+ file rename tf1 $tmpspace
+ glob -nocomplain tf* [file join $tmpspace tf*]
+} -result [file join $tmpspace tf1]
test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
- cleanup /tmp
-} -constraints {unix notRoot xdev} -body {
+ cleanup $tmpspace
+} -constraints {notRoot xdev} -body {
file mkdir td1/td2/td3
file attributes td1 -permissions 0000
- file rename td1 /tmp
+ file rename td1 $tmpspace
} -returnCodes error -cleanup {
file attributes td1 -permissions 0755
-} -match regexp -result {^error renaming "td1"( to "/tmp/td1")?: permission denied$}
+ cleanup
+} -match regexp -result {^error renaming "td1"( to "/tmp/tcl\d+/td1")?: permission denied$}
test fCmd-6.24 {CopyRenameOneFile: error uses original name} -setup {
cleanup
} -constraints {unix notRoot} -body {
@@ -662,54 +667,54 @@ test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} -setup {
file delete -force ~/td1
} -result "error copying \"~/td1\" to \"td1\": \"[file join $::env(HOME) td1 td2]\": permission denied"
test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
- cleanup /tmp
-} -constraints {unix notRoot xdev} -returnCodes error -body {
+ cleanup $tmpspace
+} -constraints {notRoot xdev} -returnCodes error -body {
file mkdir td1/td2/td3
- file mkdir /tmp/td1
- createfile /tmp/td1/tf1
- file rename -force td1 /tmp
-} -result {error renaming "td1" to "/tmp/td1": file already exists}
+ file mkdir [file join $tmpspace td1]
+ createfile [file join $tmpspace td1 tf1]
+ file rename -force td1 $tmpspace
+} -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": file already exists}
test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
- cleanup /tmp
-} -constraints {unix notRoot xdev} -body {
+ cleanup $tmpspace
+} -constraints {notRoot xdev} -body {
file mkdir td1/td2/td3
file attributes td1/td2/td3 -permissions 0000
- file rename td1 /tmp
+ file rename td1 $tmpspace
} -returnCodes error -cleanup {
file attributes td1/td2/td3 -permissions 0755
-} -result {error renaming "td1" to "/tmp/td1": "td1/td2/td3": permission denied}
+ cleanup $tmpspace
+} -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": "td1/td2/td3": permission denied}
test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} -setup {
- cleanup /tmp
-} -constraints {unix notRoot xdev} -body {
+ cleanup $tmpspace
+} -constraints {notRoot xdev} -body {
file mkdir td1/td2/td3
- file rename td1 /tmp
- glob td* /tmp/td1/t*
-} -result {/tmp/td1/td2}
+ file rename td1 $tmpspace
+ glob td* [file join $tmpspace td1 t*]
+} -result [file join $tmpspace td1 td2]
test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup {
- cleanup
-} -constraints {unix notRoot} -body {
+ cleanup $tmpspace
+} -constraints {xdev notRoot} -body {
file mkdir foo/bar
file attr foo -perm 040555
- file rename foo/bar /tmp
+ file rename foo/bar $tmpspace
} -returnCodes error -cleanup {
- catch {file delete /tmp/bar}
+ catch {file delete [file join $tmpspace bar]}
catch {file attr foo -perm 040777}
catch {file delete -force foo}
} -match glob -result {*: permission denied}
test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} -setup {
- catch {cleanup /tmp}
-} -constraints {unix notRoot xdev} -body {
- file mkdir /tmp/td1
- createfile /tmp/td1/tf1
- file rename /tmp/td1/tf1 tf1
- list [file exists /tmp/td1/tf1] [file exists tf1]
+ cleanup $tmpspace
+} -constraints {notRoot xdev} -body {
+ file mkdir [file join $tmpspace td1]
+ createfile [file join $tmpspace td1 tf1]
+ file rename [file join $tmpspace td1 tf1] tf1
+ list [file exists [file join $tmpspace td1 tf1]] [file exists tf1]
} -result {0 1}
test fCmd-6.32 {CopyRenameOneFile: copy} -constraints {notRoot} -setup {
cleanup
} -returnCodes error -body {
file copy tf1 tf2
} -result {error copying "tf1": no such file or directory}
-catch {cleanup /tmp}
test fCmd-7.1 {FileForceOption: none} -constraints {notRoot} -setup {
cleanup
@@ -1347,23 +1352,23 @@ test fCmd-12.8 {renamefile: generic error} -setup {
file delete -force tfa
} -result {1}
test fCmd-12.9 {renamefile: moving a file across volumes} -setup {
- catch {file delete -force -- tfa /tmp/tfa}
-} -constraints {unix notRoot} -body {
+ cleanup $tmpspace
+} -constraints {xdev notRoot} -body {
set s [createfile tfa]
- file rename tfa /tmp
- list [checkcontent /tmp/tfa $s] [file exists tfa]
+ file rename tfa $tmpspace
+ list [checkcontent [file join $tmpspace tfa] $s] [file exists tfa]
} -cleanup {
- file delete /tmp/tfa
+ cleanup $tmpspace
} -result {1 0}
test fCmd-12.10 {renamefile: moving a directory across volumes} -setup {
- catch {file delete -force -- tfad /tmp/tfad}
-} -constraints {unix notRoot} -body {
+ cleanup $tmpspace
+} -constraints {xdev notRoot} -body {
file mkdir tfad
set s [createfile tfad/a]
- file rename tfad /tmp
- list [checkcontent /tmp/tfad/a $s] [file exists tfad]
+ file rename tfad $tmpspace
+ list [checkcontent [file join $tmpspace tfad a] $s] [file exists tfad]
} -cleanup {
- file delete -force /tmp/tfad
+ cleanup $tmpspace
} -result {1 0}
#
@@ -2583,6 +2588,9 @@ test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {win} -body {
# cleanup
cleanup
+if {[testConstraint unix]} {
+ removeDirectory tcl[pid] /tmp
+}
::tcltest::cleanupTests
return
diff --git a/tests/io.test b/tests/io.test
index 386179e..f3c39f4 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -2086,6 +2086,8 @@ set path(pipe) [makeFile {} pipe]
set path(output) [makeFile {} output]
test io-27.6 {FlushChannel, async flushing, async close} \
{stdio asyncPipeClose openpipe} {
+ # This test may fail on old Unix systems (seen on IRIX64 6.5) with
+ # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197.
file delete $path(pipe)
file delete $path(output)
set f [open $path(pipe) w]
@@ -2645,6 +2647,8 @@ test io-29.30 {Tcl_WriteChars, crlf mode} {
file size $path(test1)
} 25
test io-29.31 {Tcl_WriteChars, background flush} {stdio openpipe} {
+ # This test may fail on old Unix systems (seen on IRIX64 6.5) with
+ # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197.
file delete $path(pipe)
file delete $path(output)
set f [open $path(pipe) w]
@@ -2686,6 +2690,8 @@ test io-29.31 {Tcl_WriteChars, background flush} {stdio openpipe} {
} ok
test io-29.32 {Tcl_WriteChars, background flush to slow reader} \
{stdio asyncPipeClose openpipe} {
+ # This test may fail on old Unix systems (seen on IRIX64 6.5) with
+ # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197.
file delete $path(pipe)
file delete $path(output)
set f [open $path(pipe) w]
diff --git a/tests/safe.test b/tests/safe.test
index f270248..dcd5bfd 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -204,6 +204,11 @@ test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -body {
[safe::interpConfigure $i]\
[safe::interpDelete $i]
} -match glob -result "{\$p(:0:)} {\$p(:*:)} 1 {can't find package http 1} {-accessPath {[list $tcl_library */dummy/unixlike/test/path]} -statics 0 -nested 1 -deleteHook {}} {}"
+test safe-7.3 {check that safe subinterpreters work} {
+ set i [safe::interpCreate]
+ set j [safe::interpCreate [list $i x]]
+ list [interp eval $j {join {o k} ""}] [safe::interpDelete $i] [interp exists $j]
+} {ok {} 0}
# test source control on file name
test safe-8.1 {safe source control on file} -setup {
diff --git a/tests/socket.test b/tests/socket.test
index d88eb65..9f1cc78 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -1696,6 +1696,7 @@ test socket_$af-13.1 {Testing use of shared socket between two threads} -body {
set i 0
vwait x
close $f
+ thread::wait
}]]
set port [thread::send $serverthread {set listen}]
set s [socket $localhost $port]
diff --git a/tests/zlib.test b/tests/zlib.test
index 5935fbe..642b2a4 100644
--- a/tests/zlib.test
+++ b/tests/zlib.test
@@ -103,6 +103,22 @@ test zlib-7.4 {zlib stream} zlib {
$s close
lappend result $data
} {{} 1 abcdeEDCBA}
+test zlib-7.5 {zlib stream} zlib {
+ set s [zlib stream gzip]
+ $s put -finalize abcdeEDCBA..
+ set data [$s get]
+ set result [list [$s get] [format %x [$s checksum]]]
+ $s close
+ lappend result [zlib gunzip $data]
+} {{} 69f34b6a abcdeEDCBA..}
+test zlib-7.6 {zlib stream} zlib {
+ set s [zlib stream gunzip]
+ $s put -finalize [zlib gzip abcdeEDCBA..]
+ set data [$s get]
+ set result [list [$s get] [format %x [$s checksum]]]
+ $s close
+ lappend result $data
+} {{} 69f34b6a abcdeEDCBA..}
test zlib-8.1 {zlib transformation} -constraints zlib -setup {
set file [makeFile {} test.gz]