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: |
f211098809964f15fe8fc23d5356d094 |
| 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
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 | '\" '\" 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. '\" | | | 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 | * 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. * | | | 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 | * 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. * | | | 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 |
#define formatObj results[0]
#define localeObj results[1]
#define timezoneObj results[2]
int gmtFlag = 0;
/* Command line options expected */
| | | 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 | * 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. * | | | 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 | /* * 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. * | | | 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 |
* 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 */
| | | 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 |
while (isdigit(*end)) {
end++;
}
copy = Tcl_NewStringObj(lastStart,
end - lastStart);
if (TclCheckBadOctal(NULL,
Tcl_GetString(copy))) {
| | | | 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 | /* * 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. * | | | 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 |
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. */
| | | 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 | * 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. * | | | 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 |
}
TclNewLiteralStringObj(keyPtr, "-errorinfo");
Tcl_IncrRefCount(keyPtr);
Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
Tcl_DecrRefCount(keyPtr);
if (valuePtr) {
| < | 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 | * 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. * | | | 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 | * 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. * | | | 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 |
METH_CGETALL,
METH_CONFIGURE,
METH_FINAL,
METH_INIT,
METH_READ,
METH_SEEK,
METH_WATCH,
| | | 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 | * 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. * | | | 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 |
"\" not supported by this system", NULL);
}
ckfree((char *) modeArgv);
return -1;
#endif
} else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) {
| < | < < < < | 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 | * 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. * | | | 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 |
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;
| | | > > | | | | 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 | /* * 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. * | | | 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 | * * 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. * | | | 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 | /* * 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. * | | | 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 |
TclReToGlob(
Tcl_Interp *interp,
const char *reStr,
int reStrLen,
Tcl_DString *dsPtr,
int *exactPtr)
{
| | | 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 |
}
break;
case '.':
anchorLeft = 0; /* prevent exact match */
if (p+1 < strEnd) {
if (p[1] == '*') {
p++;
| | > > | 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 |
msg = "unhandled RE special char";
goto invalidGlob;
break;
default:
*dsStr++ = *p;
break;
}
}
| > | | 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 | # #---------------------------------------------------------------------- # # 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. # | | | 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 |
# Set defaults
set base [clock seconds]
set string [lindex $args 0]
set format {}
set gmt 0
| | | | 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 |
# 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
| | | 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 |
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]
| | | 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 |
}
if { [catch { expr {wide($clockval)} } result] } {
return -code error $result
}
set offsets {}
set gmt 0
| | | | 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 | # 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. # | | | | 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 |
# Wait for the connection to complete.
if {$state(-timeout) > 0} {
fileevent $s writable [list http::Connect $token]
http::wait $token
| > > > > > > | | | | | | | | | | | | | > | 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 | # 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. | | | 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 |
}
}
proc http::size {token} {
variable $token
upvar 0 $token state
return $state(currentsize)
}
| > > > > | | 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 |
# Read the socket and handle callbacks.
proc http::Event {token} {
variable $token
upvar 0 $token state
set s $state(sock)
| < < < < | | 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 |
append state(body) $block
}
}
if {$n >= 0} {
incr state(currentsize) $n
}
} err]} {
| | > > > > > | 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 |
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)
}
| | | 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 |
# 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}
| | | 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 | # 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. # | | | 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 | # 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. # | | | 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 | # # 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. # | | | 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 | $(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; | | | | 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 |
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
| | | | | > > | > | | > > | > > > > > > > > > > > > > > > > > > > > | > > > | | < | | 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 | #! /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. # | | | 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 | 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, [ | | < < | | < < < > | | | | 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 | /* 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 | | | 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 | /* * 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. * | | < < < < < < < < < < < < < < < < < < < < < < < < < < | 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 | # 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)) | < < < < < < < < < < < < < < < < | 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 |
* 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. */
| < < | 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 | 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 | < < < < < < | 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 |
* 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 */
| | < < < < | 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 |
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;
| < < | < < < < < < < < < < < < | < < < < | 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 |
*handlePtr = (ClientData) INT2PTR(fsPtr->fd);
return TCL_OK;
}
return TCL_ERROR;
}
#ifdef SUPPORTS_TTY
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 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 | } /* * system calls results should be checked there. - dl */ TtySetAttributes(fsPtr->fd, &tty); | < | 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 |
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);
| > < | | 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 | SET_BITS(iostate.sg_flags, RAW); #endif /* USE_SGTTY */ /* * Only update if we're changing anything to avoid possible blocking. */ | | | 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 |
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;
| < < < < < | < < < < < < < < < < < < < < < < | 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 |
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. */
| < < | < < < < < < | 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 |
* 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) {
| < < < | < < < < | 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 |
* 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) {
| < < < | < < < < | 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 | /* * 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. * | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | /* * 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. * | | | 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 |
if (pipe(fds) != 0) {
Tcl_Panic("NotifierThreadProc: could not create trigger pipe");
}
receivePipe = fds[0];
| < | < < < | < < < < < < < < < | 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(¬ifierMutex);
triggerPipe = fds[1];
|
| ︙ | ︙ |
Changes to unix/tclUnixPipe.c.
1 2 3 4 5 6 7 8 9 10 11 12 | /* * 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. * | | | 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 |
static int
PipeBlockModeProc(
ClientData instanceData, /* Pipe state. */
int mode) /* The mode to set. Can be one of
* TCL_MODE_BLOCKING or
* TCL_MODE_NONBLOCKING. */
{
| | < < < | < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 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 | * * 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. * | | | 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 | # include <stdint.h> #endif #ifdef HAVE_UNISTD_H # include <unistd.h> #else # include "../compat/unistd.h" #endif | < < < < < < < < > < < < < | 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 | * NeXT doesn't define O_NONBLOCK, so #define it here if necessary. */ #ifndef O_NONBLOCK # define O_NONBLOCK 0x80 #endif | < < < < < < < < < < < < | 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 | #endif #ifndef SEEK_END # define SEEK_END 2 #endif /* * The stuff below is needed by the "time" command. If this system has no | | < < < < < < < < < < | 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 | #else # if defined(_sgi) || defined(__sgi) # define environ _environ # endif extern char **environ; #endif | < < < < < < < < < < < < | 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 | # # 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. # | | | 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 | $(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; | | | | 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 | /* * 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. * | | > > > > | 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 |
| ︙ | ︙ |