Tcl Source Code

Check-in [efc6bbd2cb]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:IMPLEMENTATION OF TIP#398 : Quickly Exit with Non-Blocking Blocked Channels
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk | potential incompatibility
Files: files | file ages | folders
SHA1: efc6bbd2cba9d5ebf2cec4788584b9005792e0af
User & Date: ferrieux 2012-04-28 17:09:58
Context
2012-04-30
09:15
Mention compatibility matters in Changelog. Make test insensitive to ambient compat flag. check-in: 08f40b8f8e user: ferrieux tags: trunk
2012-04-29
07:23
merge trunk check-in: 8610da4944 user: dkf tags: tip-400-impl
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-27
14:37
Move CYGWIN-specific stuff from tclPort.h to tclUnixPort.h, where it belongs check-in: add6ea1397 user: jan.nijtmans tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.









1
2
3
4
5
6
7







2012-04-27  Jan Nijtmans  <[email protected]>

	* generic/tclPort.h:    Move CYGWIN-specific stuff from tclPort.h to
	* generic/tclEnv.c:     tclUnixPort.h, where it belongs.
	* unix/tclUnixPort.h:
	* unix/tclUnixFile.c:

>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
2012-14-28  Alexandre Ferrieux  <[email protected]>

	IMPLEMENTATION OF TIP#398

	* generic/tclIO.c: Quickly Exit with Non-Blocking Blocked Channels
	* tests/io.test
	* doc/close.n

2012-04-27  Jan Nijtmans  <[email protected]>

	* generic/tclPort.h:    Move CYGWIN-specific stuff from tclPort.h to
	* generic/tclEnv.c:     tclUnixPort.h, where it belongs.
	* unix/tclUnixPort.h:
	* unix/tclUnixFile.c:

Changes to doc/close.n.

44
45
46
47
48
49
50
51
52


53
54
55
56
57
58
59
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.


.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






|
|
>
>







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














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

    while (active) {
................................................................................
	 */

	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)) {
		active = 1;
		break;
	    }
	}

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

	if (active) {

	    /*






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






>
>
>
>
>
>
>
>
>
>
>
>
>







 







|
|










>

>
>
>
>
>
>
|
|
|
|
|
|
>







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
...
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) {
................................................................................
	 */

	active = 0;
	for (statePtr = tsdPtr->firstCSPtr;
		statePtr != NULL;
		statePtr = statePtr->nextCSPtr) {
	    chanPtr = statePtr->topChanPtr;
	    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");                    
            }

	    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
....
7757
7758
7759
7760
7761
7762
7763
7764
7765
7766
7767
7768
7769
7770
7771
    close $f
    exec [interpreter] $path(script)
    set f [open $path(test1) r]
    set r [read $f]
    close $f
    set r
} "hello\nbye\nstrange\n"



















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
................................................................................
} -cleanup {
    close $f
} -result {1 {can not find channel named "@@"}}

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

# cleanup
foreach file [list fooBar longfile script 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






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|







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
....
7776
7777
7778
7779
7780
7781
7782
7783
7784
7785
7786
7787
7788
7789
7790
    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
................................................................................
} -cleanup {
    close $f
} -result {1 {can not find channel named "@@"}}

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

# cleanup
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