summaryrefslogtreecommitdiffstats
path: root/tests/ioCmd.test
diff options
context:
space:
mode:
authorstanton <stanton>1999-04-16 00:46:29 (GMT)
committerstanton <stanton>1999-04-16 00:46:29 (GMT)
commit97464e6cba8eb0008cf2727c15718671992b913f (patch)
treece9959f2747257d98d52ec8d18bf3b0de99b9535 /tests/ioCmd.test
parenta8c96ddb94d1483a9de5e340b740cb74ef6cafa7 (diff)
downloadtcl-97464e6cba8eb0008cf2727c15718671992b913f.zip
tcl-97464e6cba8eb0008cf2727c15718671992b913f.tar.gz
tcl-97464e6cba8eb0008cf2727c15718671992b913f.tar.bz2
merged tcl 8.1 branch back into the main trunk
Diffstat (limited to 'tests/ioCmd.test')
-rw-r--r--tests/ioCmd.test62
1 files changed, 39 insertions, 23 deletions
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 8de4456..1937c5d 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -7,13 +7,16 @@
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: ioCmd.test,v 1.2 1998/09/14 18:40:11 stanton Exp $
+# RCS: @(#) $Id: ioCmd.test,v 1.3 1999/04/16 00:47:29 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
removeFile test1
removeFile pipe
@@ -158,7 +161,7 @@ test iocmd-5.3 {seek command} {
} {1 {expected integer but got "gugu"}}
test iocmd-5.4 {seek command} {
list [catch {seek stdin 100 gugu} msg] $msg
-} {1 {bad origin "gugu": should be start, current, or end}}
+} {1 {bad origin "gugu": must be start, current, or end}}
test iocmd-6.1 {tell command} {
list [catch {tell} msg] $msg
@@ -205,31 +208,31 @@ test iocmd-8.6 {fconfigure command} {
test iocmd-8.7 {fconfigure command} {
removeFile test1
set f1 [open test1 w]
- fconfigure $f1 -translation lf -eofchar {}
+ fconfigure $f1 -translation lf -eofchar {} -encoding unicode
set x [fconfigure $f1]
close $f1
set x
-} {-blocking 1 -buffering full -buffersize 4096 -eofchar {} -translation lf}
+} {-blocking 1 -buffering full -buffersize 4096 -encoding unicode -eofchar {} -translation lf}
test iocmd-8.8 {fconfigure command} {
removeFile test1
set f1 [open test1 w]
fconfigure $f1 -translation lf -buffering line -buffersize 3030 \
- -eofchar {}
+ -eofchar {} -encoding unicode
set x ""
lappend x [fconfigure $f1 -buffering]
lappend x [fconfigure $f1]
close $f1
set x
-} {line {-blocking 1 -buffering line -buffersize 3030 -eofchar {} -translation lf}}
+} {line {-blocking 1 -buffering line -buffersize 3030 -encoding unicode -eofchar {} -translation lf}}
test iocmd-8.9 {fconfigure command} {
removeFile test1
set f1 [open test1 w]
fconfigure $f1 -translation binary -buffering none -buffersize 4040 \
- -eofchar {}
+ -eofchar {} -encoding binary
set x [fconfigure $f1]
close $f1
set x
-} {-blocking 1 -buffering none -buffersize 4040 -eofchar {} -translation lf}
+} {-blocking 1 -buffering none -buffersize 4040 -encoding binary -eofchar {} -translation lf}
test iocmd-8.10 {fconfigure command} {
list [catch {fconfigure a b} msg] $msg
} {1 {can not find channel named "a"}}
@@ -250,7 +253,7 @@ proc iocmdSSETUP {} {
set srv [socket -server iocmdSRV 0];
set port [lindex [fconfigure $srv -sockname] 2];
proc iocmdSRV {sock ip port} {close $sock}
- set cli [socket localhost $port];
+ set cli [socket 127.0.0.1 $port];
}
}
proc iocmdSSHTDWN {} {
@@ -293,9 +296,8 @@ test iocmd-8.18 {fconfigure command / unix tty channel} {nonPortable unixOnly} {
close $tty;
set r;
} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -eofchar, -translation, or -mode}}
-test iocmd-8.19 {fconfigure command / win tty channel} {pcOnly && !win32s} {
- # None of the com port functions are implemented on Win32s.
- # Also, might fail if com1 is unavailable
+test iocmd-8.19 {fconfigure command / win tty channel} {nonPortable pcOnly} {
+ # might fail if com1 is unavailable
set tty [open com1]
set r [list [catch {fconfigure $tty -blah blih} msg] $msg];
close $tty;
@@ -313,6 +315,8 @@ test iocmd-9.3 {eof command} {
list [catch {eof file100} msg] $msg $errorCode
} {1 {can not find channel named "file100"} NONE}
+# The tests for Tcl_ExecObjCmd are in exec.test
+
test iocmd-10.1 {fblocked command} {
list [catch {fblocked} msg] $msg
} {1 {wrong # args: should be "fblocked channelId"}}
@@ -488,7 +492,7 @@ test iocmd-15.9 {Tcl_FcopyObjCmd} {
} "1 {channel \"$rfile\" wasn't opened for writing}"
test iocmd-15.10 {Tcl_FcopyObjCmd} {
list [catch {fcopy $rfile $wfile foo bar} msg] $msg
-} {1 {bad switch "foo": must be -size, or -command}}
+} {1 {bad switch "foo": must be -size or -command}}
test iocmd-15.11 {Tcl_FcopyObjCmd} {
list [catch {fcopy $rfile $wfile -size foo} msg] $msg
} {1 {expected integer but got "foo"}}
@@ -499,14 +503,26 @@ test iocmd-15.12 {Tcl_FcopyObjCmd} {
close $rfile
close $wfile
-removeFile test1
-removeFile test2
-removeFile test3
-removeFile test4
+# cleanup
+foreach file [list test1 test2 test3 test4] {
+ ::tcltest::removeFile $file
+}
# delay long enough for background processes to finish
after 500
-removeFile test5
-removeFile pipe
-removeFile output
-set x ""
-set x
+foreach file [list test5 pipe output] {
+ ::tcltest::removeFile $file
+}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+