diff options
47 files changed, 1626 insertions, 760 deletions
@@ -1,7 +1,204 @@ -2007-02-02 Daniel Steffen <das@users.sourceforge.net> +2008-03-07 Don Porter <dgp@users.sourceforge.net> + + * generic/tclExecute.c (Tcl_ExprObj): Revised expression bytecode + compiling so that bytecodes invalid due to changing context or due + to the difference between expressions and scripts are not reused. + [Bug 1899164]. + + * generic/tclCmdAH.c: Revised direct evaluation implementation of + [expr] so that [expr $e] caches compiled bytecodes for the expression + as the intrep of $e. + + * tests/execute.test (execute-6.*): More tests checking that + script bytecode is invalidated in the right situations. + +2008-03-07 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * win/configure.in: Add AC_HEADER_STDC to support msys/win64. + +2008-03-06 Donal K. Fellows <dkf@users.sf.net> + + * doc/namespace.n: Minor tidying up. [Bug 1909019] + +2008-03-04 Don Porter <dgp@users.sourceforge.net> + + * tests/execute.test (6.3,4): Added tests for [Bug 1899164]. + +2008-03-03 Reinhard Max <max@suse.de> + + * unix/tclUnixChan.c: Fix mark and space parity on Linux, which uses + CMSPAR instead of PAREXT. + +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 star + * tests/regexpComp.test: 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: 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. [Bug 1868845] + +2008-02-22 Pat Thoyts <patthoyts@users.sourceforge.net> + + * library/http/pkgIndex.tcl: Set version 2.5.4 + * library/http/http.tcl: Always check that the state array exists + in the http::status command. [Bug 1818565] + +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: + * README + + * unix/configure: autoconf (2.59) + * win/configure: + +2008-02-12 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * generic/tclCompCmds.c (TclCompileSwitchCmd): Corrected logic for + * tests/switch.test (switch-10.15): handling -nocase compilation; the + -exact -nocase option cannot be compiled currently. [Bug 1891827] + + * unix/README: Documented missing configure flags. [Bug 1799011] + +2008-02-06 Kevin B. Kenny <kennykb@acm.org> + + * doc/clock.n (%N): Corrected an error in the explanation of the %N + format group. + * generic/tclClock.c (ClockParseformatargsObjCmd): + * library/clock.tcl (::tcl::clock::format): + * tests/clock.test (clock-1.0, clock-1.4): + Performance enhancements in [clock format] (moving the analysis of + $args into C code, holding on to Tcl_Objs with resolved command names, + [lassign] in place of [foreach], avoiding [namespace which] for + command resolution). + +2008-02-04 Don Porter <dgp@users.sourceforge.net> *** 8.5.1 TAGGED FOR RELEASE *** + * changes: Updated for 8.5.1 release. + + * generic/tcl.h: Bump to 8.5.1 for release. + * library/init.tcl: + * tools/tcl.wse.in: + * unix/configure.in: + * unix/tcl.spec: + * win/configure.in: + + * unix/configure: autoconf-2.59 + * win/configure: + +2008-02-04 Miguel Sofer <msofer@users.sf.net> + + * generic/tclExecute.c (INST_CONCAT1): fix optimisation for in-place + concatenation (was going over String type) + +2008-02-02 Daniel Steffen <das@users.sourceforge.net> + * unix/configure.in (Darwin): correct Info.plist year substitution in non-framework builds. @@ -9,8 +206,8 @@ 2008-01-30 Miguel Sofer <msofer@users.sf.net> - * generic/tclInterp.c (Tcl_GetAlias): fix for [Bug 1882373], - thanks go to an00na + * generic/tclInterp.c (Tcl_GetAlias): fix for [Bug 1882373], thanks go + to an00na 2008-01-30 Donal K. Fellows <donal.k.fellows@man.ac.uk> @@ -1,11 +1,11 @@ README: Tcl - This is the Tcl 8.5.1 source distribution. + This is the Tcl 8.5.2 source distribution. Tcl/Tk is also available through NetCVS: http://tcl.sourceforge.net/ You can get any source release of Tcl from the file distributions link at the above URL. -RCS: @(#) $Id: README,v 1.59.2.7 2008/01/23 16:42:16 dgp Exp $ +RCS: @(#) $Id: README,v 1.59.2.8 2008/03/07 22:05:01 dgp Exp $ Contents -------- @@ -1,6 +1,6 @@ Recent user-visible changes to Tcl: -RCS: @(#) $Id: changes,v 1.116.2.8 2008/01/31 02:57:52 dgp Exp $ +RCS: @(#) $Id: changes,v 1.116.2.9 2008/03/07 22:05:01 dgp Exp $ 1. No more [command1] [command2] construct for grouping multiple commands on a single command line. @@ -7128,4 +7128,4 @@ Several documentation and release notes improvements Several documentation and release notes improvements ---- Released 8.5.1, February 1, 2008 --- See ChangeLog for details --- +--- Released 8.5.1, February 5, 2008 --- See ChangeLog for details --- diff --git a/doc/clock.n b/doc/clock.n index 4a4a519..600722b 100644 --- a/doc/clock.n +++ b/doc/clock.n @@ -592,8 +592,9 @@ with exactly two digits. On input, accepts two digits and interprets them as the number of the minute of the hour. .TP \fB%N\fR -On output, produces the number of the month (1-12) with one or two digits. -digits. On input, accepts one or two digits, possibly with leading whitespace, +On output, produces the number of the month (1-12) with one or two digits, +and a leading blank for one-digit dates. +On input, accepts one or two digits, possibly with leading whitespace, and interprets them as the number of the month. .TP \fB%Od\fR, \fB%Oe\fR, \fB%OH\fR, \fB%OI\fR, \fB%Ok\fR, \fB%Ol\fR, \fB%Om\fR, \fB%OM\fR, \fB%OS\fR, \fB%Ou\fR, \fB%Ow\fR, \fB%Oy\fR @@ -881,6 +882,7 @@ 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. @@ -6,7 +6,7 @@ '\" 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.24.2.2 2007/11/01 16:25:49 dgp Exp $ +'\" RCS: @(#) $Id: http.n,v 1.24.2.3 2008/03/07 22:05:01 dgp Exp $ '\" .so man.macros .TH "http" n 2.5 http "Tcl Bundled Packages" @@ -36,6 +36,8 @@ http \- Client-side implementation of the HTTP/1.0 protocol .sp \fB::http::ncode \fItoken\fR .sp +\fB::http::meta \fItoken\fR +.sp \fB::http::data \fItoken\fR .sp \fB::http::error \fItoken\fR @@ -315,6 +317,11 @@ 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 diff --git a/doc/namespace.n b/doc/namespace.n index 3b66c4d..6bf6abc 100644 --- a/doc/namespace.n +++ b/doc/namespace.n @@ -7,7 +7,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: namespace.n,v 1.21.6.2 2007/12/10 18:32:55 dgp Exp $ +'\" RCS: @(#) $Id: namespace.n,v 1.21.6.3 2008/03/07 22:05:01 dgp Exp $ '\" .so man.macros .TH namespace n 8.5 Tcl "Tcl Built-In Commands" @@ -16,7 +16,7 @@ .SH NAME namespace \- create and manipulate contexts for commands and variables .SH SYNOPSIS -\fBnamespace \fR?\fIoption\fR? ?\fIarg ...\fR? +\fBnamespace \fR?\fIsubcommand\fR? ?\fIarg ...\fR? .BE .SH DESCRIPTION .PP @@ -24,8 +24,8 @@ The \fBnamespace\fR command lets you create, access, and destroy separate contexts for commands and variables. See the section \fBWHAT IS A NAMESPACE?\fR below for a brief overview of namespaces. -The legal values of \fIoption\fR are listed below. -Note that you can abbreviate the \fIoption\fRs. +The legal values of \fIsubcommand\fR are listed below. +Note that you can abbreviate the \fIsubcommand\fRs. .TP \fBnamespace children \fR?\fInamespace\fR? ?\fIpattern\fR? Returns a list of all child namespaces that belong to the @@ -88,7 +88,7 @@ looking it up by name. If a namespace does not exist, this command returns an error. If no namespace names are given, this command does nothing. .TP -\fBnamespace ensemble\fR \fIoption\fR ?\fIarg ...\fR? +\fBnamespace ensemble\fR \fIsubcommand\fR ?\fIarg ...\fR? .VS 8.5 Creates and manipulates a command that is formed out of an ensemble of subcommands. See the section \fBENSEMBLES\fR below for further @@ -140,19 +140,22 @@ Each \fIpattern\fR is a simple or qualified name such as \fBx\fR, \fBfoo::x\fR or \fBa::b::p*\fR. Qualified names contain double colons (\fB::\fR) and qualify a name with the name of one or more namespaces. -Each \fIqualified pattern\fR is qualified with the name of an -exporting namespace +Each +.QW "qualified pattern" +is qualified with the name of an exporting namespace and may have glob-style special characters in the command name at the end of the qualified name. Glob characters may not appear in a namespace name. -For each \fIsimple pattern\fR this command deletes the matching -commands of the +For each +.QW "simple pattern" +this command deletes the matching commands of the current namespace that were imported from a different namespace. -For \fIqualified patterns\fR, this command first finds the matching -exported commands. +For +.QW "qualified patterns" , +this command first finds the matching exported commands. It then checks whether any of those commands were previously imported by the current namespace. -If so, this command deletes the corresponding imported commands. +If so, this command deletes the corresponding imported commands. In effect, this un-does the action of a \fBnamespace import\fR command. .TP \fBnamespace import \fR?\fB\-force\fR? ?\fIpattern\fR \fIpattern ...\fR? @@ -270,20 +273,20 @@ the names of currently defined namespaces. This command arranges for one or more local variables in the current procedure to refer to variables in \fInamespace\fR. The namespace name is resolved as described in section \fBNAME RESOLUTION\fR. -The command +The command \fBnamespace upvar $ns a b\fR has the same behaviour as \fBupvar 0 $ns::a b\fR, with the sole exception of the resolution rules -used for qualified namespace or variable names. +used for qualified namespace or variable names. \fBnamespace upvar\fR returns an empty string. .TP \fBnamespace unknown\fR ?\fIscript\fR? Sets or returns the unknown command handler for the current namespace. The handler is invoked when a command called from within the namespace -cannot be found (in either the current namespace or the global namespace). +cannot be found (in either the current namespace or the global namespace). The \fIscript\fR argument, if given, should be a well formed list representing a command name and optional arguments. When the handler is invoked, the full invocation line will be appended to the -script and the result evaluated in the context of the namespace. The +script and the result evaluated in the context of the namespace. The default handler for all namespaces is \fB::unknown\fR. If no argument is given, it returns the handler for the current namespace. .TP @@ -296,7 +299,7 @@ this command returns a fully-qualified name in the global namespace. If the command or variable does not exist, this command returns an empty string. If the variable has been created but not defined, such as with the \fBvariable\fR command -or through a \fBtrace\fR on the variable, this command will return the +or through a \fBtrace\fR on the variable, this command will return the fully-qualified name of the variable. If no flag is given, \fIname\fR is treated as a command name. See the section \fBNAME RESOLUTION\fR below for an explanation of @@ -437,7 +440,7 @@ If you provide a fully-qualified name that starts with a \fB::\fR, there is no question about what command, variable, or namespace you mean. However, if the name does not start with a \fB::\fR -(i.e., is \fIrelative\fR), +(i.e., is \fIrelative\fR), Tcl follows basic rules for looking it up: Variable names are always resolved by looking first in the current namespace, @@ -477,7 +480,7 @@ set traceLevel 0 } .CE Here Tcl looks for \fBtraceLevel\fR first in the namespace \fBFoo::Debug\fR. -Since it is not found there, Tcl then looks for it +Since it is not found there, Tcl then looks for it in the global namespace. The variable \fBFoo::traceLevel\fR is completely ignored during the name resolution process. @@ -854,7 +857,6 @@ Remove all imported commands from the current namespace: .CS namespace forget {*}[namespace import] .CE - .SH "SEE ALSO" interp(n), upvar(n), variable(n) .SH KEYWORDS diff --git a/generic/tcl.h b/generic/tcl.h index 90ef419..560e135 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tcl.h,v 1.231.2.15 2008/01/23 16:49:00 dgp Exp $ + * RCS: @(#) $Id: tcl.h,v 1.231.2.16 2008/03/07 22:05:02 dgp Exp $ */ #ifndef _TCL @@ -60,10 +60,10 @@ extern "C" { #define TCL_MAJOR_VERSION 8 #define TCL_MINOR_VERSION 5 #define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE -#define TCL_RELEASE_SERIAL 1 +#define TCL_RELEASE_SERIAL 2 #define TCL_VERSION "8.5" -#define TCL_PATCH_LEVEL "8.5.1" +#define TCL_PATCH_LEVEL "8.5.2" /* * The following definitions set up the proper options for Windows compilers. diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 73c1c12..c7daa32 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -14,7 +14,7 @@ * 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.244.2.22 2008/01/25 16:43:50 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.244.2.23 2008/03/07 22:05:02 dgp Exp $ */ #include "tclInt.h" @@ -3609,6 +3609,9 @@ TclEvalObjvInternal( if (cmdEpoch != newEpoch) { checkTraces = 0; + if (commandPtr) { + Tcl_DecrRefCount(commandPtr); + } goto reparseBecauseOfTraces; } } @@ -5284,6 +5287,7 @@ Tcl_AppendObjToErrorInfo( int length; const char *message = TclGetStringFromObj(objPtr, &length); + Tcl_IncrRefCount(objPtr); Tcl_AddObjErrorInfo(interp, message, length); Tcl_DecrRefCount(objPtr); } diff --git a/generic/tclClock.c b/generic/tclClock.c index 5a9b011..cb630a6 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -12,7 +12,7 @@ * 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.61.2.1 2007/11/12 19:18:14 dgp Exp $ + * RCS: @(#) $Id: tclClock.c,v 1.61.2.2 2008/03/07 22:05:02 dgp Exp $ */ #include "tclInt.h" @@ -58,9 +58,14 @@ static const int daysInPriorMonths[2][13] = { */ typedef enum ClockLiteral { - LIT_BCE, LIT_CE, + 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_GREGORIAN, + LIT_ERA, LIT_GMT, LIT_GREGORIAN, + LIT_INTEGER_VALUE_TOO_LARGE, LIT_ISO8601WEEK, LIT_ISO8601YEAR, LIT_JULIANDAY, LIT_LOCALSECONDS, LIT_MONTH, @@ -69,9 +74,14 @@ typedef enum ClockLiteral { LIT__END } ClockLiteral; static const char *const literals[] = { - "BCE", "CE", + "", + "%a %b %d %H:%M:%S %Z %Y", + "BCE", "C", + "cannot use -gmt and -timezone in same call", + "CE", "dayOfMonth", "dayOfWeek", "dayOfYear", - "era", "gregorian", + "era", ":GMT", "gregorian", + "integer value too large to represent", "iso8601Week", "iso8601Year", "julianDay", "localSeconds", "month", @@ -176,6 +186,9 @@ static int ClockMicrosecondsObjCmd( static int ClockMillisecondsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int ClockParseformatargsObjCmd( + ClientData clientData, Tcl_Interp* interp, + int objc, Tcl_Obj *const objv[]); static int ClockSecondsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -209,6 +222,7 @@ static const struct ClockCommand clockCommands[] = { ClockGetjuliandayfromerayearmonthdayObjCmd }, { "GetJulianDayFromEraYearWeekDay", ClockGetjuliandayfromerayearweekdayObjCmd }, + { "ParseFormatArgs", ClockParseformatargsObjCmd }, { NULL, NULL } }; @@ -405,6 +419,16 @@ ClockGetdatefieldsObjCmd( 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. */ @@ -1779,6 +1803,124 @@ ClockMicrosecondsObjCmd( return TCL_OK; } +/* + *----------------------------------------------------------------------------- + * + * ClockParseformatargsObjCmd -- + * + * Parses the arguments for [clock format]. + * + * Results: + * Returns a standard Tcl result, whose value is a four-element + * list comprising the time format, the locale, and the timezone. + * + * This function exists because the loop that parses the [clock format] + * options is a known performance "hot spot", and is implemented in an + * effort to speed that particular code up. + * + *----------------------------------------------------------------------------- + */ + +static int +ClockParseformatargsObjCmd( + ClientData clientData, /* Client data containing literal pool */ + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *const objv[] /* Parameter vector */ +) { + + ClockClientData* dataPtr = (ClockClientData*) clientData; + Tcl_Obj** litPtr = dataPtr->literals; + + /* Format, locale and timezone */ + + Tcl_Obj* results[3]; +#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 */ + int saw = 0; /* Flag == 1 if option was seen already */ + Tcl_WideInt clockVal; /* Clock value - just used to parse */ + int i; + + /* Args consist of a time followed by keyword-value pairs */ + + if (objc < 2 || (objc % 2) != 0) { + Tcl_WrongNumArgs(interp, 0, objv, + "clock format clockval ?-format string? " + "?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"); + Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); + return TCL_ERROR; + } + + /* Extract values for the keywords */ + + formatObj = litPtr[LIT__DEFAULT_FORMAT]; + localeObj = litPtr[LIT_C]; + timezoneObj = litPtr[LIT__NIL]; + for (i = 2; i < objc; i+=2) { + if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", 0, + &optionIndex) != TCL_OK) { + Tcl_SetErrorCode(interp, "CLOCK", "badSwitch", + Tcl_GetString(objv[i]), NULL); + return TCL_ERROR; + } + switch (optionIndex) { + case CLOCK_FORMAT_FORMAT: + formatObj = objv[i+1]; + break; + case CLOCK_FORMAT_GMT: + if (Tcl_GetBooleanFromObj(interp, objv[i+1], &gmtFlag) != TCL_OK) { + return TCL_ERROR; + } + break; + case CLOCK_FORMAT_LOCALE: + localeObj = objv[i+1]; + break; + case CLOCK_FORMAT_TIMEZONE: + timezoneObj = objv[i+1]; + break; + } + saw |= (1 << optionIndex); + } + + /* Check options */ + + if (Tcl_GetWideIntFromObj(interp, objv[1], &clockVal) != TCL_OK) { + return TCL_ERROR; + } + if ((saw & (1 << CLOCK_FORMAT_GMT)) + && (saw & (1 << CLOCK_FORMAT_TIMEZONE))) { + Tcl_SetObjResult(interp, litPtr[LIT_CANNOT_USE_GMT_AND_TIMEZONE]); + Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", NULL); + return TCL_ERROR; + } + if (gmtFlag) { + timezoneObj = litPtr[LIT_GMT]; + } + + /* Return options as a list */ + + Tcl_SetObjResult(interp, Tcl_NewListObj(3, results)); + return TCL_OK; + +#undef timezoneObj +#undef localeObj +#undef formatObj + +} + /*---------------------------------------------------------------------- * * ClockSecondsObjCmd - diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index c83d594..7733447 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdAH.c,v 1.88.2.2 2007/11/12 19:18:14 dgp Exp $ + * RCS: @(#) $Id: tclCmdAH.c,v 1.88.2.3 2008/03/07 22:05:02 dgp Exp $ */ #include "tclInt.h" @@ -757,7 +757,6 @@ Tcl_ExprObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { - register Tcl_Obj *objPtr; Tcl_Obj *resultPtr; int result; @@ -766,10 +765,14 @@ Tcl_ExprObjCmd( return TCL_ERROR; } - objPtr = Tcl_ConcatObj(objc-1, objv+1); - Tcl_IncrRefCount(objPtr); - result = Tcl_ExprObj(interp, objPtr, &resultPtr); - Tcl_DecrRefCount(objPtr); + if (objc == 2) { + result = Tcl_ExprObj(interp, objv[1], &resultPtr); + } else { + Tcl_Obj *objPtr = Tcl_ConcatObj(objc-1, objv+1); + Tcl_IncrRefCount(objPtr); + result = Tcl_ExprObj(interp, objPtr, &resultPtr); + Tcl_DecrRefCount(objPtr); + } if (result == TCL_OK) { Tcl_SetObjResult(interp, resultPtr); diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index c56aee6..2abf5ab 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -12,7 +12,7 @@ * 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.109.2.19 2008/01/25 16:43:51 dgp Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.109.2.20 2008/03/07 22:05:03 dgp Exp $ */ #include "tclInt.h" @@ -3358,6 +3358,7 @@ TclCompileReturnCmd( /* Optimize [return -level 0 $x]. */ Tcl_DictObjSize(NULL, returnOpts, &size); if (size == 0 && level == 0 && code == TCL_OK) { + Tcl_DecrRefCount(returnOpts); return TCL_OK; } @@ -3967,7 +3968,7 @@ TclCompileSwitchCmd( } tokenPtr = TokenAfter(tokenPtr); numWords--; - if (noCase && (mode != Switch_Exact)) { + if (noCase && (mode == Switch_Exact)) { /* * Can't compile this case; no opcode for case-insensitive equality! */ @@ -4376,6 +4377,7 @@ TclCompileSwitchCmd( foundDefault = 0; for (i=0 ; i<numWords ; i+=2) { int nextArmFixupIndex = -1; + envPtr->currStackDepth = savedStackDepth + 1; if (i!=numWords-2 || bodyToken[numWords-2]->size != 7 || memcmp(bodyToken[numWords-2]->start, "default", 7)) { @@ -4400,6 +4402,7 @@ TclCompileSwitchCmd( /* * Keep in sync with TclCompileRegexpCmd. */ + if (bodyToken[i]->type == TCL_TOKEN_TEXT) { Tcl_DString ds; @@ -4439,13 +4442,15 @@ TclCompileSwitchCmd( } } else { /* - * Pass correct RE compile flags. We use only Int1 + * Pass correct RE compile flags. We use only Int1 * (8-bit), but that handles all the flags we want to - * pass. Don't use TCL_REG_NOSUB as we may have backrefs + * pass. Don't use TCL_REG_NOSUB as we may have backrefs * or capture vars. */ + int cflags = TCL_REG_ADVANCED - | (noCase ? TCL_REG_NOCASE : 0); + | (noCase ? TCL_REG_NOCASE : 0); + TclEmitInstInt1(INST_REGEXP, cflags, envPtr); } break; diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index e095f6d..f8ae67c 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -10,7 +10,7 @@ * 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.53.2.14 2008/01/25 16:43:51 dgp Exp $ + * RCS: @(#) $Id: tclCompExpr.c,v 1.53.2.15 2008/03/07 22:05:03 dgp Exp $ */ #include "tclInt.h" @@ -111,7 +111,7 @@ enum OperandTypes { 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 */ + MARK_PARENT /* Next step of traversal is to return to parent */ }; /* @@ -759,8 +759,8 @@ ParseExpr( end - lastStart); if (TclCheckBadOctal(NULL, Tcl_GetString(copy))) { - TclNewLiteralStringObj(post, - "(invalid octal number?)"); + Tcl_AppendToObj(post, + "(invalid octal number?)", -1); } Tcl_DecrRefCount(copy); } diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 9342da9..3b7a91c 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -9,7 +9,7 @@ * 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.70.2.14 2008/01/25 16:43:52 dgp Exp $ + * RCS: @(#) $Id: tclCompile.h,v 1.70.2.15 2008/03/07 22:05:04 dgp Exp $ */ #ifndef _TCLCOMPILATION @@ -672,7 +672,7 @@ typedef enum InstOperandType { * variable table. */ OPERAND_LVT4, /* Four byte unsigned index into the local * variable table. */ - OPERAND_AUX4, /* Four byte unsigned index into the aux data + OPERAND_AUX4 /* Four byte unsigned index into the aux data * table. */ } InstOperandType; diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 6ccf859..2471b72 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -12,7 +12,7 @@ * 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.72.2.4 2007/09/17 15:03:44 dgp Exp $ + * RCS: @(#) $Id: tclEvent.c,v 1.72.2.5 2008/03/07 22:05:04 dgp Exp $ */ #include "tclInt.h" @@ -376,7 +376,6 @@ TclDefaultBgErrorHandlerObjCmd( Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); Tcl_DecrRefCount(keyPtr); if (valuePtr) { - Tcl_IncrRefCount(valuePtr); Tcl_AppendObjToErrorInfo(interp, valuePtr); } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 1a9b996..a990c54 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -13,7 +13,7 @@ * 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.285.2.29 2008/01/25 16:43:52 dgp Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.285.2.30 2008/03/07 22:05:04 dgp Exp $ */ #include "tclInt.h" @@ -597,7 +597,16 @@ static int EvalStatsCmd(ClientData clientData, #endif /* TCL_COMPILE_STATS */ #ifdef TCL_COMPILE_DEBUG static char * GetOpcodeName(unsigned char *pc); +static void PrintByteCodeInfo(ByteCode *codePtr); +static const char * StringForResultCode(int result); +static void ValidatePcAndStackTop(ByteCode *codePtr, + unsigned char *pc, int stackTop, + int stackLowerBound, int checkStack); #endif /* TCL_COMPILE_DEBUG */ +static void DeleteExecStack(ExecStack *esPtr); +static void DupExprCodeInternalRep(Tcl_Obj *srcPtr, + Tcl_Obj *copyPtr); +static void FreeExprCodeInternalRep(Tcl_Obj *objPtr); static ExceptionRange * GetExceptRangeForPc(unsigned char *pc, int catchOnly, ByteCode *codePtr); static const char * GetSrcInfoForPc(unsigned char *pc, ByteCode *codePtr, @@ -607,17 +616,22 @@ static Tcl_Obj ** GrowEvaluationStack(ExecEnv *eePtr, int growth, static void IllegalExprOperandType(Tcl_Interp *interp, unsigned char *pc, Tcl_Obj *opndPtr); static void InitByteCodeExecution(Tcl_Interp *interp); -#ifdef TCL_COMPILE_DEBUG -static void PrintByteCodeInfo(ByteCode *codePtr); -static const char * StringForResultCode(int result); -static void ValidatePcAndStackTop(ByteCode *codePtr, - unsigned char *pc, int stackTop, - int stackLowerBound, int checkStack); -#endif /* TCL_COMPILE_DEBUG */ -static void DeleteExecStack(ExecStack *esPtr); /* Useful elsewhere, make available in tclInt.h or stubs? */ static Tcl_Obj ** StackAllocWords(Tcl_Interp *interp, int numWords); static Tcl_Obj ** StackReallocWords(Tcl_Interp *interp, int numWords); + +/* + * The structure below defines a bytecode Tcl object type to hold the + * compiled bytecode for Tcl expressions. + */ + +static Tcl_ObjType exprCodeType = { + "exprcode", + FreeExprCodeInternalRep, /* freeIntRepProc */ + DupExprCodeInternalRep, /* dupIntRepProc */ + NULL, /* updateStringProc */ + NULL /* setFromAnyProc */ +}; /* *---------------------------------------------------------------------- @@ -1190,36 +1204,32 @@ Tcl_ExprObj( register ByteCode *codePtr = NULL; /* Tcl Internal type of bytecode. Initialized * to avoid compiler warning. */ - Tcl_Obj *saveObjPtr; int result; /* - * Get the ByteCode from the object. If it exists, make sure it hasn't - * been invalidated by, e.g., someone redefining a command with a compile - * procedure (this might make the compiled code wrong). If necessary, - * convert the object to be a ByteCode object and compile it. Also, if the - * code was compiled in/for a different interpreter, we recompile it. - * - * Precompiled expressions, however, are immutable and therefore they are - * not recompiled, even if the epoch has changed. + * Execute the expression after first saving the interpreter's result. */ - if (objPtr->typePtr == &tclByteCodeType) { + Tcl_Obj *saveObjPtr = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(saveObjPtr); + + /* + * Get the expression ByteCode from the object. If it exists, make sure it + * is valid in the current context. + */ + if (objPtr->typePtr == &exprCodeType) { + Namespace *namespacePtr = iPtr->varFramePtr->nsPtr; + codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr; if (((Interp *) *codePtr->interpHandle != iPtr) - || (codePtr->compileEpoch != iPtr->compileEpoch)) { - if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) { - if ((Interp *) *codePtr->interpHandle != iPtr) { - Tcl_Panic("Tcl_ExprObj: compiled expression jumped interps"); - } - codePtr->compileEpoch = iPtr->compileEpoch; - } else { - objPtr->typePtr->freeIntRepProc(objPtr); - objPtr->typePtr = (Tcl_ObjType *) NULL; - } + || (codePtr->compileEpoch != iPtr->compileEpoch) + || (codePtr->nsPtr != namespacePtr) + || (codePtr->nsEpoch != namespacePtr->resolverEpoch)) { + objPtr->typePtr->freeIntRepProc(objPtr); + objPtr->typePtr = (Tcl_ObjType *) NULL; } } - if (objPtr->typePtr != &tclByteCodeType) { + if (objPtr->typePtr != &exprCodeType) { /* * TIP #280: No invoker (yet) - Expression compilation. */ @@ -1248,6 +1258,7 @@ Tcl_ExprObj( TclEmitOpcode(INST_DONE, &compEnv); TclInitByteCodeObj(objPtr, &compEnv); + objPtr->typePtr = &exprCodeType; TclFreeCompileEnv(&compEnv); codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr; #ifdef TCL_COMPILE_DEBUG @@ -1258,12 +1269,6 @@ Tcl_ExprObj( #endif /* TCL_COMPILE_DEBUG */ } - /* - * Execute the expression after first saving the interpreter's result. - */ - - saveObjPtr = Tcl_GetObjResult(interp); - Tcl_IncrRefCount(saveObjPtr); Tcl_ResetResult(interp); /* @@ -1276,8 +1281,6 @@ Tcl_ExprObj( codePtr->refCount--; if (codePtr->refCount <= 0) { TclCleanupByteCode(codePtr); - objPtr->typePtr = NULL; - objPtr->internalRep.otherValuePtr = NULL; } /* @@ -1302,6 +1305,72 @@ Tcl_ExprObj( /* *---------------------------------------------------------------------- * + * DupExprCodeInternalRep -- + * + * Part of the Tcl object type implementation for Tcl expression + * bytecode. We do not copy the bytecode intrep. Instead, we + * return with setting copyPtr->typePtr, so the copy is a plain + * string copy of the expression value, and if it is to be used + * as a compiled expression, it will just need a recompile. + * + * This makes sense, because with Tcl's copy-on-write practices, + * the usual (only?) time Tcl_DuplicateObj() will be called is + * when the copy is about to be modified, which would invalidate + * any copied bytecode anyway. The only reason it might make sense + * to copy the bytecode is if we had some modifying routines that + * operated directly on the intrep, like we do for lists and dicts. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +DupExprCodeInternalRep( + Tcl_Obj *srcPtr, + Tcl_Obj *copyPtr) +{ + return; +} + +/* + *---------------------------------------------------------------------- + * + * FreeExprCodeInternalRep -- + * + * Part of the Tcl object type implementation for Tcl expression + * bytecode. Frees the storage allocated to hold the internal rep, + * unless ref counts indicate bytecode execution is still in progress. + * + * Results: + * None. + * + * Side effects: + * May free allocated memory. Leaves objPtr untyped. + *---------------------------------------------------------------------- + */ + +static void +FreeExprCodeInternalRep( + Tcl_Obj *objPtr) +{ + ByteCode *codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr; + + codePtr->refCount--; + if (codePtr->refCount <= 0) { + TclCleanupByteCode(codePtr); + } + objPtr->typePtr = NULL; + objPtr->internalRep.otherValuePtr = NULL; +} + +/* + *---------------------------------------------------------------------- + * * TclCompEvalObj -- * * This procedure evaluates the script contained in a Tcl_Obj by first @@ -1372,9 +1441,6 @@ TclCompEvalObj( codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr; if (((Interp *) *codePtr->interpHandle != iPtr) || (codePtr->compileEpoch != iPtr->compileEpoch) -#ifdef CHECK_PROC_ORIGINATION /* [Bug: 3412 Pedantic] */ - || codePtr->procPtr != iPtr->varFramePtr->procPtr -#endif || (codePtr->nsPtr != namespacePtr) || (codePtr->nsEpoch != namespacePtr->resolverEpoch)) { if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) { @@ -1866,6 +1932,7 @@ TclExecuteByteCode( 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\")", @@ -2050,17 +2117,19 @@ TclExecuteByteCode( * If the first object is shared, we need a new obj for the result; * otherwise, we can reuse the first object. In any case, make sure it * has enough room to accomodate all the concatenated bytes. Note that - * if it is unshared its bytes are already copied by - * Tcl_SetObjectLength, so that we set the loop parameters to avoid - * copying them again: p points to the end of the already copied - * bytes, currPtr to the second object. + * if it is unshared its bytes are copied by ckrealloc, so that we set + * the loop parameters to avoid copying them again: p points to the + * end of the already copied bytes, currPtr to the second object. */ objResultPtr = OBJ_AT_DEPTH(opnd-1); bytes = TclGetStringFromObj(objResultPtr, &length); #if !TCL_COMPILE_DEBUG - if (!Tcl_IsShared(objResultPtr)) { - Tcl_SetObjLength(objResultPtr, (length + appendLen)); + if (bytes != tclEmptyStringRep && !Tcl_IsShared(objResultPtr)) { + TclFreeIntRep(objResultPtr); + objResultPtr->typePtr = NULL; + objResultPtr->bytes = ckrealloc(bytes, (length + appendLen + 1)); + objResultPtr->length = length + appendLen; p = TclGetString(objResultPtr) + length; currPtr = &OBJ_AT_DEPTH(opnd - 2); } else { diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index c15bb10..6083931 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -15,7 +15,7 @@ * 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.24.2.2 2007/11/25 06:45:44 dgp Exp $ + * RCS: @(#) $Id: tclIORChan.c,v 1.24.2.3 2008/03/07 22:05:04 dgp Exp $ */ #include <tclInt.h> @@ -191,7 +191,7 @@ typedef enum { METH_READ, METH_SEEK, METH_WATCH, - METH_WRITE, + METH_WRITE } MethodName; #define FLAG(m) (1 << (m)) diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index a278a1d..f76fa1b 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -17,7 +17,7 @@ * 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.145.2.4 2008/01/25 16:43:53 dgp Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.145.2.5 2008/03/07 22:05:05 dgp Exp $ */ #include "tclInt.h" @@ -1670,13 +1670,8 @@ TclGetOpenModeEx( #endif } else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) { -#if defined(O_NDELAY) || defined(O_NONBLOCK) -# ifdef O_NONBLOCK +#ifdef O_NONBLOCK mode |= O_NONBLOCK; -# else - mode |= O_NDELAY; -# endif - #else if (interp != NULL) { Tcl_AppendResult(interp, "access mode \"", flag, diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 7156ff3..816943e 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -23,7 +23,7 @@ * 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.134.2.15 2007/12/06 16:27:46 dgp Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.134.2.16 2008/03/07 22:05:05 dgp Exp $ */ #include "tclInt.h" @@ -2699,18 +2699,20 @@ GetNamespaceFromObj( Tcl_Namespace **nsPtrPtr) /* Result namespace pointer goes here. */ { ResolvedNsName *resNamePtr; - Namespace *nsPtr; + Namespace *nsPtr, *refNsPtr; if (objPtr->typePtr == &nsNameType) { /* - * Check that the ResolvedNsName is still valid. + * Check that the ResolvedNsName is still valid; avoid letting the ref + * cross interps. */ resNamePtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1; nsPtr = resNamePtr->nsPtr; - if (!(nsPtr->flags & NS_DYING) - && ((resNamePtr->refNsPtr == NULL) || (resNamePtr->refNsPtr - == (Namespace *) Tcl_GetCurrentNamespace(interp)))) { + 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; } diff --git a/generic/tclResult.c b/generic/tclResult.c index 80feaee..355cf92 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -8,7 +8,7 @@ * 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.36.2.5 2007/11/13 13:07:42 dgp Exp $ + * RCS: @(#) $Id: tclResult.c,v 1.36.2.6 2008/03/07 22:05:06 dgp Exp $ */ #include "tclInt.h" @@ -1494,6 +1494,7 @@ Tcl_SetReturnOptions( int objc, level, code; Tcl_Obj **objv, *mergedOpts; + Tcl_IncrRefCount(options); if (TCL_ERROR == TclListObjGetElements(interp, options, &objc, &objv) || (objc % 2)) { Tcl_ResetResult(interp); diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 23fdcfd..6855272 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -33,7 +33,7 @@ * 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.65.2.3 2008/01/23 16:42:19 dgp Exp $ */ + * RCS: @(#) $Id: tclStringObj.c,v 1.65.2.4 2008/03/07 22:05:06 dgp Exp $ */ #include "tclInt.h" #include "tommath.h" @@ -2154,6 +2154,9 @@ Tcl_AppendFormatToObj( } bits /= base; } + if (useBig) { + mp_clear(&big); + } if (gotPrecision) { while (length < precision) { Tcl_AppendToObj(segment, "0", 1); diff --git a/generic/tclUtil.c b/generic/tclUtil.c index b490e55..961e5cd 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -11,7 +11,7 @@ * 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.82.2.6 2007/12/11 16:19:56 dgp Exp $ + * RCS: @(#) $Id: tclUtil.c,v 1.82.2.7 2008/03/07 22:05:06 dgp Exp $ */ #include "tclInt.h" @@ -3270,7 +3270,7 @@ TclReToGlob( Tcl_DString *dsPtr, int *exactPtr) { - int anchorLeft, anchorRight; + int anchorLeft, anchorRight, lastIsStar; char *dsStr, *dsStrStart, *msg; const char *p, *strEnd; @@ -3300,11 +3300,16 @@ TclReToGlob( /* * 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; @@ -3312,6 +3317,7 @@ TclReToGlob( } else { anchorLeft = 0; *dsStr++ = '*'; + lastIsStar = 1; } for ( ; p < strEnd; p++) { @@ -3364,14 +3370,16 @@ TclReToGlob( if (p+1 < strEnd) { if (p[1] == '*') { p++; - if ((dsStr == dsStrStart) || (dsStr[-1] != '*')) { + if (!lastIsStar) { *dsStr++ = '*'; + lastIsStar = 1; } continue; } else if (p[1] == '+') { p++; *dsStr++ = '?'; *dsStr++ = '*'; + lastIsStar = 1; continue; } } @@ -3393,8 +3401,9 @@ TclReToGlob( *dsStr++ = *p; break; } + lastIsStar = 0; } - if (!anchorRight && ((dsStr == dsStrStart) || (dsStr[-1] != '*'))) { + if (!anchorRight && !lastIsStar) { *dsStr++ = '*'; } Tcl_DStringSetLength(dsPtr, dsStr - dsStrStart); diff --git a/library/clock.tcl b/library/clock.tcl index 512fdfc..30cca18 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -13,7 +13,7 @@ # 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.43.2.1 2007/09/04 17:43:59 dgp Exp $ +# RCS: @(#) $Id: clock.tcl,v 1.43.2.2 2008/03/07 22:05:06 dgp Exp $ # #---------------------------------------------------------------------- @@ -644,6 +644,9 @@ proc ::tcl::clock::Initialize {} { # comprising start time, UTC offset, # Daylight Saving Time indicator, and # time zone abbreviation. + variable FormatProc; # Array mapping format group + # and locale to the name of a procedure + # that renders the given format } ::tcl::clock::Initialize @@ -661,74 +664,12 @@ proc ::tcl::clock::Initialize {} { proc ::tcl::clock::format { args } { + variable FormatProc variable TZData - set format {} - - # Check the count of args - - if { [llength $args] < 1 || [llength $args] % 2 != 1 } { - set cmdName "clock format" - return -code error \ - -errorcode [list CLOCK wrongNumArgs] \ - "wrong \# args: should be\ - \"$cmdName clockval\ - ?-format string? ?-gmt boolean?\ - ?-locale LOCALE? ?-timezone ZONE?\"" - } - - # Set defaults + lassign [ParseFormatArgs {*}$args] format locale timezone + set locale [string tolower $locale] set clockval [lindex $args 0] - set format {%a %b %d %H:%M:%S %Z %Y} - set gmt 0 - set locale C - set timezone {} - - # Pick up command line options. - - foreach { flag value } [lreplace $args 0 0] { - set saw($flag) {} - switch -exact -- $flag { - -f - -fo - -for - -form - -forma - -format { - set format $value - } - -g - -gm - -gmt { - set gmt $value - } - -l - -lo - -loc - -loca - -local - -locale { - set locale $value - } - -t - -ti - -tim - -time - -timez - -timezo - -timezon - -timezone { - set timezone $value - } - default { - return -code error \ - -errorcode [list CLOCK badSwitch $flag] \ - "bad switch \"$flag\",\ - must be -format, -gmt, -locale or -timezone" - } - } - } - - # Check options for validity - - if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } { - return -code error \ - -errorcode [list CLOCK gmtWithTimezone] \ - "cannot use -gmt and -timezone in same call" - } - if { ![string is wide -strict $clockval] } { - return -code error \ - "expected integer but got \"$clockval\"" - } - if { ![string is boolean -strict $gmt] } { - return -code error \ - "expected boolean value but got \"$gmt\"" - } else { - if { $gmt } { - set timezone :GMT - } - } # Get the data for time changes in the given zone @@ -742,10 +683,19 @@ proc ::tcl::clock::format { args } { } } - # Format the result + # Build a procedure to format the result. Cache the built procedure's + # name in the 'FormatProc' array to avoid losing its internal + # representation, which contains the name resolution. + + set procName ::tcl::clock::formatproc'$format'$locale + if {[info exists FormatProc($procName)]} { + set procName $FormatProc($procName) + } else { + set FormatProc($procName) \ + [ParseClockFormatFormat $procName $format $locale] + } - set formatter [ParseClockFormatFormat $format $locale] - return [$formatter $clockval $timezone] + return [$procName $clockval $timezone] } @@ -764,10 +714,9 @@ proc ::tcl::clock::format { args } { # #---------------------------------------------------------------------- -proc ::tcl::clock::ParseClockFormatFormat {format locale} { +proc ::tcl::clock::ParseClockFormatFormat {procName format locale} { - set procName [namespace current]::formatproc'$format'$locale - if {[namespace which $procName] != {}} { + if {[namespace which $procName] ne {}} { return $procName } @@ -1274,7 +1223,7 @@ proc ::tcl::clock::scan { args } { set string [lindex $args 0] set format {} set gmt 0 - set locale C + set locale c set timezone [GetSystemTimeZone] # Pick up command line options. @@ -1292,7 +1241,7 @@ proc ::tcl::clock::scan { args } { set gmt $value } -l - -lo - -loc - -loca - -local - -locale { - set locale $value + set locale [string tolower $value] } -t - -ti - -tim - -time - -timez - -timezo - -timezon - -timezone { set timezone $value @@ -1422,15 +1371,15 @@ proc ::tcl::clock::FreeScan { string base timezone locale } { return -code error "unable to convert date-time string \"$string\"" } - foreach { parseDate parseTime parseZone parseRel - parseWeekday parseOrdinalMonth } $result break + lassign $result parseDate parseTime parseZone parseRel \ + parseWeekday parseOrdinalMonth # If the caller supplied a date in the string, update the 'date' dict # with the value. If the caller didn't specify a time with the date, # default to midnight. if { [llength $parseDate] > 0 } { - foreach { y m d } $parseDate break + lassign $parseDate y m d if { $y < 100 } { if { $y >= 39 } { incr y 1900 @@ -1454,7 +1403,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } { # a time zone indicator of +-hhmm. if { [llength $parseZone] > 0 } { - foreach { minEast dstFlag } $parseZone break + lassign $parseZone minEast dstFlag set timezone [FormatNumericTimeZone \ [expr { 60 * $minEast + 3600 * $dstFlag }]] SetupTimeZone $timezone @@ -1485,7 +1434,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } { # Do relative times if { [llength $parseRel] > 0 } { - foreach { relMonth relDay relSecond } $parseRel break + lassign $parseRel relMonth relDay relSecond set seconds [add $seconds \ $relMonth months $relDay days $relSecond seconds \ -timezone $timezone -locale $locale] @@ -1495,7 +1444,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } { if { [llength $parseWeekday] > 0 } { - foreach {dayOrdinal dayOfWeek} $parseWeekday break + lassign $parseWeekday dayOrdinal dayOfWeek set date2 [GetDateFields $seconds $TZData($timezone) 2361222] dict set date2 era CE set jdwkday [WeekdayOnOrBefore $dayOfWeek \ @@ -1523,7 +1472,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } { if { [llength $parseOrdinalMonth] > 0 } { - foreach {monthOrdinal monthNumber} $parseOrdinalMonth break + lassign $parseOrdinalMonth monthOrdinal monthNumber if { $monthOrdinal > 0 } { set monthDiff [expr { $monthNumber - [dict get $date month] }] if { $monthDiff <= 0 } { @@ -1647,7 +1596,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { dict set l [string tolower $full] $i incr i } - foreach { regex lookup } [UniquePrefixRegexp $l] break + lassign [UniquePrefixRegexp $l] regex lookup append re ( $regex ) dict set fieldSet dayOfWeek [incr fieldCount] append postcode "dict set date dayOfWeek \[" \ @@ -1665,7 +1614,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { dict set l [string tolower $abr] $i dict set l [string tolower $full] $i } - foreach { regex lookup } [UniquePrefixRegexp $l] break + lassign [UniquePrefixRegexp $l] regex lookup append re ( $regex ) dict set fieldSet month [incr fieldCount] append postcode "dict set date month \[" \ @@ -1764,7 +1713,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { p - P { # AM/PM indicator set l [list [string tolower [mc AM]] 0 \ [string tolower [mc PM]] 1] - foreach { regex lookup } [UniquePrefixRegexp $l] break + lassign [UniquePrefixRegexp $l] regex lookup append re ( $regex ) dict set fieldSet amPmIndicator [incr fieldCount] append postcode "dict set date amPmIndicator \[" \ @@ -1890,10 +1839,10 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { C { # Locale-dependent era set d {} foreach triple [mc LOCALE_ERAS] { - foreach {t symbol year} $triple break + lassign $triple t symbol year dict set d [string tolower $symbol] $year } - foreach { regex lookup } [UniquePrefixRegexp $d] break + lassign [UniquePrefixRegexp $d] regex lookup append re (?: $regex ) } E { @@ -1904,7 +1853,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { dict set l c.e. CE dict set l b.c. BCE dict set l a.d. CE - foreach {regex lookup} [UniquePrefixRegexp $l] break + lassign [UniquePrefixRegexp $l] regex lookup append re ( $regex ) dict set fieldSet era [incr fieldCount] append postcode "dict set date era \["\ @@ -1914,8 +1863,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { "\]\n" } y { # Locale-dependent year of the era - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex incr captureCount } @@ -1932,8 +1880,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { %O { switch -exact -- $c { d - e { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet dayOfMonth [incr fieldCount] append postcode "dict set date dayOfMonth \[" \ @@ -1942,8 +1889,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { "\]\n" } H - k { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet hour [incr fieldCount] append postcode "dict set date hour \[" \ @@ -1952,8 +1898,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { "\]\n" } I - l { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet hourAMPM [incr fieldCount] append postcode "dict set date hourAMPM \[" \ @@ -1962,8 +1907,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { "\]\n" } m { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet month [incr fieldCount] append postcode "dict set date month \[" \ @@ -1972,8 +1916,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { "\]\n" } M { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet minute [incr fieldCount] append postcode "dict set date minute \[" \ @@ -1982,8 +1925,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { "\]\n" } S { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet second [incr fieldCount] append postcode "dict set date second \[" \ @@ -1992,8 +1934,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { "\]\n" } u - w { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet dayOfWeek [incr fieldCount] append postcode "set dow \[dict get " [list $lookup] \ @@ -2010,8 +1951,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { } } y { - foreach {regex lookup} \ - [LocaleNumeralMatcher $locale] break + lassign [LocaleNumeralMatcher $locale] regex lookup append re $regex dict set fieldSet yearOfCentury [incr fieldCount] append postcode {dict set date yearOfCentury } \[ \ @@ -2440,7 +2380,7 @@ proc ::tcl::clock::EnterLocale { locale oldLocaleVar } { set locale ${oldLocale}_windows if { ![dict exists $McLoaded $locale] } { LoadWindowsDateTimeFormats $locale - dict set mcloaded $locale {} + dict set McLoaded $locale {} } } } @@ -2636,7 +2576,7 @@ proc ::tcl::clock::LocalizeFormat { locale format } { %EY [mc LOCALE_YEAR_FORMAT]\ %+ {%a %b %e %H:%M:%S %Z %Y}] $format] - dict set McLoaded $locale FORMAT $format $inFormat + dict set McLoaded $locale FORMAT $inFormat $format return $format } @@ -3364,13 +3304,12 @@ proc ::tcl::clock::GuessWindowsTimeZone {} { set tzname {} } if { $tzname eq {} || [dict get $TimeZoneBad $tzname] } { - foreach { - bias stdBias dstBias - stdYear stdMonth stdDayOfWeek stdDayOfMonth - stdHour stdMinute stdSecond stdMillisec - dstYear dstMonth dstDayOfWeek dstDayOfMonth + lassign $data \ + bias stdBias dstBias \ + stdYear stdMonth stdDayOfWeek stdDayOfMonth \ + stdHour stdMinute stdSecond stdMillisec \ + dstYear dstMonth dstDayOfWeek dstDayOfMonth \ dstHour dstMinute dstSecond dstMillisec - } $data break set stdDelta [expr { $bias + $stdBias }] set dstDelta [expr { $bias + $dstBias }] if { $stdDelta <= 0 } { @@ -3647,7 +3586,7 @@ proc ::tcl::clock::ReadZoneinfoFile {fileName fname} { return -code error "$fileName has times out of order" } set lastTime $t - foreach { gmtoff isDst abbrInd } [lindex $types $c] break + lassign [lindex $types $c] gmtoff isDst abbrInd set abbrev [dict get $abbrevs $abbrInd] lappend r [list $t $gmtoff $isDst $abbrev] } @@ -3664,7 +3603,7 @@ proc ::tcl::clock::ReadZoneinfoFile {fileName fname} { if {[llength $posix] > 0} { set posixFields [ParsePosixTimeZone $posix] foreach tuple [ProcessPosixTimeZone $posixFields] { - foreach {t gmtoff isDst abbrev} $tuple break + lassign $tuple t gmtoff isDst abbrev if {$t > $lastTime} { lappend r $tuple } @@ -4393,7 +4332,7 @@ proc ::tcl::clock::add { clockval args } { set offsets {} set gmt 0 - set locale C + set locale c set timezone [GetSystemTimeZone] foreach { a b } $args { @@ -4410,7 +4349,7 @@ proc ::tcl::clock::add { clockval args } { set gmt $b } -l - -lo - -loc - -loca - -local - -locale { - set locale $b + set locale [string tolower $b] } -t - -ti - -tim - -time - -timez - -timezo - -timezon - -timezone { @@ -4692,6 +4631,7 @@ proc ::tcl::clock::mc { name } { proc ::tcl::clock::ClearCaches {} { + variable FormatProc variable LocaleNumeralCache variable McLoaded variable CachedSystemTimeZone @@ -4704,6 +4644,7 @@ proc ::tcl::clock::ClearCaches {} { rename $p {} } + catch {unset FormatProc} set LocaleNumeralCache {} set McLoaded {} catch {unset CachedSystemTimeZone} diff --git a/library/http/http.tcl b/library/http/http.tcl index f307a20..e59d12c 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -8,7 +8,7 @@ # 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.60 2007/03/12 22:08:40 patthoyts Exp $ +# RCS: @(#) $Id: http.tcl,v 1.60.2.1 2008/03/07 22:05:06 dgp Exp $ # Rough version history: # 1.0 Old http_get interface. @@ -24,7 +24,7 @@ package require Tcl 8.4 # Keep this in sync with pkgIndex.tcl and with the install directories # in Makefiles -package provide http 2.5.3 +package provide http 2.5.5 namespace eval http { variable http @@ -482,19 +482,26 @@ proc http::geturl { url args } { fileevent $s writable [list http::Connect $token] http::wait $token - if {$state(status) eq "error"} { - # Something went wrong while trying to establish the connection. - # Clean up after events and such, but DON'T call the command - # callback (if available) because we're going to throw an - # exception from here instead. - set err [lindex $state(error) 0] - cleanup $token - return -code error $err - } elseif {$state(status) ne "connect"} { - # Likely to be connection timeout + 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) "" } - set state(status) "" } # Send data in cr-lf format, but accept any line terminators @@ -610,7 +617,7 @@ proc http::geturl { url args } { # if state(status) is error, it means someone's already called Finish # to do the above-described clean up. - if {$state(status) eq "error"} { + if {$state(status) ne "error"} { Finish $token $err 1 } cleanup $token @@ -632,6 +639,7 @@ proc http::data {token} { return $state(body) } proc http::status {token} { + if {![info exists $token]} { return "error" } variable $token upvar 0 $token state return $state(status) @@ -655,7 +663,11 @@ proc http::size {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 @@ -786,13 +798,9 @@ proc http::Event {token} { upvar 0 $token state set s $state(sock) - if {[eof $s]} { - Eof $token - return - } if {$state(state) eq "header"} { if {[catch {gets $s line} n]} { - Finish $token $n + return [Finish $token $n] } elseif {$n == 0} { variable encodings set state(state) body @@ -820,6 +828,7 @@ proc http::Event {token} { # Initiate a sequence of background fcopies fileevent $s readable {} CopyStart $s $token + return } } elseif {$n > 0} { if {[regexp -nocase {^content-type:(.+)$} $line x type]} { @@ -854,7 +863,7 @@ proc http::Event {token} { incr state(currentsize) $n } } err]} { - Finish $token $err + return [Finish $token $err] } else { if {[info exists state(-progress)]} { eval $state(-progress) \ @@ -862,6 +871,11 @@ proc http::Event {token} { } } } + + if {[eof $s]} { + Eof $token + return + } } # http::CopyStart @@ -957,7 +971,7 @@ proc http::wait {token} { vwait $token\(status) } - return $state(status) + return [status $token] } # http::formatQuery -- @@ -1037,3 +1051,7 @@ proc http::ProxyRequired {host} { return [list $http(-proxyhost) $http(-proxyport)] } } + +# Local variables: +# indent-tabs-mode: t +# End: diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index af88a2e..cf6a1ff 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -9,4 +9,4 @@ # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.4]} {return} -package ifneeded http 2.5.3 [list tclPkgSetup $dir http 2.5.3 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] +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}}}] diff --git a/library/init.tcl b/library/init.tcl index 9346a90..14d1f0a 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -3,7 +3,7 @@ # Default system startup file for Tcl-based applications. Defines # "unknown" procedure and auto-load facilities. # -# RCS: @(#) $Id: init.tcl,v 1.91.2.9 2008/01/23 16:49:04 dgp Exp $ +# RCS: @(#) $Id: init.tcl,v 1.91.2.10 2008/03/07 22:05:06 dgp Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -17,7 +17,7 @@ if {[info commands package] == ""} { error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" } -package require -exact Tcl 8.5.1 +package require -exact Tcl 8.5.2 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: diff --git a/tests/clock.test b/tests/clock.test index 3632db6..cbbc758 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -11,7 +11,7 @@ # 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.79.2.1 2007/09/04 17:44:04 dgp Exp $ +# RCS: @(#) $Id: clock.test,v 1.79.2.2 2008/03/07 22:05:06 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -272,9 +272,13 @@ test clock-1.3 "clock format - empty val" { clock format 0 -gmt 1 -format "" } {} -test clock-1.4 "clock format - bad flag" { +test clock-1.4 "clock format - bad flag" {*}{ + -body { list [catch {clock format 0 -oops badflag} msg] $msg $::errorCode -} {1 {bad switch "-oops", must be -format, -gmt, -locale or -timezone} {CLOCK badSwitch -oops}} + } + -match glob + -result {1 {bad switch "-oops": must be -format, -gmt, -locale, or -timezone} {CLOCK badSwitch -oops}} +} test clock-1.5 "clock format - bad timezone" { list [catch {clock format 0 -format "%s" -timezone :NOWHERE} msg] $msg $::errorCode @@ -36588,6 +36592,42 @@ 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 diff --git a/tests/cmdIL.test b/tests/cmdIL.test index 78dcb0a..37ea427 100644 --- a/tests/cmdIL.test +++ b/tests/cmdIL.test @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: cmdIL.test,v 1.33.2.2 2008/01/23 16:42:20 dgp Exp $ +# RCS: @(#) $Id: cmdIL.test,v 1.33.2.3 2008/03/07 22:05:07 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -755,7 +755,7 @@ test cmdIL-7.7 {lreverse command - empty object [Bug 1876793]} { } {} testConstraint testobj [llength [info commands testobj]] -test cmdIL-7.7 {lreverse command - shared intrep [Bug 1675044]} -setup { +test cmdIL-7.8 {lreverse command - shared intrep [Bug 1675044]} -setup { teststringobj set 1 {1 2 3} testobj convert 1 list testobj duplicate 1 2 diff --git a/tests/execute.test b/tests/execute.test index bc54725..c795e3f 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -14,7 +14,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: execute.test,v 1.24 2006/11/03 00:34:52 hobbs Exp $ +# RCS: @(#) $Id: execute.test,v 1.24.2.1 2008/03/07 22:05:07 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -34,6 +34,7 @@ testConstraint testobj [expr { }] testConstraint longIs32bit [expr {int(0x80000000) < 0}] +testConstraint testexprlongobj [llength [info commands testexprlongobj]] # Tests for the omnibus TclExecuteByteCode function: @@ -584,12 +585,188 @@ test execute-6.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName o } p } {} - test execute-6.2 {Evaluate an expression in a variable; compile the first time, do not the second} { set w {3*5} proc a {obj} {expr $obj} set res "[a $w]:[a $w]" } {15:15} +test execute-6.3 {Tcl_ExprObj: don't use cached script bytecode [Bug 1899164]} -setup { + proc 0+0 {} {return SCRIPT} +} -body { + set e { 0+0 } + if 1 $e + if 1 {expr $e} +} -cleanup { + rename 0+0 {} +} -result 0 +test execute-6.4 {TclCompEvalObj: don't use cached expr bytecode [Bug 1899164]} -setup { + proc 0+0 {} {return SCRIPT} +} -body { + set e { 0+0 } + if 1 {expr $e} + if 1 $e +} -cleanup { + rename 0+0 {} +} -result SCRIPT +test execute-6.5 {TclCompEvalObj: bytecode epoch validation} { + set script { llength {} } + set result {} + lappend result [if 1 $script] + set origName [namespace which llength] + rename $origName llength.orig + proc $origName {args} {return AHA!} + lappend result [if 1 $script] + rename $origName {} + rename llength.orig $origName + set result +} {0 AHA!} +test execute-6.6 {TclCompEvalObj: proc-body bytecode invalid for script} { + proc foo {} {set a 1} + set a untouched + set result {} + lappend result [foo] $a + lappend result [if 1 [info body foo]] $a + rename foo {} + set result +} {1 untouched 1 1} +test execute-6.7 {TclCompEvalObj: bytecode context validation} { + set script { llength {} } + namespace eval foo { + proc llength {args} {return AHA!} + } + set result {} + lappend result [if 1 $script] + lappend result [namespace eval foo $script] + namespace delete foo + set result +} {0 AHA!} +test execute-6.8 {TclCompEvalObj: bytecode name resolution epoch validation} { + set script { llength {} } + set result {} + lappend result [namespace eval foo $script] + namespace eval foo { + proc llength {args} {return AHA!} + } + lappend result [namespace eval foo $script] + namespace delete foo + set result +} {0 AHA!} +test execute-6.9 {TclCompEvalObj: bytecode interp validation} { + set script { llength {} } + interp create slave + slave eval {proc llength args {return AHA!}} + set result {} + lappend result [if 1 $script] + lappend result [slave eval $script] + interp delete slave + set result +} {0 AHA!} +test execute-6.10 {TclCompEvalObj: bytecode interp validation} { + set script { llength {} } + interp create slave + set result {} + lappend result [slave eval $script] + interp delete slave + interp create slave + lappend result [slave eval $script] + interp delete slave + set result +} {0 0} +test execute-6.11 {Tcl_ExprObj: exprcode interp validation} testexprlongobj { + set e { [llength {}]+1 } + set result {} + interp create slave + load {} Tcltest slave + interp alias {} e slave testexprlongobj + lappend result [e $e] + interp delete slave + interp create slave + load {} Tcltest slave + interp alias {} e slave testexprlongobj + lappend result [e $e] + interp delete slave + set result +} {{This is a result: 1} {This is a result: 1}} +test execute-6.12 {Tcl_ExprObj: exprcode interp validation} { + set e { [llength {}]+1 } + set result {} + interp create slave + interp alias {} e slave expr + lappend result [e $e] + interp delete slave + interp create slave + interp alias {} e slave expr + lappend result [e $e] + interp delete slave + set result +} {1 1} +test execute-6.13 {Tcl_ExprObj: exprcode epoch validation} { + set e { [llength {}]+1 } + set result {} + lappend result [expr $e] + set origName [namespace which llength] + rename $origName llength.orig + proc $origName {args} {return 1} + lappend result [expr $e] + rename $origName {} + rename llength.orig $origName + set result +} {1 2} +test execute-6.14 {Tcl_ExprObj: exprcode context validation} { + set e { [llength {}]+1 } + namespace eval foo { + proc llength {args} {return 1} + } + set result {} + lappend result [expr $e] + lappend result [namespace eval foo {expr $e}] + namespace delete foo + set result +} {1 2} +test execute-6.15 {Tcl_ExprObj: exprcode name resolution epoch validation} { + set e { [llength {}]+1 } + set result {} + lappend result [namespace eval foo {expr $e}] + namespace eval foo { + proc llength {args} {return 1} + } + lappend result [namespace eval foo {expr $e}] + namespace delete foo + set result +} {1 2} +test execute-6.16 {Tcl_ExprObj: exprcode interp validation} { + set e { [llength {}]+1 } + interp create slave + interp alias {} e slave expr + slave eval {proc llength args {return 1}} + set result {} + lappend result [expr $e] + lappend result [e $e] + interp delete slave + set result +} {1 2} +test execute-6.17 {Tcl_ExprObj: exprcode context validation} { + set e { $v } + proc foo e {set v 0; expr $e} + proc bar e {set v 1; expr $e} + set result {} + lappend result [foo $e] + lappend result [bar $e] + rename foo {} + rename bar {} + set result +} {0 1} +test execute-6.18 {Tcl_ExprObj: exprcode context validation} { + set e { [llength $v] } + proc foo e {set v {}; expr $e} + proc bar e {set v v; expr $e} + set result {} + lappend result [foo $e] + lappend result [bar $e] + rename foo {} + rename bar {} + set result +} {0 1} test execute-7.0 {Wide int handling in INST_JUMP_FALSE/LAND} { set x 0x100000000 diff --git a/tests/interp.test b/tests/interp.test index 7409993..af5bbc6 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -10,7 +10,7 @@ # 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.51.2.1 2007/12/10 18:32:57 dgp Exp $ +# RCS: @(#) $Id: interp.test,v 1.51.2.2 2008/03/07 22:05:08 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -2360,6 +2360,23 @@ test interp-28.1 {getting fooled by slave's namespace ?} { 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 diff --git a/tests/regexpComp.test b/tests/regexpComp.test index c104a69..c7a5980 100644 --- a/tests/regexpComp.test +++ b/tests/regexpComp.test @@ -802,13 +802,13 @@ test regexpComp-21.11 {regexp command compiling tests} { } } {0 {}} -test regexpComp-22.1 {Bug 1810038} { +test regexpComp-22.0.1 {Bug 1810038} { evalInProc { regexp ($|^X)* {} } } 1 -test regexpComp-22.2 {regexp compile and backrefs, Bug 1857126} { +test regexpComp-22.0.2 {regexp compile and backrefs, Bug 1857126} { evalInProc { regexp -- {([bc])\1} bb } @@ -909,6 +909,22 @@ test regexpComp-24.9 {regexp command compiling tests} { 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 diff --git a/tests/set.test b/tests/set.test index 07d8f01..5377312 100644 --- a/tests/set.test +++ b/tests/set.test @@ -10,13 +10,15 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: set.test,v 1.11.4.2 2007/11/05 14:20:57 dgp Exp $ +# RCS: @(#) $Id: set.test,v 1.11.4.3 2008/03/07 22:05:08 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } +testConstraint testset2 [llength [info commands testset2]] + catch {unset x} catch {unset i} @@ -514,7 +516,7 @@ test set-4.6 {set command: runtime error, basic array operations} { list [catch {$z a} msg] $msg } {1 {can't read "a": variable is array}} -test set-5.1 {error on malformed array name} { +test set-5.1 {error on malformed array name} testset2 { unset -nocomplain z catch {testset2 z(a) b} msg catch {testset2 z(b) a} msg1 diff --git a/tests/switch.test b/tests/switch.test index 612131d..0aaa6ad 100644 --- a/tests/switch.test +++ b/tests/switch.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: switch.test,v 1.16.4.2 2008/01/23 16:42:21 dgp Exp $ +# RCS: @(#) $Id: switch.test,v 1.16.4.3 2008/03/07 22:05:08 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -501,6 +501,12 @@ rename cswtest-exact {} rename iswtest-exact {} rename cswtest2-exact {} rename iswtest2-exact {} +# Bug 1891827 +test switch-10.15 {(not) compiled exact nocase regression} { + apply {{} { + switch -nocase -- A { a {return yes} default {return no} } + }} +} yes # Added due to TIP#75 test switch-11.1 {regexp matching with -matchvar} { diff --git a/unix/Makefile.in b/unix/Makefile.in index 818c651..c9e102d 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -4,7 +4,7 @@ # "./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.207.2.13 2007/12/04 16:55:54 dgp Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.207.2.14 2008/03/07 22:05:08 dgp Exp $ VERSION = @TCL_VERSION@ MAJOR_VERSION = @TCL_MAJOR_VERSION@ @@ -782,8 +782,8 @@ install-libraries: libraries $(INSTALL_TZDATA) install-msgs do \ $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/http1.0; \ done; - @echo "Installing package http 2.5.3 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.5.3.tm; + @echo "Installing 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 \ diff --git a/unix/README b/unix/README index 2c92bf4..962c423 100644 --- a/unix/README +++ b/unix/README @@ -1,159 +1,175 @@ Tcl UNIX README --------------- -RCS: @(#) $Id: README,v 1.26.8.3 2008/01/23 16:42:21 dgp Exp $ +RCS: @(#) $Id: README,v 1.26.8.4 2008/03/07 22:05:08 dgp Exp $ -This is the directory where you configure, compile, test, and install -UNIX versions of Tcl. This directory also contains source files for Tcl -that are specific to UNIX. Some of the files in this directory are -used on the PC or MacOSX platform too, but they all depend on UNIX -(POSIX/ANSI C) interfaces and some of them only make sense under UNIX. +This is the directory where you configure, compile, test, and install UNIX +versions of Tcl. This directory also contains source files for Tcl that are +specific to UNIX. Some of the files in this directory are used on the PC or +MacOSX platform too, but they all depend on UNIX (POSIX/ANSI C) interfaces and +some of them only make sense under UNIX. Updated forms of the information found in this file is available at: http://www.tcl.tk/doc/howto/compile.html#unix -For information on platforms where Tcl is known to compile, along -with any porting notes for getting it to work on those platforms, see: +For information on platforms where Tcl is known to compile, along with any +porting notes for getting it to work on those platforms, see: http://www.tcl.tk/software/tcltk/platforms.html -The rest of this file contains instructions on how to do this. The -release should compile and run either "out of the box" or with trivial -changes on any UNIX-like system that approximates POSIX, BSD, or System -V. We know that it runs on workstations from Sun, H-P, DEC, IBM, and -SGI, as well as PCs running Linux, BSDI, and SCO UNIX. To compile for -a PC running Windows, see the README file in the directory ../win. To -compile for MacOSX, see the README file in the directory ../macosx. +The rest of this file contains instructions on how to do this. The release +should compile and run either "out of the box" or with trivial changes on any +UNIX-like system that approximates POSIX, BSD, or System V. We know that it +runs on workstations from Sun, H-P, DEC, IBM, and SGI, as well as PCs running +Linux, BSDI, and SCO UNIX. To compile for a PC running Windows, see the README +file in the directory ../win. To compile for MacOSX, see the README file in +the directory ../macosx. How To Compile And Install Tcl: ------------------------------- (a) If you have already compiled Tcl once in this directory and are now preparing to compile again in the same directory but for a different - platform, or if you have applied patches, type "make distclean" to - discard all the configuration information computed previously. + platform, or if you have applied patches, type "make distclean" to discard + all the configuration information computed previously. -(b) If you need to reconfigure because you changed any of the .in or - .m4 files, you will need to run autoconf to create a new - ./configure script. Most users will NOT need to do this since - a configure script is already provided. +(b) If you need to reconfigure because you changed any of the .in or .m4 + files, you will need to run autoconf to create a new ./configure script. + Most users will NOT need to do this since a configure script is already + provided. (in the tcl/unix directory) autoconf -(c) Type "./configure". This runs a configuration script created by GNU - autoconf, which configures Tcl for your system and creates a - Makefile. The configure script allows you to customize the Tcl - configuration for your site; for details on how you can do this, - type "./configure -help" or refer to the autoconf documentation (not - included here). Tcl's "configure" supports the following special - switches in addition to the standard ones: - --enable-threads If this switch is set, Tcl will compile - itself with multithreading support. +(c) Type "./configure". This runs a configuration script created by GNU + autoconf, which configures Tcl for your system and creates a Makefile. The + configure script allows you to customize the Tcl configuration for your + site; for details on how you can do this, type "./configure --help" or + refer to the autoconf documentation (not included here). Tcl's "configure" + supports the following special switches in addition to the standard ones: + + --enable-threads If this switch is set, Tcl will compile itself + with multithreading support. --disable-load If this switch is specified then Tcl will configure itself not to allow dynamic loading, even if your system appears to support it. - Normally you can leave this switch out and - Tcl will build itself for dynamic loading - if your system supports it. + Normally you can leave this switch out and Tcl + will build itself for dynamic loading if your + system supports it. + --disable-dll-unloading Disables support for the [unload] command even + on platforms that can support it. Meaningless + when Tcl is compiled with --disable-load. --enable-shared If this switch is specified, Tcl will compile itself as a shared library if it can figure - out how to do that on this platform. This - is the default on platforms where we know - how to build shared libraries. + out how to do that on this platform. This is + the default on platforms where we know how to + build shared libraries. --disable-shared If this switch is specified, Tcl will compile itself as a static library. - --enable-symbols build with debugging symbols. By default - standard debugging symbols are used. You - can specify the value "mem" to include - TCL_MEM_DEBUG memory debugging, "compile" - to include TCL_COMPILE_DEBUG debugging, or - "all" to enable all internal debugging. - --disable-symbols build without debugging symbols - --enable-64bit enable 64bit support (where applicable) - --disable-64bit disable 64bit support (where applicable) - --enable-64bit-vis enable 64bit Sparc VIS support - --disable-64bit-vis disable 64bit Sparc VIS support + --enable-symbols Build with debugging symbols. By default + standard debugging symbols are used. You can + specify the value "mem" to include + TCL_MEM_DEBUG memory debugging, "compile" to + include TCL_COMPILE_DEBUG debugging, or "all" + to enable all internal debugging. + --disable-symbols Build without debugging symbols + --enable-64bit Enable 64bit support (where applicable) + --disable-64bit Disable 64bit support (where applicable) + --enable-64bit-vis Enable 64bit Sparc VIS support + --disable-64bit-vis Disable 64bit Sparc VIS support --enable-langinfo Allows use of modern nl_langinfo check for - better localization support. This is on by + better localization support. This is on by default on platforms where nl_langinfo is found. --disable-langinfo Specifically disables use of nl_langinfo. --enable-man-symlinks Use symlinks for linking the manpages that should be reachable under several names. + --enable-man-suffix[=STRING] + Append STRING to the names of installed manual + pages (prior to applying compression, if that + is also enabled). If STRING is omitted, + defaults to 'tcl'. --enable-man-compression=PROG Compress the manpages using PROG. --enable-dtrace Enable tcl DTrace provider (if DTrace is available on the platform), c.f. tclDTrace.d for descriptions of the probes made available, - see http://wiki.tcl.tk/DTrace for more details. - Mac OS X only: - --enable-framework package Tcl as a framework. - --disable-corefoundation disable use of CoreFoundation API and revert to - standard select based notifier, required when - using naked fork (i.e. not followed by execve). - - Note: by default gcc will be used if it can be located on the PATH. - If you want to use cc instead of gcc, set the CC environment variable - to "cc" before running configure. It is not safe to edit the - Makefile to use gcc after configure is run. Also note that - you should use the same compiler when building extensions. - - Note: be sure to use only absolute path names (those starting with "/") - in the --prefix and --exec-prefix options. - -(d) Type "make". This will create a library archive called - "libtcl<version>.a" or "libtcl<version>.so" and an interpreter - application called "tclsh" that allows you to type Tcl commands - interactively or execute script files. It will also create - a stub library archive "libtclstub<version>.a" that developers - may link against other C code to produce loadable extensions for Tcl. - -(e) If the make fails then you'll have to personalize the Makefile - for your site or possibly modify the distribution in other ways. - First check the porting Web page above to see if there are hints - for compiling on your system. If you need to modify Makefile, - there are comments at the beginning of it that describe the things - you might want to change and how to change them. - -(f) Type "make install" to install Tcl binaries and script files in - standard places. You'll need write permission on the installation - directories to do this. The installation directories are - determined by the "configure" script and may be specified with - the --prefix and --exec-prefix options to "configure". See the - Makefile for information on what directories were chosen; you - can override these choices by modifying the "prefix" and - "exec_prefix" variables in the Makefile. The installed binaries - have embedded within them path values relative to the install - directory. If you change your mind about where Tcl should be - installed, start this procedure over again from step (a) so that - the path embedded in the binaries agrees with the install location. + see http://wiki.tcl.tk/DTrace for more details + --with-encoding=ENCODING Specifies the encoding for compile-time + configuration values. Defaults to iso8859-1, + which is also sufficient for ASCII. + --with-tzdata=FLAG Specifies whether to install timezone data. By + default, the configure script tries to detect + whether a usable timezone database is present + on the system already. + + Mac OS X only (i.e. completely unsupported on other platforms): + + --enable-framework Package Tcl as a framework. + --disable-corefoundation Disable use of CoreFoundation API and revert + to standard select based notifier, required + when using naked fork (i.e. not followed by + execve). + + Note: by default gcc will be used if it can be located on the PATH. If you + want to use cc instead of gcc, set the CC environment variable to "cc" + before running configure. It is not safe to edit the Makefile to use gcc + after configure is run. Also note that you should use the same compiler + when building extensions. + + Note: be sure to use only absolute path names (those starting with "/") in + the --prefix and --exec-prefix options. + +(d) Type "make". This will create a library archive called "libtcl<version>.a" + or "libtcl<version>.so" and an interpreter application called "tclsh" that + allows you to type Tcl commands interactively or execute script files. It + will also create a stub library archive "libtclstub<version>.a" that + developers may link against other C code to produce loadable extensions + for Tcl. + +(e) If the make fails then you'll have to personalize the Makefile for your + site or possibly modify the distribution in other ways. First check the + porting Web page above to see if there are hints for compiling on your + system. If you need to modify Makefile, there are comments at the + beginning of it that describe the things you might want to change and how + to change them. + +(f) Type "make install" to install Tcl binaries and script files in standard + places. You'll need write permission on the installation directories to do + this. The installation directories are determined by the "configure" + script and may be specified with the standard --prefix and --exec-prefix + options to "configure". See the Makefile for information on what + directories were chosen; you can override these choices by modifying the + "prefix" and "exec_prefix" variables in the Makefile. The installed + binaries have embedded within them path values relative to the install + directory. If you change your mind about where Tcl should be installed, + start this procedure over again from step (a) so that the path embedded in + the binaries agrees with the install location. (g) At this point you can play with Tcl by running the installed "tclsh" - executable, or via the "make shell" target, and typing Tcl commands - at the interactive prompt. + executable, or via the "make shell" target, and typing Tcl commands at the + interactive prompt. If you have trouble compiling Tcl, see the URL noted above about working -platforms. It contains information that people have provided about changes -they had to make to compile Tcl in various environments. We're also -interested in hearing how to change the configuration setup so that Tcl -compiles on additional platforms "out of the box". +platforms. It contains information that people have provided about changes +they had to make to compile Tcl in various environments. We're also interested +in hearing how to change the configuration setup so that Tcl compiles on +additional platforms "out of the box". Test suite ---------- -There is a relatively complete test suite for all of the Tcl core in -the subdirectory "tests". To use it just type "make test" in this -directory. You should then see a printout of the test files processed. -If any errors occur, you'll see a much more substantial printout for -each error. See the README file in the "tests" directory for more -information on the test suite. Note: don't run the tests as superuser: -this will cause several of them to fail. If a test is failing -consistently, please send us a bug report with as much detail as you -can manage. Please use the online database at +There is a relatively complete test suite for all of the Tcl core in the +subdirectory "tests". To use it just type "make test" in this directory. You +should then see a printout of the test files processed. If any errors occur, +you'll see a much more substantial printout for each error. See the README +file in the "tests" directory for more information on the test suite. Note: +don't run the tests as superuser: this will cause several of them to fail. If +a test is failing consistently, please send us a bug report with as much +detail as you can manage. Please use the online database at http://tcl.sourceforge.net/ -The Tcl test suite is very sensitive to proper implementation of -ANSI C library procedures such as sprintf and sscanf. If the test -suite generates errors, most likely they are due to non-conformance -of your system's ANSI C library; such problems are unlikely to -affect any real applications so it's probably safe to ignore them. +The Tcl test suite is very sensitive to proper implementation of ANSI C +library procedures such as sprintf and sscanf. If the test suite generates +errors, most likely they are due to non-conformance of your system's ANSI C +library; such problems are unlikely to affect any real applications so it's +probably safe to ignore them. diff --git a/unix/configure b/unix/configure index 7050f10..1e5a28f 100755 --- a/unix/configure +++ b/unix/configure @@ -1335,7 +1335,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".1" +TCL_PATCH_LEVEL=".2" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ @@ -15093,29 +15093,56 @@ cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ - #include <sys/types.h> - #include <sys/socket.h> - #if STDC_HEADERS - #include <stdlib.h> - #include <stddef.h> - #endif + #include <sys/types.h> + #include <sys/socket.h> + +int +main () +{ + socklen_t foo; + + ; + return 0; +} _ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "(^|[^a-zA-Z_0-9])socklen_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then +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 - tcl_cv_type_socklen_t=no -fi -rm -f conftest* + 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 unsigned +#define socklen_t int _ACEOF fi diff --git a/unix/configure.in b/unix/configure.in index a7b92e6..a4f6bf6 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -3,7 +3,7 @@ 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.157.2.14 2008/02/04 16:05:27 dgp Exp $ +# RCS: @(#) $Id: configure.in,v 1.157.2.15 2008/03/07 22:05:10 dgp Exp $ AC_INIT([tcl],[8.5]) AC_PREREQ(2.59) @@ -27,7 +27,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".1" +TCL_PATCH_LEVEL=".2" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ @@ -321,18 +321,14 @@ AC_TYPE_SIZE_T AC_TYPE_UID_T AC_CACHE_CHECK([for socklen_t], tcl_cv_type_socklen_t, [ - AC_EGREP_CPP(changequote(<<,>>)dnl -<<(^|[^a-zA-Z_0-9])socklen_t[^a-zA-Z_0-9]>>dnl -changequote([,]),[ - #include <sys/types.h> - #include <sys/socket.h> - #if STDC_HEADERS - #include <stdlib.h> - #include <stddef.h> - #endif - ], tcl_cv_type_socklen_t=yes, tcl_cv_type_socklen_t=no)]) + 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, unsigned, [What is the type of socklen_t?]) + AC_DEFINE(socklen_t, int, [Define as int if socklen_t is not available]) fi AC_CHECK_TYPE([intptr_t], [ diff --git a/unix/tcl.spec b/unix/tcl.spec index 0400db7..2953d45 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -1,11 +1,11 @@ -# $Id: tcl.spec,v 1.27.2.6 2008/01/23 16:49:07 dgp Exp $ +# $Id: tcl.spec,v 1.27.2.7 2008/03/07 22:05:10 dgp Exp $ # This file is the basis for a binary Tcl RPM for Linux. %{!?directory:%define directory /usr/local} Name: tcl Summary: Tcl scripting language development environment -Version: 8.5.1 +Version: 8.5.2 Release: 2 License: BSD Group: Development/Languages diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in index 7443fd6..986c721 100644 --- a/unix/tclConfig.h.in +++ b/unix/tclConfig.h.in @@ -496,7 +496,7 @@ /* Define to `unsigned' if <sys/types.h> does not define. */ #undef size_t -/* What is the type of socklen_t? */ +/* Define as int if socklen_t is not available */ #undef socklen_t /* Do we want to use the strtod() in compat? */ diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index 2745e9b..2081adc 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -10,38 +10,12 @@ * 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.77.2.6 2007/12/04 16:55:54 dgp Exp $ + * RCS: @(#) $Id: tclUnixChan.c,v 1.77.2.7 2008/03/07 22:05:10 dgp Exp $ */ #include "tclInt.h" /* Internal definitions for Tcl. */ #include "tclIO.h" /* To get Channel type declaration. */ -/* - * sys/ioctl.h has already been included by tclPort.h. Including termios.h or - * termio.h causes a bunch of warning messages because some duplicate (but not - * contradictory) #defines exist in termios.h and/or termio.h - */ - -#undef NL0 -#undef NL1 -#undef CR0 -#undef CR1 -#undef CR2 -#undef CR3 -#undef TAB0 -#undef TAB1 -#undef TAB2 -#undef XTABS -#undef BS0 -#undef BS1 -#undef FF0 -#undef FF1 -#undef ECHO -#undef NOFLSH -#undef TOSTOP -#undef FLUSHO -#undef PENDIN - #define SUPPORTS_TTY #undef DIRECT_BAUD @@ -65,22 +39,6 @@ # define GETCONTROL(fd, intPtr) ioctl((fd), TIOCMGET, (intPtr)) # define SETCONTROL(fd, intPtr) ioctl((fd), TIOCMSET, (intPtr)) - /* - * TIP #35 introduced a different on exit flush/close behavior that does - * not work correctly with standard channels on all systems. The problem - * is tcflush throws away waiting channel data. This may be necessary for - * true serial channels that may block, but isn't correct in the standard - * case. This might be replaced with tcdrain instead, but that can block. - * For now, we revert to making this do nothing, and TtyOutputProc being - * the same old FileOutputProc. - hobbs [Bug #525783] - */ - -# define BAD_TIP35_FLUSH 0 -# if BAD_TIP35_FLUSH -# define TTYFLUSH(fd) tcflush((fd), TCIOFLUSH); -# else -# define TTYFLUSH(fd) -# endif /* BAD_TIP35_FLUSH */ # ifdef FIONREAD # define GETREADQUEUE(fd, int) ioctl((fd), FIONREAD, &(int)) # elif defined(FIORDCHK) @@ -106,6 +64,9 @@ # if !defined(CRTSCTS) && defined(CNEW_RTSCTS) # define CRTSCTS CNEW_RTSCTS # endif /* !CRTSCTS&CNEW_RTSCTS */ +# if !defined(PAREXT) && defined(CMSPAR) +# define PAREXT CMSPAR +# endif /* !PAREXT&&CMSPAR */ #else /* !USE_TERMIOS */ #ifdef USE_TERMIO @@ -158,8 +119,6 @@ typedef struct FileState { typedef struct TtyState { FileState fs; /* Per-instance state of the file descriptor. * Must be the first field. */ - int stateUpdated; /* Flag to say if the state has been modified - * and needs resetting. */ IOSTATE savedState; /* Initial state of device. Used to reset * state when device closed. */ } TtyState; @@ -270,8 +229,6 @@ static int TcpOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCode); static void TcpWatchProc(ClientData instanceData, int mask); #ifdef SUPPORTS_TTY -static int TtyCloseProc(ClientData instanceData, - Tcl_Interp *interp); static void TtyGetAttributes(int fd, TtyAttrs *ttyPtr); static int TtyGetOptionProc(ClientData instanceData, Tcl_Interp *interp, const char *optionName, @@ -282,10 +239,6 @@ static unsigned long TtyGetSpeed(int baud); #endif /* DIRECT_BAUD */ static FileState * TtyInit(int fd, int initialize); static void TtyModemStatusStr(int status, Tcl_DString *dsPtr); -#if BAD_TIP35_FLUSH -static int TtyOutputProc(ClientData instanceData, - const char *buf, int toWrite, int *errorCode); -#endif /* BAD_TIP35_FLUSH */ static int TtyParseMode(Tcl_Interp *interp, const char *mode, int *speedPtr, int *parityPtr, int *dataPtr, int *stopPtr); @@ -331,13 +284,9 @@ static Tcl_ChannelType fileChannelType = { static Tcl_ChannelType ttyChannelType = { "tty", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - TtyCloseProc, /* Close proc. */ + FileCloseProc, /* Close proc. */ FileInputProc, /* Input proc. */ -#if BAD_TIP35_FLUSH - TtyOutputProc, /* Output proc. */ -#else /* !BAD_TIP35_FLUSH */ FileOutputProc, /* Output proc. */ -#endif /* BAD_TIP35_FLUSH */ NULL, /* Seek proc. */ TtySetOptionProc, /* Set option proc. */ TtyGetOptionProc, /* Get option proc. */ @@ -404,29 +353,11 @@ FileBlockModeProc( * TCL_MODE_NONBLOCKING. */ { FileState *fsPtr = (FileState *) instanceData; - int curStatus; -#ifndef USE_FIONBIO - curStatus = fcntl(fsPtr->fd, F_GETFL); - if (mode == TCL_MODE_BLOCKING) { - CLEAR_BITS(curStatus, O_NONBLOCK); - } else { - SET_BITS(curStatus, O_NONBLOCK); - } - if (fcntl(fsPtr->fd, F_SETFL, curStatus) < 0) { - return errno; - } - curStatus = fcntl(fsPtr->fd, F_GETFL); -#else /* USE_FIONBIO */ - if (mode == TCL_MODE_BLOCKING) { - curStatus = 0; - } else { - curStatus = 1; - } - if (ioctl(fsPtr->fd, (int) FIONBIO, &curStatus) < 0) { + if (TclUnixSetBlockingMode(fsPtr->fd, mode) < 0) { return errno; } -#endif /* !USE_FIONBIO */ + return 0; } @@ -738,94 +669,6 @@ FileGetHandleProc( } #ifdef SUPPORTS_TTY -/* - *---------------------------------------------------------------------- - * - * TtyCloseProc -- - * - * This function is called from the generic IO level to perform - * channel-type-specific cleanup when a tty based channel is closed. - * - * Results: - * 0 if successful, errno if failed. - * - * Side effects: - * Closes the device of the channel. - * - *---------------------------------------------------------------------- - */ - -static int -TtyCloseProc( - ClientData instanceData, /* Tty state. */ - Tcl_Interp *interp) /* For error reporting - unused. */ -{ -#if BAD_TIP35_FLUSH - TtyState *ttyPtr = (TtyState *) instanceData; -#endif /* BAD_TIP35_FLUSH */ - -#ifdef TTYFLUSH - TTYFLUSH(ttyPtr->fs.fd); -#endif /* TTYFLUSH */ - -#if 0 - /* - * TIP#35 agreed to remove the unsave so that TCL could be used as a - * simple stty. It would be cleaner to remove all the stuff related to - * TtyState.stateUpdated - * TtyState.savedState - * Then the structure TtyState would be the same as FileState. IMO this - * cleanup could better be done for the final 8.4 release after nobody - * complained about the missing unsave. - schroedter - */ - if (ttyPtr->stateUpdated) { - SETIOSTATE(ttyPtr->fs.fd, &ttyPtr->savedState); - } -#endif - - return FileCloseProc(instanceData, interp); -} - -/* - *---------------------------------------------------------------------- - * - * TtyOutputProc-- - * - * This function is invoked from the generic IO level to write output to - * a TTY channel. - * - * Results: - * The number of bytes written is returned or -1 on error. An output - * argument contains a POSIX error code if an error occurred, or zero. - * - * Side effects: - * Writes output on the output device of the channel if the channel is - * not designated to be closed. - * - *---------------------------------------------------------------------- - */ - -#if BAD_TIP35_FLUSH -static int -TtyOutputProc( - ClientData instanceData, /* File state. */ - const char *buf, /* The data buffer. */ - int toWrite, /* How many bytes to write? */ - int *errorCodePtr) /* Where to store error code. */ -{ - if (TclInExit()) { - /* - * Do not write data during Tcl exit. Serial port may block preventing - * Tcl from exit. - */ - - return toWrite; - } - - return FileOutputProc(instanceData, buf, toWrite, errorCodePtr); -} -#endif /* BAD_TIP35_FLUSH */ - #ifdef USE_TERMIOS /* *---------------------------------------------------------------------- @@ -912,7 +755,6 @@ TtySetOptionProc( */ TtySetAttributes(fsPtr->fd, &tty); - ((TtyState *) fsPtr)->stateUpdated = 1; return TCL_OK; } @@ -1704,10 +1546,10 @@ TtyInit( int initialize) { TtyState *ttyPtr; + int stateUpdated = 0; ttyPtr = (TtyState *) ckalloc((unsigned) sizeof(TtyState)); GETIOSTATE(fd, &ttyPtr->savedState); - ttyPtr->stateUpdated = 0; if (initialize) { IOSTATE iostate = ttyPtr->savedState; @@ -1718,7 +1560,7 @@ TtyInit( iostate.c_cflag & CREAD || iostate.c_cc[VMIN] != 1 || iostate.c_cc[VTIME] != 0) { - ttyPtr->stateUpdated = 1; + stateUpdated = 1; } iostate.c_iflag = IGNBRK; iostate.c_oflag = 0; @@ -1741,7 +1583,7 @@ TtyInit( * Only update if we're changing anything to avoid possible blocking. */ - if (ttyPtr->stateUpdated) { + if (stateUpdated) { SETIOSTATE(fd, &iostate); } } @@ -1969,36 +1811,15 @@ TcpBlockModeProc( * TCL_MODE_NONBLOCKING. */ { TcpState *statePtr = (TcpState *) instanceData; - int setting; -#ifndef USE_FIONBIO - setting = fcntl(statePtr->fd, F_GETFL); if (mode == TCL_MODE_BLOCKING) { CLEAR_BITS(statePtr->flags, TCP_ASYNC_SOCKET); - CLEAR_BITS(setting, O_NONBLOCK); } else { SET_BITS(statePtr->flags, TCP_ASYNC_SOCKET); - SET_BITS(setting, O_NONBLOCK); } - if (fcntl(statePtr->fd, F_SETFL, setting) < 0) { + if (TclUnixSetBlockingMode(statePtr->fd, mode) < 0) { return errno; } -#else /* USE_FIONBIO */ - if (mode == TCL_MODE_BLOCKING) { - CLEAR_BITS(statePtr->flags, TCP_ASYNC_SOCKET); - setting = 0; - if (ioctl(statePtr->fd, (int) FIONBIO, &setting) == -1) { - return errno; - } - } else { - SET_BITS(statePtr->flags, TCP_ASYNC_SOCKET); - setting = 1; - if (ioctl(statePtr->fd, (int) FIONBIO, &setting) == -1) { - return errno; - } - } -#endif /* !USE_FIONBIO */ - return 0; } @@ -2026,7 +1847,6 @@ WaitForConnect( { int timeOut; /* How long to wait. */ int state; /* Of calling TclWaitForFile. */ - int flags; /* fcntl flags for the socket. */ /* * If an asynchronous connect is in progress, attempt to wait for it to @@ -2043,14 +1863,7 @@ WaitForConnect( state = TclUnixWaitForFile(statePtr->fd, TCL_WRITABLE | TCL_EXCEPTION, timeOut); if (!(statePtr->flags & TCP_ASYNC_SOCKET)) { -#ifndef USE_FIONBIO - flags = fcntl(statePtr->fd, F_GETFL); - CLEAR_BITS(flags, O_NONBLOCK); - (void) fcntl(statePtr->fd, F_SETFL, flags); -#else /* USE_FIONBIO */ - flags = 0; - (void) ioctl(statePtr->fd, FIONBIO, &flags); -#endif /* !USE_FIONBIO */ + (void) TclUnixSetBlockingMode(statePtr->fd, TCL_MODE_BLOCKING); } if (state & TCL_EXCEPTION) { return -1; @@ -2536,14 +2349,7 @@ CreateSocket( */ if (async) { -#ifndef USE_FIONBIO - curState = fcntl(sock, F_GETFL); - SET_BITS(curState, O_NONBLOCK); - status = fcntl(sock, F_SETFL, curState); -#else /* USE_FIONBIO */ - curState = 1; - status = ioctl(sock, FIONBIO, &curState); -#endif /* !USE_FIONBIO */ + status = TclUnixSetBlockingMode(sock, TCL_MODE_NONBLOCKING); } else { status = 0; } @@ -2565,14 +2371,7 @@ CreateSocket( */ if (async) { -#ifndef USE_FIONBIO - curState = fcntl(sock, F_GETFL); - CLEAR_BITS(curState, O_NONBLOCK); - status = fcntl(sock, F_SETFL, curState); -#else /* USE_FIONBIO */ - curState = 0; - status = ioctl(sock, FIONBIO, &curState); -#endif /* !USE_FIONBIO */ + status = TclUnixSetBlockingMode(sock, TCL_MODE_BLOCKING); } } } diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c index 9436ae7..ba07c8c 100644 --- a/unix/tclUnixCompat.c +++ b/unix/tclUnixCompat.c @@ -6,7 +6,7 @@ * 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.9.2.3 2007/11/16 07:20:58 dgp Exp $ + * RCS: @(#) $Id: tclUnixCompat.c,v 1.9.2.4 2008/03/07 22:05:10 dgp Exp $ * */ @@ -16,6 +16,50 @@ #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 * diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c index 2574015..b459c49 100644 --- a/unix/tclUnixNotfy.c +++ b/unix/tclUnixNotfy.c @@ -10,7 +10,7 @@ * 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.32 2006/08/21 01:08:03 das Exp $ + * RCS: @(#) $Id: tclUnixNotfy.c,v 1.32.6.1 2008/03/07 22:05:10 dgp Exp $ */ #include "tclInt.h" @@ -918,25 +918,12 @@ NotifierThreadProc( receivePipe = fds[0]; -#ifndef USE_FIONBIO - status = fcntl(receivePipe, F_GETFL); - status |= O_NONBLOCK; - if (fcntl(receivePipe, F_SETFL, status) < 0) { + if (TclUnixSetBlockingMode(receivePipe, TCL_MODE_NONBLOCKING) < 0) { Tcl_Panic("NotifierThreadProc: could not make receive pipe non blocking"); } - status = fcntl(fds[1], F_GETFL); - status |= O_NONBLOCK; - if (fcntl(fds[1], F_SETFL, status) < 0) { + if (TclUnixSetBlockingMode(fds[1], TCL_MODE_NONBLOCKING) < 0) { Tcl_Panic("NotifierThreadProc: could not make trigger pipe non blocking"); } -#else - if (ioctl(receivePipe, (int) FIONBIO, &status) < 0) { - Tcl_Panic("NotifierThreadProc: could not make receive pipe non blocking"); - } - if (ioctl(fds[1], (int) FIONBIO, &status) < 0) { - Tcl_Panic("NotifierThreadProc: could not make trigger pipe non blocking"); - } -#endif /* FIONBIO */ /* * Install the write end of the pipe into the global variable. diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index 383034a..c11ce0b 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -10,7 +10,7 @@ * 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.38.2.1 2007/06/21 16:04:57 dgp Exp $ + * RCS: @(#) $Id: tclUnixPipe.c,v 1.38.2.2 2008/03/07 22:05:11 dgp Exp $ */ #include "tclInt.h" @@ -841,61 +841,18 @@ PipeBlockModeProc( * TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { - PipeState *psPtr = (PipeState *) instanceData; - int curStatus; - int fd; + PipeState *psPtr = instanceData; -#ifndef USE_FIONBIO if (psPtr->inFile) { - fd = GetFd(psPtr->inFile); - curStatus = fcntl(fd, F_GETFL); - if (mode == TCL_MODE_BLOCKING) { - curStatus &= (~(O_NONBLOCK)); - } else { - curStatus |= O_NONBLOCK; - } - if (fcntl(fd, F_SETFL, curStatus) < 0) { + if (TclUnixSetBlockingMode(GetFd(psPtr->inFile), mode) < 0) { return errno; } } if (psPtr->outFile) { - fd = GetFd(psPtr->outFile); - curStatus = fcntl(fd, F_GETFL); - if (mode == TCL_MODE_BLOCKING) { - curStatus &= (~(O_NONBLOCK)); - } else { - curStatus |= O_NONBLOCK; - } - if (fcntl(fd, F_SETFL, curStatus) < 0) { - return errno; - } - } -#endif /* !FIONBIO */ - -#ifdef USE_FIONBIO - if (psPtr->inFile) { - fd = GetFd(psPtr->inFile); - if (mode == TCL_MODE_BLOCKING) { - curStatus = 0; - } else { - curStatus = 1; - } - if (ioctl(fd, (int) FIONBIO, &curStatus) < 0) { - return errno; - } - } - if (psPtr->outFile != NULL) { - fd = GetFd(psPtr->outFile); - if (mode == TCL_MODE_BLOCKING) { - curStatus = 0; - } else { - curStatus = 1; - } - if (ioctl(fd, (int) FIONBIO, &curStatus) < 0) { + if (TclUnixSetBlockingMode(GetFd(psPtr->outFile), mode) < 0) { return errno; } } -#endif /* USE_FIONBIO */ psPtr->isNonBlocking = (mode == TCL_MODE_NONBLOCKING); diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h index 32bb21f..4824699 100644 --- a/unix/tclUnixPort.h +++ b/unix/tclUnixPort.h @@ -19,7 +19,7 @@ * 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.56.2.2 2007/10/15 18:38:09 dgp Exp $ + * RCS: @(#) $Id: tclUnixPort.h,v 1.56.2.3 2008/03/07 22:05:11 dgp Exp $ */ #ifndef _TCLUNIXPORT @@ -108,20 +108,9 @@ typedef off_t Tcl_SeekOffset; #else # include "../compat/unistd.h" #endif -#ifdef USE_FIONBIO - /* - * Not using the Posix fcntl(...,O_NONBLOCK,...) interface, instead - * we are using ioctl(..,FIONBIO,..). - */ -# ifdef HAVE_SYS_FILIO_H -# include <sys/filio.h> /* For FIONBIO. */ -# endif +MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode); -# ifdef HAVE_SYS_IOCTL_H -# include <sys/ioctl.h> /* For FIONBIO. */ -# endif -#endif /* USE_FIONBIO */ #include <utime.h> /* @@ -174,18 +163,6 @@ typedef off_t Tcl_SeekOffset; #endif /* - * HPUX needs the flag O_NONBLOCK to get the right non-blocking I/O - * semantics, while most other systems need O_NDELAY. Define the - * constant NBIO_FLAG to be one of these - */ - -#ifdef HPUX -# define NBIO_FLAG O_NONBLOCK -#else -# define NBIO_FLAG O_NDELAY -#endif - -/* * The type of the status returned by wait varies from UNIX system * to UNIX system. The macro below defines it: */ @@ -258,21 +235,11 @@ typedef off_t Tcl_SeekOffset; /* * The stuff below is needed by the "time" command. If this system has no - * gettimeofday call, then must use times and the CLK_TCK #define (from - * sys/param.h) to compute elapsed time. Unfortunately, some systems only - * have HZ and no CLK_TCK, and some might not even have HZ. + * gettimeofday call, then must use times() instead. */ #ifdef NO_GETTOD # include <sys/times.h> -# include <sys/param.h> -# ifndef CLK_TCK -# ifdef HZ -# define CLK_TCK HZ -# else -# define CLK_TCK 60 -# endif -# endif #else # ifdef HAVE_BSDGETTIMEOFDAY # define gettimeofday BSDgettimeofday @@ -489,18 +456,6 @@ extern char **environ; #endif /* - * At present (12/91) not all stdlib.h implementations declare strtod. - * The declaration below is here to ensure that it's declared, so that - * the compiler won't take the default approach of assuming it returns - * an int. There's no ANSI prototype for it because there would end - * up being too many conflicts with slightly-different prototypes. - */ - -#ifdef NO_STDLIB_H -extern double strtod(); -#endif - -/* * There is no platform-specific panic routine for Unix in the Tcl internals. */ diff --git a/win/Makefile.in b/win/Makefile.in index f9bbd92..83baaf3 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -4,7 +4,7 @@ # "./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.115.2.5 2007/12/04 16:55:55 dgp Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.115.2.6 2008/03/07 22:05:11 dgp Exp $ VERSION = @TCL_VERSION@ @@ -635,8 +635,8 @@ install-libraries: libraries install-tzdata install-msgs do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; - @echo "Installing package http 2.5.3 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.5.3.tm; + @echo "Installing 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 \ diff --git a/win/configure b/win/configure index 4c865bb..afe600c 100755 --- a/win/configure +++ b/win/configure @@ -272,7 +272,7 @@ PACKAGE_STRING= PACKAGE_BUGREPORT= ac_unique_file="../generic/tcl.h" -ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT AR RANLIB RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING CFLAGS_DEFAULT LDFLAGS_DEFAULT TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_DDE_PATCH_LEVEL TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION TCL_REG_PATCH_LEVEL RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS' +ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR RANLIB RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING CFLAGS_DEFAULT LDFLAGS_DEFAULT TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_DDE_PATCH_LEVEL TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION TCL_REG_PATCH_LEVEL RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS' ac_subst_files='' # Initialize some variables set by options. @@ -729,6 +729,10 @@ ac_env_CPPFLAGS_set=${CPPFLAGS+set} ac_env_CPPFLAGS_value=$CPPFLAGS ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set} ac_cv_env_CPPFLAGS_value=$CPPFLAGS +ac_env_CPP_set=${CPP+set} +ac_env_CPP_value=$CPP +ac_cv_env_CPP_set=${CPP+set} +ac_cv_env_CPP_value=$CPP # # Report the --help message. @@ -818,6 +822,7 @@ Some influential environment variables: nonstandard directory <lib dir> CPPFLAGS C/C++ preprocessor flags, e.g. -I<include dir> if you have headers in a nonstandard directory <include dir> + CPP C preprocessor Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. @@ -1267,7 +1272,7 @@ SHELL=/bin/sh TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".1" +TCL_PATCH_LEVEL=".2" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.3 @@ -2307,6 +2312,422 @@ _ACEOF ;; esac +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5 +echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6 +# On Suns, sometimes $CPP names a directory. +if test -n "$CPP" && test -d "$CPP"; then + CPP= +fi +if test -z "$CPP"; then + if test "${ac_cv_prog_CPP+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + # Double quotes because CPP needs to be expanded + for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" + do + ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + # <limits.h> exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + Syntax error +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + : +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.$ac_ext + + # OK, works on sane cases. Now check whether non-existent headers + # can be detected and how. + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <ac_nonexistent.h> +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + # Broken: success on invalid input. +continue +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.err conftest.$ac_ext +if $ac_preproc_ok; then + break +fi + + done + ac_cv_prog_CPP=$CPP + +fi + CPP=$ac_cv_prog_CPP +else + ac_cv_prog_CPP=$CPP +fi +echo "$as_me:$LINENO: result: $CPP" >&5 +echo "${ECHO_T}$CPP" >&6 +ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + # <limits.h> exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + Syntax error +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + : +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.$ac_ext + + # OK, works on sane cases. Now check whether non-existent headers + # can be detected and how. + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <ac_nonexistent.h> +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + # Broken: success on invalid input. +continue +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.err conftest.$ac_ext +if $ac_preproc_ok; then + : +else + { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details." >&5 +echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +echo "$as_me:$LINENO: checking for egrep" >&5 +echo $ECHO_N "checking for egrep... $ECHO_C" >&6 +if test "${ac_cv_prog_egrep+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if echo a | (grep -E '(a|b)') >/dev/null 2>&1 + then ac_cv_prog_egrep='grep -E' + else ac_cv_prog_egrep='egrep' + fi +fi +echo "$as_me:$LINENO: result: $ac_cv_prog_egrep" >&5 +echo "${ECHO_T}$ac_cv_prog_egrep" >&6 + EGREP=$ac_cv_prog_egrep + + +echo "$as_me:$LINENO: checking for ANSI C header files" >&5 +echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6 +if test "${ac_cv_header_stdc+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <stdlib.h> +#include <stdarg.h> +#include <string.h> +#include <float.h> + +int +main () +{ + + ; + 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 + ac_cv_header_stdc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_header_stdc=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + +if test $ac_cv_header_stdc = yes; then + # SunOS 4.x string.h does not declare mem*, contrary to ANSI. + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <string.h> + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "memchr" >/dev/null 2>&1; then + : +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <stdlib.h> + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "free" >/dev/null 2>&1; then + : +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. + if test "$cross_compiling" = yes; then + : +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <ctype.h> +#if ((' ' & 0x0FF) == 0x020) +# define ISLOWER(c) ('a' <= (c) && (c) <= 'z') +# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) +#else +# define ISLOWER(c) \ + (('a' <= (c) && (c) <= 'i') \ + || ('j' <= (c) && (c) <= 'r') \ + || ('s' <= (c) && (c) <= 'z')) +# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) +#endif + +#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) +int +main () +{ + int i; + for (i = 0; i < 256; i++) + if (XOR (islower (i), ISLOWER (i)) + || toupper (i) != TOUPPER (i)) + exit(2); + exit (0); +} +_ACEOF +rm -f conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (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 + : +else + echo "$as_me: program exited with status $ac_status" >&5 +echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +( exit $ac_status ) +ac_cv_header_stdc=no +fi +rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext +fi +fi +fi +echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 +echo "${ECHO_T}$ac_cv_header_stdc" >&6 +if test $ac_cv_header_stdc = yes; then + +cat >>confdefs.h <<\_ACEOF +#define STDC_HEADERS 1 +_ACEOF + +fi + # To properly support cross-compilation, one would # need to use these tool checks instead of @@ -2440,7 +2861,7 @@ echo "$as_me: error: Required resource tool 'windres' not found on PATH." >&2;} fi #-------------------------------------------------------------------- -# Checks to see if the make progeam sets the $MAKE variable. +# Checks to see if the make program sets the $MAKE variable. #-------------------------------------------------------------------- echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5 @@ -4619,6 +5040,8 @@ s,@CPPFLAGS@,$CPPFLAGS,;t t s,@ac_ct_CC@,$ac_ct_CC,;t t s,@EXEEXT@,$EXEEXT,;t t s,@OBJEXT@,$OBJEXT,;t t +s,@CPP@,$CPP,;t t +s,@EGREP@,$EGREP,;t t s,@AR@,$AR,;t t s,@RANLIB@,$RANLIB,;t t s,@RC@,$RC,;t t diff --git a/win/configure.in b/win/configure.in index e99a728..846e59f 100644 --- a/win/configure.in +++ b/win/configure.in @@ -3,7 +3,7 @@ # generate the file "configure", which is run during Tcl installation # to configure the system for the local environment. # -# RCS: @(#) $Id: configure.in,v 1.92.2.7 2008/01/23 16:49:08 dgp Exp $ +# RCS: @(#) $Id: configure.in,v 1.92.2.8 2008/03/07 22:05:11 dgp Exp $ AC_INIT(../generic/tcl.h) AC_PREREQ(2.59) @@ -16,7 +16,7 @@ SHELL=/bin/sh TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".1" +TCL_PATCH_LEVEL=".2" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.3 @@ -56,6 +56,7 @@ fi AC_PROG_CC AC_C_INLINE +AC_HEADER_STDC # To properly support cross-compilation, one would # need to use these tool checks instead of @@ -84,7 +85,7 @@ if test "${GCC}" = "yes" ; then fi #-------------------------------------------------------------------- -# Checks to see if the make progeam sets the $MAKE variable. +# Checks to see if the make program sets the $MAKE variable. #-------------------------------------------------------------------- AC_PROG_MAKE_SET diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 3b07522..c97a8e8 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -8,11 +8,15 @@ * 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.57.2.2 2007/12/04 16:55:55 dgp Exp $ + * RCS: @(#) $Id: tclWinSock.c,v 1.57.2.3 2008/03/07 22:05:11 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. |