Attachment "transfer.patch" to
ticket [1252107fff]
added by
andreas_kupries
2005-08-05 01:30:19.
--- tcl8.5-changes/generic/tclTest.c 2005-07-26 12:24:39.000000000 -0700
+++ tcl8.5-transfer/generic/tclTest.c 2005-08-04 11:13:00.000000000 -0700
@@ -122,6 +122,23 @@
} TestEvent;
/*
+ * Simple detach/attach facility for testchannel cut|splice.
+ * Enables the testing of channel transfers in core testsuite.
+ *
+ * NOTE: No safeguards, i.e. no mutexes for full thread-safety,
+ * no checks that the channel is truly transferable, no clearance
+ * of active event handlers. We may have to add some of these
+ * in the future for more complex test-scenarios.
+ */
+
+typedef struct TestChannel {
+ Tcl_Channel chan; /* Detached channel */
+ struct TestChannel* nextPtr; /* Next in pool of detached channels */
+} TestChannel;
+
+static TestChannel* firstDetached;
+
+/*
* Forward declarations for procedures defined later in this file:
*/
@@ -5352,10 +5369,33 @@
chanPtr = (Channel *) NULL;
if (argc > 2) {
- chan = Tcl_GetChannel(interp, argv[2], &mode);
- if (chan == (Tcl_Channel) NULL) {
- return TCL_ERROR;
- }
+ if ((cmdName[0] == 's') && (strncmp(cmdName, "splice", len) == 0)) {
+ /* For splice access the pool of detached channels.
+ * Locate channel, remove from the list.
+ */
+
+ TestChannel** nextPtrPtr;
+ TestChannel* curPtr;
+
+ chan = (Tcl_Channel) NULL;
+ for (nextPtrPtr = &firstDetached, curPtr = firstDetached;
+ curPtr != NULL;
+ nextPtrPtr = &(curPtr->nextPtr), curPtr = curPtr->nextPtr) {
+
+ if (strcmp (argv[2], Tcl_GetChannelName (curPtr->chan)) == 0) {
+ *nextPtrPtr = curPtr->nextPtr;
+ curPtr->nextPtr = NULL;
+ chan = curPtr->chan;
+ ckfree ((char*) curPtr);
+ break;
+ }
+ }
+ } else {
+ chan = Tcl_GetChannel(interp, argv[2], &mode);
+ }
+ if (chan == (Tcl_Channel) NULL) {
+ return TCL_ERROR;
+ }
chanPtr = (Channel *) chan;
statePtr = chanPtr->state;
chanPtr = statePtr->topChanPtr;
@@ -5366,13 +5406,35 @@
chan = NULL;
}
+ /*
+ * "cut" is actually more a simplified detach facility as provided
+ * by the Thread package. Without the safeguards of a regular
+ * command (no checking that the command is truly cut'able, no
+ * mutexes for thread-safety). Its complementary command is
+ * "splice", see below.
+ */
+
if ((cmdName[0] == 'c') && (strncmp(cmdName, "cut", len) == 0)) {
+ TestChannel* det;
+
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" cut channelName\"", (char *) NULL);
return TCL_ERROR;
}
+
+ Tcl_RegisterChannel((Tcl_Interp *) NULL, chan); /* prevent closing */
+ Tcl_UnregisterChannel(interp, chan);
+
Tcl_CutChannel(chan);
+
+ /* Remember the channel in the pool of detached channels */
+
+ det = (TestChannel*) ckalloc (sizeof(TestChannel));
+ det->chan = chan;
+ det->nextPtr = firstDetached;
+ firstDetached = det;
+
return TCL_OK;
}
@@ -5626,6 +5688,14 @@
return TCL_OK;
}
+ /*
+ * "splice" is actually more a simplified attach facility as
+ * provided by the Thread package. Without the safeguards of a
+ * regular command (no checking that the command is truly
+ * cut'able, no mutexes for thread-safety). Its complementary
+ * command is "cut", see above.
+ */
+
if ((cmdName[0] == 's') && (strncmp(cmdName, "splice", len) == 0)) {
if (argc != 3) {
Tcl_AppendResult(interp, "channel name required", (char *) NULL);
@@ -5633,6 +5703,10 @@
}
Tcl_SpliceChannel(chan);
+
+ Tcl_RegisterChannel(interp, chan);
+ Tcl_UnregisterChannel((Tcl_Interp *)NULL, chan);
+
return TCL_OK;
}
--- tcl8.5-changes/generic/tclThreadTest.c 2005-07-26 12:24:39.000000000 -0700
+++ tcl8.5-transfer/generic/tclThreadTest.c 2005-08-04 11:14:11.000000000 -0700
@@ -479,6 +479,13 @@
result = Tcl_Init(tsdPtr->interp);
result = TclThread_Init(tsdPtr->interp);
+ /* This is part of the test facility.
+ * Initialize _ALL_ test commands for
+ * use by the new thread.
+ */
+
+ result = Tcltest_Init(tsdPtr->interp);
+
/*
* Update the list of threads.
*/
--- tcl8.5-changes/tests/io.test 2005-07-26 12:24:47.000000000 -0700
+++ tcl8.5-transfer/tests/io.test 2005-08-04 11:17:30.000000000 -0700
@@ -7111,6 +7111,75 @@
removeFile eofchar
} -result {77 = 23431}
+
+# Test the cutting and splicing of channels, this is incidentially the
+# attach/detach facility of package Thread, but __without any
+# safeguards__. It can also be used to emulate transfer of channels
+# between threads, and is used for that here.
+
+test io-70.0 {Cutting & Splicing channels} {testchannel} {
+ set f [makeFile {... dummy ...} cutsplice]
+ set c [open $f r]
+
+ set res {}
+ lappend res [catch {seek $c 0 start}]
+ testchannel cut $c
+
+ lappend res [catch {seek $c 0 start}]
+ testchannel splice $c
+
+ lappend res [catch {seek $c 0 start}]
+ close $c
+
+ removeFile cutsplice
+
+ set res
+} {0 1 0}
+
+# Following a duplicate of code found in "thread.test". Find a better
+# way of doing this without duplication. Maybe placement into a proc
+# which transforms to nop after the first call, and placement of its
+# defintion in a central location.
+
+testConstraint testthread [expr {[info commands testthread] != {}}]
+
+if {[testConstraint testthread]} {
+ testthread errorproc ThreadError
+
+ proc ThreadError {id info} {
+ global threadError
+ set threadError $info
+ }
+
+ proc ThreadNullError {id info} {
+ # ignore
+ }
+}
+
+test io-70.1 {Transfer channel} {testchannel testthread} {
+ set f [makeFile {... dummy ...} cutsplice]
+ set c [open $f r]
+
+ set res {}
+ lappend res [catch {seek $c 0 start}]
+ testchannel cut $c
+ lappend res [catch {seek $c 0 start}]
+
+ set tid [testthread create]
+ testthread send $tid [list set c $c]
+ lappend res [testthread send $tid {
+ testchannel splice $c
+ set res [catch {seek $c 0 start}]
+ close $c
+ set res
+ }]
+
+ tcltest::threadReap
+ removeFile cutsplice
+
+ set res
+} {0 1 0}
+
# cleanup
foreach file [list fooBar longfile script output test1 pipe my_script foo \
bar test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
