summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authormdejong <mdejong>2003-03-07 22:03:34 (GMT)
committermdejong <mdejong>2003-03-07 22:03:34 (GMT)
commitccce3f52f073d161737f2868b97a80062c05e2d7 (patch)
tree241840917b5cb8abc7c3f32abaaaf315a129a985
parent53285721f96ad476c4855909e999cfcdb0362e5c (diff)
downloadtcl-ccce3f52f073d161737f2868b97a80062c05e2d7.zip
tcl-ccce3f52f073d161737f2868b97a80062c05e2d7.tar.gz
tcl-ccce3f52f073d161737f2868b97a80062c05e2d7.tar.bz2
* tests/io.test:
* tests/ioCmd.test: Define a fcopy constraint and add it to the constraint list of any test that depends on the fcopy command. This is only useful to Jacl which does not support fcopy.
-rw-r--r--ChangeLog8
-rw-r--r--tests/io.test39
-rw-r--r--tests/ioCmd.test28
3 files changed, 43 insertions, 32 deletions
diff --git a/ChangeLog b/ChangeLog
index 63dfa6a..3cbb339 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,13 @@
2003-03-07 Mo DeJong <mdejong@users.sourceforge.net>
+ * tests/io.test:
+ * tests/ioCmd.test: Define a fcopy constraint and add
+ it to the constraint list of any test that depends
+ on the fcopy command. This is only useful to
+ Jacl which does not support fcopy.
+
+2003-03-07 Mo DeJong <mdejong@users.sourceforge.net>
+
* tests/encoding.test: Name temp files *.tcltestout
instead of *.out so that when they are removed later,
we don't accidently toast any files named *.out that
diff --git a/tests/io.test b/tests/io.test
index 8f7452a..c302958 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -12,7 +12,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: io.test,v 1.44 2003/03/07 02:23:40 mdejong Exp $
+# RCS: @(#) $Id: io.test,v 1.45 2003/03/07 22:03:39 mdejong Exp $
if {[catch {package require tcltest 2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2 required."
@@ -32,6 +32,7 @@ testConstraint testchannel [llength [info commands testchannel]]
testConstraint exec [llength [info commands exec]]
testConstraint openpipe 1
testConstraint fileevent [llength [info commands fileevent]]
+testConstraint fcopy [llength [info commands fcopy]]
# You need a *very* special environment to do some tests. In
# particular, many file systems do not support large-files...
@@ -6429,7 +6430,7 @@ test io-51.1 {Test old socket deletion on Macintosh} {socket} {
set result
} {sock1 sock2 sock3 sock4}
-test io-52.1 {TclCopyChannel} {
+test io-52.1 {TclCopyChannel} {fcopy} {
removeFile test1
set f1 [open $thisScript]
set f2 [open $path(test1) w]
@@ -6439,7 +6440,7 @@ test io-52.1 {TclCopyChannel} {
close $f2
string compare $msg "channel \"$f1\" is busy"
} {0}
-test io-52.2 {TclCopyChannel} {
+test io-52.2 {TclCopyChannel} {fcopy} {
removeFile test1
set f1 [open $thisScript]
set f2 [open $path(test1) w]
@@ -6451,7 +6452,7 @@ test io-52.2 {TclCopyChannel} {
close $f3
string compare $msg "channel \"$f2\" is busy"
} {0}
-test io-52.3 {TclCopyChannel} {
+test io-52.3 {TclCopyChannel} {fcopy} {
removeFile test1
set f1 [open $thisScript]
set f2 [open $path(test1) w]
@@ -6468,7 +6469,7 @@ test io-52.3 {TclCopyChannel} {
}
set result
} {0 0 ok}
-test io-52.4 {TclCopyChannel} {
+test io-52.4 {TclCopyChannel} {fcopy} {
removeFile test1
set f1 [open $thisScript]
set f2 [open $path(test1) w]
@@ -6480,7 +6481,7 @@ test io-52.4 {TclCopyChannel} {
close $f2
lappend result [file size $path(test1)]
} {0 0 40}
-test io-52.5 {TclCopyChannel} {
+test io-52.5 {TclCopyChannel} {fcopy} {
removeFile test1
set f1 [open $thisScript]
set f2 [open $path(test1) w]
@@ -6497,7 +6498,7 @@ test io-52.5 {TclCopyChannel} {
}
set result
} {0 0 ok}
-test io-52.6 {TclCopyChannel} {
+test io-52.6 {TclCopyChannel} {fcopy} {
removeFile test1
set f1 [open $thisScript]
set f2 [open $path(test1) w]
@@ -6514,7 +6515,7 @@ test io-52.6 {TclCopyChannel} {
}
set result
} {0 0 ok}
-test io-52.7 {TclCopyChannel} {
+test io-52.7 {TclCopyChannel} {fcopy} {
removeFile test1
set f1 [open $thisScript]
set f2 [open $path(test1) w]
@@ -6531,7 +6532,7 @@ test io-52.7 {TclCopyChannel} {
}
set result
} {0 0 ok}
-test io-52.8 {TclCopyChannel} {stdio openpipe} {
+test io-52.8 {TclCopyChannel} {stdio openpipe fcopy} {
removeFile test1
removeFile pipe
set f1 [open $path(pipe) w]
@@ -6569,7 +6570,7 @@ fconfigure $out -encoding koi8-r -translation lf
puts $out "\u0410\u0410"
close $out
-test io-52.9 {TclCopyChannel & encodings} {
+test io-52.9 {TclCopyChannel & encodings} {fcopy} {
# Copy kyrillic to UTF-8, using fcopy.
set in [open $path(kyrillic.txt) r]
@@ -6600,7 +6601,7 @@ test io-52.9 {TclCopyChannel & encodings} {
[file size $path(utf8-rp.txt)]
} {3 5 5}
-test io-52.10 {TclCopyChannel & encodings} {
+test io-52.10 {TclCopyChannel & encodings} {fcopy} {
# encoding to binary (=> implies that the
# internal utf-8 is written)
@@ -6618,7 +6619,7 @@ test io-52.10 {TclCopyChannel & encodings} {
file size $path(utf8-fcopy.txt)
} 5
-test io-52.11 {TclCopyChannel & encodings} {
+test io-52.11 {TclCopyChannel & encodings} {fcopy} {
# binary to encoding => the input has to be
# in utf-8 to make sense to the encoder
@@ -6636,7 +6637,7 @@ test io-52.11 {TclCopyChannel & encodings} {
file size $path(kyrillic.txt)
} 3
-test io-53.1 {CopyData} {
+test io-53.1 {CopyData} {fcopy} {
removeFile test1
set f1 [open $thisScript]
set f2 [open $path(test1) w]
@@ -6648,7 +6649,7 @@ test io-53.1 {CopyData} {
close $f2
lappend result [file size $path(test1)]
} {0 0 0}
-test io-53.2 {CopyData} {
+test io-53.2 {CopyData} {fcopy} {
removeFile test1
set f1 [open $thisScript]
set f2 [open $path(test1) w]
@@ -6667,7 +6668,7 @@ test io-53.2 {CopyData} {
}
set result
} {0 0 ok}
-test io-53.3 {CopyData: background read underflow} {stdio unixOnly openpipe} {
+test io-53.3 {CopyData: background read underflow} {stdio unixOnly openpipe fcopy} {
removeFile test1
removeFile pipe
set f1 [open $path(pipe) w]
@@ -6697,7 +6698,7 @@ test io-53.3 {CopyData: background read underflow} {stdio unixOnly openpipe} {
close $f
set result
} "ready line1 line2 {done\n}"
-test io-53.4 {CopyData: background write overflow} {stdio unixOnly openpipe fileevent} {
+test io-53.4 {CopyData: background write overflow} {stdio unixOnly openpipe fileevent fcopy} {
set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
variable x
for {set x 0} {$x < 12} {incr x} {
@@ -6748,7 +6749,7 @@ proc FcopyTestDone {bytes {error {}}} {
}
}
-test io-53.5 {CopyData: error during fcopy} {socket} {
+test io-53.5 {CopyData: error during fcopy} {socket fcopy} {
variable fcopyTestDone
set listen [socket -server [namespace code FcopyTestAccept] 0]
set in [open $thisScript] ;# 126 K
@@ -6764,7 +6765,7 @@ test io-53.5 {CopyData: error during fcopy} {socket} {
close $out
set fcopyTestDone ;# 1 for error condition
} 1
-test io-53.6 {CopyData: error during fcopy} {stdio openpipe} {
+test io-53.6 {CopyData: error during fcopy} {stdio openpipe fcopy} {
variable fcopyTestDone
removeFile pipe
removeFile test1
@@ -6801,7 +6802,7 @@ proc doFcopy {in out {bytes 0} {error {}}} {
}
}
-test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio openpipe} {
+test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio openpipe fcopy} {
variable fcopyTestDone
removeFile pipe
removeFile test1
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 9e721e7..f8f7032 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -12,13 +12,15 @@
# 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.16 2003/02/19 16:43:30 das Exp $
+# RCS: @(#) $Id: ioCmd.test,v 1.17 2003/03/07 22:03:43 mdejong Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+testConstraint fcopy [llength [info commands fcopy]]
+
removeFile test1
removeFile pipe
@@ -501,19 +503,19 @@ test iocmd-14.10 {file id parsing errors} {
list [catch {eof $f} msg] $msg
} $expect
-test iocmd-15.1 {Tcl_FcopyObjCmd} {
+test iocmd-15.1 {Tcl_FcopyObjCmd} {fcopy} {
list [catch {fcopy} msg] $msg
} {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}}
-test iocmd-15.2 {Tcl_FcopyObjCmd} {
+test iocmd-15.2 {Tcl_FcopyObjCmd} {fcopy} {
list [catch {fcopy 1} msg] $msg
} {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}}
-test iocmd-15.3 {Tcl_FcopyObjCmd} {
+test iocmd-15.3 {Tcl_FcopyObjCmd} {fcopy} {
list [catch {fcopy 1 2 3 4 5 6 7} msg] $msg
} {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}}
-test iocmd-15.4 {Tcl_FcopyObjCmd} {
+test iocmd-15.4 {Tcl_FcopyObjCmd} {fcopy} {
list [catch {fcopy 1 2 3} msg] $msg
} {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}}
-test iocmd-15.5 {Tcl_FcopyObjCmd} {
+test iocmd-15.5 {Tcl_FcopyObjCmd} {fcopy} {
list [catch {fcopy 1 2 3 4 5} msg] $msg
} {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}}
@@ -525,25 +527,25 @@ close $f
set rfile [open $path(test1) r]
set wfile [open $path(test2) w]
-test iocmd-15.6 {Tcl_FcopyObjCmd} {
+test iocmd-15.6 {Tcl_FcopyObjCmd} {fcopy} {
list [catch {fcopy foo $wfile} msg] $msg
} {1 {can not find channel named "foo"}}
-test iocmd-15.7 {Tcl_FcopyObjCmd} {
+test iocmd-15.7 {Tcl_FcopyObjCmd} {fcopy} {
list [catch {fcopy $rfile foo} msg] $msg
} {1 {can not find channel named "foo"}}
-test iocmd-15.8 {Tcl_FcopyObjCmd} {
+test iocmd-15.8 {Tcl_FcopyObjCmd} {fcopy} {
list [catch {fcopy $wfile $wfile} msg] $msg
} "1 {channel \"$wfile\" wasn't opened for reading}"
-test iocmd-15.9 {Tcl_FcopyObjCmd} {
+test iocmd-15.9 {Tcl_FcopyObjCmd} {fcopy} {
list [catch {fcopy $rfile $rfile} msg] $msg
} "1 {channel \"$rfile\" wasn't opened for writing}"
-test iocmd-15.10 {Tcl_FcopyObjCmd} {
+test iocmd-15.10 {Tcl_FcopyObjCmd} {fcopy} {
list [catch {fcopy $rfile $wfile foo bar} msg] $msg
} {1 {bad switch "foo": must be -size or -command}}
-test iocmd-15.11 {Tcl_FcopyObjCmd} {
+test iocmd-15.11 {Tcl_FcopyObjCmd} {fcopy} {
list [catch {fcopy $rfile $wfile -size foo} msg] $msg
} {1 {expected integer but got "foo"}}
-test iocmd-15.12 {Tcl_FcopyObjCmd} {
+test iocmd-15.12 {Tcl_FcopyObjCmd} {fcopy} {
list [catch {fcopy $rfile $wfile -command bar -size foo} msg] $msg
} {1 {expected integer but got "foo"}}