Tcl Source Code

Changes On Branch tip-398-impl
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch tip-398-impl Excluding Merge-Ins

This is equivalent to a diff from 1c1b151e93 to 96fb0e1328

2012-04-28
17:09
IMPLEMENTATION OF TIP#398 : Quickly Exit with Non-Blocking Blocked Channels check-in: efc6bbd2cb user: ferrieux tags: trunk, potential incompatibility
17:03
Compat flag, test, and doc update. Closed-Leaf check-in: 96fb0e1328 user: ferrieux tags: tip-398-impl
2012-04-24
21:29
[Bug 3508771] load tclreg.dll in cygwin tclsh Implement TclWinGetSockOpt, TclWinGetServByName and Tc... check-in: 3caedf05df user: jan.nijtmans tags: trunk
08:55
merge trunk check-in: 3a8c412e3e user: ferrieux tags: tip-398-impl
2012-04-23
17:02
grammar fix (reported on Tcler's Chat) check-in: 1c1b151e93 user: dkf tags: trunk
14:13
autoconf check-in: 4aac12631b user: dgp tags: trunk

Changes to doc/close.n.

44
45
46
47
48
49
50
51
52




53
54
55
56
57
58
59
44
45
46
47
48
49
50


51
52
53
54
55
56
57
58
59
60
61







-
-
+
+
+
+







other effect until all of the sharing interpreters have closed the
channel.
When the last interpreter in which the channel is registered invokes
\fBclose\fR, the cleanup actions described above occur. See the
\fBinterp\fR command for a description of channel sharing.
.PP
Channels are automatically closed when an interpreter is destroyed and
when the process exits.  Channels are switched to blocking mode, to ensure
that all output is correctly flushed before the process exits.
when the process exits.
.VS 8.6
From 8.6 on (TIP#398), nonblocking channels are no longer switched to blocking mode when exiting; this guarantees a timely exit even when the peer or a communication channel is stalled. To ensure proper flushing of stalled nonblocking channels on exit, one must now either (a) actively switch them back to blocking or (b) use the environment variable TCL_FLUSH_NONBLOCKING_ON_EXIT,  which when set and not equal to "0" restores the previous behavior.
.VE 8.6
.PP
The command returns an empty string, and may generate an error if
an error occurs while flushing output.  If a command in a command
pipeline created with \fBopen\fR returns an error, \fBclose\fR
generates an error (similar to the \fBexec\fR command.)
.PP
.VS 8.6

Changes to generic/tclIO.c.

392
393
394
395
396
397
398













399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418


419
420
421
422
423
424
425
426
427
428

429






430
431
432
433
434
435







436
437
438
439
440
441
442
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429


430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449






450
451
452
453
454
455
456
457
458
459
460
461
462
463







+
+
+
+
+
+
+
+
+
+
+
+
+


















-
-
+
+










+

+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+







void
TclFinalizeIOSubsystem(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    Channel *chanPtr = NULL;	/* Iterates over open channels. */
    ChannelState *statePtr;	/* State of channel stack */
    int active = 1;		/* Flag == 1 while there's still work to do */
    int doflushnb;

    /* Fetch the pre-TIP#398 compatibility flag */ 
    {
        const char *s;
        Tcl_DString ds;
        
        s = TclGetEnv("TCL_FLUSH_NONBLOCKING_ON_EXIT", &ds);
        doflushnb = ((s != NULL) && strcmp(s, "0"));
        if (s != NULL) {
            Tcl_DStringFree(&ds);
        }
    }

    /*
     * Walk all channel state structures known to this thread and close
     * corresponding channels.
     */

    while (active) {
	/*
	 * Iterate through the open channel list, and find the first channel
	 * that isn't dead. We start from the head of the list each time,
	 * because the close action on one channel can close others.
	 */

	active = 0;
	for (statePtr = tsdPtr->firstCSPtr;
		statePtr != NULL;
		statePtr = statePtr->nextCSPtr) {
	    chanPtr = statePtr->topChanPtr;
            if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED | CHANNEL_DEAD)
                || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
	    if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED | CHANNEL_DEAD)
                || (doflushnb && GotFlag(statePtr, BG_FLUSH_SCHEDULED))) {
		active = 1;
		break;
	    }
	}

	/*
	 * We've found a live channel. Close it.
	 */

	if (active) {

	    /*
	     * TIP #398:  by default, we no  longer set the  channel back into
             * blocking  mode.  To  restore  the old  blocking  behavior,  the
             * environment variable  TCL_FLUSH_NONBLOCKING_ON_EXIT must be set
             * and not be "0".
	     */
            if (doflushnb) {
	     * Set the channel back into blocking mode to ensure that we wait
	     * for all data to flush out.
	     */

	    (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
		    "-blocking", "on");
                    /* Set the channel back into blocking mode to ensure that we wait
                     * for all data to flush out.
                     */
                
                (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
                                            "-blocking", "on");                    
            }

	    if ((chanPtr == (Channel *) tsdPtr->stdinChannel) ||
		    (chanPtr == (Channel *) tsdPtr->stdoutChannel) ||
		    (chanPtr == (Channel *) tsdPtr->stderrChannel)) {
		/*
		 * Decrement the refcount which was earlier artificially
		 * bumped up to keep the channel from being closed.

Changes to tests/io.test.

2732
2733
2734
2735
2736
2737
2738



















2739
2740
2741
2742
2743
2744
2745
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    close $f
    exec [interpreter] $path(script)
    set f [open $path(test1) r]
    set r [read $f]
    close $f
    set r
} "hello\nbye\nstrange\n"
set path(script2) [makeFile {} script2]
test io-29.33b {TIP#398, no implicit flush of nonblocking on exit} {exec} {
    set f [open $path(script) w]
    puts $f {
		fconfigure stdout -blocking 0
		puts -nonewline stdout [string repeat A 655360]
		flush stdout
	}
    close $f
    set f [open $path(script2) w]
    puts $f {after 2000}
    close $f
	set t1 [clock seconds]
	set ff [open "|[list [interpreter] $path(script2)]" w]
	exec [interpreter] $path(script) >@ $ff
	set t2 [clock seconds]
	close $ff
	expr {($t2-$t1)/2}
} 0
test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac fileevent} {
    variable c 0
    variable x running
    set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
    proc writelots {s l} {
	for {set i 0} {$i < 2000} {incr i} {
	    puts $s $l
7757
7758
7759
7760
7761
7762
7763
7764

7765
7766
7767
7768
7769
7770
7771
7776
7777
7778
7779
7780
7781
7782

7783
7784
7785
7786
7787
7788
7789
7790







-
+







} -cleanup {
    close $f
} -result {1 {can not find channel named "@@"}}

# ### ### ### ######### ######### #########

# cleanup
foreach file [list fooBar longfile script output test1 pipe my_script \
foreach file [list fooBar longfile script script2 output test1 pipe my_script \
	test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
    removeFile $file
}
cleanupTests
}
namespace delete ::tcl::test::io
return