Tcl Source Code

Check-in [8610da4944]
Login

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

Overview
Comment:merge trunk
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tip-400-impl
Files: files | file ages | folders
SHA1: 8610da4944700d267c6dc2c293a8cd22daeed45a
User & Date: dkf 2012-04-29 07:23:07
Context
2012-05-01
04:51
merge trunk check-in: f0310da009 user: dkf tags: tip-400-impl
2012-04-29
07:23
merge trunk check-in: 8610da4944 user: dkf tags: tip-400-impl
07:18
Differentiate what options may be set by format type. check-in: bf9b0551c5 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
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.





























1
2
3
4
5
6
7




























2012-04-25  Donal K. Fellows  <[email protected]>

	* generic/tclUtil.c (TclDStringToObj): Added internal function to make
	the fairly-common operation of converting a DString into an Obj a more
	efficient one; for long strings, it can just transfer the ownership of
	the buffer directly. Replaces this:
	   obj=Tcl_NewStringObj(Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
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:

2012-04-27  Donal K. Fellows  <[email protected]>

	* library/init.tcl (auto_execok): Allow shell builtins to be detected
	even if they are upper-cased.

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

	* generic/tclStubInit.c:    get rid of _ANSI_ARGS_ and CONST
	* generic/tclIO.c
	* generic/tclIOCmd.c
	* generic/tclTest.c
	* unix/tclUnixChan.c

2012-04-25  Donal K. Fellows  <[email protected]>

	* generic/tclUtil.c (TclDStringToObj): Added internal function to make
	the fairly-common operation of converting a DString into an Obj a more
	efficient one; for long strings, it can just transfer the ownership of
	the buffer directly. Replaces this:
	   obj=Tcl_NewStringObj(Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));

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/tclEnv.c.

694
695
696
697
698
699
700

701
702
703
704
705
706
707

/*
 * When using cygwin, when an environment variable changes, we need to synch
 * with both the cygwin environment (in case the application C code calls
 * fork) and the Windows environment (in case the application TCL code calls
 * exec, which calls the Windows CreateProcess function).
 */


static void
TclCygwinPutenv(
    char *str)
{
    char *name, *value;








>







694
695
696
697
698
699
700
701
702
703
704
705
706
707
708

/*
 * When using cygwin, when an environment variable changes, we need to synch
 * with both the cygwin environment (in case the application C code calls
 * fork) and the Windows environment (in case the application TCL code calls
 * exec, which calls the Windows CreateProcess function).
 */
DLLIMPORT extern void __stdcall SetEnvironmentVariableA(const char*, const char *);

static void
TclCygwinPutenv(
    char *str)
{
    char *name, *value;

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
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) {
	/*
	 * 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)) {
		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
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)
                || (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.
8852
8853
8854
8855
8856
8857
8858
8859
8860
8861
8862
8863
8864
8865
8866
    Channel *chanPtr;		/* The channel to create the handler for. */
    ChannelState *statePtr;	/* State info for channel */
    Tcl_Channel chan;		/* The opaque type for the channel. */
    const char *chanName;
    int modeIndex;		/* Index of mode argument. */
    int mask;
    static const char *const modeOptions[] = {"readable", "writable", NULL};
    static CONST int maskArray[] = {TCL_READABLE, TCL_WRITABLE};

    if ((objc != 3) && (objc != 4)) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[2], modeOptions, "event name", 0,
	    &modeIndex) != TCL_OK) {







|







8873
8874
8875
8876
8877
8878
8879
8880
8881
8882
8883
8884
8885
8886
8887
    Channel *chanPtr;		/* The channel to create the handler for. */
    ChannelState *statePtr;	/* State info for channel */
    Tcl_Channel chan;		/* The opaque type for the channel. */
    const char *chanName;
    int modeIndex;		/* Index of mode argument. */
    int mask;
    static const char *const modeOptions[] = {"readable", "writable", NULL};
    static const int maskArray[] = {TCL_READABLE, TCL_WRITABLE};

    if ((objc != 3) && (objc != 4)) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[2], modeOptions, "event name", 0,
	    &modeIndex) != TCL_OK) {

Changes to generic/tclIOCmd.c.

517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
    Tcl_WideInt offset;		/* Where to seek? */
    int mode;			/* How to seek? */
    Tcl_WideInt result;		/* Of calling Tcl_Seek. */
    int optionIndex;
    static const char *const originOptions[] = {
	"start", "current", "end", NULL
    };
    static CONST int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END};

    if ((objc != 3) && (objc != 4)) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId offset ?origin?");
	return TCL_ERROR;
    }
    if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
	return TCL_ERROR;







|







517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
    Tcl_WideInt offset;		/* Where to seek? */
    int mode;			/* How to seek? */
    Tcl_WideInt result;		/* Of calling Tcl_Seek. */
    int optionIndex;
    static const char *const originOptions[] = {
	"start", "current", "end", NULL
    };
    static const int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END};

    if ((objc != 3) && (objc != 4)) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId offset ?origin?");
	return TCL_ERROR;
    }
    if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
	return TCL_ERROR;

Changes to generic/tclPort.h.

21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
#   include "tclWinPort.h"
#endif
#include "tcl.h"
#if !defined(_WIN32)
#   include "tclUnixPort.h"
#endif

#if defined(__CYGWIN__)
#   define USE_PUTENV 1
#   define USE_PUTENV_FOR_UNSET 1
/* On Cygwin, the environment is imported from the Cygwin DLL. */
#   define environ __cygwin_environ
#   define timezone _timezone
    DLLIMPORT extern char **__cygwin_environ;
    DLLIMPORT extern int cygwin_conv_to_win32_path(const char *, char *);
    DLLIMPORT extern int cygwin_posix_to_win32_path_list_buf_size(char *value);
    DLLIMPORT extern void cygwin_posix_to_win32_path_list(char *buf, char *value);
    //DLLIMPORT extern void __stdcall SetEnvironmentVariableA(const char*, const char *);
#endif

#if !defined(LLONG_MIN)
#   ifdef TCL_WIDE_INT_IS_LONG
#      define LLONG_MIN LONG_MIN
#   else
#      ifdef LLONG_BIT
#         define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<(LLONG_BIT-1)))
#      else







<
<
<
<
<
<
<
<
<
<
<
<
<







21
22
23
24
25
26
27













28
29
30
31
32
33
34
#   include "tclWinPort.h"
#endif
#include "tcl.h"
#if !defined(_WIN32)
#   include "tclUnixPort.h"
#endif














#if !defined(LLONG_MIN)
#   ifdef TCL_WIDE_INT_IS_LONG
#      define LLONG_MIN LONG_MIN
#   else
#      ifdef LLONG_BIT
#         define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<(LLONG_BIT-1)))
#      else

Changes to generic/tclStubInit.c.

167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
    if (!winTCharEncoding) {
	winTCharEncoding = Tcl_GetEncoding(0, "unicode");
    }
    return Tcl_ExternalToUtfDString(winTCharEncoding,
	    string, len, dsPtr);
}

#define Tcl_MacOSXOpenBundleResources (int (*) _ANSI_ARGS_(( \
		Tcl_Interp *, const char *, int, int, char *))) Tcl_WinUtfToTChar
#define Tcl_MacOSXOpenVersionedBundleResources (int (*) _ANSI_ARGS_(( \
		Tcl_Interp *, const char *, const char *, int, int, char *))) Tcl_WinTCharToUtf
#define TclMacOSXGetFileAttribute (int (*) _ANSI_ARGS_((Tcl_Interp *,  \
		int, Tcl_Obj *, Tcl_Obj **))) TclpCreateProcess
#define TclMacOSXMatchType (int (*) _ANSI_ARGS_((Tcl_Interp *, const char *, \
		const char *, Tcl_StatBuf *, Tcl_GlobTypeData *))) TclpMakeFile
#define TclMacOSXNotifierAddRunLoopMode (void (*) _ANSI_ARGS_((const void *))) TclpOpenFile
#define TclpLocaltime_unix (struct tm *(*) _ANSI_ARGS_((const time_t *))) TclGetAndDetachPids
#define TclpGmtime_unix (struct tm *(*) _ANSI_ARGS_((const time_t *))) TclpCloseFile

#elif !defined(__WIN32__) /* UNIX and MAC */
#   define TclWinConvertError (void (*) _ANSI_ARGS_((unsigned int))) TclGetAndDetachPids
#   undef TclWinConvertWSAError
#   define TclWinConvertWSAError (void (*) _ANSI_ARGS_((unsigned int))) TclpCloseFile
#   define TclWinGetPlatformId (int (*)()) TclpCreateTempFile
#   define TclWinGetTclInstance (void *(*)()) TclpCreateProcess
#   define TclWinNToHS (unsigned short (*) _ANSI_ARGS_((unsigned short ns))) TclpMakeFile
#   define TclWinSetSockOpt (int (*) _ANSI_ARGS_((void *, int, int, const char *, int))) TclpOpenFile
#   define TclWinGetSockOpt (int (*) _ANSI_ARGS_((void *, int, int, char *, int))) TclpCreatePipe
#   define TclWinGetServByName (struct servent *(*) _ANSI_ARGS_((const char *nm, const char *proto))) TclpCreateCommandChannel
#   define TclIntPlatReserved13 (void (*) ()) TclpInetNtoa
#   define TclWinAddProcess 0
#   define TclWinNoBackslash 0
#   define TclWinSetInterfaces 0
#   define TclWinFlushDirtyChannels 0
#   define TclWinResetInterfaces 0
#   define TclpGetPid 0







|
|
|
|
|
|
|
|
|
|
|


|

|



|
|
|







167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
    if (!winTCharEncoding) {
	winTCharEncoding = Tcl_GetEncoding(0, "unicode");
    }
    return Tcl_ExternalToUtfDString(winTCharEncoding,
	    string, len, dsPtr);
}

#define Tcl_MacOSXOpenBundleResources (int (*) ( \
		Tcl_Interp *, const char *, int, int, char *)) Tcl_WinUtfToTChar
#define Tcl_MacOSXOpenVersionedBundleResources (int (*) ( \
		Tcl_Interp *, const char *, const char *, int, int, char *)) Tcl_WinTCharToUtf
#define TclMacOSXGetFileAttribute (int (*) (Tcl_Interp *,  \
		int, Tcl_Obj *, Tcl_Obj **)) TclpCreateProcess
#define TclMacOSXMatchType (int (*) (Tcl_Interp *, const char *, \
		const char *, Tcl_StatBuf *, Tcl_GlobTypeData *)) TclpMakeFile
#define TclMacOSXNotifierAddRunLoopMode (void (*) (const void *)) TclpOpenFile
#define TclpLocaltime_unix (struct tm *(*) (const time_t *)) TclGetAndDetachPids
#define TclpGmtime_unix (struct tm *(*) (const time_t *)) TclpCloseFile

#elif !defined(__WIN32__) /* UNIX and MAC */
#   define TclWinConvertError (void (*) (unsigned int)) TclGetAndDetachPids
#   undef TclWinConvertWSAError
#   define TclWinConvertWSAError (void (*) (unsigned int)) TclpCloseFile
#   define TclWinGetPlatformId (int (*)()) TclpCreateTempFile
#   define TclWinGetTclInstance (void *(*)()) TclpCreateProcess
#   define TclWinNToHS (unsigned short (*) _ANSI_ARGS_((unsigned short ns))) TclpMakeFile
#   define TclWinSetSockOpt (int (*) (void *, int, int, const char *, int)) TclpOpenFile
#   define TclWinGetSockOpt (int (*) (void *, int, int, char *, int *)) TclpCreatePipe
#   define TclWinGetServByName (struct servent *(*) (const char *nm, const char *proto)) TclpCreateCommandChannel
#   define TclIntPlatReserved13 (void (*) ()) TclpInetNtoa
#   define TclWinAddProcess 0
#   define TclWinNoBackslash 0
#   define TclWinSetInterfaces 0
#   define TclWinFlushDirtyChannels 0
#   define TclWinResetInterfaces 0
#   define TclpGetPid 0

Changes to generic/tclTest.c.

3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
    int index;
    const char *locale;

    static const char *const optionStrings[] = {
	"ctype", "numeric", "time", "collate", "monetary",
	"all",	NULL
    };
    static CONST int lcTypes[] = {
	LC_CTYPE, LC_NUMERIC, LC_TIME, LC_COLLATE, LC_MONETARY,
	LC_ALL
    };

    /*
     * LC_CTYPE, etc. correspond to the indices for the strings.
     */







|







3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
    int index;
    const char *locale;

    static const char *const optionStrings[] = {
	"ctype", "numeric", "time", "collate", "monetary",
	"all",	NULL
    };
    static const int lcTypes[] = {
	LC_CTYPE, LC_NUMERIC, LC_TIME, LC_COLLATE, LC_MONETARY,
	LC_ALL
    };

    /*
     * LC_CTYPE, etc. correspond to the indices for the strings.
     */

Changes to library/init.tcl.

647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
    if {[info exists env(PATHEXT)]} {
	# Add an initial ; to have the {} extension check first.
	set execExtensions [split ";$env(PATHEXT)" ";"]
    } else {
	set execExtensions [list {} .com .exe .bat .cmd]
    }

    if {$name in $shellBuiltins} {
	# When this is command.com for some reason on Win2K, Tcl won't
	# exec it unless the case is right, which this corrects.  COMSPEC
	# may not point to a real file, so do the check.
	set cmd $env(COMSPEC)
	if {[file exists $cmd]} {
	    set cmd [file attributes $cmd -shortname]
	}







|







647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
    if {[info exists env(PATHEXT)]} {
	# Add an initial ; to have the {} extension check first.
	set execExtensions [split ";$env(PATHEXT)" ";"]
    } else {
	set execExtensions [list {} .com .exe .bat .cmd]
    }

    if {[string tolower $name] in $shellBuiltins} {
	# When this is command.com for some reason on Win2K, Tcl won't
	# exec it unless the case is right, which this corrects.  COMSPEC
	# may not point to a real file, so do the check.
	set cmd $env(COMSPEC)
	if {[file exists $cmd]} {
	    set cmd [file attributes $cmd -shortname]
	}

Changes to tests/io.test.

2732
2733
2734
2735
2736
2737
2738



















2739
2740
2741
2742
2743
2744
2745
    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







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







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







|







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

Changes to unix/tclUnixChan.c.

977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
}

#ifdef DIRECT_BAUD
#   define TtyGetSpeed(baud)	((unsigned) (baud))
#   define TtyGetBaud(speed)	((int) (speed))
#else /* !DIRECT_BAUD */

static CONST struct {int baud; unsigned long speed;} speeds[] = {
#ifdef B0
    {0, B0},
#endif
#ifdef B50
    {50, B50},
#endif
#ifdef B75







|







977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
}

#ifdef DIRECT_BAUD
#   define TtyGetSpeed(baud)	((unsigned) (baud))
#   define TtyGetBaud(speed)	((int) (speed))
#else /* !DIRECT_BAUD */

static const struct {int baud; unsigned long speed;} speeds[] = {
#ifdef B0
    {0, B0},
#endif
#ifdef B50
    {50, B50},
#endif
#ifdef B75

Changes to unix/tclUnixFile.c.

35
36
37
38
39
40
41

42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61

62
63
64
65
66
67
68
69
70
71
72
73
74
75
 */

void
TclpFindExecutable(
    const char *argv0)		/* The value of the application's argv[0]
				 * (native). */
{

#ifdef __CYGWIN__
    int length;
    char buf[PATH_MAX * TCL_UTF_MAX + 1];
    char name[PATH_MAX * TCL_UTF_MAX + 1];

    /* Make some symbols available without including <windows.h> */
#   define CP_UTF8 65001
    extern int cygwin_conv_to_full_posix_path(const char *, char *);
    extern __stdcall int GetModuleFileNameW(void *, const char *, int);
    extern __stdcall int WideCharToMultiByte(int, int, const char *, int,
		const char *, int, const char *, const char *);

    GetModuleFileNameW(NULL, name, PATH_MAX);
    WideCharToMultiByte(CP_UTF8, 0, name, -1, buf, PATH_MAX, NULL, NULL);
    cygwin_conv_to_full_posix_path(buf, name);
    length = strlen(name);
    if ((length > 4) && !strcasecmp(name + length - 4, ".exe")) {
	/* Strip '.exe' part. */
	length -= 4;
    }

	TclSetObjNameOfExecutable(
		Tcl_NewStringObj(name, length), Tcl_GetEncoding(NULL, NULL));
#else
    const char *name, *p;
    Tcl_StatBuf statBuf;
    Tcl_DString buffer, nameString, cwd, utfName;
    Tcl_Encoding encoding;

    if (argv0 == NULL) {
	return;
    }
    Tcl_DStringInit(&buffer);

    name = argv0;







>







|
|
|










>

|




<







35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69

70
71
72
73
74
75
76
 */

void
TclpFindExecutable(
    const char *argv0)		/* The value of the application's argv[0]
				 * (native). */
{
    Tcl_Encoding encoding;
#ifdef __CYGWIN__
    int length;
    char buf[PATH_MAX * TCL_UTF_MAX + 1];
    char name[PATH_MAX * TCL_UTF_MAX + 1];

    /* Make some symbols available without including <windows.h> */
#   define CP_UTF8 65001
    DLLIMPORT extern int cygwin_conv_to_full_posix_path(const char *, char *);
    DLLIMPORT extern __stdcall int GetModuleFileNameW(void *, const char *, int);
    DLLIMPORT extern __stdcall int WideCharToMultiByte(int, int, const char *, int,
		const char *, int, const char *, const char *);

    GetModuleFileNameW(NULL, name, PATH_MAX);
    WideCharToMultiByte(CP_UTF8, 0, name, -1, buf, PATH_MAX, NULL, NULL);
    cygwin_conv_to_full_posix_path(buf, name);
    length = strlen(name);
    if ((length > 4) && !strcasecmp(name + length - 4, ".exe")) {
	/* Strip '.exe' part. */
	length -= 4;
    }
	encoding = Tcl_GetEncoding(NULL, NULL);
	TclSetObjNameOfExecutable(
		Tcl_NewStringObj(name, length), encoding);
#else
    const char *name, *p;
    Tcl_StatBuf statBuf;
    Tcl_DString buffer, nameString, cwd, utfName;


    if (argv0 == NULL) {
	return;
    }
    Tcl_DStringInit(&buffer);

    name = argv0;

Changes to unix/tclUnixPort.h.

75
76
77
78
79
80
81









82
83
84
85
86
87
88
89
90
#else
typedef off_t		Tcl_SeekOffset;
#   define TclOSseek		lseek
#   define TclOSopen		open
#endif

#ifdef __CYGWIN__









MODULE_SCOPE int TclOSstat(const char *name, Tcl_StatBuf *statBuf);
MODULE_SCOPE int TclOSlstat(const char *name, Tcl_StatBuf *statBuf);
#elif defined(HAVE_STRUCT_STAT64)
#   define TclOSstat		stat64
#   define TclOSlstat		lstat64
#else
#   define TclOSstat		stat
#   define TclOSlstat		lstat
#endif







>
>
>
>
>
>
>
>
>
|
|







75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
#else
typedef off_t		Tcl_SeekOffset;
#   define TclOSseek		lseek
#   define TclOSopen		open
#endif

#ifdef __CYGWIN__
#   define USE_PUTENV 1
#   define USE_PUTENV_FOR_UNSET 1
/* On Cygwin, the environment is imported from the Cygwin DLL. */
#   define environ __cygwin_environ
#   define timezone _timezone
    DLLIMPORT extern char **__cygwin_environ;
    DLLIMPORT extern int cygwin_conv_to_win32_path(const char *, char *);
    DLLIMPORT extern int cygwin_posix_to_win32_path_list_buf_size(char *value);
    DLLIMPORT extern void cygwin_posix_to_win32_path_list(char *buf, char *value);
    MODULE_SCOPE int TclOSstat(const char *name, Tcl_StatBuf *statBuf);
    MODULE_SCOPE int TclOSlstat(const char *name, Tcl_StatBuf *statBuf);
#elif defined(HAVE_STRUCT_STAT64)
#   define TclOSstat		stat64
#   define TclOSlstat		lstat64
#else
#   define TclOSstat		stat
#   define TclOSlstat		lstat
#endif

Changes to win/tclWinInit.c.

284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299

	/*
	 * The lstrcmpi() will work even if pathv[pathc-1] is random UTF-8
	 * chars because I know shortlib is ascii.
	 */

	if ((pathc > 0) && (lstrcmpiA(shortlib, pathv[pathc - 1]) != 0)) {
	    const char *str;

	    /*
	     * TCL_LIBRARY is set but refers to a different tcl installation
	     * than the current version. Try fiddling with the specified
	     * directory to make it refer to this installation by removing the
	     * old "tclX.Y" and substituting the current version string.
	     */








<
<







284
285
286
287
288
289
290


291
292
293
294
295
296
297

	/*
	 * The lstrcmpi() will work even if pathv[pathc-1] is random UTF-8
	 * chars because I know shortlib is ascii.
	 */

	if ((pathc > 0) && (lstrcmpiA(shortlib, pathv[pathc - 1]) != 0)) {


	    /*
	     * TCL_LIBRARY is set but refers to a different tcl installation
	     * than the current version. Try fiddling with the specified
	     * directory to make it refer to this installation by removing the
	     * old "tclX.Y" and substituting the current version string.
	     */