summaryrefslogtreecommitdiffstats
path: root/tests/chanio.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/chanio.test')
-rw-r--r--tests/chanio.test45
1 files changed, 23 insertions, 22 deletions
diff --git a/tests/chanio.test b/tests/chanio.test
index daacdd0..04f0e3f 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -6,9 +6,9 @@
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
-# Copyright (c) 1991-1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1991-1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -36,8 +36,8 @@ namespace eval ::tcl::test::io {
catch {
::tcltest::loadTestedCommands
- package require -exact Tcltest [info patchlevel]
- set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
+ package require -exact tcl::test [info patchlevel]
+ set ::tcltestlib [info loaded {} Tcltest]
}
package require tcltests
@@ -47,7 +47,8 @@ namespace eval ::tcl::test::io {
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread [llength [info commands testmainthread]]
testConstraint testservicemode [llength [info commands testservicemode]]
- testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
+ testConstraint notWinCI [expr {
+ $::tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}]
testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}]
# You need a *very* special environment to do some tests. In particular,
@@ -1886,7 +1887,7 @@ test chan-io-20.3 {Tcl_CreateChannel: initial settings} -constraints {unix} -bod
} -result {{{} {}} {auto lf}}
test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} -setup {
set path(stdout) [makeFile {} stdout]
-} -constraints {stdio knownMsvcBug} -body {
+} -constraints {stdio notWinCI} -body {
set f [open $path(script) w]
chan puts -nonewline $f {
chan close stdout
@@ -2796,7 +2797,7 @@ test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} -s
chan puts $s $l
}
}
-} -constraints {socket tempNotMac fileevent knownMsvcBug} -body {
+} -constraints {socket tempNotMac fileevent notWinCI} -body {
proc accept {s a p} {
variable x
chan event $s readable [namespace code [list readit $s]]
@@ -3050,7 +3051,7 @@ test chan-io-30.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} -setup {
string length [chan read $f]
} -cleanup {
chan close $f
-} -result [expr 700*15+1]
+} -result [expr {700*15 + 1}]
test chan-io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} -setup {
file delete $path(test1)
} -body {
@@ -3067,7 +3068,7 @@ test chan-io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} -setup {
string length [chan read $f]
} -cleanup {
chan close $f
-} -result [expr 700*15+1]
+} -result [expr {700*15 + 1}]
test chan-io-30.15 {Tcl_Write mixed, Tcl_Read auto} -setup {
file delete $path(test1)
} -body {
@@ -3909,7 +3910,7 @@ test chan-io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} -setup {
}
chan close $f
string length $c
-} -result [expr 700*15+1]
+} -result [expr {700*15 + 1}]
test chan-io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} -setup {
file delete $path(test1)
set c ""
@@ -3929,7 +3930,7 @@ test chan-io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} -setup {
}
chan close $f
string length $c
-} -result [expr 700*15+1]
+} -result [expr {700*15 + 1}]
# Test Tcl_Read and buffering.
@@ -5338,9 +5339,9 @@ test chan-io-40.1 {POSIX open access modes: RDWR} -setup {
test chan-io-40.2 {POSIX open access modes: CREAT} -setup {
file delete $path(test3)
} -constraints {unix} -body {
- set f [open $path(test3) {WRONLY CREAT} 0600]
+ set f [open $path(test3) {WRONLY CREAT} 0o600]
file stat $path(test3) stats
- set x [format "%#o" [expr $stats(mode)&0o777]]
+ set x [format 0o%03o [expr {$stats(mode) & 0o777}]]
chan puts $f "line 1"
chan close $f
set f [open $path(test3) r]
@@ -5354,8 +5355,8 @@ test chan-io-40.3 {POSIX open access modes: CREAT} -setup {
# This test only works if your umask is 2, like ouster's.
chan close [open $path(test3) {WRONLY CREAT}]
file stat $path(test3) stats
- format "%#o" [expr $stats(mode)&0o777]
-} -result [format %#5o [expr {0o666 & ~ $umaskValue}]]
+ format 0o%03o [expr {$stats(mode) & 0o777}]
+} -result [format 0o%03o [expr {0o666 & ~ $umaskValue}]]
test chan-io-40.4 {POSIX open access modes: CREAT} -setup {
file delete $path(test3)
} -body {
@@ -6501,10 +6502,10 @@ test chan-io-50.5 {testing handler deletion vs reentrant calls} -setup {
set u recursive
lappend z "del calling recursive"
set timer [after 50 lappend z timeout]
- set mode [test servicemode 1]
+ set mode [testservicemode 1]
vwait z
after cancel $timer
- test servicemode $mode
+ testservicemode $mode
lappend z "del after update"
}
}
@@ -6721,7 +6722,7 @@ test chan-io-52.6 {TclCopyChannel} -setup {
set f2 [open $path(test1) w]
chan configure $f1 -translation lf -blocking 0
chan configure $f2 -translation lf -blocking 0
- set s0 [chan copy $f1 $f2 -size [expr [file size $thisScript] + 5]]
+ set s0 [chan copy $f1 $f2 -size [expr {[file size $thisScript] + 5}]]
set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
chan close $f1
chan close $f2
@@ -6963,7 +6964,7 @@ test chan-io-53.5 {CopyData: error during chan copy} {socket fcopy} {
chan close $listen ;# This means the socket open never really succeeds
chan copy $in $out -command [namespace code FcopyTestDone]
variable fcopyTestDone
- if ![info exists fcopyTestDone] {
+ if {![info exists fcopyTestDone]} {
vwait [namespace which -variable fcopyTestDone] ;# The error occurs here in the b.g.
}
chan close $in
@@ -6983,7 +6984,7 @@ test chan-io-53.6 {CopyData: error during chan copy} -setup {
set out [open $path(test1) w]
chan copy $in $out -command [namespace code FcopyTestDone]
variable fcopyTestDone
- if ![info exists fcopyTestDone] {
+ if {![info exists fcopyTestDone]} {
vwait [namespace which -variable fcopyTestDone]
}
return $fcopyTestDone ;# 0 for plain end of file
@@ -7036,7 +7037,7 @@ test chan-io-53.7 {CopyData: Flooding chan copy from pipe} -setup {
vwait [namespace which -variable fcopyTestDone]
}
# -1=error 0=script error N=number of bytes
- expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1
+ expr {($fcopyTestDone == 0) ? $fcopyTestCount : -1}
} -cleanup {
catch {chan close $in}
chan close $out
generated by cgit v0.12 at 2024-11-16 09:07:40 (GMT)