Check-in [f211098809]
Not logged in

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

Overview
Comment:merge updates from HEAD
Timelines: family | ancestors | descendants | both | dgp-refactor
Files: files | file ages | folders
SHA1: f211098809964f15fe8fc23d5356d09490f33c69
User & Date: dgp 2008-03-03 04:34:59.000
Context
2008-03-04
03:21
merge updates from HEAD check-in: b8b0172cfd user: dgp tags: dgp-refactor
2008-03-03
04:34
merge updates from HEAD check-in: f211098809 user: dgp tags: dgp-refactor
2008-02-16
22:17
merge updates from HEAD check-in: 5330cb1295 user: dgp tags: dgp-refactor
Changes
Unified Diff Ignore Whitespace Patch
Changes to ChangeLog.





















































































































1
2
3
4
5
6
7





















































































































2008-02-13  Don Porter	<dgp@users.sourceforge.net>

	* generic/tcl.h:	Bump version number to 8.5.2b1 to distinguish
	* library/init.tcl:	CVS development snapshots from the 8.5.1 and
	* unix/configure.in:	8.5.2 releases.
	* unix/tcl.spec:
	* win/configure.in:
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
2008-03-02  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclNamesp.c (GetNamespaceFromObj): 
	* tests/interp.test (interp-28.2): spoil the intrep of an
	nsNameType obj when the reference crosses interpreter 
	boundaries. 

2008-02-29  Don Porter	<dgp@users.sourceforge.net>

	* generic/tclResult.c (Tcl_SetReturnOptions):	Revised the refcount
	management of Tcl_SetReturnOptions to become that of a conventional
	Consumer routine.  Thanks to Peter Spjuth for pointing out the
	difficulties calling Tcl_SetReturnOptions with non-0-count value for
	options.
	* generic/tclExecute.c (INST_RETURN_STK): Revised the one caller
	within Tcl itself which passes a non-0-count value to
	Tcl_SetReturnOptions().

	* generic/tclBasic.c (Tcl_AppendObjToErrorInfo):	Revised the
	refcount management of Tcl_AppendObjToErrorInfo to become that of
	a conventional Consumer routine.  This preserves the ease of use
	for the overwhelming common callers who pass in a 0-count value,
	but makes the proper call with a non-0-count value less surprising.
	* generic/tclEvent.c (TclDefaultBgErrorHandlerObjCmd):	Revised the
	one caller within Tcl itself which passes a non-0-count value to
	Tcl_AppendObjToErrorInfo().

2008-02-28  Joe English  <jenglish@users.sourceforge.net>

	* unix/tclPort.h, unix/tclCompat.h, unix/tclUnixChan.h:
	Reduce scope of <sys/filio.h> and <sys/ioctl.h> #includes
	[Patch 1903339].

2008-02-28  Joe English  <jenglish@users.sourceforge.net>

	* unix/tclUnixChan.c, unix/tclUnixNotfy.c, unix/tclUnixPipe.c:
	Consolidate all code conditionalized on -DUSE_FIONBIO into one place.
	* unix/tclUnixPort.h, unix/tclUnixCompat.c: New routine
	TclUnixSetBlockingMode() [Patch 1903339].

2008-02-28  Don Porter	<dgp@users.sourceforge.net>

	* generic/tclBasic.c (TclEvalObjvInternal):	Plug memory leak when
	an enter trace deletes or changes the command, prompting a reparsing.
	Don't let the second pass lose commandPtr value allocated during the
	first pass.

	* generic/tclCompExpr.c (ParseExpr):	Plug memory leak in error
	message generation.

	* generic/tclStringObj.c (Tcl_AppendFormatToObj): [format %llx $big]
	leaked an mp_int.

	* generic/tclCompCmds.c (TclCompileReturnCmd):	The 2007-10-18 commit
	to optimize compiled [return -level 0 $x] [RFE 1794073] introduced
	a memory leak of the return options dictionary.  Fixing that.

2008-02-27  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* library/http/http.tcl: bug #705956 - fix inverted logic when
	cleaning up socket error in geturl.

2008-02-27  Kevin B. Kenny  <kennykb@acm.org>

	* doc/clock.n: Corrected minor indentation gaffe in the
	penultimate paragraph. [Bug 1898025]
	* generic/tclClock.c (ParseClockFormatArgs): Changed to check that 
	the clock value is in the range of a 64-bit integer. [Bug 1862555]
	* library/clock.tcl (::tcl::clock::format, ::tcl::clock::scan,
	::tcl::clock::add, ::tcl::clock::LocalizeFormat): Fixed bugs
	in caching of localized strings that caused weird results when
	localized date/time formats were used. [Bug 1902423]
	* tests/clock.test (clock-61.*, clock-62.1): Regression tests
	for [Bug 1862555] and [Bug 1902423].

2008-02-26  Joe English  <jenglish@users.sourceforge.net>

	* generic/tclIOUtil.c, unix/tclUnixPort.h, unix/tclUnixChan.c: 
	Remove dead/unused portability-related #defines and
	unused conditional code.  See [Patch 1901828] for discussion.

2008-02-26  Joe English  <jenglish@users.sourceforge.net>

	* generic/tclIORChan.c(enum MethodName),
	generic/tclCompExpr.c(enum Marks): More stray trailing ","s

2008-02-26  Joe English  <jenglish@users.sourceforge.net>

	* unix/configure.in(socklen_t test): Define socklen_t 
	as "int" if missing, not "unsigned".
	Use AC_TRY_COMPILE instead of AC_EGREP_HEADER.
	* unix/configure: regenerated.

2008-02-26  Joe English  <jenglish@users.sourceforge.net>

	* generic/tclCompile.h: Remove stray trailing "," from 
	enum InstOperandType definition (C99ism).

2008-02-26  Jeff Hobbs  <jeffh@ActiveState.com>

	* generic/tclUtil.c (TclReToGlob): fix the handling of the last
	* tests/regexpComp.test:	   star possibly being escaped in
	determining right anchor. [Bug 1902436]

2008-02-26  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* library/http/pkgIndex.tcl: Set version 2.5.5
	* library/http/http.tcl:     bug #1868845 - it is better to do the
	[eof] check after trying to read from the socket. No clashes found
	in testing.  Added http::meta command to access the http headers.

2008-02-22  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* library/http/pkgIndex.tcl: Set version 2.5.4
	* library/http/http.tcl:     Fix for bug #1818565. Always check that
	the state array exists in the http::status command.

2008-02-13  Don Porter	<dgp@users.sourceforge.net>

	* generic/tcl.h:	Bump version number to 8.5.2b1 to distinguish
	* library/init.tcl:	CVS development snapshots from the 8.5.1 and
	* unix/configure.in:	8.5.2 releases.
	* unix/tcl.spec:
	* win/configure.in:
Changes to doc/clock.n.
878
879
880
881
882
883
884

885
886
887
888
889
890
891
unit\fR. Acceptable units are \fByear\fR, \fBfortnight\fR, 
\fBmonth\fR, \fBweek\fR, \fBday\fR,
\fBhour\fR, \fBminute\fR (or \fBmin\fR), and \fBsecond\fR (or \fBsec\fR).  The
unit can be specified as a singular or plural, as in \fB3 weeks\fR.
These modifiers may also be specified:
\fBtomorrow\fR, \fByesterday\fR, \fBtoday\fR, \fBnow\fR,
\fBlast\fR, \fBthis\fR, \fBnext\fR, \fBago\fR.

The actual date is calculated according to the following steps.
.PP
First, any absolute date and/or time is processed and converted.
Using that time as the base, day-of-week specifications are added.
Next, relative specifications are used.  If a date or day is
specified, and no absolute or relative time is given, midnight is
used.  Finally, a correction is applied so that the correct hour of







>







878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
unit\fR. Acceptable units are \fByear\fR, \fBfortnight\fR, 
\fBmonth\fR, \fBweek\fR, \fBday\fR,
\fBhour\fR, \fBminute\fR (or \fBmin\fR), and \fBsecond\fR (or \fBsec\fR).  The
unit can be specified as a singular or plural, as in \fB3 weeks\fR.
These modifiers may also be specified:
\fBtomorrow\fR, \fByesterday\fR, \fBtoday\fR, \fBnow\fR,
\fBlast\fR, \fBthis\fR, \fBnext\fR, \fBago\fR.
.PP
The actual date is calculated according to the following steps.
.PP
First, any absolute date and/or time is processed and converted.
Using that time as the base, day-of-week specifications are added.
Next, relative specifications are used.  If a date or day is
specified, and no absolute or relative time is given, midnight is
used.  Finally, a correction is applied so that the correct hour of
Changes to doc/http.n.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
'\"
'\" Copyright (c) 1995-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1998-2000 by Ajuba Solutions.
'\" Copyright (c) 2004 ActiveState Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: http.n,v 1.18.4.7 2007/11/01 16:55:55 dgp Exp $
'\" 
.so man.macros
.TH "http" n 2.5 http "Tcl Bundled Packages"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
http \- Client-side implementation of the HTTP/1.0 protocol








|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
'\"
'\" Copyright (c) 1995-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1998-2000 by Ajuba Solutions.
'\" Copyright (c) 2004 ActiveState Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: http.n,v 1.18.4.8 2008/03/03 04:35:03 dgp Exp $
'\" 
.so man.macros
.TH "http" n 2.5 http "Tcl Bundled Packages"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
http \- Client-side implementation of the HTTP/1.0 protocol
31
32
33
34
35
36
37


38
39
40
41
42
43
44
\fB::http::status \fItoken\fR
.sp
\fB::http::size \fItoken\fR
.sp
\fB::http::code \fItoken\fR
.sp
\fB::http::ncode \fItoken\fR


.sp
\fB::http::data \fItoken\fR
.sp
\fB::http::error \fItoken\fR
.sp
\fB::http::cleanup \fItoken\fR
.sp







>
>







31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
\fB::http::status \fItoken\fR
.sp
\fB::http::size \fItoken\fR
.sp
\fB::http::code \fItoken\fR
.sp
\fB::http::ncode \fItoken\fR
.sp
\fB::http::meta \fItoken\fR
.sp
\fB::http::data \fItoken\fR
.sp
\fB::http::error \fItoken\fR
.sp
\fB::http::cleanup \fItoken\fR
.sp
311
312
313
314
315
316
317





318
319
320
321
322
323
324
code (200, 404, etc.) from the \fBhttp\fR element of the state array.
.TP
\fB::http::size\fR \fItoken\fR
This is a convenience procedure that returns the \fBcurrentsize\fR
element of the state array, which represents the number of bytes
received from the URL in the \fB::http::geturl\fR call.
.TP





\fB::http::cleanup\fR \fItoken\fR
This procedure cleans up the state associated with the connection
identified by \fItoken\fR.  After this call, the procedures
like \fB::http::data\fR cannot be used to get information
about the operation.  It is \fIstrongly\fR recommended that you call
this function after you are done with a given HTTP request.  Not doing
so will result in memory not being freed, and if your app calls







>
>
>
>
>







313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
code (200, 404, etc.) from the \fBhttp\fR element of the state array.
.TP
\fB::http::size\fR \fItoken\fR
This is a convenience procedure that returns the \fBcurrentsize\fR
element of the state array, which represents the number of bytes
received from the URL in the \fB::http::geturl\fR call.
.TP
\fB::http::meta\fR \fItoken\fR
This is a convenience procedure that returns the \fBmeta\fR
element of the state array which contains the HTTP response
headers. See below for an explanation of this element.
.TP
\fB::http::cleanup\fR \fItoken\fR
This procedure cleans up the state associated with the connection
identified by \fItoken\fR.  After this call, the procedures
like \fB::http::data\fR cannot be used to get information
about the operation.  It is \fIstrongly\fR recommended that you call
this function after you are done with a given HTTP request.  Not doing
so will result in memory not being freed, and if your app calls
Changes to generic/tclBasic.c.
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclBasic.c,v 1.82.2.75 2008/01/23 21:21:39 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include <float.h>
#include <limits.h>
#include <math.h>







|







10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclBasic.c,v 1.82.2.76 2008/03/03 04:35:03 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include <float.h>
#include <limits.h>
#include <math.h>
3670
3671
3672
3673
3674
3675
3676



3677
3678
3679
3680
3681
3682
3683
	 * checkTraces is set to 0 to prevent the re-calling of traces (and
	 * any possible infinite loop) and we go back to re-find the command
	 * implementation.
	 */

	if (cmdEpoch != newEpoch) {
	    checkTraces = 0;



	    goto reparseBecauseOfTraces;
	}
    }

    if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
	char *a[10];
	int i = 0;







>
>
>







3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
	 * checkTraces is set to 0 to prevent the re-calling of traces (and
	 * any possible infinite loop) and we go back to re-find the command
	 * implementation.
	 */

	if (cmdEpoch != newEpoch) {
	    checkTraces = 0;
	    if (commandPtr) {
		Tcl_DecrRefCount(commandPtr);
	    }
	    goto reparseBecauseOfTraces;
	}
    }

    if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
	char *a[10];
	int i = 0;
5268
5269
5270
5271
5272
5273
5274

5275
5276
5277
5278
5279
5280
5281
    Tcl_Interp *interp,		/* Interpreter to which error information
				 * pertains. */
    Tcl_Obj *objPtr)		/* Message to record. */
{
    int length;
    const char *message = TclGetStringFromObj(objPtr, &length);


    Tcl_AddObjErrorInfo(interp, message, length);
    Tcl_DecrRefCount(objPtr);
}

/*
 *----------------------------------------------------------------------
 *







>







5271
5272
5273
5274
5275
5276
5277
5278
5279
5280
5281
5282
5283
5284
5285
    Tcl_Interp *interp,		/* Interpreter to which error information
				 * pertains. */
    Tcl_Obj *objPtr)		/* Message to record. */
{
    int length;
    const char *message = TclGetStringFromObj(objPtr, &length);

    Tcl_IncrRefCount(objPtr);
    Tcl_AddObjErrorInfo(interp, message, length);
    Tcl_DecrRefCount(objPtr);
}

/*
 *----------------------------------------------------------------------
 *
Changes to generic/tclClock.c.
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.
 * Copyright (c) 1995 Sun Microsystems, Inc.
 * Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclClock.c,v 1.23.2.21 2008/02/12 04:34:04 dgp Exp $
 */

#include "tclInt.h"

/*
 * Windows has mktime. The configurators do not check.
 */







|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.
 * Copyright (c) 1995 Sun Microsystems, Inc.
 * Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclClock.c,v 1.23.2.22 2008/03/03 04:35:04 dgp Exp $
 */

#include "tclInt.h"

/*
 * Windows has mktime. The configurators do not check.
 */
61
62
63
64
65
66
67

68
69
70
71
72
73
74
75
76
77
78
79
80
81
82

83
84
85
86
87
88
89
    LIT__NIL,
    LIT__DEFAULT_FORMAT,
    LIT_BCE,		LIT_C,			
    LIT_CANNOT_USE_GMT_AND_TIMEZONE,
    LIT_CE,
    LIT_DAYOFMONTH,	LIT_DAYOFWEEK,		LIT_DAYOFYEAR,
    LIT_ERA,		LIT_GMT,		LIT_GREGORIAN,

    LIT_ISO8601WEEK,	LIT_ISO8601YEAR,
    LIT_JULIANDAY,	LIT_LOCALSECONDS,
    LIT_MONTH,
    LIT_SECONDS,	LIT_TZNAME,		LIT_TZOFFSET,
    LIT_YEAR,
    LIT__END
} ClockLiteral;
static const char *const literals[] = {
    "",
    "%a %b %d %H:%M:%S %Z %Y",
    "BCE",		"C",			
    "cannot use -gmt and -timezone in same call",
    "CE",
    "dayOfMonth",	"dayOfWeek",		"dayOfYear",
    "era",		":GMT",			"gregorian",

    "iso8601Week",	"iso8601Year",
    "julianDay",	"localSeconds",
    "month",
    "seconds",		"tzName",		"tzOffset",
    "year"
};








>















>







61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
    LIT__NIL,
    LIT__DEFAULT_FORMAT,
    LIT_BCE,		LIT_C,			
    LIT_CANNOT_USE_GMT_AND_TIMEZONE,
    LIT_CE,
    LIT_DAYOFMONTH,	LIT_DAYOFWEEK,		LIT_DAYOFYEAR,
    LIT_ERA,		LIT_GMT,		LIT_GREGORIAN,
    LIT_INTEGER_VALUE_TOO_LARGE,
    LIT_ISO8601WEEK,	LIT_ISO8601YEAR,
    LIT_JULIANDAY,	LIT_LOCALSECONDS,
    LIT_MONTH,
    LIT_SECONDS,	LIT_TZNAME,		LIT_TZOFFSET,
    LIT_YEAR,
    LIT__END
} ClockLiteral;
static const char *const literals[] = {
    "",
    "%a %b %d %H:%M:%S %Z %Y",
    "BCE",		"C",			
    "cannot use -gmt and -timezone in same call",
    "CE",
    "dayOfMonth",	"dayOfWeek",		"dayOfYear",
    "era",		":GMT",			"gregorian",
    "integer value too large to represent",
    "iso8601Week",	"iso8601Year",
    "julianDay",	"localSeconds",
    "month",
    "seconds",		"tzName",		"tzOffset",
    "year"
};

412
413
414
415
416
417
418










419
420
421
422
423
424
425
	Tcl_WrongNumArgs(interp, 1, objv, "seconds tzdata changeover");
	return TCL_ERROR;
    }
    if (Tcl_GetWideIntFromObj(interp, objv[1], &(fields.seconds)) != TCL_OK
	    || TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK) {
	return TCL_ERROR;
    }











    /*
     * Convert UTC time to local.
     */

    if (ConvertUTCToLocal(interp, &fields, objv[2], changeover) != TCL_OK) {
	return TCL_ERROR;







>
>
>
>
>
>
>
>
>
>







414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
	Tcl_WrongNumArgs(interp, 1, objv, "seconds tzdata changeover");
	return TCL_ERROR;
    }
    if (Tcl_GetWideIntFromObj(interp, objv[1], &(fields.seconds)) != TCL_OK
	    || TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK) {
	return TCL_ERROR;
    }

    /* 
     * fields.seconds could be an unsigned number that overflowed.  Make
     * sure that it isn't.
     */

    if (objv[1]->typePtr == &tclBignumType) {
	Tcl_SetObjResult(interp, literals[LIT_INTEGER_VALUE_TOO_LARGE]);
	return TCL_ERROR;
    }

    /*
     * Convert UTC time to local.
     */

    if (ConvertUTCToLocal(interp, &fields, objv[2], changeover) != TCL_OK) {
	return TCL_ERROR;
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
#define formatObj results[0]
#define localeObj results[1]
#define timezoneObj results[2]
    int gmtFlag = 0;

    /* Command line options expected */

    const static char* options[] = {
	"-format",		"-gmt",			"-locale",
	"-timezone",		NULL };
    enum optionInd {
	CLOCK_FORMAT_FORMAT,	CLOCK_FORMAT_GMT,	CLOCK_FORMAT_LOCALE,
	CLOCK_FORMAT_TIMEZONE 
    };
    int optionIndex;		/* Index of an option */







|







1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
#define formatObj results[0]
#define localeObj results[1]
#define timezoneObj results[2]
    int gmtFlag = 0;

    /* Command line options expected */

    static const char* options[] = {
	"-format",		"-gmt",			"-locale",
	"-timezone",		NULL };
    enum optionInd {
	CLOCK_FORMAT_FORMAT,	CLOCK_FORMAT_GMT,	CLOCK_FORMAT_LOCALE,
	CLOCK_FORMAT_TIMEZONE 
    };
    int optionIndex;		/* Index of an option */
Changes to generic/tclCompCmds.c.
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2002 ActiveState Corporation.
 * Copyright (c) 2004-2006 by Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCompCmds.c,v 1.49.2.37 2008/02/12 17:40:27 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"

/*
 * Macro that encapsulates an efficiency trick that avoids a function call for







|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2002 ActiveState Corporation.
 * Copyright (c) 2004-2006 by Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCompCmds.c,v 1.49.2.38 2008/03/03 04:35:04 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"

/*
 * Macro that encapsulates an efficiency trick that avoids a function call for
3354
3355
3356
3357
3358
3359
3360

3361
3362
3363
3364
3365
3366
3367
	    return TCL_OK;
	}
    }

    /* Optimize [return -level 0 $x]. */
    Tcl_DictObjSize(NULL, returnOpts, &size);
    if (size == 0 && level == 0 && code == TCL_OK) {

	return TCL_OK;
    }

    /*
     * Could not use the optimization, so we push the return options dict, and
     * emit the INST_RETURN_IMM instruction with code and level as operands.
     */







>







3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
	    return TCL_OK;
	}
    }

    /* Optimize [return -level 0 $x]. */
    Tcl_DictObjSize(NULL, returnOpts, &size);
    if (size == 0 && level == 0 && code == TCL_OK) {
	Tcl_DecrRefCount(returnOpts);
	return TCL_OK;
    }

    /*
     * Could not use the optimization, so we push the return options dict, and
     * emit the INST_RETURN_IMM instruction with code and level as operands.
     */
Changes to generic/tclCompExpr.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tclCompExpr.c --
 *
 *	This file contains the code to parse and compile Tcl expressions
 *	and implementations of the Tcl commands corresponding to expression
 *	operators, such as the command ::tcl::mathop::+ .
 *
 * Contributions from Don Porter, NIST, 2006-2007. (not subject to US copyright)
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCompExpr.c,v 1.14.2.35 2008/01/17 22:03:14 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"		/* CompileEnv */

/*
 * Expression parsing takes place in the routine ParseExpr().  It takes a












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tclCompExpr.c --
 *
 *	This file contains the code to parse and compile Tcl expressions
 *	and implementations of the Tcl commands corresponding to expression
 *	operators, such as the command ::tcl::mathop::+ .
 *
 * Contributions from Don Porter, NIST, 2006-2007. (not subject to US copyright)
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCompExpr.c,v 1.14.2.36 2008/03/03 04:35:04 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"		/* CompileEnv */

/*
 * Expression parsing takes place in the routine ParseExpr().  It takes a
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
 * The mark field is use to control the traversal of the tree, so
 * that it can be done non-recursively.  The mark values are:
 */

enum Marks {
    MARK_LEFT,		/* Next step of traversal is to visit left subtree */
    MARK_RIGHT,		/* Next step of traversal is to visit right subtree */
    MARK_PARENT,	/* Next step of traversal is to return to parent */
};

/*
 * The constant field is a boolean flag marking which subexpressions are
 * completely known at compile time, and are eligible for computing then
 * rather than waiting until run time.
 */







|







107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
 * The mark field is use to control the traversal of the tree, so
 * that it can be done non-recursively.  The mark values are:
 */

enum Marks {
    MARK_LEFT,		/* Next step of traversal is to visit left subtree */
    MARK_RIGHT,		/* Next step of traversal is to visit right subtree */
    MARK_PARENT		/* Next step of traversal is to return to parent */
};

/*
 * The constant field is a boolean flag marking which subexpressions are
 * completely known at compile time, and are eligible for computing then
 * rather than waiting until run time.
 */
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
				while (isdigit(*end)) {
				    end++;
				}
				copy = Tcl_NewStringObj(lastStart,
					end - lastStart);
				if (TclCheckBadOctal(NULL,
					Tcl_GetString(copy))) {
					TclNewLiteralStringObj(post,
						"(invalid octal number?)");
				}
				Tcl_DecrRefCount(copy);
			    }
			    scanned = 0;
			    insertMark = 1;
			    parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
			}







|
|







755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
				while (isdigit(*end)) {
				    end++;
				}
				copy = Tcl_NewStringObj(lastStart,
					end - lastStart);
				if (TclCheckBadOctal(NULL,
					Tcl_GetString(copy))) {
				    Tcl_AppendToObj(post,
					    "(invalid octal number?)", -1);
				}
				Tcl_DecrRefCount(copy);
			    }
			    scanned = 0;
			    insertMark = 1;
			    parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
			}
Changes to generic/tclCompile.h.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/*
 * tclCompile.h --
 *
 * Copyright (c) 1996-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 by Scriptics Corporation.
 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCompile.h,v 1.36.2.35 2008/01/23 21:27:46 dgp Exp $
 */

#ifndef _TCLCOMPILATION
#define _TCLCOMPILATION 1

#include "tclInt.h"












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/*
 * tclCompile.h --
 *
 * Copyright (c) 1996-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 by Scriptics Corporation.
 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCompile.h,v 1.36.2.36 2008/03/03 04:35:05 dgp Exp $
 */

#ifndef _TCLCOMPILATION
#define _TCLCOMPILATION 1

#include "tclInt.h"

668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
    OPERAND_UINT4,		/* Four byte unsigned integer. */
    OPERAND_IDX4,		/* Four byte signed index (actually an
				 * integer, but displayed differently.) */
    OPERAND_LVT1,		/* One byte unsigned index into the local
				 * variable table. */
    OPERAND_LVT4,		/* Four byte unsigned index into the local
				 * variable table. */
    OPERAND_AUX4,		/* Four byte unsigned index into the aux data
				 * table. */
} InstOperandType;

typedef struct InstructionDesc {
    char *name;			/* Name of instruction. */
    int numBytes;		/* Total number of bytes for instruction. */
    int stackEffect;		/* The worst-case balance stack effect of the







|







668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
    OPERAND_UINT4,		/* Four byte unsigned integer. */
    OPERAND_IDX4,		/* Four byte signed index (actually an
				 * integer, but displayed differently.) */
    OPERAND_LVT1,		/* One byte unsigned index into the local
				 * variable table. */
    OPERAND_LVT4,		/* Four byte unsigned index into the local
				 * variable table. */
    OPERAND_AUX4		/* Four byte unsigned index into the aux data
				 * table. */
} InstOperandType;

typedef struct InstructionDesc {
    char *name;			/* Name of instruction. */
    int numBytes;		/* Total number of bytes for instruction. */
    int stackEffect;		/* The worst-case balance stack effect of the
Changes to generic/tclEvent.c.
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 2004 by Zoran Vasiljevic.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclEvent.c,v 1.29.2.27 2007/09/17 15:10:51 dgp Exp $
 */

#include "tclInt.h"

/*
 * The data structure below is used to report background errors. One such
 * structure is allocated for each error; it holds information about the







|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 2004 by Zoran Vasiljevic.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclEvent.c,v 1.29.2.28 2008/03/03 04:35:05 dgp Exp $
 */

#include "tclInt.h"

/*
 * The data structure below is used to report background errors. One such
 * structure is allocated for each error; it holds information about the
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
    }

    TclNewLiteralStringObj(keyPtr, "-errorinfo");
    Tcl_IncrRefCount(keyPtr);
    Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
    Tcl_DecrRefCount(keyPtr);
    if (valuePtr) {
	Tcl_IncrRefCount(valuePtr);
	Tcl_AppendObjToErrorInfo(interp, valuePtr);
    }

    if (code == TCL_ERROR) {
	Tcl_SetObjResult(interp, tempObjv[1]);
    }








<







372
373
374
375
376
377
378

379
380
381
382
383
384
385
    }

    TclNewLiteralStringObj(keyPtr, "-errorinfo");
    Tcl_IncrRefCount(keyPtr);
    Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
    Tcl_DecrRefCount(keyPtr);
    if (valuePtr) {

	Tcl_AppendObjToErrorInfo(interp, valuePtr);
    }

    if (code == TCL_ERROR) {
	Tcl_SetObjResult(interp, tempObjv[1]);
    }

Changes to generic/tclExecute.c.
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 * Copyright (c) 2002-2005 by Miguel Sofer.
 * Copyright (c) 2005-2007 by Donal K. Fellows.
 * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclExecute.c,v 1.101.2.73 2008/02/12 04:34:04 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tommath.h"

#include <math.h>







|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 * Copyright (c) 2002-2005 by Miguel Sofer.
 * Copyright (c) 2005-2007 by Donal K. Fellows.
 * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclExecute.c,v 1.101.2.74 2008/03/03 04:35:05 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tommath.h"

#include <math.h>
1868
1869
1870
1871
1872
1873
1874

1875
1876
1877
1878
1879
1880
1881
	}
    }

    case INST_RETURN_STK:
	TRACE(("=> "));
	objResultPtr = POP_OBJECT();
	result = Tcl_SetReturnOptions(interp, OBJ_AT_TOS);

	OBJ_AT_TOS = objResultPtr;
	if (result == TCL_OK) {
	    TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")",
		    O2S(objResultPtr)));
	    NEXT_INST_F(1, 0, 0);
	} else {
	    Tcl_SetObjResult(interp, objResultPtr);







>







1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
	}
    }

    case INST_RETURN_STK:
	TRACE(("=> "));
	objResultPtr = POP_OBJECT();
	result = Tcl_SetReturnOptions(interp, OBJ_AT_TOS);
	Tcl_DecrRefCount(OBJ_AT_TOS);
	OBJ_AT_TOS = objResultPtr;
	if (result == TCL_OK) {
	    TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")",
		    O2S(objResultPtr)));
	    NEXT_INST_F(1, 0, 0);
	} else {
	    Tcl_SetObjResult(interp, objResultPtr);
Changes to generic/tclIORChan.c.
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 *	See TIP #219 for the specification of this functionality.
 *
 * Copyright (c) 2004-2005 ActiveState, a divison of Sophos
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclIORChan.c,v 1.3.2.14 2007/12/06 06:51:40 dgp Exp $
 */

#include <tclInt.h>
#include <tclIO.h>
#include <assert.h>

#ifndef EINVAL







|







11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 *	See TIP #219 for the specification of this functionality.
 *
 * Copyright (c) 2004-2005 ActiveState, a divison of Sophos
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclIORChan.c,v 1.3.2.15 2008/03/03 04:35:06 dgp Exp $
 */

#include <tclInt.h>
#include <tclIO.h>
#include <assert.h>

#ifndef EINVAL
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
    METH_CGETALL,
    METH_CONFIGURE,
    METH_FINAL,
    METH_INIT,
    METH_READ,
    METH_SEEK,
    METH_WATCH,
    METH_WRITE,
} MethodName;

#define FLAG(m) (1 << (m))
#define REQUIRED_METHODS \
	(FLAG(METH_INIT) | FLAG(METH_FINAL) | FLAG(METH_WATCH))
#define NULLABLE_METHODS \
	(FLAG(METH_BLOCKING) | FLAG(METH_SEEK) | \







|







187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
    METH_CGETALL,
    METH_CONFIGURE,
    METH_FINAL,
    METH_INIT,
    METH_READ,
    METH_SEEK,
    METH_WATCH,
    METH_WRITE
} MethodName;

#define FLAG(m) (1 << (m))
#define REQUIRED_METHODS \
	(FLAG(METH_INIT) | FLAG(METH_FINAL) | FLAG(METH_WATCH))
#define NULLABLE_METHODS \
	(FLAG(METH_BLOCKING) | FLAG(METH_SEEK) | \
Changes to generic/tclIOUtil.c.
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 2001-2004 Vincent Darley.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclIOUtil.c,v 1.81.2.35 2008/01/23 21:22:00 dgp Exp $
 */

#include "tclInt.h"
#ifdef __WIN32__
#   include "tclWinInt.h"
#endif
#include "tclFileSystem.h"







|







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 2001-2004 Vincent Darley.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclIOUtil.c,v 1.81.2.36 2008/03/03 04:35:06 dgp Exp $
 */

#include "tclInt.h"
#ifdef __WIN32__
#   include "tclWinInt.h"
#endif
#include "tclFileSystem.h"
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
			"\" not supported by this system", NULL);
	    }
	    ckfree((char *) modeArgv);
	    return -1;
#endif

	} else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) {
#if defined(O_NDELAY) || defined(O_NONBLOCK)
#   ifdef O_NONBLOCK
	    mode |= O_NONBLOCK;
#   else
	    mode |= O_NDELAY;
#   endif

#else
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "access mode \"", flag,
			"\" not supported by this system", NULL);
	    }
	    ckfree((char *) modeArgv);
	    return -1;







<
|

<
<
<
<







1666
1667
1668
1669
1670
1671
1672

1673
1674




1675
1676
1677
1678
1679
1680
1681
			"\" not supported by this system", NULL);
	    }
	    ckfree((char *) modeArgv);
	    return -1;
#endif

	} else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) {

#ifdef O_NONBLOCK
	    mode |= O_NONBLOCK;




#else
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "access mode \"", flag,
			"\" not supported by this system", NULL);
	    }
	    ckfree((char *) modeArgv);
	    return -1;
Changes to generic/tclNamesp.c.
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
 *   Michael J. McLennan
 *   Bell Labs Innovations for Lucent Technologies
 *   mmclennan@lucent.com
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclNamesp.c,v 1.31.4.46 2007/12/06 17:08:38 dgp Exp $
 */

#include "tclInt.h"

/*
 * Thread-local storage used to avoid having a global lock on data that is not
 * limited to a single interpreter.







|







19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
 *   Michael J. McLennan
 *   Bell Labs Innovations for Lucent Technologies
 *   mmclennan@lucent.com
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclNamesp.c,v 1.31.4.47 2008/03/03 04:35:07 dgp Exp $
 */

#include "tclInt.h"

/*
 * Thread-local storage used to avoid having a global lock on data that is not
 * limited to a single interpreter.
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706

2707
2708
2709
2710

2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
GetNamespaceFromObj(
    Tcl_Interp *interp,		/* The current interpreter. */
    Tcl_Obj *objPtr,		/* The object to be resolved as the name of a
				 * namespace. */
    Tcl_Namespace **nsPtrPtr)	/* Result namespace pointer goes here. */
{
    ResolvedNsName *resNamePtr;
    Namespace *nsPtr;

    if (objPtr->typePtr == &nsNameType) {
	/*
	 * Check that the ResolvedNsName is still valid.

	 */

	resNamePtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1;
	nsPtr = resNamePtr->nsPtr;

	if (!(nsPtr->flags & NS_DYING)
		&& ((resNamePtr->refNsPtr == NULL) || (resNamePtr->refNsPtr
		== (Namespace *) Tcl_GetCurrentNamespace(interp)))) {
	    *nsPtrPtr = (Tcl_Namespace *) nsPtr;
	    return TCL_OK;
	}
    }
    if (SetNsNameFromAny(interp, objPtr) == TCL_OK) {
	resNamePtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1;
	*nsPtrPtr = (Tcl_Namespace *) resNamePtr->nsPtr;







|



|
>




>
|
|
|







2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
GetNamespaceFromObj(
    Tcl_Interp *interp,		/* The current interpreter. */
    Tcl_Obj *objPtr,		/* The object to be resolved as the name of a
				 * namespace. */
    Tcl_Namespace **nsPtrPtr)	/* Result namespace pointer goes here. */
{
    ResolvedNsName *resNamePtr;
    Namespace *nsPtr, *refNsPtr;

    if (objPtr->typePtr == &nsNameType) {
	/*
	 * Check that the ResolvedNsName is still valid; avoid letting the ref 
	 * cross interps.
	 */

	resNamePtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1;
	nsPtr = resNamePtr->nsPtr;
	refNsPtr = resNamePtr->refNsPtr;
	if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp) &&
		(!refNsPtr || ((interp == refNsPtr->interp) &&
		 (refNsPtr== (Namespace *) Tcl_GetCurrentNamespace(interp))))) {
	    *nsPtrPtr = (Tcl_Namespace *) nsPtr;
	    return TCL_OK;
	}
    }
    if (SetNsNameFromAny(interp, objPtr) == TCL_OK) {
	resNamePtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1;
	*nsPtrPtr = (Tcl_Namespace *) resNamePtr->nsPtr;
Changes to generic/tclResult.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/*
 * tclResult.c --
 *
 *	This file contains code to manage the interpreter result.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclResult.c,v 1.6.2.21 2007/11/13 13:15:49 dgp Exp $
 */

#include "tclInt.h"

/*
 * Indices of the standard return options dictionary keys.
 */










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/*
 * tclResult.c --
 *
 *	This file contains code to manage the interpreter result.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclResult.c,v 1.6.2.22 2008/03/03 04:35:07 dgp Exp $
 */

#include "tclInt.h"

/*
 * Indices of the standard return options dictionary keys.
 */
1490
1491
1492
1493
1494
1495
1496

1497
1498
1499
1500
1501
1502
1503
Tcl_SetReturnOptions(
    Tcl_Interp *interp,
    Tcl_Obj *options)
{
    int objc, level, code;
    Tcl_Obj **objv, *mergedOpts;


    if (TCL_ERROR == TclListObjGetElements(interp, options, &objc, &objv)
	    || (objc % 2)) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "expected dict but got \"",
		TclGetString(options), "\"", NULL);
	code = TCL_ERROR;
    } else if (TCL_ERROR == TclMergeReturnOptions(interp, objc, objv,







>







1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
Tcl_SetReturnOptions(
    Tcl_Interp *interp,
    Tcl_Obj *options)
{
    int objc, level, code;
    Tcl_Obj **objv, *mergedOpts;

    Tcl_IncrRefCount(options);
    if (TCL_ERROR == TclListObjGetElements(interp, options, &objc, &objv)
	    || (objc % 2)) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "expected dict but got \"",
		TclGetString(options), "\"", NULL);
	code = TCL_ERROR;
    } else if (TCL_ERROR == TclMergeReturnOptions(interp, objc, objv,
Changes to generic/tclStringObj.c.
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclStringObj.c,v 1.32.4.17 2008/01/10 16:46:30 dgp Exp $ */

#include "tclInt.h"
#include "tommath.h"

/*
 * Prototypes for functions defined later in this file:
 */







|







29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclStringObj.c,v 1.32.4.18 2008/03/03 04:35:07 dgp Exp $ */

#include "tclInt.h"
#include "tommath.h"

/*
 * Prototypes for functions defined later in this file:
 */
2150
2151
2152
2153
2154
2155
2156



2157
2158
2159
2160
2161
2162
2163
		    if (digitOffset > 9) {
			bytes[numDigits] = 'a' + digitOffset - 10;
		    } else {
			bytes[numDigits] = '0' + digitOffset;
		    }
		    bits /= base;
		}



		if (gotPrecision) {
		    while (length < precision) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		    gotZero = 0;
		}







>
>
>







2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
		    if (digitOffset > 9) {
			bytes[numDigits] = 'a' + digitOffset - 10;
		    } else {
			bytes[numDigits] = '0' + digitOffset;
		    }
		    bits /= base;
		}
		if (useBig) {
		    mp_clear(&big);
		}
		if (gotPrecision) {
		    while (length < precision) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		    gotZero = 0;
		}
Changes to generic/tclUtil.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/*
 * tclUtil.c --
 *
 *	This file contains utility functions that are used by many Tcl
 *	commands.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUtil.c,v 1.37.2.30 2007/12/11 16:22:08 dgp Exp $
 */

#include "tclInt.h"
#include <float.h>
#include <math.h>

/*













|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/*
 * tclUtil.c --
 *
 *	This file contains utility functions that are used by many Tcl
 *	commands.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUtil.c,v 1.37.2.31 2008/03/03 04:35:07 dgp Exp $
 */

#include "tclInt.h"
#include <float.h>
#include <math.h>

/*
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
TclReToGlob(
    Tcl_Interp *interp,
    const char *reStr,
    int reStrLen,
    Tcl_DString *dsPtr,
    int *exactPtr)
{
    int anchorLeft, anchorRight;
    char *dsStr, *dsStrStart, *msg;
    const char *p, *strEnd;

    strEnd = reStr + reStrLen;
    Tcl_DStringInit(dsPtr);

    /*







|







3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
TclReToGlob(
    Tcl_Interp *interp,
    const char *reStr,
    int reStrLen,
    Tcl_DString *dsPtr,
    int *exactPtr)
{
    int anchorLeft, anchorRight, lastIsStar;
    char *dsStr, *dsStrStart, *msg;
    const char *p, *strEnd;

    strEnd = reStr + reStrLen;
    Tcl_DStringInit(dsPtr);

    /*
3296
3297
3298
3299
3300
3301
3302




3303
3304
3305
3306
3307

3308
3309
3310
3311
3312
3313
3314

3315
3316
3317
3318
3319
3320
3321

    Tcl_DStringSetLength(dsPtr, reStrLen + 2);
    dsStrStart = Tcl_DStringValue(dsPtr);

    /*
     * Check for anchored REs (ie ^foo$), so we can use string equal if
     * possible. Do not alter the start of str so we can free it correctly.




     */

    msg = NULL;
    p = reStr;
    anchorRight = 0;

    dsStr = dsStrStart;
    if (*p == '^') {
	anchorLeft = 1;
	p++;
    } else {
	anchorLeft = 0;
	*dsStr++ = '*';

    }

    for ( ; p < strEnd; p++) {
	switch (*p) {
	case '\\':
	    p++;
	    switch (*p) {







>
>
>
>





>







>







3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327

    Tcl_DStringSetLength(dsPtr, reStrLen + 2);
    dsStrStart = Tcl_DStringValue(dsPtr);

    /*
     * Check for anchored REs (ie ^foo$), so we can use string equal if
     * possible. Do not alter the start of str so we can free it correctly.
     *
     * Keep track of the last char being an unescaped star to prevent
     * multiple instances.  Simpler than checking that the last star
     * may be escaped.
     */

    msg = NULL;
    p = reStr;
    anchorRight = 0;
    lastIsStar = 0;
    dsStr = dsStrStart;
    if (*p == '^') {
	anchorLeft = 1;
	p++;
    } else {
	anchorLeft = 0;
	*dsStr++ = '*';
	lastIsStar = 1;
    }

    for ( ; p < strEnd; p++) {
	switch (*p) {
	case '\\':
	    p++;
	    switch (*p) {
3360
3361
3362
3363
3364
3365
3366
3367
3368

3369
3370
3371
3372
3373
3374

3375
3376
3377
3378
3379
3380
3381
	    }
	    break;
	case '.':
	    anchorLeft = 0; /* prevent exact match */
	    if (p+1 < strEnd) {
		if (p[1] == '*') {
		    p++;
		    if ((dsStr == dsStrStart) || (dsStr[-1] != '*')) {
			*dsStr++ = '*';

		    }
		    continue;
		} else if (p[1] == '+') {
		    p++;
		    *dsStr++ = '?';
		    *dsStr++ = '*';

		    continue;
		}
	    }
	    *dsStr++ = '?';
	    break;
	case '$':
	    if (p+1 != strEnd) {







|

>






>







3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
	    }
	    break;
	case '.':
	    anchorLeft = 0; /* prevent exact match */
	    if (p+1 < strEnd) {
		if (p[1] == '*') {
		    p++;
		    if (!lastIsStar) {
			*dsStr++ = '*';
			lastIsStar = 1;
		    }
		    continue;
		} else if (p[1] == '+') {
		    p++;
		    *dsStr++ = '?';
		    *dsStr++ = '*';
		    lastIsStar = 1;
		    continue;
		}
	    }
	    *dsStr++ = '?';
	    break;
	case '$':
	    if (p+1 != strEnd) {
3389
3390
3391
3392
3393
3394
3395

3396
3397
3398
3399
3400
3401
3402
3403
3404
	    msg = "unhandled RE special char";
	    goto invalidGlob;
	    break;
	default:
	    *dsStr++ = *p;
	    break;
	}

    }
    if (!anchorRight && ((dsStr == dsStrStart) || (dsStr[-1] != '*'))) {
	*dsStr++ = '*';
    }
    Tcl_DStringSetLength(dsPtr, dsStr - dsStrStart);

    if (exactPtr) {
	*exactPtr = (anchorLeft && anchorRight);
    }







>

|







3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
	    msg = "unhandled RE special char";
	    goto invalidGlob;
	    break;
	default:
	    *dsStr++ = *p;
	    break;
	}
	lastIsStar = 0;
    }
    if (!anchorRight && !lastIsStar) {
	*dsStr++ = '*';
    }
    Tcl_DStringSetLength(dsPtr, dsStr - dsStrStart);

    if (exactPtr) {
	*exactPtr = (anchorLeft && anchorRight);
    }
Changes to library/clock.tcl.
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
#
#----------------------------------------------------------------------
#
# Copyright (c) 2004,2005,2006,2007 by Kevin B. Kenny
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: clock.tcl,v 1.4.2.19 2008/02/12 04:34:05 dgp Exp $
#
#----------------------------------------------------------------------

# We must have message catalogs that support the root locale, and
# we need access to the Registry on Windows systems.

uplevel \#0 {







|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
#
#----------------------------------------------------------------------
#
# Copyright (c) 2004,2005,2006,2007 by Kevin B. Kenny
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: clock.tcl,v 1.4.2.20 2008/03/03 04:35:08 dgp Exp $
#
#----------------------------------------------------------------------

# We must have message catalogs that support the root locale, and
# we need access to the Registry on Windows systems.

uplevel \#0 {
664
665
666
667
668
669
670

671
672
673
674
675
676
677

proc ::tcl::clock::format { args } {

    variable FormatProc
    variable TZData

    lassign [ParseFormatArgs {*}$args] format locale timezone

    set clockval [lindex $args 0]

    # Get the data for time changes in the given zone
    
    if {$timezone eq ""} {
	set timezone [GetSystemTimeZone]
    }







>







664
665
666
667
668
669
670
671
672
673
674
675
676
677
678

proc ::tcl::clock::format { args } {

    variable FormatProc
    variable TZData

    lassign [ParseFormatArgs {*}$args] format locale timezone
    set locale [string tolower $locale]
    set clockval [lindex $args 0]

    # Get the data for time changes in the given zone
    
    if {$timezone eq ""} {
	set timezone [GetSystemTimeZone]
    }
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250

    # Set defaults

    set base [clock seconds]
    set string [lindex $args 0]
    set format {}
    set gmt 0
    set locale C
    set timezone [GetSystemTimeZone]

    # Pick up command line options.

    foreach { flag value } [lreplace $args 0 0] {
	set saw($flag) {}
	switch -exact -- $flag {
	    -b - -ba - -bas - -base {
		set base $value
	    }
	    -f - -fo - -for - -form - -forma - -format {
		set format $value
	    }
	    -g - -gm - -gmt {
		set gmt $value
	    }
	    -l - -lo - -loc - -loca - -local - -locale {
		set locale $value
	    }
	    -t - -ti - -tim - -time - -timez - -timezo - -timezon - -timezone {
		set timezone $value
	    }
	    default {
		return -code error \
		    -errorcode [list CLOCK badSwitch $flag] \







|

















|







1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251

    # Set defaults

    set base [clock seconds]
    set string [lindex $args 0]
    set format {}
    set gmt 0
    set locale c
    set timezone [GetSystemTimeZone]

    # Pick up command line options.

    foreach { flag value } [lreplace $args 0 0] {
	set saw($flag) {}
	switch -exact -- $flag {
	    -b - -ba - -bas - -base {
		set base $value
	    }
	    -f - -fo - -for - -form - -forma - -format {
		set format $value
	    }
	    -g - -gm - -gmt {
		set gmt $value
	    }
	    -l - -lo - -loc - -loca - -local - -locale {
		set locale [string tolower $value]
	    }
	    -t - -ti - -tim - -time - -timez - -timezo - -timezon - -timezone {
		set timezone $value
	    }
	    default {
		return -code error \
		    -errorcode [list CLOCK badSwitch $flag] \
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389

	    # Make a new locale string for the system locale, and
	    # get the Control Panel information

	    set locale ${oldLocale}_windows
	    if { ![dict exists $McLoaded $locale] } {
		LoadWindowsDateTimeFormats $locale
		dict set mcloaded $locale {}
	    }
	}
    }
    if { $locale eq {current}} {
	set locale $oldLocale
	unset oldLocale
    } elseif { $locale eq $oldLocale } {







|







2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390

	    # Make a new locale string for the system locale, and
	    # get the Control Panel information

	    set locale ${oldLocale}_windows
	    if { ![dict exists $McLoaded $locale] } {
		LoadWindowsDateTimeFormats $locale
		dict set McLoaded $locale {}
	    }
	}
    }
    if { $locale eq {current}} {
	set locale $oldLocale
	unset oldLocale
    } elseif { $locale eq $oldLocale } {
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
    set format [string map [list %r [mc TIME_FORMAT_12] \
				%R [mc TIME_FORMAT_24] \
				%T [mc TIME_FORMAT_24_SECS]] $format]
    set format [string map [list %D %m/%d/%Y \
				%EY [mc LOCALE_YEAR_FORMAT]\
				%+ {%a %b %e %H:%M:%S %Z %Y}] $format]

    dict set McLoaded $locale FORMAT $format $inFormat
    return $format
}

#----------------------------------------------------------------------
#
# FormatNumericTimeZone --
#







|







2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
    set format [string map [list %r [mc TIME_FORMAT_12] \
				%R [mc TIME_FORMAT_24] \
				%T [mc TIME_FORMAT_24_SECS]] $format]
    set format [string map [list %D %m/%d/%Y \
				%EY [mc LOCALE_YEAR_FORMAT]\
				%+ {%a %b %e %H:%M:%S %Z %Y}] $format]

    dict set McLoaded $locale FORMAT $inFormat $format
    return $format
}

#----------------------------------------------------------------------
#
# FormatNumericTimeZone --
#
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
    }
    if { [catch { expr {wide($clockval)} } result] } {
	return -code error $result
    }

    set offsets {}
    set gmt 0
    set locale C
    set timezone [GetSystemTimeZone]

    foreach { a b } $args {

	if { [string is integer -strict $a] } {

	    lappend offsets $a $b

	} else {

	    switch -exact -- $a {

		-g - -gm - -gmt {
		    set gmt $b
		}
		-l - -lo - -loc - -loca - -local - -locale {
		    set locale $b
		}
		-t - -ti - -tim - -time - -timez - -timezo - -timezon -
		-timezone {
		    set timezone $b
		}
		default {
		    return -code error \







|
















|







4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
    }
    if { [catch { expr {wide($clockval)} } result] } {
	return -code error $result
    }

    set offsets {}
    set gmt 0
    set locale c
    set timezone [GetSystemTimeZone]

    foreach { a b } $args {

	if { [string is integer -strict $a] } {

	    lappend offsets $a $b

	} else {

	    switch -exact -- $a {

		-g - -gm - -gmt {
		    set gmt $b
		}
		-l - -lo - -loc - -loca - -local - -locale {
		    set locale [string tolower $b]
		}
		-t - -ti - -tim - -time - -timez - -timezo - -timezon -
		-timezone {
		    set timezone $b
		}
		default {
		    return -code error \
Changes to library/http/http.tcl.
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
# http.tcl --
#
#	Client-side HTTP for GET, POST, and HEAD commands. These routines can
#	be used in untrusted code that uses the Safesock security policy. These
#	procedures use a callback interface to avoid using vwait, which is not
#	defined in the safe base.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: http.tcl,v 1.44.2.8 2007/04/08 14:59:25 dgp Exp $

# Rough version history:
# 1.0	Old http_get interface.
# 2.0	http:: namespace and http::geturl.
# 2.1	Added callbacks to handle arriving data, and timeouts.
# 2.2	Added ability to fetch into a channel.
# 2.3	Added SSL support, and ability to post from a channel. This version
#	also cleans up error cases and eliminates the "ioerror" status in
#	favor of raising an error
# 2.4	Added -binary option to http::geturl and charset element to the state
#	array.

package require Tcl 8.4
# Keep this in sync with pkgIndex.tcl and with the install directories
# in Makefiles
package provide http 2.5.3

namespace eval http {
    variable http
    array set http {
	-accept */*
	-proxyhost {}
	-proxyport {}










|















|







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
# http.tcl --
#
#	Client-side HTTP for GET, POST, and HEAD commands. These routines can
#	be used in untrusted code that uses the Safesock security policy. These
#	procedures use a callback interface to avoid using vwait, which is not
#	defined in the safe base.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: http.tcl,v 1.44.2.9 2008/03/03 04:35:08 dgp Exp $

# Rough version history:
# 1.0	Old http_get interface.
# 2.0	http:: namespace and http::geturl.
# 2.1	Added callbacks to handle arriving data, and timeouts.
# 2.2	Added ability to fetch into a channel.
# 2.3	Added SSL support, and ability to post from a channel. This version
#	also cleans up error cases and eliminates the "ioerror" status in
#	favor of raising an error
# 2.4	Added -binary option to http::geturl and charset element to the state
#	array.

package require Tcl 8.4
# Keep this in sync with pkgIndex.tcl and with the install directories
# in Makefiles
package provide http 2.5.5

namespace eval http {
    variable http
    array set http {
	-accept */*
	-proxyhost {}
	-proxyport {}
478
479
480
481
482
483
484






485
486
487
488
489
490
491
492
493
494
495
496
497

498
499
500
501
502
503
504

    # Wait for the connection to complete.

    if {$state(-timeout) > 0} {
	fileevent $s writable [list http::Connect $token]
	http::wait $token







	if {$state(status) eq "error"} {
	    # Something went wrong while trying to establish the connection.
	    # Clean up after events and such, but DON'T call the command
	    # callback (if available) because we're going to throw an
	    # exception from here instead.
	    set err [lindex $state(error) 0]
	    cleanup $token
	    return -code error $err
	} elseif {$state(status) ne "connect"} {
	    # Likely to be connection timeout
	    return $token
	}
	set state(status) ""

    }

    # Send data in cr-lf format, but accept any line terminators

    fconfigure $s -translation {auto crlf} -buffersize $state(-blocksize)

    # The following is disallowed in safe interpreters, but the socket is







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







478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511

    # Wait for the connection to complete.

    if {$state(-timeout) > 0} {
	fileevent $s writable [list http::Connect $token]
	http::wait $token

	if {![info exists state]} {
	    # If we timed out then Finish has been called and the users
	    # command callback may have cleaned up the token. If so
	    # we end up here with nothing left to do.
	    return $token
	} else {
	    if {$state(status) eq "error"} {
		# Something went wrong while trying to establish the connection.
		# Clean up after events and such, but DON'T call the command
		# callback (if available) because we're going to throw an
		# exception from here instead.
		set err [lindex $state(error) 0]
		cleanup $token
		return -code error $err
	    } elseif {$state(status) ne "connect"} {
		# Likely to be connection timeout
		return $token
	    }
	    set state(status) ""
	}
    }

    # Send data in cr-lf format, but accept any line terminators

    fconfigure $s -translation {auto crlf} -buffersize $state(-blocksize)

    # The following is disallowed in safe interpreters, but the socket is
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620

	# Clean up after events and such, but DON'T call the command callback
	# (if available) because we're going to throw an exception from here
	# instead.

	# if state(status) is error, it means someone's already called Finish
	# to do the above-described clean up.
	if {$state(status) eq "error"} {
	    Finish $token $err 1
	}
	cleanup $token
	return -code error $err
    }

    return $token







|







613
614
615
616
617
618
619
620
621
622
623
624
625
626
627

	# Clean up after events and such, but DON'T call the command callback
	# (if available) because we're going to throw an exception from here
	# instead.

	# if state(status) is error, it means someone's already called Finish
	# to do the above-described clean up.
	if {$state(status) ne "error"} {
	    Finish $token $err 1
	}
	cleanup $token
	return -code error $err
    }

    return $token
628
629
630
631
632
633
634

635
636
637
638
639
640
641

proc http::data {token} {
    variable $token
    upvar 0 $token state
    return $state(body)
}
proc http::status {token} {

    variable $token
    upvar 0 $token state
    return $state(status)
}
proc http::code {token} {
    variable $token
    upvar 0 $token state







>







635
636
637
638
639
640
641
642
643
644
645
646
647
648
649

proc http::data {token} {
    variable $token
    upvar 0 $token state
    return $state(body)
}
proc http::status {token} {
    if {![info exists $token]} { return "error" }    
    variable $token
    upvar 0 $token state
    return $state(status)
}
proc http::code {token} {
    variable $token
    upvar 0 $token state
651
652
653
654
655
656
657




658
659
660
661
662
663
664
665
    }
}
proc http::size {token} {
    variable $token
    upvar 0 $token state
    return $state(currentsize)
}





proc http::error {token} {
    variable $token
    upvar 0 $token state
    if {[info exists state(error)]} {
	return $state(error)
    }
    return ""







>
>
>
>
|







659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
    }
}
proc http::size {token} {
    variable $token
    upvar 0 $token state
    return $state(currentsize)
}
proc http::meta {token} {
    variable $token
    upvar 0 $token state
    return $state(meta)
}
proc http::error {token} {
    variable $token
    upvar 0 $token state
    if {[info exists state(error)]} {
	return $state(error)
    }
    return ""
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
#	Read the socket and handle callbacks.

proc http::Event {token} {
    variable $token
    upvar 0 $token state
    set s $state(sock)

     if {[eof $s]} {
	Eof $token
	return
    }
    if {$state(state) eq "header"} {
	if {[catch {gets $s line} n]} {
	    Finish $token $n
	} elseif {$n == 0} {
	    variable encodings
	    set state(state) body
	    if {$state(-binary) || ![string match -nocase text* $state(type)]
		    || [string match *gzip* $state(coding)]
		    || [string match *compress* $state(coding)]} {
		# Turn off conversions for non-text data







<
<
<
<


|







794
795
796
797
798
799
800




801
802
803
804
805
806
807
808
809
810
#	Read the socket and handle callbacks.

proc http::Event {token} {
    variable $token
    upvar 0 $token state
    set s $state(sock)





    if {$state(state) eq "header"} {
	if {[catch {gets $s line} n]} {
	    return [Finish $token $n]
	} elseif {$n == 0} {
	    variable encodings
	    set state(state) body
	    if {$state(-binary) || ![string match -nocase text* $state(type)]
		    || [string match *gzip* $state(coding)]
		    || [string match *compress* $state(coding)]} {
		# Turn off conversions for non-text data
816
817
818
819
820
821
822

823
824
825
826
827
828
829
		}
	    }
	    if {[info exists state(-channel)] && \
		    ![info exists state(-handler)]} {
		# Initiate a sequence of background fcopies
		fileevent $s readable {}
		CopyStart $s $token

	    }
	} elseif {$n > 0} {
	    if {[regexp -nocase {^content-type:(.+)$} $line x type]} {
		set state(type) [string trim $type]
		# grab the optional charset information
		regexp -nocase {charset\s*=\s*(\S+)} $type x state(charset)
	    }







>







824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
		}
	    }
	    if {[info exists state(-channel)] && \
		    ![info exists state(-handler)]} {
		# Initiate a sequence of background fcopies
		fileevent $s readable {}
		CopyStart $s $token
		return
	    }
	} elseif {$n > 0} {
	    if {[regexp -nocase {^content-type:(.+)$} $line x type]} {
		set state(type) [string trim $type]
		# grab the optional charset information
		regexp -nocase {charset\s*=\s*(\S+)} $type x state(charset)
	    }
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864





865
866
867
868
869
870
871
		    append state(body) $block
		}
	    }
	    if {$n >= 0} {
		incr state(currentsize) $n
	    }
	} err]} {
	    Finish $token $err
	} else {
	    if {[info exists state(-progress)]} {
		eval $state(-progress) \
			{$token $state(totalsize) $state(currentsize)}
	    }
	}
    }





}

# http::CopyStart
#
#	Error handling wrapper around fcopy
#
# Arguments







|







>
>
>
>
>







859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
		    append state(body) $block
		}
	    }
	    if {$n >= 0} {
		incr state(currentsize) $n
	    }
	} err]} {
	    return [Finish $token $err]
	} else {
	    if {[info exists state(-progress)]} {
		eval $state(-progress) \
			{$token $state(totalsize) $state(currentsize)}
	    }
	}
    }

    if {[eof $s]} {
	Eof $token
	return
    }
}

# http::CopyStart
#
#	Error handling wrapper around fcopy
#
# Arguments
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
    upvar 0 $token state

    if {![info exists state(status)] || [string length $state(status)] == 0} {
	# We must wait on the original variable name, not the upvar alias
	vwait $token\(status)
    }

    return $state(status)
}

# http::formatQuery --
#
#	See documentation for details. Call http::formatQuery with an even
#	number of arguments, where the first is a name, the second is a value,
#	the third is another name, and so on.







|







967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
    upvar 0 $token state

    if {![info exists state(status)] || [string length $state(status)] == 0} {
	# We must wait on the original variable name, not the upvar alias
	vwait $token\(status)
    }

    return [status $token]
}

# http::formatQuery --
#
#	See documentation for details. Call http::formatQuery with an even
#	number of arguments, where the first is a name, the second is a value,
#	the third is another name, and so on.
1033
1034
1035
1036
1037
1038
1039




	if {![info exists http(-proxyport)] || \
		![string length $http(-proxyport)]} {
	    set http(-proxyport) 8080
	}
	return [list $http(-proxyhost) $http(-proxyport)]
    }
}











>
>
>
>
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
	if {![info exists http(-proxyport)] || \
		![string length $http(-proxyport)]} {
	    set http(-proxyport) 8080
	}
	return [list $http(-proxyhost) $http(-proxyport)]
    }
}

# Local variables:
# indent-tabs-mode: t
# End:
Changes to library/http/pkgIndex.tcl.
1
2
3
4
5
6
7
8
9
10
11
12
# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded http 2.5.3 [list tclPkgSetup $dir http 2.5.3 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]











|
1
2
3
4
5
6
7
8
9
10
11
12
# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded http 2.5.5 [list tclPkgSetup $dir http 2.5.5 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
Changes to tests/clock.test.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# clock.test --
#
#	This test file covers the 'clock' command that manipulates time.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: clock.test,v 1.23.2.23 2008/02/12 04:34:05 dgp Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

if {[testConstraint win]} {













|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# clock.test --
#
#	This test file covers the 'clock' command that manipulates time.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: clock.test,v 1.23.2.24 2008/03/03 04:35:08 dgp Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

if {[testConstraint win]} {
36587
36588
36589
36590
36591
36592
36593




































36594
36595
36596
36597
36598
36599
36600
36601
36602
36603
36604
} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] 
test clock-60.11 {case insensitive month names} {
    clock scan "1 December 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] 
test clock-60.12 {case insensitive month names} {
    clock scan "1 DECEMBER 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] 





































# cleanup

namespace delete ::testClock
::tcl::clock::ClearCaches
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:







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











36587
36588
36589
36590
36591
36592
36593
36594
36595
36596
36597
36598
36599
36600
36601
36602
36603
36604
36605
36606
36607
36608
36609
36610
36611
36612
36613
36614
36615
36616
36617
36618
36619
36620
36621
36622
36623
36624
36625
36626
36627
36628
36629
36630
36631
36632
36633
36634
36635
36636
36637
36638
36639
36640
} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] 
test clock-60.11 {case insensitive month names} {
    clock scan "1 December 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] 
test clock-60.12 {case insensitive month names} {
    clock scan "1 DECEMBER 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] 

test clock-61.1 {overflow of a wide integer on output} {*}{
    -body {
	clock format 0x8000000000000000 -format %s -gmt true
    } 
    -result {integer value too large to represent}
    -returnCodes error
}
test clock-61.2 {overflow of a wide integer on output} {*}{
    -body {
	clock format -0x8000000000000001 -format %s -gmt true
    } 
    -result {integer value too large to represent}
    -returnCodes error
}
test clock-61.3 {near-miss overflow of a wide integer on output} {
    clock format 0x7fffffffffffffff -format %s -gmt true
} [expr 0x7fffffffffffffff]
test clock-61.4 {near-miss overflow of a wide integer on output} {
    clock format -0x8000000000000000 -format %s -gmt true
} [expr -0x8000000000000000]

test clock-62.1 {Bug 1902423} {*}{
    -setup {::tcl::clock::ClearCaches}
    -body {
	set s 1204049747
	set f1 [clock format $s -format {%Y-%m-%d %T} -locale C]
	set f2 [clock format $s -format {%Y-%m-%d %H:%M:%S} -locale C]
	if {$f1 ne $f2} {
	    subst "$f2 is not $f1"
	} else {
	    subst "ok"
	}
    }
    -result ok
}

# cleanup

namespace delete ::testClock
::tcl::clock::ClearCaches
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:
Changes to tests/interp.test.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# This file tests the multiple interpreter facility of Tcl
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: interp.test,v 1.22.2.17 2007/12/10 19:04:54 dgp Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2.1
    namespace import -force ::tcltest::*
}

testConstraint testinterpdelete [llength [info commands testinterpdelete]]












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# This file tests the multiple interpreter facility of Tcl
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: interp.test,v 1.22.2.18 2008/03/03 04:35:10 dgp Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2.1
    namespace import -force ::tcltest::*
}

testConstraint testinterpdelete [llength [info commands testinterpdelete]]
2355
2356
2357
2358
2359
2360
2361

















2362
2363
2364
2365
2366
2367
2368
	    master;
	}
	info commands list
    }]
    interp delete $i;
    set r
} {}


















# Part 29: recursion limit
#  29.1.*  Argument checking
#  29.2.*  Reading and setting the recursion limit
#  29.3.*  Does the recursion limit work?
#  29.4.*  Recursion limit inheritance by sub-interpreters
#  29.5.*  Confirming the recursionlimit command does not affect the parent







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







2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
	    master;
	}
	info commands list
    }]
    interp delete $i;
    set r
} {}

test interp-28.2 {master's nsName cache should not cross} {
    set i [interp create]
    set res [$i eval {
	set x {namespace children ::}
	set y [list namespace children ::]
	namespace delete [{*}$y]
	set j [interp create]
	$j eval {namespace delete {*}[namespace children ::]}
	namespace eval foo {}
	set res [list [eval $x] [eval $y] [$j eval $x] [$j eval $y]]
	interp delete $j
	set res
    }]
    interp delete $i
    set res
} {::foo ::foo {} {}}

# Part 29: recursion limit
#  29.1.*  Argument checking
#  29.2.*  Reading and setting the recursion limit
#  29.3.*  Does the recursion limit work?
#  29.4.*  Recursion limit inheritance by sub-interpreters
#  29.5.*  Confirming the recursionlimit command does not affect the parent
Changes to tests/regexpComp.test.
905
906
907
908
909
910
911
















912
913
914
915
} 0
test regexpComp-24.9 {regexp command compiling tests} {
    evalInProc {
	set re "("
	list [catch {regexp -- $re dogfod} msg] $msg
    }
} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}

















# cleanup
::tcltest::cleanupTests
return







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




905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
} 0
test regexpComp-24.9 {regexp command compiling tests} {
    evalInProc {
	set re "("
	list [catch {regexp -- $re dogfod} msg] $msg
    }
} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
test regexpComp-24.10 {regexp command compiling tests} {
    # Bug 1902436 - last * escaped
    evalInProc {
	set text {this is *bold* !}
	set re {\*bold\*}
	regexp -- $re $text
    }
} 1
test regexpComp-24.11 {regexp command compiling tests} {
    # Bug 1902436 - last * escaped
    evalInProc {
	set text {this is *bold* !}
	set re {\*bold\*.*!}
	regexp -- $re $text
    }
} 1

# cleanup
::tcltest::cleanupTests
return
Changes to unix/Makefile.in.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
#
# This file is a Makefile for Tcl. If it has the name "Makefile.in" then it is
# a template for a Makefile; to generate the actual Makefile, run
# "./configure", which is a configuration script generated by the "autoconf"
# program (constructs like "@foo@" will get replaced in the actual Makefile.
#
# RCS: @(#) $Id: Makefile.in,v 1.127.2.40 2007/12/06 06:51:49 dgp Exp $

VERSION 		= @TCL_VERSION@
MAJOR_VERSION		= @TCL_MAJOR_VERSION@
MINOR_VERSION		= @TCL_MINOR_VERSION@
PATCH_LEVEL		= @TCL_PATCH_LEVEL@

#--------------------------------------------------------------------------






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
#
# This file is a Makefile for Tcl. If it has the name "Makefile.in" then it is
# a template for a Makefile; to generate the actual Makefile, run
# "./configure", which is a configuration script generated by the "autoconf"
# program (constructs like "@foo@" will get replaced in the actual Makefile.
#
# RCS: @(#) $Id: Makefile.in,v 1.127.2.41 2008/03/03 04:35:11 dgp Exp $

VERSION 		= @TCL_VERSION@
MAJOR_VERSION		= @TCL_MAJOR_VERSION@
MINOR_VERSION		= @TCL_MINOR_VERSION@
PATCH_LEVEL		= @TCL_PATCH_LEVEL@

#--------------------------------------------------------------------------
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
	    $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
	    done;
	@echo "Installing library http1.0 directory";
	@for j in $(TOP_DIR)/library/http1.0/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/http1.0; \
	    done;
	@echo "Installing package http 2.5.3 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.5.3.tm;
	@echo "Installing library opt0.4 directory";
	@for j in $(TOP_DIR)/library/opt/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/opt0.4; \
	    done;
	@echo "Installing package msgcat 1.4.2 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.2.tm;







|
|







778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
	    $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
	    done;
	@echo "Installing library http1.0 directory";
	@for j in $(TOP_DIR)/library/http1.0/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/http1.0; \
	    done;
	@echo "Installing package http 2.5.5 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.5.5.tm;
	@echo "Installing library opt0.4 directory";
	@for j in $(TOP_DIR)/library/opt/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/opt0.4; \
	    done;
	@echo "Installing package msgcat 1.4.2 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.2.tm;
Changes to unix/configure.
15089
15090
15091
15092
15093
15094
15095
15096
15097
15098
15099


15100

15101
15102


15103
15104




















15105
15106
15107



15108
15109
15110
15111
15112
15113
15114
15115
15116
15117
15118
15119
15120
15121
15122
15123
15124
15125
    cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

    #include <sys/types.h>
    #include <sys/socket.h>
    #if STDC_HEADERS
    #include <stdlib.h>


    #include <stddef.h>

    #endif



_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |




















  $EGREP "(^|[^a-zA-Z_0-9])socklen_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
  tcl_cv_type_socklen_t=yes
else



  tcl_cv_type_socklen_t=no
fi
rm -f conftest*

fi
echo "$as_me:$LINENO: result: $tcl_cv_type_socklen_t" >&5
echo "${ECHO_T}$tcl_cv_type_socklen_t" >&6
if test $tcl_cv_type_socklen_t = no; then

cat >>confdefs.h <<\_ACEOF
#define socklen_t unsigned
_ACEOF

fi

echo "$as_me:$LINENO: checking for intptr_t" >&5
echo $ECHO_N "checking for intptr_t... $ECHO_C" >&6
if test "${ac_cv_type_intptr_t+set}" = set; then







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

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


>
>
>
|

|
<






|







15089
15090
15091
15092
15093
15094
15095
15096
15097
15098
15099
15100
15101
15102
15103
15104
15105
15106
15107
15108
15109
15110
15111
15112
15113
15114
15115
15116
15117
15118
15119
15120
15121
15122
15123
15124
15125
15126
15127
15128
15129
15130
15131
15132
15133
15134
15135
15136
15137
15138

15139
15140
15141
15142
15143
15144
15145
15146
15147
15148
15149
15150
15151
15152
    cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

	#include <sys/types.h>
	#include <sys/socket.h>

int
main ()
{

    	socklen_t foo;

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  (eval $ac_compile) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_cv_type_socklen_t=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

tcl_cv_type_socklen_t=no
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $tcl_cv_type_socklen_t" >&5
echo "${ECHO_T}$tcl_cv_type_socklen_t" >&6
if test $tcl_cv_type_socklen_t = no; then

cat >>confdefs.h <<\_ACEOF
#define socklen_t int
_ACEOF

fi

echo "$as_me:$LINENO: checking for intptr_t" >&5
echo $ECHO_N "checking for intptr_t... $ECHO_C" >&6
if test "${ac_cv_type_intptr_t+set}" = set; then
Changes to unix/configure.in.
1
2
3
4
5
6
7
8
9
10
11
12
13
#! /bin/bash -norc
dnl	This file is an input file used by the GNU "autoconf" program to
dnl	generate the file "configure", which is run during Tcl installation
dnl	to configure the system for the local environment.
#
# RCS: @(#) $Id: configure.in,v 1.109.2.38 2008/02/16 22:17:29 dgp Exp $

AC_INIT([tcl],[8.5])
AC_PREREQ(2.59)

dnl This is only used when included from macosx/configure.ac
m4_ifdef([SC_USE_CONFIG_HEADERS], [
    AC_CONFIG_HEADERS([tclConfig.h:../unix/tclConfig.h.in])





|







1
2
3
4
5
6
7
8
9
10
11
12
13
#! /bin/bash -norc
dnl	This file is an input file used by the GNU "autoconf" program to
dnl	generate the file "configure", which is run during Tcl installation
dnl	to configure the system for the local environment.
#
# RCS: @(#) $Id: configure.in,v 1.109.2.39 2008/03/03 04:35:13 dgp Exp $

AC_INIT([tcl],[8.5])
AC_PREREQ(2.59)

dnl This is only used when included from macosx/configure.ac
m4_ifdef([SC_USE_CONFIG_HEADERS], [
    AC_CONFIG_HEADERS([tclConfig.h:../unix/tclConfig.h.in])
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331

332
333
334
335
336
337
338
339
340
341
342

AC_TYPE_MODE_T
AC_TYPE_PID_T
AC_TYPE_SIZE_T
AC_TYPE_UID_T

AC_CACHE_CHECK([for socklen_t], tcl_cv_type_socklen_t, [
    AC_EGREP_CPP(changequote(<<,>>)dnl
<<(^|[^a-zA-Z_0-9])socklen_t[^a-zA-Z_0-9]>>dnl
changequote([,]),[
    #include <sys/types.h>
    #include <sys/socket.h>
    #if STDC_HEADERS
    #include <stdlib.h>
    #include <stddef.h>

    #endif
    ], tcl_cv_type_socklen_t=yes, tcl_cv_type_socklen_t=no)])
if test $tcl_cv_type_socklen_t = no; then
    AC_DEFINE(socklen_t, unsigned, [What is the type of socklen_t?])
fi

AC_CHECK_TYPE([intptr_t], [
    AC_DEFINE([HAVE_INTPTR_T], 1, [Do we have the intptr_t type?])], [
    AC_CACHE_CHECK([for pointer-size signed integer type], tcl_cv_intptr_t, [
    for tcl_cv_intptr_t in "int" "long" "long long" none; do
	if test "$tcl_cv_intptr_t" != none; then







|
<
<
|
|
<
<
<
>
|
|

|







317
318
319
320
321
322
323
324


325
326



327
328
329
330
331
332
333
334
335
336
337
338

AC_TYPE_MODE_T
AC_TYPE_PID_T
AC_TYPE_SIZE_T
AC_TYPE_UID_T

AC_CACHE_CHECK([for socklen_t], tcl_cv_type_socklen_t, [
    AC_TRY_COMPILE([


	#include <sys/types.h>
	#include <sys/socket.h>



    ],[
    	socklen_t foo;
    ],[tcl_cv_type_socklen_t=yes],[tcl_cv_type_socklen_t=no])])
if test $tcl_cv_type_socklen_t = no; then
    AC_DEFINE(socklen_t, int, [Define as int if socklen_t is not available])
fi

AC_CHECK_TYPE([intptr_t], [
    AC_DEFINE([HAVE_INTPTR_T], 1, [Do we have the intptr_t type?])], [
    AC_CACHE_CHECK([for pointer-size signed integer type], tcl_cv_intptr_t, [
    for tcl_cv_intptr_t in "int" "long" "long long" none; do
	if test "$tcl_cv_intptr_t" != none; then
Changes to unix/tclConfig.h.in.
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506

/* Define to `int' if <sys/types.h> does not define. */
#undef pid_t

/* Define to `unsigned' if <sys/types.h> does not define. */
#undef size_t

/* What is the type of socklen_t? */
#undef socklen_t

/* Do we want to use the strtod() in compat? */
#undef strtod

/* Define to `int' if <sys/types.h> doesn't define. */
#undef uid_t







|







492
493
494
495
496
497
498
499
500
501
502
503
504
505
506

/* Define to `int' if <sys/types.h> does not define. */
#undef pid_t

/* Define to `unsigned' if <sys/types.h> does not define. */
#undef size_t

/* Define as int if socklen_t is not available */
#undef socklen_t

/* Do we want to use the strtod() in compat? */
#undef strtod

/* Define to `int' if <sys/types.h> doesn't define. */
#undef uid_t
Changes to unix/tclUnixChan.c.
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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
/*
 * tclUnixChan.c
 *
 *	Common channel driver for Unix channels based on files, command pipes
 *	and TCP sockets.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixChan.c,v 1.42.4.29 2007/12/06 06:51:52 dgp Exp $
 */

#include "tclInt.h"	/* Internal definitions for Tcl. */
#include "tclIO.h"	/* To get Channel type declaration. */

/*
 * sys/ioctl.h has already been included by tclPort.h. Including termios.h or
 * termio.h causes a bunch of warning messages because some duplicate (but not
 * contradictory) #defines exist in termios.h and/or termio.h
 */

#undef NL0
#undef NL1
#undef CR0
#undef CR1
#undef CR2
#undef CR3
#undef TAB0
#undef TAB1
#undef TAB2
#undef XTABS
#undef BS0
#undef BS1
#undef FF0
#undef FF1
#undef ECHO
#undef NOFLSH
#undef TOSTOP
#undef FLUSHO
#undef PENDIN

#define SUPPORTS_TTY

#undef DIRECT_BAUD
#ifdef B4800
#   if (B4800 == 4800)
#	define DIRECT_BAUD
#   endif /* B4800 == 4800 */












|





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







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
/*
 * tclUnixChan.c
 *
 *	Common channel driver for Unix channels based on files, command pipes
 *	and TCP sockets.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixChan.c,v 1.42.4.30 2008/03/03 04:35:13 dgp Exp $
 */

#include "tclInt.h"	/* Internal definitions for Tcl. */
#include "tclIO.h"	/* To get Channel type declaration. */



























#define SUPPORTS_TTY

#undef DIRECT_BAUD
#ifdef B4800
#   if (B4800 == 4800)
#	define DIRECT_BAUD
#   endif /* B4800 == 4800 */
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
#   endif /* HAVE_SYS_MODEM_H */
#   define IOSTATE			struct termios
#   define GETIOSTATE(fd, statePtr)	tcgetattr((fd), (statePtr))
#   define SETIOSTATE(fd, statePtr)	tcsetattr((fd), TCSADRAIN, (statePtr))
#   define GETCONTROL(fd, intPtr)	ioctl((fd), TIOCMGET, (intPtr))
#   define SETCONTROL(fd, intPtr)	ioctl((fd), TIOCMSET, (intPtr))

    /*
     * TIP #35 introduced a different on exit flush/close behavior that does
     * not work correctly with standard channels on all systems. The problem
     * is tcflush throws away waiting channel data. This may be necessary for
     * true serial channels that may block, but isn't correct in the standard
     * case. This might be replaced with tcdrain instead, but that can block.
     * For now, we revert to making this do nothing, and TtyOutputProc being
     * the same old FileOutputProc. - hobbs [Bug #525783]
     */

#   define BAD_TIP35_FLUSH 0
#   if BAD_TIP35_FLUSH
#	define TTYFLUSH(fd)		tcflush((fd), TCIOFLUSH);
#   else
#	define TTYFLUSH(fd)
#   endif /* BAD_TIP35_FLUSH */
#   ifdef FIONREAD
#	define GETREADQUEUE(fd, int)	ioctl((fd), FIONREAD, &(int))
#   elif defined(FIORDCHK)
#	define GETREADQUEUE(fd, int)	int = ioctl((fd), FIORDCHK, NULL)
#   endif /* FIONREAD */
#   ifdef TIOCOUTQ
#	define GETWRITEQUEUE(fd, int)	ioctl((fd), TIOCOUTQ, &(int))







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







35
36
37
38
39
40
41
















42
43
44
45
46
47
48
#   endif /* HAVE_SYS_MODEM_H */
#   define IOSTATE			struct termios
#   define GETIOSTATE(fd, statePtr)	tcgetattr((fd), (statePtr))
#   define SETIOSTATE(fd, statePtr)	tcsetattr((fd), TCSADRAIN, (statePtr))
#   define GETCONTROL(fd, intPtr)	ioctl((fd), TIOCMGET, (intPtr))
#   define SETCONTROL(fd, intPtr)	ioctl((fd), TIOCMSET, (intPtr))

















#   ifdef FIONREAD
#	define GETREADQUEUE(fd, int)	ioctl((fd), FIONREAD, &(int))
#   elif defined(FIORDCHK)
#	define GETREADQUEUE(fd, int)	int = ioctl((fd), FIORDCHK, NULL)
#   endif /* FIONREAD */
#   ifdef TIOCOUTQ
#	define GETWRITEQUEUE(fd, int)	ioctl((fd), TIOCOUTQ, &(int))
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
 * The following structure describes per-instance state of a tty-based
 * channel.
 */

typedef struct TtyState {
    FileState fs;		/* Per-instance state of the file descriptor.
				 * Must be the first field. */
    int stateUpdated;		/* Flag to say if the state has been modified
				 * and needs resetting. */
    IOSTATE savedState;		/* Initial state of device. Used to reset
				 * state when device closed. */
} TtyState;

/*
 * The following structure is used to set or get the serial port attributes in
 * a platform-independant manner.







<
<







112
113
114
115
116
117
118


119
120
121
122
123
124
125
 * The following structure describes per-instance state of a tty-based
 * channel.
 */

typedef struct TtyState {
    FileState fs;		/* Per-instance state of the file descriptor.
				 * Must be the first field. */


    IOSTATE savedState;		/* Initial state of device. Used to reset
				 * state when device closed. */
} TtyState;

/*
 * The following structure is used to set or get the serial port attributes in
 * a platform-independant manner.
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
			    Tcl_DString *dsPtr);
static int		TcpInputProc(ClientData instanceData, char *buf,
			    int toRead, int *errorCode);
static int		TcpOutputProc(ClientData instanceData,
			    const char *buf, int toWrite, int *errorCode);
static void		TcpWatchProc(ClientData instanceData, int mask);
#ifdef SUPPORTS_TTY
static int		TtyCloseProc(ClientData instanceData,
			    Tcl_Interp *interp);
static void		TtyGetAttributes(int fd, TtyAttrs *ttyPtr);
static int		TtyGetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
#ifndef DIRECT_BAUD
static int		TtyGetBaud(unsigned long speed);
static unsigned long	TtyGetSpeed(int baud);
#endif /* DIRECT_BAUD */
static FileState *	TtyInit(int fd, int initialize);
static void		TtyModemStatusStr(int status, Tcl_DString *dsPtr);
#if BAD_TIP35_FLUSH
static int		TtyOutputProc(ClientData instanceData,
			    const char *buf, int toWrite, int *errorCode);
#endif /* BAD_TIP35_FLUSH */
static int		TtyParseMode(Tcl_Interp *interp, const char *mode,
			    int *speedPtr, int *parityPtr, int *dataPtr,
			    int *stopPtr);
static void		TtySetAttributes(int fd, TtyAttrs *ttyPtr);
static int		TtySetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    const char *value);







<
<










<
<
<
<







222
223
224
225
226
227
228


229
230
231
232
233
234
235
236
237
238




239
240
241
242
243
244
245
			    Tcl_DString *dsPtr);
static int		TcpInputProc(ClientData instanceData, char *buf,
			    int toRead, int *errorCode);
static int		TcpOutputProc(ClientData instanceData,
			    const char *buf, int toWrite, int *errorCode);
static void		TcpWatchProc(ClientData instanceData, int mask);
#ifdef SUPPORTS_TTY


static void		TtyGetAttributes(int fd, TtyAttrs *ttyPtr);
static int		TtyGetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
#ifndef DIRECT_BAUD
static int		TtyGetBaud(unsigned long speed);
static unsigned long	TtyGetSpeed(int baud);
#endif /* DIRECT_BAUD */
static FileState *	TtyInit(int fd, int initialize);
static void		TtyModemStatusStr(int status, Tcl_DString *dsPtr);




static int		TtyParseMode(Tcl_Interp *interp, const char *mode,
			    int *speedPtr, int *parityPtr, int *dataPtr,
			    int *stopPtr);
static void		TtySetAttributes(int fd, TtyAttrs *ttyPtr);
static int		TtySetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    const char *value);
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
 * This structure describes the channel type structure for serial IO.
 * Note that this type is a subclass of the "file" type.
 */

static Tcl_ChannelType ttyChannelType = {
    "tty",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    TtyCloseProc,		/* Close proc. */
    FileInputProc,		/* Input proc. */
#if BAD_TIP35_FLUSH
    TtyOutputProc,		/* Output proc. */
#else /* !BAD_TIP35_FLUSH */
    FileOutputProc,		/* Output proc. */
#endif /* BAD_TIP35_FLUSH */
    NULL,			/* Seek proc. */
    TtySetOptionProc,		/* Set option proc. */
    TtyGetOptionProc,		/* Get option proc. */
    FileWatchProc,		/* Initialize notifier. */
    FileGetHandleProc,		/* Get OS handles out of channel. */
    NULL,			/* close2proc. */
    FileBlockModeProc,		/* Set blocking or non-blocking mode.*/







|

<
<
<

<







277
278
279
280
281
282
283
284
285



286

287
288
289
290
291
292
293
 * This structure describes the channel type structure for serial IO.
 * Note that this type is a subclass of the "file" type.
 */

static Tcl_ChannelType ttyChannelType = {
    "tty",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    FileCloseProc,		/* Close proc. */
    FileInputProc,		/* Input proc. */



    FileOutputProc,		/* Output proc. */

    NULL,			/* Seek proc. */
    TtySetOptionProc,		/* Set option proc. */
    TtyGetOptionProc,		/* Get option proc. */
    FileWatchProc,		/* Initialize notifier. */
    FileGetHandleProc,		/* Get OS handles out of channel. */
    NULL,			/* close2proc. */
    FileBlockModeProc,		/* Set blocking or non-blocking mode.*/
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
FileBlockModeProc(
    ClientData instanceData,	/* File state. */
    int mode)			/* The mode to set. Can be one of
				 * TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    FileState *fsPtr = (FileState *) instanceData;
    int curStatus;

#ifndef USE_FIONBIO
    curStatus = fcntl(fsPtr->fd, F_GETFL);
    if (mode == TCL_MODE_BLOCKING) {
	CLEAR_BITS(curStatus, O_NONBLOCK);
    } else {
	SET_BITS(curStatus, O_NONBLOCK);
    }
    if (fcntl(fsPtr->fd, F_SETFL, curStatus) < 0) {
	return errno;
    }
    curStatus = fcntl(fsPtr->fd, F_GETFL);
#else /* USE_FIONBIO */
    if (mode == TCL_MODE_BLOCKING) {
	curStatus = 0;
    } else {
	curStatus = 1;
    }
    if (ioctl(fsPtr->fd, (int) FIONBIO, &curStatus) < 0) {
	return errno;
    }
#endif /* !USE_FIONBIO */
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * FileInputProc --







<

<
|
<
<
<
<
<
<


<
<
<
<
<
<
|
<
<
<
<







346
347
348
349
350
351
352

353

354






355
356






357




358
359
360
361
362
363
364
FileBlockModeProc(
    ClientData instanceData,	/* File state. */
    int mode)			/* The mode to set. Can be one of
				 * TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    FileState *fsPtr = (FileState *) instanceData;



    if (TclUnixSetBlockingMode(fsPtr->fd, mode) < 0) {






	return errno;
    }











    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * FileInputProc --
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
	*handlePtr = (ClientData) INT2PTR(fsPtr->fd);
	return TCL_OK;
    }
    return TCL_ERROR;
}

#ifdef SUPPORTS_TTY
/*
 *----------------------------------------------------------------------
 *
 * TtyCloseProc --
 *
 *	This function is called from the generic IO level to perform
 *	channel-type-specific cleanup when a tty based channel is closed.
 *
 * Results:
 *	0 if successful, errno if failed.
 *
 * Side effects:
 *	Closes the device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
TtyCloseProc(
    ClientData instanceData,	/* Tty state. */
    Tcl_Interp *interp)		/* For error reporting - unused. */
{
#if BAD_TIP35_FLUSH
    TtyState *ttyPtr = (TtyState *) instanceData;
#endif /* BAD_TIP35_FLUSH */

#ifdef TTYFLUSH
    TTYFLUSH(ttyPtr->fs.fd);
#endif /* TTYFLUSH */

#if 0
    /*
     * TIP#35 agreed to remove the unsave so that TCL could be used as a
     * simple stty. It would be cleaner to remove all the stuff related to
     *	  TtyState.stateUpdated
     *	  TtyState.savedState
     * Then the structure TtyState would be the same as FileState. IMO this
     * cleanup could better be done for the final 8.4 release after nobody
     * complained about the missing unsave. - schroedter
     */
    if (ttyPtr->stateUpdated) {
	SETIOSTATE(ttyPtr->fs.fd, &ttyPtr->savedState);
    }
#endif

    return FileCloseProc(instanceData, interp);
}

/*
 *----------------------------------------------------------------------
 *
 * TtyOutputProc--
 *
 *	This function is invoked from the generic IO level to write output to
 *	a TTY channel.
 *
 * Results:
 *	The number of bytes written is returned or -1 on error. An output
 *	argument contains a POSIX error code if an error occurred, or zero.
 *
 * Side effects:
 *	Writes output on the output device of the channel if the channel is
 *	not designated to be closed.
 *
 *----------------------------------------------------------------------
 */

#if BAD_TIP35_FLUSH
static int
TtyOutputProc(
    ClientData instanceData,	/* File state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCodePtr)		/* Where to store error code. */
{
    if (TclInExit()) {
	/*
	 * Do not write data during Tcl exit. Serial port may block preventing
	 * Tcl from exit.
	 */

	return toWrite;
    }

    return FileOutputProc(instanceData, buf, toWrite, errorCodePtr);
}
#endif /* BAD_TIP35_FLUSH */

#ifdef USE_TERMIOS
/*
 *----------------------------------------------------------------------
 *
 * TtyModemStatusStr --
 *
 *	Converts a RS232 modem status list of readable flags







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







662
663
664
665
666
667
668
























































































669
670
671
672
673
674
675
	*handlePtr = (ClientData) INT2PTR(fsPtr->fd);
	return TCL_OK;
    }
    return TCL_ERROR;
}

#ifdef SUPPORTS_TTY
























































































#ifdef USE_TERMIOS
/*
 *----------------------------------------------------------------------
 *
 * TtyModemStatusStr --
 *
 *	Converts a RS232 modem status list of readable flags
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
	}

	/*
	 * system calls results should be checked there. - dl
	 */

	TtySetAttributes(fsPtr->fd, &tty);
	((TtyState *) fsPtr)->stateUpdated = 1;
	return TCL_OK;
    }

#ifdef USE_TERMIOS

    /*
     * Option -handshake none|xonxoff|rtscts|dtrdsr







<







748
749
750
751
752
753
754

755
756
757
758
759
760
761
	}

	/*
	 * system calls results should be checked there. - dl
	 */

	TtySetAttributes(fsPtr->fd, &tty);

	return TCL_OK;
    }

#ifdef USE_TERMIOS

    /*
     * Option -handshake none|xonxoff|rtscts|dtrdsr
1700
1701
1702
1703
1704
1705
1706

1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
static FileState *
TtyInit(
    int fd,			/* Open file descriptor for serial port to be
				 * initialized. */
    int initialize)
{
    TtyState *ttyPtr;


    ttyPtr = (TtyState *) ckalloc((unsigned) sizeof(TtyState));
    GETIOSTATE(fd, &ttyPtr->savedState);
    ttyPtr->stateUpdated = 0;
    if (initialize) {
	IOSTATE iostate = ttyPtr->savedState;

#if defined(USE_TERMIOS) || defined(USE_TERMIO)
	if (iostate.c_iflag != IGNBRK ||
		iostate.c_oflag != 0 ||
		iostate.c_lflag != 0 ||
		iostate.c_cflag & CREAD ||
		iostate.c_cc[VMIN] != 1 ||
		iostate.c_cc[VTIME] != 0) {
	    ttyPtr->stateUpdated = 1;
	}
	iostate.c_iflag = IGNBRK;
	iostate.c_oflag = 0;
	iostate.c_lflag = 0;
	SET_BITS(iostate.c_cflag, CREAD);
	iostate.c_cc[VMIN] = 1;
	iostate.c_cc[VTIME] = 0;







>



<










|







1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549

1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
static FileState *
TtyInit(
    int fd,			/* Open file descriptor for serial port to be
				 * initialized. */
    int initialize)
{
    TtyState *ttyPtr;
    int stateUpdated = 0;

    ttyPtr = (TtyState *) ckalloc((unsigned) sizeof(TtyState));
    GETIOSTATE(fd, &ttyPtr->savedState);

    if (initialize) {
	IOSTATE iostate = ttyPtr->savedState;

#if defined(USE_TERMIOS) || defined(USE_TERMIO)
	if (iostate.c_iflag != IGNBRK ||
		iostate.c_oflag != 0 ||
		iostate.c_lflag != 0 ||
		iostate.c_cflag & CREAD ||
		iostate.c_cc[VMIN] != 1 ||
		iostate.c_cc[VTIME] != 0) {
	    stateUpdated = 1;
	}
	iostate.c_iflag = IGNBRK;
	iostate.c_oflag = 0;
	iostate.c_lflag = 0;
	SET_BITS(iostate.c_cflag, CREAD);
	iostate.c_cc[VMIN] = 1;
	iostate.c_cc[VTIME] = 0;
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
	SET_BITS(iostate.sg_flags, RAW);
#endif	/* USE_SGTTY */

	/*
	 * Only update if we're changing anything to avoid possible blocking.
	 */

	if (ttyPtr->stateUpdated) {
	    SETIOSTATE(fd, &iostate);
	}
    }

    return &ttyPtr->fs;
}
#endif	/* SUPPORTS_TTY */







|







1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
	SET_BITS(iostate.sg_flags, RAW);
#endif	/* USE_SGTTY */

	/*
	 * Only update if we're changing anything to avoid possible blocking.
	 */

	if (stateUpdated) {
	    SETIOSTATE(fd, &iostate);
	}
    }

    return &ttyPtr->fs;
}
#endif	/* SUPPORTS_TTY */
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
TcpBlockModeProc(
    ClientData instanceData,	/* Socket state. */
    int mode)			/* The mode to set. Can be one of
				 * TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    TcpState *statePtr = (TcpState *) instanceData;
    int setting;

#ifndef USE_FIONBIO
    setting = fcntl(statePtr->fd, F_GETFL);
    if (mode == TCL_MODE_BLOCKING) {
	CLEAR_BITS(statePtr->flags, TCP_ASYNC_SOCKET);
	CLEAR_BITS(setting, O_NONBLOCK);
    } else {
	SET_BITS(statePtr->flags, TCP_ASYNC_SOCKET);
	SET_BITS(setting, O_NONBLOCK);
    }
    if (fcntl(statePtr->fd, F_SETFL, setting) < 0) {
	return errno;
    }
#else /* USE_FIONBIO */
    if (mode == TCL_MODE_BLOCKING) {
	CLEAR_BITS(statePtr->flags, TCP_ASYNC_SOCKET);
	setting = 0;
	if (ioctl(statePtr->fd, (int) FIONBIO, &setting) == -1) {
	    return errno;
	}
    } else {
	SET_BITS(statePtr->flags, TCP_ASYNC_SOCKET);
	setting = 1;
	if (ioctl(statePtr->fd, (int) FIONBIO, &setting) == -1) {
	    return errno;
	}
    }
#endif /* !USE_FIONBIO */

    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * WaitForConnect --







<

<
<


<


<

|


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







1804
1805
1806
1807
1808
1809
1810

1811


1812
1813

1814
1815

1816
1817
1818
1819
















1820
1821
1822
1823
1824
1825
1826
TcpBlockModeProc(
    ClientData instanceData,	/* Socket state. */
    int mode)			/* The mode to set. Can be one of
				 * TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    TcpState *statePtr = (TcpState *) instanceData;




    if (mode == TCL_MODE_BLOCKING) {
	CLEAR_BITS(statePtr->flags, TCP_ASYNC_SOCKET);

    } else {
	SET_BITS(statePtr->flags, TCP_ASYNC_SOCKET);

    }
    if (TclUnixSetBlockingMode(statePtr->fd, mode) < 0) {
	return errno;
    }
















    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * WaitForConnect --
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
static int
WaitForConnect(
    TcpState *statePtr,		/* State of the socket. */
    int *errorCodePtr)		/* Where to store errors? */
{
    int timeOut;		/* How long to wait. */
    int state;			/* Of calling TclWaitForFile. */
    int flags;			/* fcntl flags for the socket. */

    /*
     * If an asynchronous connect is in progress, attempt to wait for it to
     * complete before reading.
     */

    if (statePtr->flags & TCP_ASYNC_CONNECT) {
	if (statePtr->flags & TCP_ASYNC_SOCKET) {
	    timeOut = 0;
	} else {
	    timeOut = -1;
	}
	errno = 0;
	state = TclUnixWaitForFile(statePtr->fd,
		TCL_WRITABLE | TCL_EXCEPTION, timeOut);
	if (!(statePtr->flags & TCP_ASYNC_SOCKET)) {
#ifndef USE_FIONBIO
	    flags = fcntl(statePtr->fd, F_GETFL);
	    CLEAR_BITS(flags, O_NONBLOCK);
	    (void) fcntl(statePtr->fd, F_SETFL, flags);
#else /* USE_FIONBIO */
	    flags = 0;
	    (void) ioctl(statePtr->fd, FIONBIO, &flags);
#endif /* !USE_FIONBIO */
	}
	if (state & TCL_EXCEPTION) {
	    return -1;
	}
	if (state & TCL_WRITABLE) {
	    CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
	} else if (timeOut == 0) {







<
















<
|
<
<
<
<
<
<







1840
1841
1842
1843
1844
1845
1846

1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862

1863






1864
1865
1866
1867
1868
1869
1870
static int
WaitForConnect(
    TcpState *statePtr,		/* State of the socket. */
    int *errorCodePtr)		/* Where to store errors? */
{
    int timeOut;		/* How long to wait. */
    int state;			/* Of calling TclWaitForFile. */


    /*
     * If an asynchronous connect is in progress, attempt to wait for it to
     * complete before reading.
     */

    if (statePtr->flags & TCP_ASYNC_CONNECT) {
	if (statePtr->flags & TCP_ASYNC_SOCKET) {
	    timeOut = 0;
	} else {
	    timeOut = -1;
	}
	errno = 0;
	state = TclUnixWaitForFile(statePtr->fd,
		TCL_WRITABLE | TCL_EXCEPTION, timeOut);
	if (!(statePtr->flags & TCP_ASYNC_SOCKET)) {

	    (void) TclUnixSetBlockingMode(statePtr->fd, TCL_MODE_BLOCKING);






	}
	if (state & TCL_EXCEPTION) {
	    return -1;
	}
	if (state & TCL_WRITABLE) {
	    CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
	} else if (timeOut == 0) {
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
	 * Attempt to connect. The connect may fail at present with an
	 * EINPROGRESS but at a later time it will complete. The caller will
	 * set up a file handler on the socket if she is interested in being
	 * informed when the connect completes.
	 */

	if (async) {
#ifndef USE_FIONBIO
	    curState = fcntl(sock, F_GETFL);
	    SET_BITS(curState, O_NONBLOCK);
	    status = fcntl(sock, F_SETFL, curState);
#else /* USE_FIONBIO */
	    curState = 1;
	    status = ioctl(sock, FIONBIO, &curState);
#endif /* !USE_FIONBIO */
	} else {
	    status = 0;
	}
	if (status > -1) {
	    status = connect(sock, (struct sockaddr *) &sockaddr,
		    sizeof(sockaddr));
	    if (status < 0) {







<
<
<
|
<
<
<
<







2342
2343
2344
2345
2346
2347
2348



2349




2350
2351
2352
2353
2354
2355
2356
	 * Attempt to connect. The connect may fail at present with an
	 * EINPROGRESS but at a later time it will complete. The caller will
	 * set up a file handler on the socket if she is interested in being
	 * informed when the connect completes.
	 */

	if (async) {



	    status = TclUnixSetBlockingMode(sock, TCL_MODE_NONBLOCKING);




	} else {
	    status = 0;
	}
	if (status > -1) {
	    status = connect(sock, (struct sockaddr *) &sockaddr,
		    sizeof(sockaddr));
	    if (status < 0) {
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
		 * asynchronous connect we have to reset the channel to
		 * blocking mode. This appears to happen not very often, but
		 * e.g. on a HP 9000/800 under HP-UX B.11.00 we enter this
		 * stage. [Bug: 4388]
		 */

		if (async) {
#ifndef USE_FIONBIO
		    curState = fcntl(sock, F_GETFL);
		    CLEAR_BITS(curState, O_NONBLOCK);
		    status = fcntl(sock, F_SETFL, curState);
#else /* USE_FIONBIO */
		    curState = 0;
		    status = ioctl(sock, FIONBIO, &curState);
#endif /* !USE_FIONBIO */
		}
	    }
	}
    }

  bindError:
    if (status < 0) {







<
<
<
|
<
<
<
<







2364
2365
2366
2367
2368
2369
2370



2371




2372
2373
2374
2375
2376
2377
2378
		 * asynchronous connect we have to reset the channel to
		 * blocking mode. This appears to happen not very often, but
		 * e.g. on a HP 9000/800 under HP-UX B.11.00 we enter this
		 * stage. [Bug: 4388]
		 */

		if (async) {



		    status = TclUnixSetBlockingMode(sock, TCL_MODE_BLOCKING);




		}
	    }
	}
    }

  bindError:
    if (status < 0) {
Changes to unix/tclUnixCompat.c.
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
/*
 * tclUnixCompat.c
 *
 * Written by: Zoran Vasiljevic (vasiljevic@users.sourceforge.net).
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixCompat.c,v 1.8.6.5 2007/11/16 08:07:30 dgp Exp $
 *
 */

#include "tclInt.h"
#include <pwd.h>
#include <grp.h>
#include <errno.h>
#include <string.h>













































/*
 * Used to pad structures at size'd boundaries
 *
 * This macro assumes that the pointer 'buffer' was created from an aligned
 * pointer by adding the 'length'. If this 'length' was not a multiple of the
 * 'size' the result is unaligned and PadBuffer corrects both the pointer,
 * _and_ the 'length'. The latter means that future increments of 'buffer' by








|









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







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
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
/*
 * tclUnixCompat.c
 *
 * Written by: Zoran Vasiljevic (vasiljevic@users.sourceforge.net).
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixCompat.c,v 1.8.6.6 2008/03/03 04:35:13 dgp Exp $
 *
 */

#include "tclInt.h"
#include <pwd.h>
#include <grp.h>
#include <errno.h>
#include <string.h>

/* See also: SC_BLOCKING_STYLE in unix/tcl.m4
 */
#ifdef	USE_FIONBIO
#   ifdef HAVE_SYS_FILIO_H
#	include	<sys/filio.h>	/* For FIONBIO. */
#   endif
#   ifdef HAVE_SYS_IOCTL_H
#	include	<sys/ioctl.h>
#   endif
#endif	/* USE_FIONBIO */

/*
 *---------------------------------------------------------------------------
 *
 * TclUnixSetBlockingMode --
 *
 *	Set the blocking mode of a file descriptor.
 *
 * Results:
 *
 *	0 on success, -1 (with errno set) on error.
 *
 *---------------------------------------------------------------------------
 */
int
TclUnixSetBlockingMode(
    int fd,		/* File descriptor */
    int mode)		/* TCL_MODE_BLOCKING or TCL_MODE_NONBLOCKING */
{
#ifndef USE_FIONBIO
    int flags = fcntl(fd, F_GETFL);

    if (mode == TCL_MODE_BLOCKING) {
	flags &= ~O_NONBLOCK;
    } else {
	flags |= O_NONBLOCK;
    }
    return fcntl(fd, F_SETFL, flags);
#else /* USE_FIONBIO */
    int state = (mode == TCL_MODE_NONBLOCKING);
    return ioctl(fd, FIONBIO, &state);
#endif /* !USE_FIONBIO */
}

/*
 * Used to pad structures at size'd boundaries
 *
 * This macro assumes that the pointer 'buffer' was created from an aligned
 * pointer by adding the 'length'. If this 'length' was not a multiple of the
 * 'size' the result is unaligned and PadBuffer corrects both the pointer,
 * _and_ the 'length'. The latter means that future increments of 'buffer' by
Changes to unix/tclUnixNotfy.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tclUnixNotify.c --
 *
 *	This file contains the implementation of the select()-based
 *	Unix-specific notifier, which is the lowest-level part of the Tcl
 *	event loop. This file works together with generic/tclNotify.c.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixNotfy.c,v 1.12.2.15 2006/08/29 16:19:47 dgp Exp $
 */

#include "tclInt.h"
#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */
#include <signal.h>













|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tclUnixNotify.c --
 *
 *	This file contains the implementation of the select()-based
 *	Unix-specific notifier, which is the lowest-level part of the Tcl
 *	event loop. This file works together with generic/tclNotify.c.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixNotfy.c,v 1.12.2.16 2008/03/03 04:35:13 dgp Exp $
 */

#include "tclInt.h"
#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */
#include <signal.h>

914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946

    if (pipe(fds) != 0) {
	Tcl_Panic("NotifierThreadProc: could not create trigger pipe");
    }

    receivePipe = fds[0];

#ifndef USE_FIONBIO
    status = fcntl(receivePipe, F_GETFL);
    status |= O_NONBLOCK;
    if (fcntl(receivePipe, F_SETFL, status) < 0) {
	Tcl_Panic("NotifierThreadProc: could not make receive pipe non blocking");
    }
    status = fcntl(fds[1], F_GETFL);
    status |= O_NONBLOCK;
    if (fcntl(fds[1], F_SETFL, status) < 0) {
	Tcl_Panic("NotifierThreadProc: could not make trigger pipe non blocking");
    }
#else
    if (ioctl(receivePipe, (int) FIONBIO, &status) < 0) {
	Tcl_Panic("NotifierThreadProc: could not make receive pipe non blocking");
    }
    if (ioctl(fds[1], (int) FIONBIO, &status) < 0) {
	Tcl_Panic("NotifierThreadProc: could not make trigger pipe non blocking");
    }
#endif /* FIONBIO */

    /*
     * Install the write end of the pipe into the global variable.
     */

    Tcl_MutexLock(&notifierMutex);
    triggerPipe = fds[1];







<
|
<
<


<
|
<


<
<
<
<
<
<
<
<







914
915
916
917
918
919
920

921


922
923

924

925
926








927
928
929
930
931
932
933

    if (pipe(fds) != 0) {
	Tcl_Panic("NotifierThreadProc: could not create trigger pipe");
    }

    receivePipe = fds[0];


    if (TclUnixSetBlockingMode(receivePipe, TCL_MODE_NONBLOCKING) < 0) {


	Tcl_Panic("NotifierThreadProc: could not make receive pipe non blocking");
    }

    if (TclUnixSetBlockingMode(fds[1], TCL_MODE_NONBLOCKING) < 0) {

	Tcl_Panic("NotifierThreadProc: could not make trigger pipe non blocking");
    }









    /*
     * Install the write end of the pipe into the global variable.
     */

    Tcl_MutexLock(&notifierMutex);
    triggerPipe = fds[1];
Changes to unix/tclUnixPipe.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tclUnixPipe.c --
 *
 *	This file implements the UNIX-specific exec pipeline functions, the
 *	"pipe" channel driver, and the "pid" Tcl command.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixPipe.c,v 1.23.4.12 2007/06/21 16:31:37 dgp Exp $
 */

#include "tclInt.h"

#ifdef USE_VFORK
#define fork vfork
#endif












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tclUnixPipe.c --
 *
 *	This file implements the UNIX-specific exec pipeline functions, the
 *	"pipe" channel driver, and the "pid" Tcl command.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixPipe.c,v 1.23.4.13 2008/03/03 04:35:14 dgp Exp $
 */

#include "tclInt.h"

#ifdef USE_VFORK
#define fork vfork
#endif
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
static int
PipeBlockModeProc(
    ClientData instanceData,	/* Pipe state. */
    int mode)			/* The mode to set. Can be one of
				 * TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    PipeState *psPtr = (PipeState *) instanceData;
    int curStatus;
    int fd;

#ifndef	USE_FIONBIO
    if (psPtr->inFile) {
	fd = GetFd(psPtr->inFile);
	curStatus = fcntl(fd, F_GETFL);
	if (mode == TCL_MODE_BLOCKING) {
	    curStatus &= (~(O_NONBLOCK));
	} else {
	    curStatus |= O_NONBLOCK;
	}
	if (fcntl(fd, F_SETFL, curStatus) < 0) {
	    return errno;
	}
    }
    if (psPtr->outFile) {
	fd = GetFd(psPtr->outFile);
	curStatus = fcntl(fd, F_GETFL);
	if (mode == TCL_MODE_BLOCKING) {
	    curStatus &= (~(O_NONBLOCK));
	} else {
	    curStatus |= O_NONBLOCK;
	}
	if (fcntl(fd, F_SETFL, curStatus) < 0) {
	    return errno;
	}
    }
#endif	/* !FIONBIO */

#ifdef	USE_FIONBIO
    if (psPtr->inFile) {
	fd = GetFd(psPtr->inFile);
	if (mode == TCL_MODE_BLOCKING) {
	    curStatus = 0;
	} else {
	    curStatus = 1;
	}
	if (ioctl(fd, (int) FIONBIO, &curStatus) < 0) {
	    return errno;
	}
    }
    if (psPtr->outFile != NULL) {
	fd = GetFd(psPtr->outFile);
	if (mode == TCL_MODE_BLOCKING) {
	    curStatus = 0;
	} else {
	    curStatus = 1;
	}
	if (ioctl(fd, (int) FIONBIO, &curStatus) < 0) {
	    return errno;
	}
    }
#endif	/* USE_FIONBIO */

    psPtr->isNonBlocking = (mode == TCL_MODE_NONBLOCKING);

    return 0;
}

/*







|
<
<

<

|
<
<
<
<
<
<
<




|
<
<
<
<
<
<
<



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







837
838
839
840
841
842
843
844


845

846
847







848
849
850
851
852







853
854
855


























856
857
858
859
860
861
862
static int
PipeBlockModeProc(
    ClientData instanceData,	/* Pipe state. */
    int mode)			/* The mode to set. Can be one of
				 * TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    PipeState *psPtr = instanceData;




    if (psPtr->inFile) {
	if (TclUnixSetBlockingMode(GetFd(psPtr->inFile), mode) < 0) {







	    return errno;
	}
    }
    if (psPtr->outFile) {
	if (TclUnixSetBlockingMode(GetFd(psPtr->outFile), mode) < 0) {







	    return errno;
	}
    }



























    psPtr->isNonBlocking = (mode == TCL_MODE_NONBLOCKING);

    return 0;
}

/*
Changes to unix/tclUnixPort.h.
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixPort.h,v 1.28.2.20 2007/10/15 18:32:38 dgp Exp $
 */

#ifndef _TCLUNIXPORT
#define _TCLUNIXPORT

/*
 *---------------------------------------------------------------------------







|







15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixPort.h,v 1.28.2.21 2008/03/03 04:35:14 dgp Exp $
 */

#ifndef _TCLUNIXPORT
#define _TCLUNIXPORT

/*
 *---------------------------------------------------------------------------
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119

120
121
122
123
124
125
126
127
128
129
130
131
#   include <stdint.h>
#endif
#ifdef HAVE_UNISTD_H
#   include <unistd.h>
#else
#   include "../compat/unistd.h"
#endif
#ifdef	USE_FIONBIO
    /*
     * Not using the Posix fcntl(...,O_NONBLOCK,...) interface, instead
     * we are using ioctl(..,FIONBIO,..).
     */

#   ifdef HAVE_SYS_FILIO_H
#	include	<sys/filio.h>	/* For FIONBIO. */
#   endif


#   ifdef HAVE_SYS_IOCTL_H
#	include	<sys/ioctl.h>	/* For FIONBIO. */
#   endif
#endif	/* USE_FIONBIO */
#include <utime.h>

/*
 * Socket support stuff: This likely needs more work to parameterize for
 * each system.
 */
#include <sys/socket.h>		/* struct sockaddr, SOCK_STREAM, ... */







<
<
<
<
<

<
<
<
>

<
<
<
<







104
105
106
107
108
109
110





111



112
113




114
115
116
117
118
119
120
#   include <stdint.h>
#endif
#ifdef HAVE_UNISTD_H
#   include <unistd.h>
#else
#   include "../compat/unistd.h"
#endif









MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode);





#include <utime.h>

/*
 * Socket support stuff: This likely needs more work to parameterize for
 * each system.
 */
#include <sys/socket.h>		/* struct sockaddr, SOCK_STREAM, ... */
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
 * NeXT doesn't define O_NONBLOCK, so #define it here if necessary.
 */

#ifndef O_NONBLOCK
#   define O_NONBLOCK 0x80
#endif

/*
 * HPUX needs the flag O_NONBLOCK to get the right non-blocking I/O
 * semantics, while most other systems need O_NDELAY.  Define the
 * constant NBIO_FLAG to be one of these
 */

#ifdef HPUX
#  define NBIO_FLAG O_NONBLOCK
#else
#  define NBIO_FLAG O_NDELAY
#endif

/*
 * The type of the status returned by wait varies from UNIX system
 * to UNIX system.  The macro below defines it:
 */

#ifdef _AIX
#   define WAIT_STATUS_TYPE pid_t







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







158
159
160
161
162
163
164












165
166
167
168
169
170
171
 * NeXT doesn't define O_NONBLOCK, so #define it here if necessary.
 */

#ifndef O_NONBLOCK
#   define O_NONBLOCK 0x80
#endif













/*
 * The type of the status returned by wait varies from UNIX system
 * to UNIX system.  The macro below defines it:
 */

#ifdef _AIX
#   define WAIT_STATUS_TYPE pid_t
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
#endif
#ifndef SEEK_END
#   define SEEK_END 2
#endif

/*
 * The stuff below is needed by the "time" command.  If this system has no
 * gettimeofday call, then must use times and the CLK_TCK #define (from
 * sys/param.h) to compute elapsed time.  Unfortunately, some systems only
 * have HZ and no CLK_TCK, and some might not even have HZ.
 */

#ifdef NO_GETTOD
#   include <sys/times.h>
#   include <sys/param.h>
#   ifndef CLK_TCK
#       ifdef HZ
#           define CLK_TCK HZ
#       else
#           define CLK_TCK 60
#       endif
#   endif
#else
#   ifdef HAVE_BSDGETTIMEOFDAY
#	define gettimeofday BSDgettimeofday
#   endif
#endif

#ifdef GETTOD_NOT_DECLARED







|
<
<




<
<
<
<
<
<
<
<







231
232
233
234
235
236
237
238


239
240
241
242








243
244
245
246
247
248
249
#endif
#ifndef SEEK_END
#   define SEEK_END 2
#endif

/*
 * The stuff below is needed by the "time" command.  If this system has no
 * gettimeofday call, then must use times() instead.


 */

#ifdef NO_GETTOD
#   include <sys/times.h>








#else
#   ifdef HAVE_BSDGETTIMEOFDAY
#	define gettimeofday BSDgettimeofday
#   endif
#endif

#ifdef GETTOD_NOT_DECLARED
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
#else
#   if defined(_sgi) || defined(__sgi)
#       define environ _environ
#   endif
extern char **environ;
#endif

/*
 * At present (12/91) not all stdlib.h implementations declare strtod.
 * The declaration below is here to ensure that it's declared, so that
 * the compiler won't take the default approach of assuming it returns
 * an int.  There's no ANSI prototype for it because there would end
 * up being too many conflicts with slightly-different prototypes.
 */

#ifdef NO_STDLIB_H
extern double strtod();
#endif

/*
 * There is no platform-specific panic routine for Unix in the Tcl internals.
 */

#define TclpPanic ((Tcl_PanicProc *) NULL)

/*







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







451
452
453
454
455
456
457












458
459
460
461
462
463
464
#else
#   if defined(_sgi) || defined(__sgi)
#       define environ _environ
#   endif
extern char **environ;
#endif













/*
 * There is no platform-specific panic routine for Unix in the Tcl internals.
 */

#define TclpPanic ((Tcl_PanicProc *) NULL)

/*
Changes to win/Makefile.in.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
#
# This file is a Makefile for Tcl.  If it has the name "Makefile.in" then it
# is a template for a Makefile; to generate the actual Makefile, run
# "./configure", which is a configuration script generated by the "autoconf"
# program (constructs like "@foo@" will get replaced in the actual Makefile.
#
# RCS: @(#) $Id: Makefile.in,v 1.71.2.25 2007/12/06 06:51:52 dgp Exp $

VERSION = @TCL_VERSION@

#--------------------------------------------------------------------------
# Things you can change to personalize the Makefile for your own site (you can
# make these changes in either Makefile.in or Makefile, but changes to
# Makefile will get lost if you re-run the configuration script).






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
#
# This file is a Makefile for Tcl.  If it has the name "Makefile.in" then it
# is a template for a Makefile; to generate the actual Makefile, run
# "./configure", which is a configuration script generated by the "autoconf"
# program (constructs like "@foo@" will get replaced in the actual Makefile.
#
# RCS: @(#) $Id: Makefile.in,v 1.71.2.26 2008/03/03 04:35:14 dgp Exp $

VERSION = @TCL_VERSION@

#--------------------------------------------------------------------------
# Things you can change to personalize the Makefile for your own site (you can
# make these changes in either Makefile.in or Makefile, but changes to
# Makefile will get lost if you re-run the configuration script).
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
	    $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	@echo "Installing library http1.0 directory";
	@for j in $(ROOT_DIR)/library/http1.0/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
	    done;
	@echo "Installing package http 2.5.3 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.5.3.tm;
	@echo "Installing library opt0.4 directory";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.4.2 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.2.tm;







|
|







631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
	    $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	@echo "Installing library http1.0 directory";
	@for j in $(ROOT_DIR)/library/http1.0/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
	    done;
	@echo "Installing package http 2.5.5 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.5.5.tm;
	@echo "Installing library opt0.4 directory";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.4.2 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.2.tm;
Changes to win/tclWinSock.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14




15
16
17
18
19
20
21
/*
 * tclWinSock.c --
 *
 *	This file contains Windows-specific socket related code.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclWinSock.c,v 1.37.2.14 2007/12/06 06:51:53 dgp Exp $
 */

#include "tclWinInt.h"





/*
 * Support for control over sockets' KEEPALIVE and NODELAY behavior is
 * currently disabled.
 */

#undef TCL_FEATURE_KEEPALIVE_NAGLE










|



>
>
>
>







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
/*
 * tclWinSock.c --
 *
 *	This file contains Windows-specific socket related code.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclWinSock.c,v 1.37.2.15 2008/03/03 04:35:14 dgp Exp $
 */

#include "tclWinInt.h"

#ifdef _MSC_VER
#   pragma comment (lib, "ws2_32")
#endif

/*
 * Support for control over sockets' KEEPALIVE and NODELAY behavior is
 * currently disabled.
 */

#undef TCL_FEATURE_KEEPALIVE_NAGLE