diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2012-06-05 16:05:36 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2012-06-05 16:05:36 (GMT) |
commit | e6d8763bc8e167637a136b863e0728665471eff3 (patch) | |
tree | dcd63dcfb36e95741a3c4c89b7a852034b2a9011 /tests | |
parent | c69794cc05d5ab01537ede052537fa25613c01c4 (diff) | |
parent | 7d602745337ea00ec3bd5cbb4efcd1c0e3379fbb (diff) | |
download | tcl-e6d8763bc8e167637a136b863e0728665471eff3.zip tcl-e6d8763bc8e167637a136b863e0728665471eff3.tar.gz tcl-e6d8763bc8e167637a136b863e0728665471eff3.tar.bz2 |
merge trunk
Diffstat (limited to 'tests')
-rw-r--r-- | tests/fCmd.test | 132 | ||||
-rw-r--r-- | tests/io.test | 6 | ||||
-rw-r--r-- | tests/safe.test | 5 | ||||
-rw-r--r-- | tests/socket.test | 1 | ||||
-rw-r--r-- | tests/zlib.test | 16 |
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] |