summaryrefslogtreecommitdiffstats
path: root/tests/cmdAH.test
diff options
context:
space:
mode:
authorhobbs <hobbs>2000-10-06 21:10:49 (GMT)
committerhobbs <hobbs>2000-10-06 21:10:49 (GMT)
commit7a4df867f2b62e7ad9c0a0cb99fac03efee6db97 (patch)
tree003571a97e3676b17ea721540bd90211dfef2304 /tests/cmdAH.test
parent82649d2e27f64a5898fa06b66c013308353e859c (diff)
downloadtcl-7a4df867f2b62e7ad9c0a0cb99fac03efee6db97.zip
tcl-7a4df867f2b62e7ad9c0a0cb99fac03efee6db97.tar.gz
tcl-7a4df867f2b62e7ad9c0a0cb99fac03efee6db97.tar.bz2
* tests/cmdAH.test: extra tests for 'file channels' that include
multiple interpreter tests and channel sharing * generic/tclIO.c (Tcl_GetChannelNamesEx): corrected function (and consequently 'file channels') to return channels that are actually registered for this specific interp, rather than this thread.
Diffstat (limited to 'tests/cmdAH.test')
-rw-r--r--tests/cmdAH.test77
1 files changed, 66 insertions, 11 deletions
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 912cd30..03e76eb 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: cmdAH.test,v 1.11 2000/09/20 23:09:54 jenn Exp $
+# RCS: @(#) $Id: cmdAH.test,v 1.12 2000/10/06 21:10:51 hobbs Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -1491,23 +1491,78 @@ test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} {
} {1 {user "woohgy" doesn't exist}}
# channels
+# In testing 'file channels', we need to make sure that a channel
+# created in one interp isn't visible in another.
+
+interp create simpleInterp
+interp create -safe safeInterp
+interp c
+safeInterp expose file file
test cmdAH-31.1 {Tcl_FileObjCmd: channels, too many args} {
list [catch {file channels a b} msg] $msg
} {1 {wrong # args: should be "file channels ?pattern?"}}
-test cmdAH-31.2 {Tcl_FileObjCmd: channels, too many args} {singleTestInterp} {
- file chan
-} {stderr stdout stdin}
-test cmdAH-31.3 {Tcl_FileObjCmd: channels, too many args} {
+test cmdAH-31.2 {Tcl_FileObjCmd: channels, too many args} {
+ # Normal interps start out with only the standard channels
+ lsort [simpleInterp eval [list file chan]]
+} [lsort {stderr stdout stdin}]
+test cmdAH-31.3 {Tcl_FileObjCmd: channels, globbing} {
string equal [file channels] [file channels *]
} {1}
-test cmdAH-31.4 {Tcl_FileObjCmd: channels} {singleTestInterp} {
- set old [file channels gorp.file]
- set f [open gorp.file w]
- set new [file channels file*]
- close $f
- string equal $f $new
+test cmdAH-31.4 {Tcl_FileObjCmd: channels, globbing} {
+ lsort [file channels std*]
+} [lsort {stdout stderr stdin}]
+
+set newFileId [open gorp.file w]
+
+test cmdAH-31.5 {Tcl_FileObjCmd: channels} {
+ set res [file channels $newFileId]
+ string equal $newFileId $res
} {1}
+test cmdAH-31.6 {Tcl_FileObjCmd: channels in other interp} {
+ # Safe interps start out with no channels
+ safeInterp eval [list file channels]
+} {}
+test cmdAH-31.7 {Tcl_FileObjCmd: channels in other interp} {
+ list [catch {safeInterp eval [list puts $newFileId "hello"]} msg] $msg
+} [list 1 "can not find channel named \"$newFileId\""]
+
+interp share {} $newFileId safeInterp
+interp share {} stdout safeInterp
+
+test cmdAH-31.8 {Tcl_FileObjCmd: channels in other interp} {
+ # $newFileId should now be visible in both interps
+ list [file channels $newFileId] \
+ [safeInterp eval [list file channels $newFileId]]
+} [list $newFileId $newFileId]
+test cmdAH-31.9 {Tcl_FileObjCmd: channels in other interp} {
+ lsort [safeInterp eval [list file channels]]
+} [lsort [list stdout $newFileId]]
+test cmdAH-31.10 {Tcl_FileObjCmd: channels in other interp} {
+ # we can now write to $newFileId from slave
+ safeInterp eval [list puts $newFileId "hello"]
+} {}
+
+interp transfer {} $newFileId safeInterp
+
+test cmdAH-31.11 {Tcl_FileObjCmd: channels in other interp} {
+ # $newFileId should now be visible only in safeInterp
+ list [file channels $newFileId] \
+ [safeInterp eval [list file channels $newFileId]]
+} [list {} $newFileId]
+test cmdAH-31.12 {Tcl_FileObjCmd: channels in other interp} {
+ lsort [safeInterp eval [list file channels]]
+} [lsort [list stdout $newFileId]]
+test cmdAH-31.13 {Tcl_FileObjCmd: channels in other interp} {
+ safeInterp eval [list close $newFileId]
+ safeInterp eval [list file channels]
+} {stdout}
+
+# This shouldn't work, but just in case a test above failed...
+catch {close $newFileId}
+
+interp delete safeInterp
+interp delete simpleInterp
# cleanup
catch {testsetplatform $platform}