summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/clock.test9
-rw-r--r--tests/cmdAH.test3
-rw-r--r--tests/fCmd.test6
-rw-r--r--tests/http.test12
-rw-r--r--tests/io.test71
-rw-r--r--tests/ioCmd.test98
-rw-r--r--tests/ioTrans.test19
-rw-r--r--tests/iogt.test35
-rw-r--r--tests/namespace.test2
-rw-r--r--tests/obj.test4
-rw-r--r--tests/string.test9
-rw-r--r--tests/stringComp.test34
-rw-r--r--tests/winFCmd.test96
-rw-r--r--tests/winFile.test18
-rw-r--r--tests/winPipe.test8
15 files changed, 286 insertions, 138 deletions
diff --git a/tests/clock.test b/tests/clock.test
index 0202fc7..8debba1 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -36927,6 +36927,15 @@ test clock-67.1 {clock format, %% with a letter following [Bug 2819334]} {
clock format [clock seconds] -format %%r
} %r
+test clock-67.2 {Bug d19a30db57} -body {
+ # error, not segfault
+ tcl::clock::GetJulianDayFromEraYearMonthDay {} 2361222
+} -returnCodes error -match glob -result *
+test clock-67.3 {Bug d19a30db57} -body {
+ # error, not segfault
+ tcl::clock::GetJulianDayFromEraYearWeekDay {} 2361222
+} -returnCodes error -match glob -result *
+
# cleanup
namespace delete ::testClock
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 68a9a49..8af1228 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -139,6 +139,9 @@ test cmdAH-2.6.2 {cd} -constraints {unix nonPortable} -setup {
} -cleanup {
cd $dir
} -result {/}
+test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -returnCodes error -body {
+ cd .\0
+} -result "couldn't change working directory to \".\0\": no such file or directory"
test cmdAH-2.7 {Tcl_ConcatObjCmd} {
concat
} {}
diff --git a/tests/fCmd.test b/tests/fCmd.test
index b99dd16..8d867eb 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -511,12 +511,6 @@ test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} -setup {
} -returnCodes error -cleanup {
testchmod 755 td1
} -result {error renaming "tf1" to "td1/tf1": permission denied}
-test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} -setup {
- cleanup
-} -constraints {win 95} -returnCodes error -body {
- createfile tf1
- file rename tf1 $long
-} -result [subst {error renaming "tf1" to "$long": file name too long}]
test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} -setup {
cleanup
} -constraints {unix notRoot} -body {
diff --git a/tests/http.test b/tests/http.test
index a52cfb1..a0a26de 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -492,14 +492,10 @@ proc myProgress {token total current} {
}
set progress [list $total $current]
}
-if 0 {
- # This test hangs on Windows95 because the client never gets EOF
- set httpLog 1
- test http-4.6.1 {http::Event} knownBug {
- set token [http::geturl $url -blocksize 50 -progress myProgress]
- return $progress
- } {111 111}
-}
+test http-4.6.1 {http::Event} knownBug {
+ set token [http::geturl $url -blocksize 50 -progress myProgress]
+ return $progress
+} {111 111}
test http-4.7 {http::Event} -body {
set token [http::geturl $url -keepalive 0 -progress myProgress]
return $progress
diff --git a/tests/io.test b/tests/io.test
index 0688c14..edc0b11 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -4725,6 +4725,77 @@ test io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} {
close $f
list $c $l $e
} {21 8 1}
+test io-35.18 {Tcl_Eof, eof char, cr write, crlf read} -body {
+ file delete $path(test1)
+ set f [open $path(test1) w]
+ fconfigure $f -translation cr
+ puts $f abc\ndef
+ close $f
+ set s [file size $path(test1)]
+ set f [open $path(test1) r]
+ fconfigure $f -translation crlf
+ set l [string length [set in [read $f]]]
+ set e [eof $f]
+ close $f
+ list $s $l $e [scan [string index $in end] %c]
+} -result {8 8 1 13}
+test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} -body {
+ file delete $path(test1)
+ set f [open $path(test1) w]
+ fconfigure $f -translation cr -eofchar \x1a
+ puts $f abc\ndef
+ close $f
+ set s [file size $path(test1)]
+ set f [open $path(test1) r]
+ fconfigure $f -translation crlf -eofchar \x1a
+ set l [string length [set in [read $f]]]
+ set e [eof $f]
+ close $f
+ list $s $l $e [scan [string index $in end] %c]
+} -result {9 8 1 13}
+test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} -constraints knownBug -body {
+ file delete $path(test1)
+ set f [open $path(test1) w]
+ fconfigure $f -translation cr -eofchar \x1a
+ puts $f {}
+ close $f
+ set s [file size $path(test1)]
+ set f [open $path(test1) r]
+ fconfigure $f -translation crlf -eofchar \x1a
+ set l [string length [set in [read $f]]]
+ set e [eof $f]
+ close $f
+ list $s $l $e [scan [string index $in end] %c]
+} -result {2 1 1 13}
+test io-35.18c {Tcl_Eof, eof char, cr write, crlf read} -body {
+ file delete $path(test1)
+ set f [open $path(test1) w]
+ fconfigure $f -translation cr
+ puts $f {}
+ close $f
+ set s [file size $path(test1)]
+ set f [open $path(test1) r]
+ fconfigure $f -translation crlf
+ set l [string length [set in [read $f]]]
+ set e [eof $f]
+ close $f
+ list $s $l $e [scan [string index $in end] %c]
+} -result {1 1 1 13}
+test io-35.19 {Tcl_Eof, eof char in middle, cr write, crlf read} -body {
+ file delete $path(test1)
+ set f [open $path(test1) w]
+ fconfigure $f -translation cr -eofchar {}
+ set i [format abc\ndef\n%cqrs\nuvw 26]
+ puts $f $i
+ close $f
+ set c [file size $path(test1)]
+ set f [open $path(test1) r]
+ fconfigure $f -translation crlf -eofchar \x1a
+ set l [string length [set in [read $f]]]
+ set e [eof $f]
+ close $f
+ list $c $l $e [scan [string index $in end] %c]
+} -result {17 8 1 13}
# Test Tcl_InputBlocked
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 03242be..3976d25 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -793,6 +793,90 @@ test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match g
rename foo {}
set res
} -result {{} {initialize rc* {read write}} 1 {*all required methods*} {}}
+test iocmd-21.20 {Bug 88aef05cda} -setup {
+ proc foo {method chan args} {
+ switch -- $method blocking {
+ chan configure $chan -blocking [lindex $args 0]
+ return
+ } initialize {
+ return {initialize finalize watch blocking read write
+ configure cget cgetall}
+ } finalize {
+ return
+ }
+ }
+ set ch [chan create {read write} foo]
+} -body {
+ list [catch {chan configure $ch -blocking 0} m] $m
+} -cleanup {
+ close $ch
+ rename foo {}
+} -match glob -result {1 {*nested eval*}}
+test iocmd-21.21 {[close] in [read] segfaults} -setup {
+ proc foo {method chan args} {
+ switch -- $method initialize {
+ return {initialize finalize watch read}
+ } finalize {} watch {} read {
+ close $chan
+ return a
+ }
+ }
+ set ch [chan create read foo]
+} -body {
+ read $ch 0
+} -cleanup {
+ close $ch
+ rename foo {}
+} -result {}
+test iocmd-21.22 {[close] in [read] segfaults} -setup {
+ proc foo {method chan args} {
+ switch -- $method initialize {
+ return {initialize finalize watch read}
+ } finalize {} watch {} read {
+ catch {close $chan}
+ return a
+ }
+ }
+ set ch [chan create read foo]
+} -body {
+ read $ch 1
+} -returnCodes error -cleanup {
+ catch {close $ch}
+ rename foo {}
+} -match glob -result {*invalid argument*}
+test iocmd-21.23 {[close] in [gets] segfaults} -setup {
+ proc foo {method chan args} {
+ switch -- $method initialize {
+ return {initialize finalize watch read}
+ } finalize {} watch {} read {
+ catch {close $chan}
+ return \n
+ }
+ }
+ set ch [chan create read foo]
+} -body {
+ gets $ch
+} -cleanup {
+ catch {close $ch}
+ rename foo {}
+} -result {}
+test iocmd-21.24 {[close] in binary [gets] segfaults} -setup {
+ proc foo {method chan args} {
+ switch -- $method initialize {
+ return {initialize finalize watch read}
+ } finalize {} watch {} read {
+ catch {close $chan}
+ return \n
+ }
+ }
+ set ch [chan create read foo]
+} -body {
+ chan configure $ch -translation binary
+ gets $ch
+} -cleanup {
+ catch {close $ch}
+ rename foo {}
+} -result {}
# --- --- --- --------- --------- ---------
# Helper commands to record the arguments to handler methods.
@@ -1051,6 +1135,20 @@ test iocmd-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glo
rename foo {}
unset res
} -result {{read rc* 4096} {} 0}
+test iocmd-23.11 {chan read, close pulls the rug out} -match glob -body {
+ set res {}
+ proc foo {args} {
+ oninit; onfinal; track
+ set args [lassign $args sub id]
+ if {$sub ne "read"} {return}
+ close $id
+ return {}
+ }
+ set c [chan create {r} foo]
+ note [read $c]
+ rename foo {}
+ set res
+} -result {{read rc* 4096} {}}
# --- === *** ###########################
# method write
diff --git a/tests/ioTrans.test b/tests/ioTrans.test
index 5a8874c..b21d894 100644
--- a/tests/ioTrans.test
+++ b/tests/ioTrans.test
@@ -540,6 +540,25 @@ test iortrans-4.8 {chan read, read, bug 2921116} -setup {
rename foo {}
} -result {{read rt* {test data
}} file*}
+test iortrans-4.8.1 {chan read, bug 721ec69271} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {fd args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ # Kill and recreate transform while it is operating
+ chan pop $fd
+ chan push $fd [list foo $fd]
+ }
+ set c [chan push [set c [tempchan]] [list foo $c]]
+ chan configure $c -buffersize 2
+ lappend res [read $c]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{read rt* {test data
+}} file*}
test iortrans-4.9 {chan read, gets, bug 2921116} -setup {
set res {}
} -match glob -body {
diff --git a/tests/iogt.test b/tests/iogt.test
index d4c31d2..bd3c67b 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -220,6 +220,26 @@ proc id_fulltrail {var op data} {
return $res
}
+proc id_torture {chan op data} {
+ switch -- $op {
+ create/write -
+ create/read -
+ delete/write -
+ delete/read -
+ clear_read {;#ignore}
+ flush/write -
+ flush/read -
+ write -
+ read {
+ testchannel unstack $chan
+ testchannel transform $chan \
+ -command [namespace code [list id_torture $chan]]
+ return $data
+ }
+ query/maxRead {return -1}
+ }
+}
+
proc counter {var op data} {
namespace upvar [namespace current] $var n
@@ -326,6 +346,11 @@ proc audit_ops {var -attach channel} {
proc audit_flow {var -attach channel} {
testchannel transform $channel -command [namespace code [list id_fulltrail $var]]
}
+
+proc torture {-attach channel} {
+ testchannel transform $channel -command [namespace code [list id_torture $channel]]
+}
+
proc stopafter {var n -attach channel} {
namespace upvar [namespace current] $var vn
set vn $n
@@ -546,6 +571,16 @@ delete/read {} *ignored*
flush/write {} {}
delete/write {} *ignored*}
+test iogt-2.4 {basic I/O, mixed trail} {testchannel} {
+ set fh [open $path(dummy) r]
+ torture -attach $fh
+ chan configure $fh -buffersize 2
+ set x [read $fh]
+ testchannel unstack $fh
+ close $fh
+ set x
+} {}
+
test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} -setup {
proc DoneCopy {n {err {}}} {
variable copy 1
diff --git a/tests/namespace.test b/tests/namespace.test
index 8c4b81c..fab0040 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -303,7 +303,7 @@ test namespace-9.4 {Tcl_Import, simple import} {
}
test_ns_import::p
} {cmd1: 123}
-test namespace-9.5 {Tcl_Import, can't redefine cmd unless allowOverwrite!=0} {
+test namespace-9.5 {Tcl_Import, RFE 1230597} {
list [catch {namespace eval test_ns_import {namespace import ::test_ns_export::*}} msg] $msg
} {0 {}}
test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} {
diff --git a/tests/obj.test b/tests/obj.test
index 71a39b4..151abfb 100644
--- a/tests/obj.test
+++ b/tests/obj.test
@@ -605,7 +605,7 @@ test obj-33.2 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
set x 0xffff; append x ffff
list [string is integer $x] [expr { wide($x) }]
} {1 4294967295}
-test obj-33.3 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
+test obj-33.3 {integer overflow on input} {
set x 0x10000; append x 0000
list [string is integer $x] [expr { wide($x) }]
} {0 4294967296}
@@ -621,7 +621,7 @@ test obj-33.6 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
set x -0xffff; append x ffff
list [string is integer $x] [expr { wide($x) }]
} {1 -4294967295}
-test obj-33.7 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
+test obj-33.7 {integer overflow on input} {
set x -0x10000; append x 0000
list [string is integer $x] [expr { wide($x) }]
} {0 -4294967296}
diff --git a/tests/string.test b/tests/string.test
index 1b0486c..45efe37 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -1398,6 +1398,9 @@ test string-15.9 {string tolower} {
test string-15.10 {string tolower, unicode} {
string tolower ABCabc\xc7\xe7
} "abcabc\xe7\xe7"
+test string-15.11 {string tolower, compiled} {
+ lindex [string tolower [list A B [list C]]] 1
+} b
test string-16.1 {string toupper} {
list [catch {string toupper} msg] $msg
@@ -1429,6 +1432,9 @@ test string-16.9 {string toupper} {
test string-16.10 {string toupper, unicode} {
string toupper ABCabc\xc7\xe7
} "ABCABC\xc7\xc7"
+test string-16.11 {string toupper, compiled} {
+ lindex [string toupper [list a b [list c]]] 1
+} B
test string-17.1 {string totitle} {
list [catch {string totitle} msg] $msg
@@ -1451,6 +1457,9 @@ test string-17.6 {string totitle, unicode} {
test string-17.7 {string totitle, unicode} {
string totitle \u01f3BCabc\xc7\xe7
} "\u01f2bcabc\xe7\xe7"
+test string-17.8 {string totitle, compiled} {
+ lindex [string totitle [list aa bb [list cc]]] 0
+} Aa
test string-18.1 {string trim} {
list [catch {string trim} msg] $msg
diff --git a/tests/stringComp.test b/tests/stringComp.test
index 210f431..1ebda90 100644
--- a/tests/stringComp.test
+++ b/tests/stringComp.test
@@ -26,6 +26,22 @@ catch [list package require -exact Tcltest [info patchlevel]]
# Some tests require the testobj command
testConstraint testobj [expr {[info commands testobj] != {}}]
+testConstraint memory [llength [info commands memory]]
+if {[testConstraint memory]} {
+ proc getbytes {} {
+ set lines [split [memory info] \n]
+ return [lindex $lines 3 3]
+ }
+ proc leaktest {script {iterations 3}} {
+ set end [getbytes]
+ for {set i 0} {$i < $iterations} {incr i} {
+ uplevel 1 $script
+ set tmp $end
+ set end [getbytes]
+ }
+ return [expr {$end - $tmp}]
+ }
+}
test stringComp-1.1 {error conditions} {
proc foo {} {string gorp a b}
@@ -687,7 +703,23 @@ test stringComp-12.1 {Bug 3588366: end-offsets before start} {
## not yet bc
## string replace
-## not yet bc
+test stringComp-14.1 {Bug 82e7f67325} {
+ apply {x {
+ set a [join $x {}]
+ lappend b [string length [string replace ___! 0 2 $a]]
+ lappend b [string length [string replace ___! 0 2 $a[unset a]]]
+ }} {a b}
+} {3 3}
+test stringComp-14.2 {Bug 82e7f67325} memory {
+ # As in stringComp-14.1, but make sure we don't retain too many refs
+ leaktest {
+ apply {x {
+ set a [join $x {}]
+ lappend b [string length [string replace ___! 0 2 $a]]
+ lappend b [string length [string replace ___! 0 2 $a[unset a]]]
+ }} {a b}
+ }
+} {0}
## string tolower
## not yet bc
diff --git a/tests/winFCmd.test b/tests/winFCmd.test
index 28a0e9f..bd50328 100644
--- a/tests/winFCmd.test
+++ b/tests/winFCmd.test
@@ -208,22 +208,11 @@ test winFCmd-1.13 {TclpRenameFile: errno: EACCES} -setup {
} -constraints {win win2000orXP testfile} -body {
testfile mv nul tf1
} -returnCodes error -result EINVAL
-test winFCmd-1.13.1 {TclpRenameFile: errno: EACCES} -setup {
+test winFCmd-1.14 {TclpRenameFile: errno: EACCES} -setup {
cleanup
} -constraints {win nt winOlderThan2000 testfile} -body {
testfile mv nul tf1
} -returnCodes error -result EACCES
-test winFCmd-1.13.2 {TclpRenameFile: errno: ENOENT} -setup {
- cleanup
-} -constraints {win 95 testfile} -body {
- testfile mv nul tf1
-} -returnCodes error -result ENOENT
-test winFCmd-1.14 {TclpRenameFile: errno: EACCES} -setup {
- cleanup
-} -constraints {win 95 testfile} -body {
- createfile tf1
- testfile mv tf1 nul
-} -returnCodes error -result EACCES
test winFCmd-1.15 {TclpRenameFile: errno: EEXIST} -setup {
cleanup
} -constraints {win nt testfile} -body {
@@ -257,11 +246,6 @@ test winFCmd-1.19.1 {TclpRenameFile: errno == EACCES} -setup {
} -constraints {win nt winOlderThan2000 testfile} -body {
testfile mv nul tf1
} -returnCodes error -result EACCES
-test winFCmd-1.19.2 {TclpRenameFile: errno == ENOENT} -setup {
- cleanup
-} -constraints {win 95 testfile} -body {
- testfile mv nul tf1
-} -returnCodes error -result ENOENT
test winFCmd-1.20 {TclpRenameFile: src is dir} -setup {
cleanup
} -constraints {win nt testfile} -body {
@@ -474,29 +458,14 @@ test winFCmd-2.6 {TclpCopyFile: errno: ENOENT} -setup {
} -returnCodes error -result ENOENT
test winFCmd-2.7 {TclpCopyFile: errno: EACCES} -setup {
cleanup
-} -constraints {win 95 testfile} -body {
- createfile tf1
- set fd [open tf2 w]
- testfile cp tf1 tf2
-} -cleanup {
- close $fd
- cleanup
-} -returnCodes error -result EACCES
-test winFCmd-2.8 {TclpCopyFile: errno: EACCES} -setup {
- cleanup
} -constraints {win win2000orXP testfile} -body {
testfile cp nul tf1
} -returnCodes error -result EINVAL
-test winFCmd-2.8.1 {TclpCopyFile: errno: EACCES} -setup {
+test winFCmd-2.8 {TclpCopyFile: errno: EACCES} -setup {
cleanup
} -constraints {win nt winOlderThan2000 testfile} -body {
testfile cp nul tf1
} -returnCodes error -result EACCES
-test winFCmd-2.9 {TclpCopyFile: errno: ENOENT} -setup {
- cleanup
-} -constraints {win 95 testfile} -body {
- testfile cp nul tf1
-} -returnCodes error -result ENOENT
test winFCmd-2.10 {TclpCopyFile: CopyFile succeeds} -setup {
cleanup
} -constraints {win testfile} -body {
@@ -573,17 +542,6 @@ test winFCmd-2.17 {TclpCopyFile: dst is readonly} -setup {
catch {testchmod 666 tf2}
cleanup
} -result {1 tf1}
-test winFCmd-2.18 {TclpCopyFile: still can't copy onto dst} -setup {
- cleanup
-} -constraints {win 95 testfile testchmod} -body {
- createfile tf1
- createfile tf2
- testchmod 000 tf2
- set fd [open tf2]
- set msg [list [catch {testfile cp tf1 tf2} msg] $msg]
- close $fd
- lappend msg [file writable tf2]
-} -result {1 EACCES 0}
test winFCmd-3.1 {TclpDeleteFile: errno: EACCES} -body {
testfile rm $cdfile $cdrom/dummy~~.fil
@@ -666,9 +624,6 @@ test winFCmd-3.11 {TclpDeleteFile: still can't remove path} -setup {
test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} -body {
testfile mkdir $cdrom/dummy~~.dir
} -constraints {win nt cdrom testfile} -returnCodes error -result EACCES
-test winFCmd-4.2 {TclpCreateDirectory: errno: EACCES} -body {
- testfile mkdir $cdrom/dummy~~.dir
-} -constraints {win 95 cdrom testfile} -returnCodes error -result ENOSPC
test winFCmd-4.3 {TclpCreateDirectory: errno: EEXIST} -setup {
cleanup
} -constraints {win testfile} -body {
@@ -764,11 +719,6 @@ test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} -setup {
catch {testchmod 666 td1}
cleanup
} -result {td1 EACCES}
-test winFCmd-6.10 {TclpRemoveDirectory: attr == -1} -setup {
- cleanup
-} -constraints {win 95 testfile} -body {
- testfile rmdir nul
-} -returnCodes error -result {nul EACCES}
test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
cleanup
} -constraints {win nt testfile} -body {
@@ -776,16 +726,6 @@ test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
# WinXP returns EEXIST, WinNT seems to return EACCES. No policy
# decision has been made as to which is correct.
} -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$}
-# This next test has a very hokey way of matching...
-test winFCmd-6.12 {TclpRemoveDirectory: errno == EACCES} -setup {
- cleanup
-} -constraints {win 95 testfile} -body {
- createfile tf1
- set res [catch {testfile rmdir tf1} msg]
- # get rid of path
- set msg [list [file tail [lindex $msg 0]] [lindex $msg 1]]
- list $res $msg
-} -result {1 {tf1 ENOTDIR}}
test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup {
cleanup
} -constraints {winVista testfile testchmod} -body {
@@ -798,16 +738,6 @@ test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup {
cleanup
} -returnCodes error -result {td1 EACCES}
# This next test has a very hokey way of matching...
-test winFCmd-6.14 {TclpRemoveDirectory: check if empty dir} -setup {
- cleanup
-} -constraints {win 95 testfile} -body {
- file mkdir td1/td2
- set res [catch {testfile rmdir td1} msg]
- # get rid of path
- set msg [list [file tail [lindex $msg 0]] [lindex $msg 1]]
- list $res $msg
-} -result {1 {td1 EEXIST}}
-# This next test has a very hokey way of matching...
test winFCmd-6.15 {TclpRemoveDirectory: !recursive} -setup {
cleanup
} -constraints {win testfile} -body {
@@ -887,11 +817,6 @@ test winFCmd-7.7 {TraverseWinTree: append \ to source if necessary} -setup {
} -cleanup {
cleanup
} -result {tf1}
-test winFCmd-7.8 {TraverseWinTree: append \ to source if necessary} -body {
- # cdrom can return either d:\ or D:/, but we only care about the errcode
- testfile rmdir $cdrom/
-} -constraints {win 95 cdrom testfile} -returnCodes error -match glob \
- -result {* EACCES} ; # was EEXIST, but changed for win98.
test winFCmd-7.9 {TraverseWinTree: append \ to source if necessary} -body {
testfile rmdir $cdrom/
} -constraints {win nt cdrom testfile} -returnCodes error -match glob \
@@ -930,14 +855,6 @@ test winFCmd-7.13 {TraverseWinTree: append \ to target if necessary} -setup {
} -cleanup {
cleanup
} -result {tf1}
-test winFCmd-7.14 {TraverseWinTree: append \ to target if necessary} -setup {
- cleanup
-} -constraints {win 95 testfile} -body {
- file mkdir td1
- testfile cpdir td1 /
-} -cleanup {
- cleanup
-} -returnCodes error -result {/ EEXIST}
test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} -setup {
cleanup
} -constraints {win nt testfile} -body {
@@ -1038,15 +955,6 @@ test winFCmd-9.1 {TraversalDelete: DOTREE_F} -setup {
createfile td1/tf1
testfile rmdir -force td1
} -result {}
-test winFCmd-9.2 {TraversalDelete: DOTREE_F} -setup {
- cleanup
-} -constraints {win 95 testfile} -body {
- file mkdir td1
- set fd [open td1/tf1 w]
- testfile rmdir -force td1
-} -cleanup {
- close $fd
-} -returnCodes error -result {td1\tf1 EACCES}
test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup {
cleanup
} -constraints {winVista testfile testchmod} -body {
diff --git a/tests/winFile.test b/tests/winFile.test
index fba9bcb..2c47f5f 100644
--- a/tests/winFile.test
+++ b/tests/winFile.test
@@ -37,24 +37,6 @@ test winFile-1.2 {TclpGetUserHome} -constraints {win nt nonPortable} -body {
# The administrator account should always exist.
glob ~administrator
} -match glob -result *
-test winFile-1.3 {TclpGetUserHome} -constraints {win 95} -body {
- # Find some user in system.ini and then see if they have a home.
-
- set f [open $::env(windir)/system.ini]
- while {[gets $f line] >= 0} {
- if {$line ne {[Password Lists]}} {
- continue
- }
- gets $f
- set name [lindex [split [gets $f] =] 0]
- if {$name ne ""} {
- return [catch {glob ~$name}]
- }
- }
- return 0 ;# didn't find anything...
-} -cleanup {
- catch {close $f}
-} -result {0}
test winFile-1.4 {TclpGetUserHome} {win nt nonPortable} {
catch {glob ~stanton@workgroup}
} {0}
diff --git a/tests/winPipe.test b/tests/winPipe.test
index d2e804d..9c6f94d 100644
--- a/tests/winPipe.test
+++ b/tests/winPipe.test
@@ -82,10 +82,6 @@ test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {win nt exec cat3
exec [interpreter] $path(more) < $path(big) | $cat32 > $path(stdout) 2> $path(stderr)
list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
-test winpipe-1.5 {32 bit comprehensive tests: a lot from pipe} {win 95 exec cat32} {
- exec command /c type $path(big) |& $cat32 > $path(stdout) 2> $path(stderr)
- list [contents $path(stdout)] [contents $path(stderr)]
-} "{$big} stderr32"
test winpipe-1.6 {32 bit comprehensive tests: from console} \
{win cat32 AllocConsole} {
# would block waiting for human input
@@ -174,10 +170,6 @@ test winpipe-1.21 {32 bit comprehensive tests: read/write application} \
catch {close $f}
set r
} "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
-test winpipe-1.22 {Checking command.com for Win95/98 hanging} {win 95 exec} {
- exec command.com /c dir /b
- set result 1
-} 1
test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} {
proc readResults {f} {
generated by cgit v0.12 at 2024-11-21 22:02:08 (GMT)