* 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.


FossilOrigin-Name: 0ccff04f89f9726cf2cde2ec472d9c8f0f95a733

2 files changed, 35 insertions, 32 deletions

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"}}