diff options
69 files changed, 2020 insertions, 1277 deletions
@@ -1,3 +1,85 @@ +2005-05-05 Kevin B. Kenny <kennykb@acm.org> + + [kennykb-numerics-branch] Merged with HEAD. + +2005-05-05 Kevin B. Kenny <kennykb@acm.org> + + * win/tclWinThrd.c: Corrected a compilation error on the + --enable-threads configuration. + +2005-05-05 Don Porter <dgp@users.sourceforge.net> + + * generic/tclCompCmds.c: Replaced all instance of + * generic/tclCompile.c: TCL_OUT_LINE_COMPILE with TCL_ERROR. + * generic/tclInt.h: Now that we've eradicated the mistaken + * tests/appendComp.test: notion of a "compile-time error", we + can use the TCL_ERROR return code to signal any failure to produce + bytecode. + +2005-05-03 Don Porter <dgp@users.sourceforge.net> + + * doc/DString.3: Eliminated use of identifier "string" in Tcl's + * doc/Environment.3: public C API to avoid conflict/confusion with + * doc/Eval.3: the std::string of C++. + * doc/ExprLong.3, doc/ExprLongObj.3, doc/GetInt.3, doc/GetOpnFl.3: + * doc/ParseCmd.3, doc/RegExp.3, doc/SetResult.3, doc/StrMatch.3: + * doc/Utf.3, generic/tcl.decls, generic/tclBasic.c, generic/tclEnv.c: + * generic/tclGet.c, generic/tclParse.c, generic/tclParseExpr.c: + * generic/tclRegexp.c, generic/tclResult.c, generic/tclUtf.c: + * generic/tclUtil.c, unix/tclUnixChan.c: + + * generic/tclDecls.h: `make genstubs` + +2005-05-02 Don Porter <dgp@users.sourceforge.net> + + * generic/tcl.decls: + * generic/tclBasic.c: Simplified implementation of Tcl_ExprString. + * tests/expr-old.test: + + * generic/tclDecls.h: `make genstubs` + +2005-04-30 Daniel Steffen <das@users.sourceforge.net> + + * unix/tclUnixNotfy.c: applied dkf's tkMacOSXNotify.c cleanup changes. + +2005-04-29 Don Porter <dgp@users.sourceforge.net> + + TIP#176 IMPLEMENTATION [Patch 1165695] + + * generic/tclUtil.c: Extended TclGetIntForIndex to recognize + index formats including end+integer and integer+/-integer. + + * generic/tclCmdMZ.c: Extended the -start switch of [regexp] + and [regsub] to accept all index formats known by TclGetIntForIndex. + + * doc/lindex.n: Updated docs to note new index formats. + * doc/linsert.n, doc/lrange.n, doc/lreplace.n, doc/lsearch.n: + * doc/lset.n, doc/lsort.n, doc/regexp.n, doc/regsub.n, doc/string.n: + + * tests/cmdIL.test: Updated tests. + * tests/compile.test, tests/lindex.test, tests/linsert.test: + * tests/lrange.test, tests/lreplace.test, tests/lsearch.test: + * tests/lset.test, tests/regexp.test, tests/regexpComp.test: + * tests/string.test, tests/stringComp.test, tests/util.test: + +2005-04-28 Don Porter <dgp@users.sourceforge.net> + + * tests/unixInit.test (7.1): Alternative fix for the 2004-11-11 commit. + +2005-04-27 Don Porter <dgp@users.sourceforge.net> + + * library/init.tcl: Corrected flaw in interactive command + * tests/main.test: auto-completion. [Bug 1191409]. + + TIP#183 IMPLEMENTATION [Patch 577093] + + * generic/tclIOUtil.c (TclGetOpenModeEx): New routine. + * generic/tclInt.h: + + * generic/tclIO.c (Tcl_OpenObjCmd): Support for "b" and + * doc/open.n: "BINARY" in "access" argument to [open]. + * tests/ioCmd.test: + 2005-04-26 Kevin B. Kenny <kennykb@users.sourceforge.net> * generic/tclBinary.c (FormatNumber): @@ -25,6 +107,33 @@ * doc/CrtMathFunc.n: Revised documentation for TIP 232 +2005-04-25 Daniel Steffen <das@users.sourceforge.net> + + * compat/string.h: fixed memchr() protoype for __APPLE__ so that we + build on Mac OS X 10.1 again. + + * generic/tclNotify.c (TclFinalizeNotifier): fixed notifier not being + finalized in unthreaded core (was testing for notifier initialization in + current thread by checking thread id != 0 but thread id is always 0 in + untreaded core). + + * win/tclWinNotify.c (Tcl_WaitForEvent): + * unix/tclUnixNotfy.c (Tcl_WaitForEvent): don't call ScaleTimeProc for + zero wait times (as specified in TIP 233). + + * unix/Makefile.in: added @PLAT_SRCS@ to SRCS and split out NOTIFY_SRCS + from UNIX_SRCS for parity with UNIX_OBJS & NOTIFY_OBJS. + + * unix/tcl.m4 (Darwin): added configure checks for recently added linker + flags -single_module and -search_paths_first to allow building with + older tools (and on Mac OS X 10.1), use -single_module in SHLIB_LD and + not just T{CL,K}_SHLIB_LD_EXTRAS, added unexporting from Tk of symbols + from libtclstub to avoid duplicate symbol warnings, added PLAT_SRCS + definition for Mac OS X, defined MODULE_SCOPE to __private_extern__. + (SC_MISSING_POSIX_HEADERS): added caching of dirent.h check. + + * unix/configure: autoconf-2.59 + 2005-04-25 Kevin B. Kenny <kennykb@users.sourceforge.net> * library/tzdata/America/Boise: @@ -175,29 +284,29 @@ to find the requested symbol (this is not considered to be an error). - Set of changes correcting huge memory waste (not a leak) - when a thread exits. This has been introduced in 8.4.7 - within an attempt to correctly cleanup after ourselves when - Tcl library is being unloaded with the Tcl_Finalize() call. + Set of changes correcting huge memory waste (not a leak) + when a thread exits. This has been introduced in 8.4.7 + within an attempt to correctly cleanup after ourselves when + Tcl library is being unloaded with the Tcl_Finalize() call. - This fixes the Tcl Bug #1178445. + This fixes the Tcl Bug #1178445. - * generic/tclInt.h: added prototypes for TclpFreeAllocCache() - and TclFreeAllocCache() + * generic/tclInt.h: added prototypes for TclpFreeAllocCache() + and TclFreeAllocCache() - * generic/tclThreadAlloc.c: modified TclFinalizeThreadAlloc() - to explicitly call TclpFreeAllocCache with the NULL-ptr as - argument signalling cleanup of private tsd key used only by - the threading allocator. + * generic/tclThreadAlloc.c: modified TclFinalizeThreadAlloc() + to explicitly call TclpFreeAllocCache with the NULL-ptr as + argument signalling cleanup of private tsd key used only by + the threading allocator. - * unix/tclUnixThrd.c: fixed TclpFreeAllocCache() to recognize - when being called with NULL argument. This is a signal for it - to clean up the tsd key associated with the threading allocator. + * unix/tclUnixThrd.c: fixed TclpFreeAllocCache() to recognize + when being called with NULL argument. This is a signal for it + to clean up the tsd key associated with the threading allocator. - * win/tclWinThrd.c: renamed TclWinFreeAllocCache to TclpFreeAllocCache - and fixed to recognize when being called with NULL argument. - This is a signal for it to clean up the tsd key associated with the - threading allocator. + * win/tclWinThrd.c: renamed TclWinFreeAllocCache to TclpFreeAllocCache + and fixed to recognize when being called with NULL argument. + This is a signal for it to clean up the tsd key associated with the + threading allocator. 2005-04-13 Don Porter <dgp@users.sourceforge.net> @@ -1074,14 +1183,14 @@ leading zeroes appeared to be a two-digit group, leading to misinterpreting the time 0012 as 1200. [Bug # 1090413] * library/clock.tcl: Added code to interpret correctly months - outside the range 01-12 as reduced modulo 12 + outside the range 01-12 as reduced modulo 12 with a corresponding adjustment to the year. [Bug 1092789] * tests/clock.test: Added regression test cases for the above two - bugs. + bugs. * unix/Makefile.in: Added --no-lines to the 'bison' command line * win/Makefile.in: to help constrain the number of diffs in a cvs - checkin. + checkin. 2004-12-24 Miguel Sofer <msofer@users.sf.net> @@ -2092,7 +2201,7 @@ 2004-10-26 Kevin Kenny <kennykb@acm.org> * tests/format.test (format-19.1): Additional regression test for - Bug 868489. + Bug 868489. 2004-10-27 Donal K. Fellows <donal.k.fellows@man.ac.uk> @@ -2733,8 +2842,8 @@ * generic/tclCmdAH.c (Tcl_FormatObjCmd): Removed some grubby * generic/tclObj.c (SetBooleanFromAny): work-around code - that was needed only - because of Bug 868489. + that was needed only + because of Bug 868489. * generic/tclBasic.c (TclObjInvoke): Removed three unused variables to silence a compiler warning in VC++. @@ -4147,9 +4256,9 @@ 2004-05-25 Kevin Kenny <kennykb@acm.org> * tests/winFCmd.test: Correct test for the presence of a CD-ROM so - that it doesn't misdetect some other sort - of filesystem with a write-protected root as - being a CD-ROM drive. [Bug 918267] + that it doesn't misdetect some other sort + of filesystem with a write-protected root as + being a CD-ROM drive. [Bug 918267] 2004-05-25 Don Porter <dgp@users.sourceforge.net> @@ -4294,15 +4403,15 @@ * generic/tclIO.c: Fixed [SF Tcl Bug 943274]. This is the same problem * generic/tclIO.h: as [SF Tcl Bug 462317], see ChangeLog entry - 2001-09-26. The fix done at that time is incomplete. It - is possible to get around it if the actual read - operation is defered and not executed in the event - handler itself. Instead of tracking if we are in an - read caused by a synthesized fileevent we now track if - the OS has delivered a true event = actual data and - bypass the driver if a read finds that there is no - actual data waiting. The flag is cleared by a short or - full read. + 2001-09-26. The fix done at that time is incomplete. It + is possible to get around it if the actual read + operation is defered and not executed in the event + handler itself. Instead of tracking if we are in an + read caused by a synthesized fileevent we now track if + the OS has delivered a true event = actual data and + bypass the driver if a read finds that there is no + actual data waiting. The flag is cleared by a short or + full read. ***POTENTIAL INCOMPATIBILITY*** for channel drivers. @@ -4421,17 +4530,17 @@ * unix/tclUnixPort.h: * generic/tclClock.c: Changed a buggy 'GMT' timezone specification - to the correct 'GMT0'. [Bug #922848] + to the correct 'GMT0'. [Bug #922848] * unix/tclUnixThrd.c: Moved TclpGmtime and TclpLocaltime to - unix/tclUnixTime.c where they belong. + unix/tclUnixTime.c where they belong. * unix/tclUnixTime.c (TclpGmtime, TclpLocaltime, TclpGetTimeZone, - ThreadSafeGMTime [removed], - ThreadSafeLocalTime [removed], - SetTZIfNecessary, CleanupMemory): + ThreadSafeGMTime [removed], + ThreadSafeLocalTime [removed], + SetTZIfNecessary, CleanupMemory): Restructured to make sure that the same mutex protects - all calls to localtime, gmtime, and tzset. Added a check + all calls to localtime, gmtime, and tzset. Added a check in front of those calls to make sure that the TZ env var hasn't changed since the last call to tzset, and repeat tzset if necessary. [Bug #942078] Removed a buggy test diff --git a/compat/string.h b/compat/string.h index c2ecd0b..fdb484a 100644 --- a/compat/string.h +++ b/compat/string.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: string.h,v 1.5 2004/03/17 18:14:12 das Exp $ + * RCS: @(#) $Id: string.h,v 1.5.2.1 2005/05/05 17:55:18 kennykb Exp $ */ #ifndef _STRING @@ -26,7 +26,11 @@ #include <sys/types.h> +#ifdef __APPLE__ +extern VOID * memchr _ANSI_ARGS_((CONST VOID *s, int c, size_t n)); +#else extern char * memchr _ANSI_ARGS_((CONST VOID *s, int c, size_t n)); +#endif extern int memcmp _ANSI_ARGS_((CONST VOID *s1, CONST VOID *s2, size_t n)); extern char * memcpy _ANSI_ARGS_((VOID *t, CONST VOID *f, size_t n)); diff --git a/doc/DString.3 b/doc/DString.3 index e5d5e33..d1e1750 100644 --- a/doc/DString.3 +++ b/doc/DString.3 @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: DString.3,v 1.11 2004/10/07 15:15:36 dkf Exp $ +'\" RCS: @(#) $Id: DString.3,v 1.11.2.1 2005/05/05 17:55:20 kennykb Exp $ '\" .so man.macros .TH Tcl_DString 3 7.4 Tcl "Tcl Library Procedures" @@ -19,10 +19,10 @@ Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSu \fBTcl_DStringInit\fR(\fIdsPtr\fR) .sp char * -\fBTcl_DStringAppend\fR(\fIdsPtr, string, length\fR) +\fBTcl_DStringAppend\fR(\fIdsPtr, bytes, length\fR) .sp char * -\fBTcl_DStringAppendElement\fR(\fIdsPtr, string\fR) +\fBTcl_DStringAppendElement\fR(\fIdsPtr, element\fR) .sp \fBTcl_DStringStartSublist\fR(\fIdsPtr\fR) .sp @@ -47,10 +47,12 @@ char * .AS Tcl_DString newLength in/out .AP Tcl_DString *dsPtr in/out Pointer to structure that is used to manage a dynamic string. -.AP "const char" *string in -Pointer to characters to add to dynamic string. +.AP "const char" *bytes in +Pointer to characters to append to dynamic string. +.AP "const char" *element in +Pointer to characters to append as list element to dynamic string. .AP int length in -Number of characters from string to add to dynamic string. If -1, +Number of bytes from \fIbytes\fR to add to dynamic string. If -1, add all characters up to null terminating character. .AP int newLength in New length for dynamic string, not including null terminating @@ -77,7 +79,7 @@ string. .PP \fBTcl_DStringAppend\fR adds new information to a dynamic string, allocating more memory for the string if needed. -If \fIlength\fR is less than zero then everything in \fIstring\fR +If \fIlength\fR is less than zero then everything in \fIbytes\fR is appended to the dynamic string; otherwise \fIlength\fR specifies the number of bytes to append. \fBTcl_DStringAppend\fR returns a pointer to the characters of @@ -86,7 +88,7 @@ the new string. The string can also be retrieved from the .PP \fBTcl_DStringAppendElement\fR is similar to \fBTcl_DStringAppend\fR except that it doesn't take a \fIlength\fR argument (it appends -all of \fIstring\fR) and it converts the string to a proper list element +all of \fIelement\fR) and it converts the string to a proper list element before appending. \fBTcl_DStringAppendElement\fR adds a separator space before the new list element unless the new list element is the first in a diff --git a/doc/Environment.3 b/doc/Environment.3 index 93df3c2..c2d5c12 100644 --- a/doc/Environment.3 +++ b/doc/Environment.3 @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: Environment.3,v 1.4 2004/10/07 15:15:37 dkf Exp $ +'\" RCS: @(#) $Id: Environment.3,v 1.4.2.1 2005/05/05 17:55:20 kennykb Exp $ '\" .so man.macros .TH Tcl_PutEnv 3 "7.5" Tcl "Tcl Library Procedures" @@ -16,12 +16,12 @@ Tcl_PutEnv \- procedures to manipulate the environment \fB#include <tcl.h>\fR .sp int -\fBTcl_PutEnv\fR(\fIstring\fR) +\fBTcl_PutEnv\fR(\fIassignment\fR) .SH ARGUMENTS -.AS "const char" *string -.AP "const char" *string in -Info about environment variable in the form NAME=value. The string is -in native format. +.AS "const char" *assignment +.AP "const char" *assignnment in +Info about environment variable in the format NAME=value. +The \fIassignment\fR argument is in the system encoding. .BE .SH DESCRIPTION @@ -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: Eval.3,v 1.18.2.1 2005/04/10 23:14:41 kennykb Exp $ +'\" RCS: @(#) $Id: Eval.3,v 1.18.2.2 2005/05/05 17:55:20 kennykb Exp $ '\" .so man.macros .TH Tcl_Eval 3 8.1 Tcl "Tcl Library Procedures" @@ -39,7 +39,7 @@ int \fBTcl_GlobalEvalObj\fR(\fIinterp, objPtr\fR) .sp int -\fBTcl_VarEval\fR(\fIinterp, string, string, ... \fB(char *) NULL\fR) +\fBTcl_VarEval\fR(\fIinterp, part, part, ... \fB(char *) NULL\fR) .sp int \fBTcl_VarEvalVA\fR(\fIinterp, argList\fR) @@ -67,7 +67,7 @@ null terminating character. If \-1, then all characters up to the first null byte are used. .AP "const char" *script in Points to first byte of script to execute (null-terminated and UTF-8). -.AP char *string in +.AP char *part in String forming part of a Tcl script. .AP va_list argList in An argument list which must have been initialized using diff --git a/doc/ExprLong.3 b/doc/ExprLong.3 index bb00edf..9024ea2 100644 --- a/doc/ExprLong.3 +++ b/doc/ExprLong.3 @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: ExprLong.3,v 1.9 2004/10/07 16:05:13 dkf Exp $ +'\" RCS: @(#) $Id: ExprLong.3,v 1.9.2.1 2005/05/05 17:55:21 kennykb Exp $ '\" .so man.macros .TH Tcl_ExprLong 3 7.0 Tcl "Tcl Library Procedures" @@ -17,21 +17,21 @@ Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean, Tcl_ExprString \- evaluate an exp \fB#include <tcl.h>\fR .sp int -\fBTcl_ExprLong\fR(\fIinterp, string, longPtr\fR) +\fBTcl_ExprLong\fR(\fIinterp, expr, longPtr\fR) .sp int -\fBTcl_ExprDouble\fR(\fIinterp, string, doublePtr\fR) +\fBTcl_ExprDouble\fR(\fIinterp, expr, doublePtr\fR) .sp int -\fBTcl_ExprBoolean\fR(\fIinterp, string, booleanPtr\fR) +\fBTcl_ExprBoolean\fR(\fIinterp, expr, booleanPtr\fR) .sp int -\fBTcl_ExprString\fR(\fIinterp, string\fR) +\fBTcl_ExprString\fR(\fIinterp, expr\fR) .SH ARGUMENTS .AS Tcl_Interp *booleanPtr out .AP Tcl_Interp *interp in -Interpreter in whose context to evaluate \fIstring\fR or \fIobjPtr\fR. -.AP "const char" *string in +Interpreter in whose context to evaluate \fIexpr\fR. +.AP "const char" *expr in Expression to be evaluated. .AP long *longPtr out Pointer to location in which to store the integer value of the @@ -47,7 +47,7 @@ expression. .SH DESCRIPTION .PP These four procedures all evaluate the expression -given by the \fIstring\fR argument +given by the \fIexpr\fR argument and return the result in one of four different forms. The expression can have any of the forms accepted by the \fBexpr\fR command. Note that these procedures have been largely replaced by the @@ -96,12 +96,6 @@ such as ``yes'' or ``no'', or else an error occurs. .PP \fBTcl_ExprString\fR returns the value of the expression as a string stored in the interpreter's result. -If the expression's actual value is an integer -then \fBTcl_ExprString\fR converts it to a string using \fBsprintf\fR -with a ``%d'' converter. -If the expression's actual value is a floating-point -number, then \fBTcl_ExprString\fR calls \fBTcl_PrintDouble\fR -to convert it to a string. .SH "SEE ALSO" Tcl_ExprLongObj, Tcl_ExprDoubleObj, Tcl_ExprBooleanObj, Tcl_ExprObj diff --git a/doc/ExprLongObj.3 b/doc/ExprLongObj.3 index 5892b4c..27153ef 100644 --- a/doc/ExprLongObj.3 +++ b/doc/ExprLongObj.3 @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: ExprLongObj.3,v 1.3 2001/09/03 09:38:50 dkf Exp $ +'\" RCS: @(#) $Id: ExprLongObj.3,v 1.3.16.1 2005/05/05 17:55:21 kennykb Exp $ '\" .so man.macros .TH Tcl_ExprLongObj 3 8.0 Tcl "Tcl Library Procedures" @@ -29,7 +29,7 @@ int .SH ARGUMENTS .AS Tcl_Interp **resultPtrPtr out .AP Tcl_Interp *interp in -Interpreter in whose context to evaluate \fIstring\fR or \fIobjPtr\fR. +Interpreter in whose context to evaluate \fIobjPtr\fR. .AP Tcl_Obj *objPtr in Pointer to an object containing the expression to evaluate. .AP long *longPtr out diff --git a/doc/GetInt.3 b/doc/GetInt.3 index 515dd91..da0ff73 100644 --- a/doc/GetInt.3 +++ b/doc/GetInt.3 @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: GetInt.3,v 1.7.2.1 2005/04/25 21:37:18 kennykb Exp $ +'\" RCS: @(#) $Id: GetInt.3,v 1.7.2.2 2005/05/05 17:55:21 kennykb Exp $ '\" .so man.macros .TH Tcl_GetInt 3 "" Tcl "Tcl Library Procedures" @@ -17,51 +17,51 @@ Tcl_GetInt, Tcl_GetDouble, Tcl_GetBoolean \- convert from string to integer, dou \fB#include <tcl.h>\fR .sp int -\fBTcl_GetInt\fR(\fIinterp, str, intPtr\fR) +\fBTcl_GetInt\fR(\fIinterp, src, intPtr\fR) .sp int -\fBTcl_GetDouble\fR(\fIinterp, str, doublePtr\fR) +\fBTcl_GetDouble\fR(\fIinterp, src, doublePtr\fR) .sp int -\fBTcl_GetBoolean\fR(\fIinterp, str, boolPtr\fR) +\fBTcl_GetBoolean\fR(\fIinterp, src, boolPtr\fR) .SH ARGUMENTS .AS Tcl_Interp *doublePtr out .AP Tcl_Interp *interp in Interpreter to use for error reporting. -.AP "const char" *str in +.AP "const char" *src in Textual value to be converted. .AP int *intPtr out -Points to place to store integer value converted from \fIstr\fR. +Points to place to store integer value converted from \fIsrc\fR. .AP double *doublePtr out Points to place to store double-precision floating-point -value converted from \fIstr\fR. +value converted from \fIsrc\fR. .AP int *boolPtr out -Points to place to store boolean value (0 or 1) converted from \fIstr\fR. +Points to place to store boolean value (0 or 1) converted from \fIsrc\fR. .BE .SH DESCRIPTION .PP These procedures convert from strings to integers or double-precision floating-point values or booleans (represented as 0- or 1-valued -integers). Each of the procedures takes a \fIstr\fR argument, +integers). Each of the procedures takes a \fIsrc\fR argument, converts it to an internal form of a particular type, and stores the converted value at the location indicated by the procedure's third argument. If all goes well, each of the procedures returns -\fBTCL_OK\fR. If \fIstr\fR doesn't have the proper syntax for the +\fBTCL_OK\fR. If \fIsrc\fR doesn't have the proper syntax for the desired type then \fBTCL_ERROR\fR is returned, an error message is left in the interpreter's result, and nothing is stored at *\fIintPtr\fR or *\fIdoublePtr\fR or *\fIboolPtr\fR. .PP -\fBTcl_GetInt\fR expects \fIstr\fR to consist of a collection +\fBTcl_GetInt\fR expects \fIsrc\fR to consist of a collection of integer digits, optionally signed and optionally preceded by -white space. If the first two characters of \fIstr\fR +white space. If the first two characters of \fIsrc\fR after the optional white space and sign are ``0x'' -then \fIstr\fR is expected to be in hexadecimal form; otherwise, -if the first such character is ``0'' then \fIstr\fR -is expected to be in octal form; otherwise, \fIstr\fR is +then \fIsrc\fR is expected to be in hexadecimal form; otherwise, +if the first such character is ``0'' then \fIsrc\fR +is expected to be in octal form; otherwise, \fIsrc\fR is expected to be in decimal form. .PP -\fBTcl_GetDouble\fR expects \fIstr\fR to consist of a floating-point +\fBTcl_GetDouble\fR expects \fIsrc\fR to consist of a floating-point number, which is: white space; a sign; a sequence of digits; a decimal point; a sequence of digits; the letter ``e''; a signed decimal exponent ; and more white space. @@ -70,11 +70,11 @@ the digits either before or after the decimal point must be present and if the ``e'' is present then it must be followed by the exponent number. .PP -\fBTcl_GetBoolean\fR expects \fIstr\fR to specify a boolean -value. If \fIstr\fR is any of \fB0\fR, \fBfalse\fR, +\fBTcl_GetBoolean\fR expects \fIsrc\fR to specify a boolean +value. If \fIsrc\fR is any of \fB0\fR, \fBfalse\fR, \fBno\fR, or \fBoff\fR, then \fBTcl_GetBoolean\fR stores a zero value at \fI*boolPtr\fR. -If \fIstr\fR is any of \fB1\fR, \fBtrue\fR, \fByes\fR, or \fBon\fR, +If \fIsrc\fR is any of \fB1\fR, \fBtrue\fR, \fByes\fR, or \fBon\fR, then 1 is stored at \fI*boolPtr\fR. Any of these values may be abbreviated, and upper-case spellings are also acceptable. diff --git a/doc/GetOpnFl.3 b/doc/GetOpnFl.3 index 13f63a5..221468a 100644 --- a/doc/GetOpnFl.3 +++ b/doc/GetOpnFl.3 @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: GetOpnFl.3,v 1.8.2.1 2005/04/10 23:14:41 kennykb Exp $ +'\" RCS: @(#) $Id: GetOpnFl.3,v 1.8.2.2 2005/05/05 17:55:22 kennykb Exp $ .so man.macros .TH Tcl_GetOpenFile 3 8.0 Tcl "Tcl Library Procedures" .BS @@ -15,13 +15,13 @@ Tcl_GetOpenFile \- Return a FILE* for a channel registered in the given interpre \fB#include <tcl.h>\fR .sp int -\fBTcl_GetOpenFile\fR(\fIinterp, string, write, checkUsage, filePtr\fR) +\fBTcl_GetOpenFile\fR(\fIinterp, chanID, write, checkUsage, filePtr\fR) .sp .SH ARGUMENTS .AS Tcl_Interp checkUsage out .AP Tcl_Interp *interp in Tcl interpreter from which file handle is to be obtained. -.AP "const char" *string in +.AP "const char" *chanID in String identifying channel, such as \fBstdin\fR or \fBfile4\fR. .AP int write in Non-zero means the file will be used for writing, zero means it will @@ -31,7 +31,7 @@ If non-zero, then an error will be generated if the file wasn't opened for the access indicated by \fIwrite\fR. .AP ClientData *filePtr out Points to word in which to store pointer to FILE structure for -the file given by \fIstring\fR. +the file given by \fIchanID\fR. .BE .SH DESCRIPTION @@ -46,7 +46,7 @@ In some cases, such as a channel that connects to a pipeline of subprocesses, different FILE pointers will be returned for reading and writing. \fBTcl_GetOpenFile\fR normally returns \fBTCL_OK\fR. -If an error occurs in \fBTcl_GetOpenFile\fR (e.g. \fIstring\fR didn't +If an error occurs in \fBTcl_GetOpenFile\fR (e.g. \fIchanID\fR didn't make any sense or \fIcheckUsage\fR was set and the file wasn't opened for the access specified by \fIwrite\fR) then \fBTCL_ERROR\fR is returned and the interpreter's result will contain an error message. diff --git a/doc/ParseCmd.3 b/doc/ParseCmd.3 index 12b0f31..787c630 100644 --- a/doc/ParseCmd.3 +++ b/doc/ParseCmd.3 @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: ParseCmd.3,v 1.18.2.1 2005/04/10 23:14:42 kennykb Exp $ +'\" RCS: @(#) $Id: ParseCmd.3,v 1.18.2.2 2005/05/05 17:55:22 kennykb Exp $ '\" .so man.macros .TH Tcl_ParseCommand 3 8.3 Tcl "Tcl Library Procedures" @@ -16,22 +16,22 @@ Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_Par \fB#include <tcl.h>\fR .sp int -\fBTcl_ParseCommand\fR(\fIinterp, string, numBytes, nested, parsePtr\fR) +\fBTcl_ParseCommand\fR(\fIinterp, start, numBytes, nested, parsePtr\fR) .sp int -\fBTcl_ParseExpr\fR(\fIinterp, string, numBytes, parsePtr\fR) +\fBTcl_ParseExpr\fR(\fIinterp, start, numBytes, parsePtr\fR) .sp int -\fBTcl_ParseBraces\fR(\fIinterp, string, numBytes, parsePtr, append, termPtr\fR) +\fBTcl_ParseBraces\fR(\fIinterp, start, numBytes, parsePtr, append, termPtr\fR) .sp int -\fBTcl_ParseQuotedString\fR(\fIinterp, string, numBytes, parsePtr, append, termPtr\fR) +\fBTcl_ParseQuotedString\fR(\fIinterp, start, numBytes, parsePtr, append, termPtr\fR) .sp int -\fBTcl_ParseVarName\fR(\fIinterp, string, numBytes, parsePtr, append\fR) +\fBTcl_ParseVarName\fR(\fIinterp, start, numBytes, parsePtr, append\fR) .sp const char * -\fBTcl_ParseVar\fR(\fIinterp, string, termPtr\fR) +\fBTcl_ParseVar\fR(\fIinterp, start, termPtr\fR) .sp \fBTcl_FreeParse\fR(\fIusedParsePtr\fR) .sp @@ -49,12 +49,12 @@ if NULL, then no error messages are left after errors. For \fBTcl_EvalTokens\fR and \fBTcl_EvalTokensStandard\fR, determines the context for evaluating the script and also is used for error reporting; must not be NULL. -.AP "const char" *string in +.AP "const char" *start in Pointer to first character in string to parse. .AP int numBytes in -Number of bytes in \fIstring\fR, not including any terminating null +Number of bytes in string to parse, not including any terminating null character. If less than 0 then the script consists of all characters -in \fIstring\fR up to the first null character. +following \fIstart\fR up to the first null character. .AP int nested in Non-zero means that the script is part of a command substitution so an unquoted close bracket should be treated as a command terminator. If zero, @@ -120,8 +120,8 @@ result, and no information is left at \fI*parsePtr\fR. \fBTcl_ParseBraces\fR parses a string or command argument enclosed in braces such as \fB{hello}\fR or \fB{string \\t with \\t tabs}\fR -from the beginning of its argument \fIstring\fR. -The first character of \fIstring\fR must be \fB{\fR. +from the beginning of its argument \fIstart\fR. +The first character of \fIstart\fR must be \fB{\fR. If the braced string was parsed successfully, \fBTcl_ParseBraces\fR returns \fBTCL_OK\fR, fills in the structure pointed to by \fIparsePtr\fR @@ -136,8 +136,8 @@ and no information is left at \fI*parsePtr\fR or \fI*termPtr\fR. .PP \fBTcl_ParseQuotedString\fR parses a double-quoted string such as \fB"sum is [expr $a+$b]"\fR -from the beginning of the argument \fIstring\fR. -The first character of \fIstring\fR must be \fB"\fR. +from the beginning of the argument \fIstart\fR. +The first character of \fIstart\fR must be \fB"\fR. If the double-quoted string was parsed successfully, \fBTcl_ParseQuotedString\fR returns \fBTCL_OK\fR, fills in the structure pointed to by \fIparsePtr\fR @@ -152,8 +152,8 @@ and no information is left at \fI*parsePtr\fR or \fI*termPtr\fR. .PP \fBTcl_ParseVarName\fR parses a Tcl variable reference such as \fB$abc\fR or \fB$x([expr $index + 1])\fR from the beginning of its -\fIstring\fR argument. -The first character of \fIstring\fR must be \fB$\fR. +\fIstart\fR argument. +The first character of \fIstart\fR must be \fB$\fR. If a variable name was parsed successfully, \fBTcl_ParseVarName\fR returns \fBTCL_OK\fR and fills in the structure pointed to by \fIparsePtr\fR with information about the structure of the variable name @@ -163,8 +163,8 @@ error message is left in \fIinterp\fR's result (if \fIinterp\fR isn't NULL), and no information is left at \fI*parsePtr\fR. .PP \fBTcl_ParseVar\fR parse a Tcl variable reference such as \fB$abc\fR -or \fB$x([expr $index + 1])\fR from the beginning of its \fIstring\fR -argument. The first character of \fIstring\fR must be \fB$\fR. If +or \fB$x([expr $index + 1])\fR from the beginning of its \fIstart\fR +argument. The first character of \fIstart\fR must be \fB$\fR. If the variable name is parsed successfully, \fBTcl_ParseVar\fR returns a pointer to the string value of the variable. If an error occurs while parsing, then NULL is returned and an error message is left in @@ -431,7 +431,7 @@ Tcl_Parse structure depends on the contents of the quoted string. It will consist of one or more \fBTCL_TOKEN_TEXT\fR, \fBTCL_TOKEN_BS\fR, \fBTCL_TOKEN_COMMAND\fR, and \fBTCL_TOKEN_VARIABLE\fR sub-tokens. The array always contains at least one token; -for example, if the argument \fIstring\fR is empty, +for example, if the argument \fIstart\fR is empty, the array returned consists of a single \fBTCL_TOKEN_TEXT\fR token with a zero \fIsize\fR field. Only the token information in the Tcl_Parse structure @@ -452,7 +452,7 @@ the \fIcommentStart\fR, \fIcommentSize\fR, .PP All of the character pointers in the Tcl_Parse and Tcl_Token structures refer -to characters in the \fIstring\fR argument passed to +to characters in the \fIstart\fR argument passed to \fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR, \fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR. .PP diff --git a/doc/RegExp.3 b/doc/RegExp.3 index d2b2aad..ae042ab 100644 --- a/doc/RegExp.3 +++ b/doc/RegExp.3 @@ -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: RegExp.3,v 1.20.2.1 2005/04/10 23:14:42 kennykb Exp $ +'\" RCS: @(#) $Id: RegExp.3,v 1.20.2.2 2005/05/05 17:55:22 kennykb Exp $ '\" .so man.macros .TH Tcl_RegExpMatch 3 8.1 Tcl "Tcl Library Procedures" @@ -18,16 +18,16 @@ Tcl_RegExpMatch, Tcl_RegExpCompile, Tcl_RegExpExec, Tcl_RegExpRange, Tcl_GetRegE \fB#include <tcl.h>\fR .sp int -\fBTcl_RegExpMatchObj\fR(\fIinterp\fR, \fIstrObj\fR, \fIpatObj\fR) +\fBTcl_RegExpMatchObj\fR(\fIinterp\fR, \fItextObj\fR, \fIpatObj\fR) .sp int -\fBTcl_RegExpMatch\fR(\fIinterp\fR, \fIstring\fR, \fIpattern\fR) +\fBTcl_RegExpMatch\fR(\fIinterp\fR, \fItext\fR, \fIpattern\fR) .sp Tcl_RegExp \fBTcl_RegExpCompile\fR(\fIinterp\fR, \fIpattern\fR) .sp int -\fBTcl_RegExpExec\fR(\fIinterp\fR, \fIregexp\fR, \fIstring\fR, \fIstart\fR) +\fBTcl_RegExpExec\fR(\fIinterp\fR, \fIregexp\fR, \fItext\fR, \fIstart\fR) .sp void \fBTcl_RegExpRange\fR(\fIregexp\fR, \fIindex\fR, \fIstartPtr\fR, \fIendPtr\fR) @@ -36,7 +36,7 @@ Tcl_RegExp \fBTcl_GetRegExpFromObj\fR(\fIinterp\fR, \fIpatObj\fR, \fIcflags\fR) .sp int -\fBTcl_RegExpExecObj\fR(\fIinterp\fR, \fIregexp\fR, \fIobjPtr\fR, \fIoffset\fR, \fInmatches\fR, \fIeflags\fR) +\fBTcl_RegExpExecObj\fR(\fIinterp\fR, \fIregexp\fR, \fItextObj\fR, \fIoffset\fR, \fInmatches\fR, \fIeflags\fR) .sp void \fBTcl_RegExpGetInfo\fR(\fIregexp\fR, \fIinfoPtr\fR) @@ -46,24 +46,24 @@ void .AP Tcl_Interp *interp in Tcl interpreter to use for error reporting. The interpreter may be NULL if no error reporting is desired. -.AP Tcl_Obj *strObj in/out -Refers to the object from which to get the string to search. The +.AP Tcl_Obj *textObj in/out +Refers to the object from which to get the text to search. The internal representation of the object may be converted to a form that can be efficiently searched. .AP Tcl_Obj *patObj in/out Refers to the object from which to get a regular expression. The compiled regular expression is cached in the object. -.AP char *string in -String to check for a match with a regular expression. +.AP char *text in +Text to search for a match with a regular expression. .AP "const char" *pattern in String in the form of a regular expression pattern. .AP Tcl_RegExp regexp in Compiled regular expression. Must have been returned previously by \fBTcl_GetRegExpFromObj\fR or \fBTcl_RegExpCompile\fR. .AP char *start in -If \fIstring\fR is just a portion of some other string, this argument +If \fItext\fR is just a portion of some other string, this argument identifies the beginning of the larger string. -If it isn't the same as \fIstring\fR, then no \fB^\fR matches +If it isn't the same as \fItext\fR, then no \fB^\fR matches will be allowed. .AP int index in Specifies which range is desired: 0 means the range of the entire @@ -77,11 +77,8 @@ The address of the character just after the last one in the range is stored here, or NULL if there is no such range. .AP int cflags in OR-ed combination of compilation flags. See below for more information. -.AP Tcl_Obj *objPtr in/out -An object which contains the string to check for a match with a -regular expression. .AP int offset in -The character offset into the string where matching should begin. +The character offset into the text where matching should begin. The value of the offset has no impact on \fB^\fR matches. This behavior is controlled by \fIeflags\fR. .AP int nmatches in @@ -111,7 +108,7 @@ If an error occurs in the matching process (e.g. \fIpattern\fR is not a valid regular expression) then \fBTcl_RegExpMatch\fR returns \-1 and leaves an error message in the interpreter result. \fBTcl_RegExpMatchObj\fR is similar to \fBTcl_RegExpMatch\fR except it -operates on the Tcl objects \fIstrObj\fR and \fIpatObj\fR instead of +operates on the Tcl objects \fItextObj\fR and \fIpatObj\fR instead of UTF strings. \fBTcl_RegExpMatchObj\fR is generally more efficient than \fBTcl_RegExpMatch\fR, so it is the preferred interface. @@ -130,7 +127,7 @@ up to the next call to \fBTcl_RegExpCompile\fR; it is not safe to retain these values for long periods of time. .PP \fBTcl_RegExpExec\fR executes the regular expression pattern matcher. -It returns 1 if \fIstring\fR contains a range of characters that +It returns 1 if \fItext\fR contains a range of characters that match \fIregexp\fR, 0 if no match is found, and \-1 if an error occurs. In the case of an error, \fBTcl_RegExpExec\fR leaves an error @@ -139,14 +136,14 @@ When searching a string for multiple matches of a pattern, it is important to distinguish between the start of the original string and the start of the current search. For example, when searching for the second occurrence of a -match, the \fIstring\fR argument might point to the character +match, the \fItext\fR argument might point to the character just after the first match; however, it is important for the pattern matcher to know that this is not the start of the entire string, so that it doesn't allow \fB^\fR atoms in the pattern to match. The \fIstart\fR argument provides this information by pointing -to the start of the overall string containing \fIstring\fR. -\fIStart\fR will be less than or equal to \fIstring\fR; if it -is less than \fIstring\fR then no \fB^\fR matches will be allowed. +to the start of the overall string containing \fItext\fR. +\fIStart\fR will be less than or equal to \fItext\fR; if it +is less than \fItext\fR then no \fB^\fR matches will be allowed. .PP \fBTcl_RegExpRange\fR may be invoked after \fBTcl_RegExpExec\fR returns; it provides detailed information about what ranges of diff --git a/doc/SetResult.3 b/doc/SetResult.3 index c43cb4c..f3960ae 100644 --- a/doc/SetResult.3 +++ b/doc/SetResult.3 @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: SetResult.3,v 1.11 2004/10/07 15:15:48 dkf Exp $ +'\" RCS: @(#) $Id: SetResult.3,v 1.11.2.1 2005/05/05 17:55:23 kennykb Exp $ '\" .so man.macros .TH Tcl_SetResult 3 8.0 Tcl "Tcl Library Procedures" @@ -21,16 +21,16 @@ Tcl_SetObjResult, Tcl_GetObjResult, Tcl_SetResult, Tcl_GetStringResult, Tcl_Appe Tcl_Obj * \fBTcl_GetObjResult\fR(\fIinterp\fR) .sp -\fBTcl_SetResult\fR(\fIinterp, string, freeProc\fR) +\fBTcl_SetResult\fR(\fIinterp, result, freeProc\fR) .sp const char * \fBTcl_GetStringResult\fR(\fIinterp\fR) .sp -\fBTcl_AppendResult\fR(\fIinterp, string, string, ... , \fB(char *) NULL\fR) +\fBTcl_AppendResult\fR(\fIinterp, result, result, ... , \fB(char *) NULL\fR) .sp \fBTcl_AppendResultVA\fR(\fIinterp, argList\fR) .sp -\fBTcl_AppendElement\fR(\fIinterp, string\fR) +\fBTcl_AppendElement\fR(\fIinterp, element\fR) .sp \fBTcl_ResetResult\fR(\fIinterp\fR) .sp @@ -41,12 +41,15 @@ const char * Interpreter whose result is to be modified or read. .AP Tcl_Obj *objPtr in Object value to become result for \fIinterp\fR. -.AP char *string in +.AP char *result in String value to become result for \fIinterp\fR or to be appended to the existing result. +.AP char *element in +String value to append as a list element +to the existing result of \fIinterp\fR. .AP Tcl_FreeProc *freeProc in Address of procedure to call to release storage at -\fIstring\fR, or \fBTCL_STATIC\fR, \fBTCL_DYNAMIC\fR, or +\fIresult\fR, or \fBTCL_STATIC\fR, \fBTCL_DYNAMIC\fR, or \fBTCL_VOLATILE\fR. .AP va_list argList in An argument list which must have been initialized using @@ -87,17 +90,17 @@ they should use \fBTcl_IncrRefCount\fR to increment its reference count in order to keep it from being freed too early or accidentally changed. .PP \fBTcl_SetResult\fR -arranges for \fIstring\fR to be the result for the current Tcl +arranges for \fIresult\fR to be the result for the current Tcl command in \fIinterp\fR, replacing any existing result. The \fIfreeProc\fR argument specifies how to manage the storage -for the \fIstring\fR argument; +for the \fIresult\fR argument; it is discussed in the section \fBTHE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT\fR below. -If \fIstring\fR is \fBNULL\fR, then \fIfreeProc\fR is ignored +If \fIresult\fR is \fBNULL\fR, then \fIfreeProc\fR is ignored and \fBTcl_SetResult\fR re-initializes \fIinterp\fR's result to point to an empty string. .PP -\fBTcl_GetStringResult\fR returns the result for \fIinterp\fR as an string. +\fBTcl_GetStringResult\fR returns the result for \fIinterp\fR as a string. If the result was set to an object by a \fBTcl_SetObjResult\fR call, the object form will be converted to a string and returned. If the object's string representation contains null bytes, @@ -118,12 +121,12 @@ and the result is left as a empty string. and \fBTcl_SetErrorCode\fR. .PP \fBTcl_AppendResult\fR makes it easy to build up Tcl results in pieces. -It takes each of its \fIstring\fR arguments and appends them in order +It takes each of its \fIresult\fR arguments and appends them in order to the current result associated with \fIinterp\fR. If the result is in its initialized empty state (e.g. a command procedure was just invoked or \fBTcl_ResetResult\fR was just called), then \fBTcl_AppendResult\fR sets the result to the concatenation of -its \fIstring\fR arguments. +its \fIresult\fR arguments. \fBTcl_AppendResult\fR may be called repeatedly as additional pieces of the result are produced. \fBTcl_AppendResult\fR takes care of all the @@ -132,7 +135,7 @@ result, such as allocating a larger result area if necessary. It also manages conversion to and from the \fIresult\fR field of the \fIinterp\fR so as to handle backward-compatability with old-style extensions. -Any number of \fIstring\fR arguments may be passed in a single +Any number of \fIresult\fR arguments may be passed in a single call; the last argument in the list must be a NULL pointer. .PP \fBTcl_AppendResultVA\fR is the same as \fBTcl_AppendResult\fR except that @@ -148,12 +151,12 @@ can be significantly more efficient. .PP \fBTcl_AppendElement\fR is similar to \fBTcl_AppendResult\fR in that it allows results to be built up in pieces. -However, \fBTcl_AppendElement\fR takes only a single \fIstring\fR +However, \fBTcl_AppendElement\fR takes only a single \fIelement\fR argument and it appends that argument to the current result as a proper Tcl list element. \fBTcl_AppendElement\fR adds backslashes or braces if necessary to ensure that \fIinterp\fR's result can be parsed as a list and that -\fIstring\fR will be extracted as a single element. +\fIelement\fR will be extracted as a single element. Under normal conditions, \fBTcl_AppendElement\fR will add a space character to \fIinterp\fR's result just before adding the new list element, so that the list elements in the result are properly @@ -185,21 +188,21 @@ and write the result using \fBTcl_SetObjResult\fR or \fBTcl_SetResult\fR. .SH "THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT" .PP \fBTcl_SetResult\fR's \fIfreeProc\fR argument specifies how -the Tcl system is to manage the storage for the \fIstring\fR argument. +the Tcl system is to manage the storage for the \fIresult\fR argument. If \fBTcl_SetResult\fR or \fBTcl_SetObjResult\fR are called at a time when \fIinterp\fR holds a string result, they do whatever is necessary to dispose of the old string result (see the \fBTcl_Interp\fR manual entry for details on this). .PP -If \fIfreeProc\fR is \fBTCL_STATIC\fR it means that \fIstring\fR +If \fIfreeProc\fR is \fBTCL_STATIC\fR it means that \fIresult\fR refers to an area of static storage that is guaranteed not to be modified until at least the next call to \fBTcl_Eval\fR. If \fIfreeProc\fR -is \fBTCL_DYNAMIC\fR it means that \fIstring\fR was allocated with a call +is \fBTCL_DYNAMIC\fR it means that \fIresult\fR was allocated with a call to \fBTcl_Alloc\fR and is now the property of the Tcl system. \fBTcl_SetResult\fR will arrange for the string's storage to be released by calling \fBTcl_Free\fR when it is no longer needed. -If \fIfreeProc\fR is \fBTCL_VOLATILE\fR it means that \fIstring\fR +If \fIfreeProc\fR is \fBTCL_VOLATILE\fR it means that \fIresult\fR points to an area of memory that is likely to be overwritten when \fBTcl_SetResult\fR returns (e.g. it points to something in a stack frame). In this case \fBTcl_SetResult\fR will make a copy of the string in @@ -217,7 +220,7 @@ result that match the type \fBTcl_FreeProc\fR: typedef void Tcl_FreeProc(char *\fIblockPtr\fR); .CE When \fIfreeProc\fR is called, its \fIblockPtr\fR will be set to -the value of \fIstring\fR passed to \fBTcl_SetResult\fR. +the value of \fIresult\fR passed to \fBTcl_SetResult\fR. .SH "SEE ALSO" Tcl_AddErrorInfo, Tcl_CreateObjCommand, Tcl_SetErrorCode, Tcl_Interp diff --git a/doc/StrMatch.3 b/doc/StrMatch.3 index 96a1311..e9781aa 100644 --- a/doc/StrMatch.3 +++ b/doc/StrMatch.3 @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: StrMatch.3,v 1.6.2.1 2005/04/10 23:14:42 kennykb Exp $ +'\" RCS: @(#) $Id: StrMatch.3,v 1.6.2.2 2005/05/05 17:55:24 kennykb Exp $ '\" .so man.macros .TH Tcl_StringMatch 3 8.1 Tcl "Tcl Library Procedures" @@ -17,13 +17,13 @@ Tcl_StringMatch, Tcl_StringCaseMatch \- test whether a string matches a pattern \fB#include <tcl.h>\fR .sp int -\fBTcl_StringMatch\fR(\fIstring\fR, \fIpattern\fR) +\fBTcl_StringMatch\fR(\fIstr\fR, \fIpattern\fR) .sp int -\fBTcl_StringCaseMatch\fR(\fIstring\fR, \fIpattern\fR, \fInocase\fR) +\fBTcl_StringCaseMatch\fR(\fIstr\fR, \fIpattern\fR, \fInocase\fR) .SH ARGUMENTS .AS "const char" *pattern -.AP "const char" *string in +.AP "const char" *str in String to test. .AP "const char" *pattern in Pattern to match against string. May contain special @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: Utf.3,v 1.20.2.1 2005/04/10 23:14:42 kennykb Exp $ +'\" RCS: @(#) $Id: Utf.3,v 1.20.2.2 2005/05/05 17:55:24 kennykb Exp $ '\" .so man.macros .TH Utf 3 "8.1" Tcl "Tcl Library Procedures" @@ -24,34 +24,34 @@ int \fBTcl_UtfToUniChar\fR(\fIsrc, chPtr\fR) .sp char * -\fBTcl_UniCharToUtfDString\fR(\fIuniStr, numChars, dstPtr\fR) +\fBTcl_UniCharToUtfDString\fR(\fIuniStr, uniLength, dsPtr\fR) .sp Tcl_UniChar * -\fBTcl_UtfToUniCharDString\fR(\fIsrc, len, dstPtr\fR) +\fBTcl_UtfToUniCharDString\fR(\fIsrc, length, dsPtr\fR) .sp int \fBTcl_UniCharLen\fR(\fIuniStr\fR) .sp int -\fBTcl_UniCharNcmp\fR(\fIuniStr, uniStr, num\fR) +\fBTcl_UniCharNcmp\fR(\fIucs, uct, numChars\fR) .sp int -\fBTcl_UniCharNcasecmp\fR(\fIuniStr, uniStr, num\fR) +\fBTcl_UniCharNcasecmp\fR(\fIucs, uct, numChars\fR) .sp int \fBTcl_UniCharCaseMatch\fR(\fIuniStr, uniPattern, nocase\fR) .sp int -\fBTcl_UtfNcmp\fR(\fIsrc, src, num\fR) +\fBTcl_UtfNcmp\fR(\fIcs, ct, numChars\fR) .sp int -\fBTcl_UtfNcasecmp\fR(\fIsrc, src, num\fR) +\fBTcl_UtfNcasecmp\fR(\fIcs, ct, numChars\fR) .sp int -\fBTcl_UtfCharComplete\fR(\fIsrc, len\fR) +\fBTcl_UtfCharComplete\fR(\fIsrc, length\fR) .sp int -\fBTcl_NumUtfChars\fR(\fIsrc, len\fR) +\fBTcl_NumUtfChars\fR(\fIsrc, length\fR) .sp const char * \fBTcl_UtfFindFirst\fR(\fIsrc, ch\fR) @@ -84,19 +84,27 @@ The Tcl_UniChar to be converted or examined. Filled with the Tcl_UniChar represented by the head of the UTF-8 string. .AP "const char" *src in Pointer to a UTF-8 string. +.AP "const char" *cs in +Pointer to a UTF-8 string. +.AP "const char" *ct in +Pointer to a UTF-8 string. .AP "const Tcl_UniChar" *uniStr in A null-terminated Unicode string. +.AP "const Tcl_UniChar" *ucs in +A null-terminated Unicode string. +.AP "const Tcl_UniChar" *uct in +A null-terminated Unicode string. .AP "const Tcl_UniChar" *uniPattern in A null-terminated Unicode string. -.AP int len in +.AP int length in The length of the UTF-8 string in bytes (not UTF-8 characters). If negative, all bytes up to the first null byte are used. -.AP int numChars in +.AP int uniLength in The length of the Unicode string in characters. Must be greater than or equal to 0. -.AP "Tcl_DString" *dstPtr in/out +.AP "Tcl_DString" *dsPtr in/out A pointer to a previously initialized \fBTcl_DString\fR. -.AP "unsigned long" num in +.AP "unsigned long" numChars in The number of characters to compare. .AP "const char" *start in Pointer to the beginning of a UTF-8 string. @@ -140,15 +148,16 @@ byte of \fIsrc\fR in \fI*chPtr\fR as a Tcl_UniChar between 0x0000 and .PP \fBTcl_UniCharToUtfDString\fR converts the given Unicode string to UTF-8, storing the result in a previously initialized \fBTcl_DString\fR. -You must specify the length of the given Unicode string. +You must specify \fIuniLength\fR, the length of the given Unicode string. The return value is a pointer to the UTF-8 representation of the Unicode string. Storage for the return value is appended to the end of the \fBTcl_DString\fR. .PP \fBTcl_UtfToUniCharDString\fR converts the given UTF-8 string to Unicode, storing the result in the previously initialized \fBTcl_DString\fR. -You may either specify the length of the given UTF-8 string or "-1", -in which case \fBTcl_UtfToUniCharDString\fR uses \fBstrlen\fR to +In the argument \fIlength\fR, you may either specify the length of +the given UTF-8 string in bytes or "-1", in which +case \fBTcl_UtfToUniCharDString\fR uses \fBstrlen\fR to calculate the length. The return value is a pointer to the Unicode representation of the UTF-8 string. Storage for the return value is appended to the end of the \fBTcl_DString\fR. The Unicode string @@ -161,7 +170,7 @@ the number of Unicode characters (not bytes) in that string. \fBTcl_UniCharNcmp\fR and \fBTcl_UniCharNcasecmp\fR correspond to \fBstrncmp\fR and \fBstrncasecmp\fR, respectively, for Unicode characters. They accept two null-terminated Unicode strings and the number of characters -to compare. Both strings are assumed to be at least \fIlen\fR characters +to compare. Both strings are assumed to be at least \fInumChars\fR characters long. \fBTcl_UniCharNcmp\fR compares the two strings character-by-character according to the Unicode character ordering. It returns an integer greater than, equal to, or less than 0 if the first string is greater than, equal @@ -175,7 +184,7 @@ be case sensitive and returns whether the string matches the pattern. .PP \fBTcl_UtfNcmp\fR corresponds to \fBstrncmp\fR for UTF-8 strings. It accepts two null-terminated UTF-8 strings and the number of characters -to compare. (Both strings are assumed to be at least \fIlen\fR +to compare. (Both strings are assumed to be at least \fInumChars\fR characters long.) \fBTcl_UtfNcmp\fR compares the two strings character-by-character according to the Unicode character ordering. It returns an integer greater than, equal to, or less than 0 if the @@ -188,7 +197,7 @@ differences in case when comparing upper, lower or title case characters. .PP \fBTcl_UtfCharComplete\fR returns 1 if the source UTF-8 string \fIsrc\fR -of length \fIlen\fR bytes is long enough to be decoded by +of \fIlength\fR bytes is long enough to be decoded by \fBTcl_UtfToUniChar\fR, or 0 otherwise. This function does not guarantee that the UTF-8 string is properly formed. This routine is used by procedures that are operating on a byte at a time and need to know if a @@ -196,7 +205,7 @@ full Tcl_UniChar has been seen. .PP \fBTcl_NumUtfChars\fR corresponds to \fBstrlen\fR for UTF-8 strings. It returns the number of Tcl_UniChars that are represented by the UTF-8 string -\fIsrc\fR. The length of the source string is \fIlen\fR bytes. If the +\fIsrc\fR. The length of the source string is \fIlength\fR bytes. If the length is negative, all bytes up to the first null byte are used. .PP \fBTcl_UtfFindFirst\fR corresponds to \fBstrchr\fR for UTF-8 strings. It diff --git a/doc/lindex.n b/doc/lindex.n index 8b5233c..14aeb3f 100644 --- a/doc/lindex.n +++ b/doc/lindex.n @@ -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: lindex.n,v 1.8.2.1 2005/04/10 23:14:43 kennykb Exp $ +'\" RCS: @(#) $Id: lindex.n,v 1.8.2.2 2005/05/05 17:55:24 kennykb Exp $ '\" .so man.macros .TH lindex n 8.4 Tcl "Tcl Built-In Commands" @@ -46,9 +46,11 @@ substitution and command substitution do not occur. If \fIindex\fR is negative or greater than or equal to the number of elements in \fIvalue\fR, then an empty string is returned. -If \fIindex\fR has the value \fBend\fR, it refers to the last element -in the list, and \fBend\-\fIinteger\fR refers to the last element in -the list minus the specified integer offset. +.VS 8.5 +The interpretation of each simple \fIindex\fR value is the same as +for the command \fBstring index\fR, supporting simple index +arithmetic and indices relative to the end of the list. +.VE 8.5 .PP If additional \fIindex\fR arguments are supplied, then each argument is used in turn to select an element from the previous indexing operation, @@ -79,7 +81,10 @@ lindex [lindex [lindex $a 1] 2] 3 .CE .SH "SEE ALSO" list(n), lappend(n), linsert(n), llength(n), lsearch(n), -lset(n), lsort(n), lrange(n), lreplace(n) +lset(n), lsort(n), lrange(n), lreplace(n), +.VS 8.5 +string(n) +.VE .SH KEYWORDS element, index, list diff --git a/doc/linsert.n b/doc/linsert.n index e7b4c10..2d140ee 100644 --- a/doc/linsert.n +++ b/doc/linsert.n @@ -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: linsert.n,v 1.10.2.1 2005/04/10 23:14:43 kennykb Exp $ +'\" RCS: @(#) $Id: linsert.n,v 1.10.2.2 2005/05/05 17:55:24 kennykb Exp $ '\" .so man.macros .TH linsert n 8.2 Tcl "Tcl Built-In Commands" @@ -24,11 +24,12 @@ This command produces a new list from \fIlist\fR by inserting all of the \fIelement\fR arguments just before the \fIindex\fR'th element of \fIlist\fR. Each \fIelement\fR argument will become a separate element of the new list. If \fIindex\fR is less than or equal to zero, then the new -elements are inserted at the beginning of the list. If \fIindex\fR has the -value \fBend\fR, or if it is greater than or equal to the number of -elements in the list, then the new elements are appended to the list. -\fBend\-\fIinteger\fR refers to the last element in the list minus the -specified integer offset. +elements are inserted at the beginning of the list. +.VS 8.5 +The interpretation of the \fIindex\fR value is the same as +for the command \fBstring index\fR, supporting simple index +arithmetic and indices relative to the end of the list. +.VE .SH EXAMPLE Putting some values into a list, first indexing from the start and then indexing from the end, and then chaining them together: @@ -42,7 +43,10 @@ set newerList [\fBlinsert\fR [\fBlinsert\fR $oldList end-1 quick] 1 lazy] .SH "SEE ALSO" list(n), lappend(n), lindex(n), llength(n), lsearch(n), -lset(n), lsort(n), lrange(n), lreplace(n) +lset(n), lsort(n), lrange(n), lreplace(n), +.VS 8.5 +string(n) +.VE .SH KEYWORDS element, insert, list diff --git a/doc/lrange.n b/doc/lrange.n index e99196a..ccb344f 100644 --- a/doc/lrange.n +++ b/doc/lrange.n @@ -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: lrange.n,v 1.9.2.1 2005/04/10 23:14:43 kennykb Exp $ +'\" RCS: @(#) $Id: lrange.n,v 1.9.2.2 2005/05/05 17:55:25 kennykb Exp $ '\" .so man.macros .TH lrange n 7.4 Tcl "Tcl Built-In Commands" @@ -23,9 +23,12 @@ lrange \- Return one or more adjacent elements from a list \fIList\fR must be a valid Tcl list. This command will return a new list consisting of elements \fIfirst\fR through \fIlast\fR, inclusive. -\fIFirst\fR or \fIlast\fR -may be \fBend\fR (or any abbreviation of it) to refer to the last -element of the list. +.VS 8.5 +The index values \fIfirst\fR and \fIlast\fR are interpreted +the same as index values for the command \fBstring index\fR, +supporting simple index arithmetic and indices relative to the +end of the list. +.VE If \fIfirst\fR is less than zero, it is treated as if it were zero. If \fIlast\fR is greater than or equal to the number of elements in the list, then it is treated as if it were \fBend\fR. @@ -67,7 +70,10 @@ elements to .SH "SEE ALSO" list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n), -lset(n), lreplace(n), lsort(n) +lset(n), lreplace(n), lsort(n), +.VS 8.5 +string(n) +.VE .SH KEYWORDS element, list, range, sublist diff --git a/doc/lreplace.n b/doc/lreplace.n index 29093cb..bfa173e 100644 --- a/doc/lreplace.n +++ b/doc/lreplace.n @@ -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: lreplace.n,v 1.10.2.1 2005/04/10 23:14:43 kennykb Exp $ +'\" RCS: @(#) $Id: lreplace.n,v 1.10.2.2 2005/05/05 17:55:25 kennykb Exp $ '\" .so man.macros .TH lreplace n 7.4 Tcl "Tcl Built-In Commands" @@ -22,11 +22,17 @@ lreplace \- Replace elements in a list with new elements .PP \fBlreplace\fR returns a new list formed by replacing one or more elements of \fIlist\fR with the \fIelement\fR arguments. -\fIfirst\fR and \fIlast\fR specify the first and last index of the -range of elements to replace. 0 refers to the first element of the -list, and \fBend\fR (or any abbreviation of it) may be used to refer -to the last element of the list. If \fIlist\fR is empty, then -\fIfirst\fR and \fIlast\fR are ignored. +.VS 8.5 +\fIfirst\fR and \fIlast\fR are index values specifying the first and +last elements of the range to replace. +The index values \fIfirst\fR and \fIlast\fR are interpreted +the same as index values for the command \fBstring index\fR, +supporting simple index arithmetic and indices relative to the +end of the list. +0 refers to the first element of the +list, and \fBend\fR refers to the last element of the list. +If \fIlist\fR is empty, then \fIfirst\fR and \fIlast\fR are ignored. +.VE If \fIfirst\fR is less than zero, it is considered to refer to the first element of the list. For non-empty lists, the element indicated @@ -66,7 +72,11 @@ a b c d .SH "SEE ALSO" list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n), -lset(n), lrange(n), lsort(n) +lset(n), lrange(n), lsort(n), +.VS 8.5 +string(n) +.VE + .SH KEYWORDS element, list, replace diff --git a/doc/lsearch.n b/doc/lsearch.n index a860ff2..4fd2c0a 100644 --- a/doc/lsearch.n +++ b/doc/lsearch.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: lsearch.n,v 1.21.2.1 2005/01/20 14:53:39 kennykb Exp $ +'\" RCS: @(#) $Id: lsearch.n,v 1.21.2.2 2005/05/05 17:55:25 kennykb Exp $ '\" .so man.macros .TH lsearch n 8.5 Tcl "Tcl Built-In Commands" @@ -70,10 +70,12 @@ This negates the sense of the match, returning the index of the first non-matching value in the list. .TP \fB\-start\fR\0\fIindex\fR -The list is searched starting at position \fIindex\fR. If \fIindex\fR -has the value \fBend\fR, it refers to the last element in the list, -and \fBend\-\fIinteger\fR refers to the last element in the list minus -the specified integer offset. +The list is searched starting at position \fIindex\fR. +.VS 8.5 +The interpretation of the \fIindex\fR value is the same as +for the command \fBstring index\fR, supporting simple index +arithmetic and indices relative to the end of the list. +.VE 8.5 .SS "CONTENTS DESCRIPTION OPTIONS" These options describe how to interpret the items in the list being searched. They are only meaningful when used with the \fB\-exact\fR @@ -166,7 +168,11 @@ It is also possible to search inside elements: .SH "SEE ALSO" foreach(n), list(n), lappend(n), lindex(n), linsert(n), llength(n), -lset(n), lsort(n), lrange(n), lreplace(n) +lset(n), lsort(n), lrange(n), lreplace(n), +.VS 8.5 +string(n) +.VE + .SH KEYWORDS list, match, pattern, regular expression, search, string @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: lset.n,v 1.7 2003/12/01 21:27:14 msofer Exp $ +'\" RCS: @(#) $Id: lset.n,v 1.7.2.1 2005/05/05 17:55:26 kennykb Exp $ '\" .so man.macros .TH lset n 8.4 Tcl "Tcl Built-In Commands" @@ -52,9 +52,11 @@ command. If \fIindex\fR is negative or greater than or equal to the number of elements in \fI$varName\fR, then an error occurs. .PP -If \fIindex\fR has the value \fBend\fR, it refers to the last element -in the list, and \fBend\-\fIinteger\fR refers to the last element in -the list minus the specified integer offset. +.VS 8.5 +The interpretation of each simple \fIindex\fR value is the same as +for the command \fBstring index\fR, supporting simple index +arithmetic and indices relative to the end of the list. +.VE 8.5 .PP If additional \fIindex\fR arguments are supplied, then each argument is used in turn to address an element within a sublist designated @@ -107,7 +109,11 @@ lset x {1 1 0} j => {{a b} {c d}} {{e f} {j h}} .CE .SH "SEE ALSO" list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n), -lsort(n), lrange(n), lreplace(n) +lsort(n), lrange(n), lreplace(n), +.VS 8.5 +string(n) +.VE + .SH KEYWORDS element, index, list, replace, set diff --git a/doc/lsort.n b/doc/lsort.n index ae7d177..27bf90c 100644 --- a/doc/lsort.n +++ b/doc/lsort.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: lsort.n,v 1.18 2004/10/27 12:53:22 dkf Exp $ +'\" RCS: @(#) $Id: lsort.n,v 1.18.2.1 2005/05/05 17:55:27 kennykb Exp $ '\" .so man.macros .TH lsort n 8.3 Tcl "Tcl Built-In Commands" @@ -78,10 +78,7 @@ sublists, \fBlsort\fR will extract the \fIindexList\fR'th element from each sublist .VS 8.5 (as if the overall element and the \fIindexList\fR were passed to -\fBlindex\fR) and sort based on the given element. The keyword -\fBend\fP is allowed for each element of the \fIindexList\fR to sort -on the last sublist element, and \fBend-\fIindex\fR sorts on a sublist -element offset from the end. +\fBlindex\fR) and sort based on the given element. .VE 8.5 For example, .RS @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: open.n,v 1.22.2.1 2005/04/10 23:14:43 kennykb Exp $ +'\" RCS: @(#) $Id: open.n,v 1.22.2.2 2005/05/05 17:55:27 kennykb Exp $ '\" .so man.macros .TH open n 8.3 Tcl "Tcl Built-In Commands" @@ -61,6 +61,14 @@ Set the initial access position to the end of the file. Open the file for reading and writing. If the file doesn't exist, create a new empty file. Set the initial access position to the end of the file. +.VS 8.5 +.PP +All of the legal \fIaccess\fR values above may have the character +\fBb\fR added as the second or third character in the value to +indicate that the opened channel should be configured with the +\fB-translation binary\fR option, making the channel suitable for +reading or writing of binary data. +.VE 8.5 .PP In the second form, \fIaccess\fR consists of a list of any of the following flags, all of which have the standard POSIX meanings. @@ -78,6 +86,11 @@ Open the file for both reading and writing. \fBAPPEND\fR Set the file pointer to the end of the file prior to each write. .TP 15 +.VS 8.5 +\fBBINARY\fR +Configure the opened channed with the \fB-translation binary\fR option. +.VE 8.5 +.TP 15 \fBCREAT\fR Create the file if it doesn't already exist (without this flag it is an error for the file not to exist). @@ -106,14 +119,6 @@ If a new file is created as part of opening it, \fIpermissions\fR (an integer) is used to set the permissions for the new file in conjunction with the process's file mode creation mask. \fIPermissions\fR defaults to 0666. -.PP -Note that if you are going to be reading or writing binary data from -the channel created by this command, you should use the -\fBfconfigure\fR command to change the \fB-translation\fR option of -the channel to \fBbinary\fR before transferring any binary data. This -is in contrast to the ``b'' character passed as part of the equivalent -of the \fIaccess\fR parameter to some versions of the C library -\fIfopen()\fR function. .SH "COMMAND PIPELINES" .PP diff --git a/doc/regexp.n b/doc/regexp.n index 2a6db1b..ac229b9 100644 --- a/doc/regexp.n +++ b/doc/regexp.n @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: regexp.n,v 1.16.2.1 2005/04/10 23:14:44 kennykb Exp $ +'\" RCS: @(#) $Id: regexp.n,v 1.16.2.2 2005/05/05 17:55:27 kennykb Exp $ '\" .so man.macros .TH regexp n 8.3 Tcl "Tcl Built-In Commands" @@ -107,7 +107,12 @@ regular expression. Examples are: .TP 15 \fB\-start\fR \fIindex\fR Specifies a character index offset into the string to start -matching the regular expression at. When using this switch, `^' +matching the regular expression at. +.VS 8.5 +The \fIindex\fR value is interpreted in the same manner +as the \fIindex\fR argument to \fBstring index\fR. +.VE 8.5 +When using this switch, `^' will not match the beginning of the line, and \\A will still match the start of the string at \fIindex\fR. If \fB\-indices\fR is specified, the indices will be indexed starting from the @@ -153,7 +158,11 @@ characters) in a string: .CE .SH "SEE ALSO" -re_syntax(n), regsub(n) +re_syntax(n), regsub(n), +.VS 8.5 +string(n) +.VE + .SH KEYWORDS match, regular expression, string diff --git a/doc/regsub.n b/doc/regsub.n index bc1416f..71ac04c 100644 --- a/doc/regsub.n +++ b/doc/regsub.n @@ -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: regsub.n,v 1.12.2.1 2005/04/10 23:14:44 kennykb Exp $ +'\" RCS: @(#) $Id: regsub.n,v 1.12.2.2 2005/05/05 17:55:28 kennykb Exp $ '\" .so man.macros .TH regsub n 8.3 Tcl "Tcl Built-In Commands" @@ -92,7 +92,12 @@ by \fIsubSpec\fR use the original unconverted form of \fIstring\fR. .TP 10 \fB\-start\fR \fIindex\fR Specifies a character index offset into the string to start -matching the regular expression at. When using this switch, `^' +matching the regular expression at. +.VS 8.5 +The \fIindex\fR value is interpreted in the same manner +as the \fIindex\fR argument to \fBstring index\fR. +.VE 8.5 +When using this switch, `^' will not match the beginning of the line, and \\A will still match the start of the string at \fIindex\fR. \fIindex\fR will be constrained to the bounds of the input string. @@ -134,7 +139,11 @@ set quoted [subst [\fBregsub\fR -all $RE $string $substitution]] .CE .SH "SEE ALSO" -regexp(n), re_syntax(n), subst(n) +regexp(n), re_syntax(n), subst(n), +.VS 8.5 +string(n) +.VE + .SH KEYWORDS match, pattern, regular expression, substitute diff --git a/doc/string.n b/doc/string.n index 9c14298..64013dc 100644 --- a/doc/string.n +++ b/doc/string.n @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: string.n,v 1.24.2.2 2005/03/09 15:57:15 kennykb Exp $ +'\" RCS: @(#) $Id: string.n,v 1.24.2.3 2005/05/05 17:55:28 kennykb Exp $ '\" .so man.macros .TH string n 8.1 Tcl "Tcl Built-In Commands" @@ -72,18 +72,38 @@ will return \fB\-1\fR. Returns the \fIcharIndex\fR'th character of the \fIstring\fR argument. A \fIcharIndex\fR of 0 corresponds to the first character of the string. \fIcharIndex\fR may be specified as follows: +.VS 8.5 .RS .IP \fIinteger\fR 10 -The char specified at this integral index. +For any index value that passes \fBstring is integer -strict\fR, +the char specified at this integral index +(e.g. \fB2\fR would refer to the "c" in "abcd"). .IP \fBend\fR 10 -The last char of the string. -.IP \fBend\-\fIinteger\fR 10 -The last char of the string minus the specified integer offset +The last char of the string +(e.g. \fBend\fR would refer to the "d" in "abcd"). +.IP \fBend\-\fIN\fR 10 +The last char of the string minus the specified integer offset \fIN\fR (e.g. \fBend\-1\fR would refer to the "c" in "abcd"). +.IP \fBend\+\fIN\fR 10 +The last char of the string plus the specified integer offset \fIN\fR +(e.g. \fBend\+\-1\fR would refer to the "c" in "abcd"). +.IP \fIM\fR\+\fIN\fR 10 +The char specified at the integral index that is the sum of +integer values \fIM\fR and \fIN\fR +(e.g. \fB1\+1\fR would refer to the "c" in "abcd"). +.IP \fIM\fR\-\fIN\fR 10 +The char specified at the integral index that is the difference of +integer values \fIM\fR and \fIN\fR +(e.g. \fB2\-1\fR would refer to the "b" in "abcd"). +.PP +In the specifications above, the integer value \fIM\fR contains no +trailing whitespace and the integer value \fIN\fR contains no +leading whitespace. .PP If \fIcharIndex\fR is less than 0 or greater than or equal to the -length of the string then an empty string is returned. +length of the string then this command returns an empty string. .RE +.VE .TP \fBstring is \fIclass\fR ?\fB\-strict\fR? ?\fB\-failindex \fIvarname\fR? \fIstring\fR Returns 1 if \fIstring\fR is a valid member of the specified character diff --git a/generic/tcl.decls b/generic/tcl.decls index db39a1a..c2176cf 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -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: tcl.decls,v 1.105.2.5 2005/02/02 15:53:14 kennykb Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.105.2.6 2005/05/05 17:55:29 kennykb Exp $ library tcl @@ -136,7 +136,7 @@ declare 30 generic { void TclFreeObj(Tcl_Obj *objPtr) } declare 31 generic { - int Tcl_GetBoolean(Tcl_Interp *interp, CONST char *str, int *boolPtr) + int Tcl_GetBoolean(Tcl_Interp *interp, CONST char *src, int *boolPtr) } declare 32 generic { int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, @@ -146,7 +146,7 @@ declare 33 generic { unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, int *lengthPtr) } declare 34 generic { - int Tcl_GetDouble(Tcl_Interp *interp, CONST char *str, double *doublePtr) + int Tcl_GetDouble(Tcl_Interp *interp, CONST char *src, double *doublePtr) } declare 35 generic { int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, @@ -157,7 +157,7 @@ declare 36 generic { CONST84 char **tablePtr, CONST char *msg, int flags, int *indexPtr) } declare 37 generic { - int Tcl_GetInt(Tcl_Interp *interp, CONST char *str, int *intPtr) + int Tcl_GetInt(Tcl_Interp *interp, CONST char *src, int *intPtr) } declare 38 generic { int Tcl_GetIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr) @@ -261,7 +261,7 @@ declare 68 generic { void Tcl_AllowExceptions(Tcl_Interp *interp) } declare 69 generic { - void Tcl_AppendElement(Tcl_Interp *interp, CONST char *string) + void Tcl_AppendElement(Tcl_Interp *interp, CONST char *element) } declare 70 generic { void Tcl_AppendResult(Tcl_Interp *interp, ...) @@ -431,10 +431,10 @@ declare 116 generic { void Tcl_DoWhenIdle(Tcl_IdleProc *proc, ClientData clientData) } declare 117 generic { - char * Tcl_DStringAppend(Tcl_DString *dsPtr, CONST char *str, int length) + char * Tcl_DStringAppend(Tcl_DString *dsPtr, CONST char *bytes, int length) } declare 118 generic { - char * Tcl_DStringAppendElement(Tcl_DString *dsPtr, CONST char *string) + char * Tcl_DStringAppendElement(Tcl_DString *dsPtr, CONST char *element) } declare 119 generic { void Tcl_DStringEndSublist(Tcl_DString *dsPtr) @@ -467,7 +467,7 @@ declare 128 generic { CONST84_RETURN char * Tcl_ErrnoMsg(int err) } declare 129 generic { - int Tcl_Eval(Tcl_Interp *interp, CONST char *string) + int Tcl_Eval(Tcl_Interp *interp, CONST char *script) } # This is obsolete, use Tcl_FSEvalFile declare 130 generic { @@ -487,19 +487,19 @@ declare 134 generic { CONST char *cmdName) } declare 135 generic { - int Tcl_ExprBoolean(Tcl_Interp *interp, CONST char *str, int *ptr) + int Tcl_ExprBoolean(Tcl_Interp *interp, CONST char *expr, int *ptr) } declare 136 generic { int Tcl_ExprBooleanObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr) } declare 137 generic { - int Tcl_ExprDouble(Tcl_Interp *interp, CONST char *str, double *ptr) + int Tcl_ExprDouble(Tcl_Interp *interp, CONST char *expr, double *ptr) } declare 138 generic { int Tcl_ExprDoubleObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr) } declare 139 generic { - int Tcl_ExprLong(Tcl_Interp *interp, CONST char *str, long *ptr) + int Tcl_ExprLong(Tcl_Interp *interp, CONST char *expr, long *ptr) } declare 140 generic { int Tcl_ExprLongObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr) @@ -509,7 +509,7 @@ declare 141 generic { Tcl_Obj **resultPtrPtr) } declare 142 generic { - int Tcl_ExprString(Tcl_Interp *interp, CONST char *string) + int Tcl_ExprString(Tcl_Interp *interp, CONST char *expr) } declare 143 generic { void Tcl_Finalize(void) @@ -599,7 +599,7 @@ declare 166 generic { # generic interface, so we inlcude it here for compatibility reasons. declare 167 unix { - int Tcl_GetOpenFile(Tcl_Interp *interp, CONST char *str, int forWriting, + int Tcl_GetOpenFile(Tcl_Interp *interp, CONST char *chanID, int forWriting, int checkUsage, ClientData *filePtr) } # Obsolete. Should now use Tcl_FSGetPathType which is objectified @@ -727,7 +727,7 @@ declare 202 generic { void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst) } declare 203 generic { - int Tcl_PutEnv(CONST char *string) + int Tcl_PutEnv(CONST char *assignment) } declare 204 generic { CONST84_RETURN char * Tcl_PosixError(Tcl_Interp *interp) @@ -754,14 +754,14 @@ declare 211 generic { void Tcl_RegisterObjType(Tcl_ObjType *typePtr) } declare 212 generic { - Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp, CONST char *string) + Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp, CONST char *pattern) } declare 213 generic { int Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp, - CONST char *str, CONST char *start) + CONST char *text, CONST char *start) } declare 214 generic { - int Tcl_RegExpMatch(Tcl_Interp *interp, CONST char *str, + int Tcl_RegExpMatch(Tcl_Interp *interp, CONST char *text, CONST char *pattern) } declare 215 generic { @@ -821,7 +821,7 @@ declare 231 generic { int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth) } declare 232 generic { - void Tcl_SetResult(Tcl_Interp *interp, char *str, + void Tcl_SetResult(Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc) } declare 233 generic { @@ -956,7 +956,7 @@ declare 269 generic { CONST84_RETURN char * Tcl_HashStats(Tcl_HashTable *tablePtr) } declare 270 generic { - CONST84_RETURN char * Tcl_ParseVar(Tcl_Interp *interp, CONST char *str, + CONST84_RETURN char * Tcl_ParseVar(Tcl_Interp *interp, CONST char *start, CONST84 char **termPtr) } declare 271 generic { @@ -1120,7 +1120,7 @@ declare 311 generic { Tcl_Time *timePtr) } declare 312 generic { - int Tcl_NumUtfChars(CONST char *src, int len) + int Tcl_NumUtfChars(CONST char *src, int length) } declare 313 generic { int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, @@ -1165,7 +1165,7 @@ declare 325 generic { CONST84_RETURN char * Tcl_UtfAtIndex(CONST char *src, int index) } declare 326 generic { - int Tcl_UtfCharComplete(CONST char *src, int len) + int Tcl_UtfCharComplete(CONST char *src, int length) } declare 327 generic { int Tcl_UtfBackslash(CONST char *src, int *readPtr, char *dst) @@ -1247,18 +1247,18 @@ declare 351 generic { int Tcl_UniCharIsWordChar(int ch) } declare 352 generic { - int Tcl_UniCharLen(CONST Tcl_UniChar *str) + int Tcl_UniCharLen(CONST Tcl_UniChar *uniStr) } declare 353 generic { - int Tcl_UniCharNcmp(CONST Tcl_UniChar *cs, CONST Tcl_UniChar *ct, - unsigned long n) + int Tcl_UniCharNcmp(CONST Tcl_UniChar *ucs, CONST Tcl_UniChar *uct, + unsigned long numChars) } declare 354 generic { - char * Tcl_UniCharToUtfDString(CONST Tcl_UniChar *string, - int numChars, Tcl_DString *dsPtr) + char * Tcl_UniCharToUtfDString(CONST Tcl_UniChar *uniStr, + int uniLength, Tcl_DString *dsPtr) } declare 355 generic { - Tcl_UniChar * Tcl_UtfToUniCharDString(CONST char *string, + Tcl_UniChar * Tcl_UtfToUniCharDString(CONST char *src, int length, Tcl_DString *dsPtr) } declare 356 generic { @@ -1278,24 +1278,24 @@ declare 359 generic { CONST char *command, int length) } declare 360 generic { - int Tcl_ParseBraces(Tcl_Interp *interp, CONST char *string, int numBytes, + int Tcl_ParseBraces(Tcl_Interp *interp, CONST char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr) } declare 361 generic { - int Tcl_ParseCommand(Tcl_Interp *interp, CONST char *string, int numBytes, + int Tcl_ParseCommand(Tcl_Interp *interp, CONST char *start, int numBytes, int nested, Tcl_Parse *parsePtr) } declare 362 generic { - int Tcl_ParseExpr(Tcl_Interp *interp, CONST char *string, int numBytes, + int Tcl_ParseExpr(Tcl_Interp *interp, CONST char *start, int numBytes, Tcl_Parse *parsePtr) } declare 363 generic { - int Tcl_ParseQuotedString(Tcl_Interp *interp, CONST char *string, + int Tcl_ParseQuotedString(Tcl_Interp *interp, CONST char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr) } declare 364 generic { - int Tcl_ParseVarName(Tcl_Interp *interp, CONST char *string, int numBytes, + int Tcl_ParseVarName(Tcl_Interp *interp, CONST char *start, int numBytes, Tcl_Parse *parsePtr, int append) } # These 4 functions are obsolete, use Tcl_FSGetCwd, Tcl_FSChdir, @@ -1335,7 +1335,7 @@ declare 375 generic { } declare 376 generic { int Tcl_RegExpExecObj(Tcl_Interp *interp, Tcl_RegExp regexp, - Tcl_Obj *objPtr, int offset, int nmatches, int flags) + Tcl_Obj *textObj, int offset, int nmatches, int flags) } declare 377 generic { void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr) @@ -1364,7 +1364,7 @@ declare 384 generic { int length) } declare 385 generic { - int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *stringObj, + int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj) } declare 386 generic { @@ -1479,12 +1479,12 @@ declare 418 generic { } declare 419 generic { - int Tcl_UniCharNcasecmp(CONST Tcl_UniChar *cs, CONST Tcl_UniChar *ct, - unsigned long n) + int Tcl_UniCharNcasecmp(CONST Tcl_UniChar *ucs, CONST Tcl_UniChar *uct, + unsigned long numChars) } declare 420 generic { - int Tcl_UniCharCaseMatch(CONST Tcl_UniChar *ustr, - CONST Tcl_UniChar *pattern, int nocase) + int Tcl_UniCharCaseMatch(CONST Tcl_UniChar *uniStr, + CONST Tcl_UniChar *uniPattern, int nocase) } declare 421 generic { diff --git a/generic/tclBasic.c b/generic/tclBasic.c index b7c1a1b..1aaf783 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.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: tclBasic.c,v 1.136.2.7 2005/04/25 21:37:19 kennykb Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.136.2.8 2005/05/05 17:55:30 kennykb Exp $ */ #include "tclInt.h" @@ -1963,8 +1963,7 @@ TclInvokeObjectCommand(clientData, interp, argc, argv) for (i = 0; i < argc; i++) { length = strlen(argv[i]); - TclNewObj(objPtr); - TclInitStringRep(objPtr, argv[i], length); + TclNewStringObj(objPtr, argv[i], length); Tcl_IncrRefCount(objPtr); objv[i] = objPtr; } @@ -3956,12 +3955,12 @@ Tcl_EvalEx(interp, script, numBytes, flags) */ int -Tcl_Eval(interp, string) +Tcl_Eval(interp, script) Tcl_Interp *interp; /* Token for command interpreter (returned * by previous call to Tcl_CreateInterp). */ - CONST char *string; /* Pointer to TCL command to execute. */ + CONST char *script; /* Pointer to TCL command to execute. */ { - int code = Tcl_EvalEx(interp, string, -1, 0); + int code = Tcl_EvalEx(interp, script, -1, 0); /* * For backwards compatibility with old C code that predates the @@ -4197,19 +4196,19 @@ ProcessUnexpectedResult(interp, returnCode) */ int -Tcl_ExprLong(interp, string, ptr) +Tcl_ExprLong(interp, exprstring, ptr) Tcl_Interp *interp; /* Context in which to evaluate the * expression. */ - CONST char *string; /* Expression to evaluate. */ + CONST char *exprstring; /* Expression to evaluate. */ long *ptr; /* Where to store result. */ { register Tcl_Obj *exprPtr; Tcl_Obj *resultPtr; - int length = strlen(string); + int length = strlen(exprstring); int result = TCL_OK; if (length > 0) { - TclNewStringObj(exprPtr, string, length); + exprPtr = Tcl_NewStringObj(exprstring, length); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprObj(interp, exprPtr, &resultPtr); if (result == TCL_OK) { @@ -4265,19 +4264,19 @@ Tcl_ExprLong(interp, string, ptr) } int -Tcl_ExprDouble(interp, string, ptr) +Tcl_ExprDouble(interp, exprstring, ptr) Tcl_Interp *interp; /* Context in which to evaluate the * expression. */ - CONST char *string; /* Expression to evaluate. */ + CONST char *exprstring; /* Expression to evaluate. */ double *ptr; /* Where to store result. */ { register Tcl_Obj *exprPtr; Tcl_Obj *resultPtr; - int length = strlen(string); + int length = strlen(exprstring); int result = TCL_OK; if (length > 0) { - TclNewStringObj(exprPtr, string, length); + exprPtr = Tcl_NewStringObj(exprstring, length); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprObj(interp, exprPtr, &resultPtr); if (result == TCL_OK) { @@ -4333,19 +4332,19 @@ Tcl_ExprDouble(interp, string, ptr) } int -Tcl_ExprBoolean(interp, string, ptr) +Tcl_ExprBoolean(interp, exprstring, ptr) Tcl_Interp *interp; /* Context in which to evaluate the * expression. */ - CONST char *string; /* Expression to evaluate. */ + CONST char *exprstring; /* Expression to evaluate. */ int *ptr; /* Where to store 0/1 result. */ { register Tcl_Obj *exprPtr; Tcl_Obj *resultPtr; - int length = strlen(string); + int length = strlen(exprstring); int result = TCL_OK; if (length > 0) { - TclNewStringObj(exprPtr, string, length); + exprPtr = Tcl_NewStringObj(exprstring, length); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprObj(interp, exprPtr, &resultPtr); if (result == TCL_OK) { @@ -4633,61 +4632,29 @@ TclObjInvoke(interp, objc, objv, flags) */ int -Tcl_ExprString(interp, string) +Tcl_ExprString(interp, expr) Tcl_Interp *interp; /* Context in which to evaluate the * expression. */ - CONST char *string; /* Expression to evaluate. */ + CONST char *expr; /* Expression to evaluate. */ { - register Tcl_Obj *exprPtr; - Tcl_Obj *resultPtr; - int length = strlen(string); - char buf[TCL_DOUBLE_SPACE]; - int result = TCL_OK; - - if (length > 0) { - TclNewObj(exprPtr); - TclInitStringRep(exprPtr, string, length); - Tcl_IncrRefCount(exprPtr); - - result = Tcl_ExprObj(interp, exprPtr, &resultPtr); - if (result == TCL_OK) { - /* - * Set the interpreter's string result from the result object. - */ - - if (resultPtr->typePtr == &tclIntType) { - sprintf(buf, "%ld", resultPtr->internalRep.longValue); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - } else if (resultPtr->typePtr == &tclDoubleType) { - Tcl_PrintDouble((Tcl_Interp *) NULL, - resultPtr->internalRep.doubleValue, buf); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - } else { - /* - * Set interpreter's string result from the result object. - */ - - Tcl_SetResult(interp, TclGetString(resultPtr), - TCL_VOLATILE); - } - Tcl_DecrRefCount(resultPtr); /* discard the result object */ - } else { - /* - * Move the interpreter's object result to the string result, - * then reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - } - Tcl_DecrRefCount(exprPtr); /* discard the expression object */ - } else { - /* - * An empty string. Just set the interpreter's result to 0. - */ - + int code = TCL_OK; + if (expr[0] == '\0') { + /* An empty string. Just set the interpreter's result to 0. */ Tcl_SetResult(interp, "0", TCL_VOLATILE); + } else { + Tcl_Obj *resultPtr, *exprObj = Tcl_NewStringObj(expr, -1); + Tcl_IncrRefCount(exprObj); + code = Tcl_ExprObj(interp, exprObj, &resultPtr); + Tcl_DecrRefCount(exprObj); + if (code == TCL_OK) { + Tcl_SetObjResult(interp, resultPtr); + Tcl_DecrRefCount(resultPtr); + } + + /* Force the string rep of the interp result */ + (void) Tcl_GetStringResult(interp); } - return result; + return code; } /* diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 54e8b61..958a03d 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.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: tclCmdMZ.c,v 1.115.2.3 2005/04/10 23:14:46 kennykb Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.115.2.4 2005/05/05 17:55:32 kennykb Exp $ */ #include "tclInt.h" @@ -90,7 +90,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) int i, indices, match, about, offset, all, doinline, numMatchesSaved; int cflags, eflags, stringLength; Tcl_RegExp regExpr; - Tcl_Obj *objPtr, *resultPtr = NULL; + Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL; Tcl_RegExpInfo info; static CONST char *options[] = { "-all", "-about", "-indices", "-inline", @@ -121,7 +121,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) } if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT, &index) != TCL_OK) { - return TCL_ERROR; + goto optionError; } switch ((enum options) index) { case REGEXP_ALL: { @@ -161,15 +161,18 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) break; } case REGEXP_START: { + int temp; if (++i >= objc) { goto endOfForLoop; } - if (Tcl_GetIntFromObj(interp, objv[i], &offset) != TCL_OK) { - return TCL_ERROR; + if (TclGetIntForIndex(interp, objv[i], 0, &temp) != TCL_OK) { + goto optionError; } - if (offset < 0) { - offset = 0; + if (startIndex) { + Tcl_DecrRefCount(startIndex); } + startIndex = objv[i]; + Tcl_IncrRefCount(startIndex); break; } case REGEXP_LAST: { @@ -183,7 +186,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) if ((objc - i) < (2 - about)) { Tcl_WrongNumArgs(interp, 1, objv, "?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"); - return TCL_ERROR; + goto optionError; } objc -= i; objv += i; @@ -194,7 +197,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) */ Tcl_AppendResult(interp, "regexp match variables not allowed", " when using -inline", (char *) NULL); - return TCL_ERROR; + goto optionError; } /* @@ -203,6 +206,10 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) if (about) { regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags); if ((regExpr == NULL) || (TclRegAbout(interp, regExpr) < 0)) { +optionError: + if (startIndex) { + Tcl_DecrRefCount(startIndex); + } return TCL_ERROR; } return TCL_OK; @@ -216,6 +223,14 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) objPtr = objv[1]; stringLength = Tcl_GetCharLength(objPtr); + if (startIndex) { + TclGetIntForIndex(NULL, startIndex, stringLength, &offset); + Tcl_DecrRefCount(startIndex); + if (offset < 0) { + offset = 0; + } + } + regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags); if (regExpr == NULL) { return TCL_ERROR; @@ -426,7 +441,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) int start, end, subStart, subEnd, match; Tcl_RegExp regExpr; Tcl_RegExpInfo info; - Tcl_Obj *resultPtr, *subPtr, *objPtr; + Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL; Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend; static CONST char *options[] = { @@ -455,7 +470,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) } if (Tcl_GetIndexFromObj(interp, objv[idx], options, "switch", TCL_EXACT, &index) != TCL_OK) { - return TCL_ERROR; + goto optionError; } switch ((enum options) index) { case REGSUB_ALL: { @@ -483,15 +498,18 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) break; } case REGSUB_START: { + int temp; if (++idx >= objc) { goto endOfForLoop; } - if (Tcl_GetIntFromObj(interp, objv[idx], &offset) != TCL_OK) { - return TCL_ERROR; + if (TclGetIntForIndex(interp, objv[idx], 0, &temp) != TCL_OK) { + goto optionError; } - if (offset < 0) { - offset = 0; + if (startIndex) { + Tcl_DecrRefCount(startIndex); } + startIndex = objv[idx]; + Tcl_IncrRefCount(startIndex); break; } case REGSUB_LAST: { @@ -504,12 +522,25 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) if (objc-idx < 3 || objc-idx > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?switches? exp string subSpec ?varName?"); - return TCL_ERROR; +optionError: + if (startIndex) { + Tcl_DecrRefCount(startIndex); + } + return TCL_ERROR; } objc -= idx; objv += idx; + if (startIndex) { + int stringLength = Tcl_GetCharLength(objv[1]); + TclGetIntForIndex(NULL, startIndex, stringLength, &offset); + Tcl_DecrRefCount(startIndex); + if (offset < 0) { + offset = 0; + } + } + if (all && (offset == 0) && (strpbrk(TclGetString(objv[2]), "&\\") == NULL) && (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) { diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 229e809..04ba646 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.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: tclCompCmds.c,v 1.59.2.2 2005/04/10 23:14:47 kennykb Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.59.2.3 2005/05/05 17:55:34 kennykb Exp $ */ #include "tclInt.h" @@ -53,7 +53,7 @@ AuxDataType tclForeachInfoType = { * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "append" command @@ -74,7 +74,7 @@ TclCompileAppendCmd(interp, parsePtr, envPtr) numWords = parsePtr->numWords; if (numWords == 1) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } else if (numWords == 2) { /* * append varName == set varName @@ -84,7 +84,7 @@ TclCompileAppendCmd(interp, parsePtr, envPtr) /* * APPEND instructions currently only handle one value */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -160,7 +160,7 @@ TclCompileAppendCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "break" command @@ -177,7 +177,7 @@ TclCompileBreakCmd(interp, parsePtr, envPtr) CompileEnv *envPtr; /* Holds resulting instructions. */ { if (parsePtr->numWords != 1) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -197,7 +197,7 @@ TclCompileBreakCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "catch" command @@ -224,7 +224,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr) * compile. Let runtime checks determine if syntax has changed. */ if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -234,7 +234,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr) */ if ((parsePtr->numWords == 3) && (envPtr->procPtr == NULL)) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -251,13 +251,13 @@ TclCompileCatchCmd(interp, parsePtr, envPtr) name = nameTokenPtr[1].start; nameChars = nameTokenPtr[1].size; if (!TclIsLocalScalar(name, nameChars)) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } localIndex = TclFindCompiledLocal(nameTokenPtr[1].start, nameTokenPtr[1].size, /*create*/ 1, /*flags*/ VAR_SCALAR, envPtr->procPtr); } else { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } } @@ -358,7 +358,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "continue" command @@ -379,7 +379,7 @@ TclCompileContinueCmd(interp, parsePtr, envPtr) */ if (parsePtr->numWords != 1) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -399,7 +399,7 @@ TclCompileContinueCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "expr" command @@ -418,7 +418,7 @@ TclCompileExprCmd(interp, parsePtr, envPtr) Tcl_Token *firstWordPtr; if (parsePtr->numWords == 1) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } firstWordPtr = parsePtr->tokenPtr @@ -436,7 +436,7 @@ TclCompileExprCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "for" command @@ -458,7 +458,7 @@ TclCompileForCmd(interp, parsePtr, envPtr) int savedStackDepth = envPtr->currStackDepth; if (parsePtr->numWords != 5) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -471,7 +471,7 @@ TclCompileForCmd(interp, parsePtr, envPtr) + (parsePtr->tokenPtr->numComponents + 1); testTokenPtr = startTokenPtr + (startTokenPtr->numComponents + 1); if (testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -483,7 +483,7 @@ TclCompileForCmd(interp, parsePtr, envPtr) bodyTokenPtr = nextTokenPtr + (nextTokenPtr->numComponents + 1); if ((nextTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -608,7 +608,7 @@ TclCompileForCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "foreach" command @@ -657,12 +657,12 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) */ if (procPtr == NULL) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } numWords = parsePtr->numWords; if ((numWords < 4) || (numWords%2 != 0)) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -675,7 +675,7 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) } bodyTokenPtr = tokenPtr; if (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -712,7 +712,7 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) i++, tokenPtr += (tokenPtr->numComponents + 1)) { if (i%2 == 1) { if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - code = TCL_OUT_LINE_COMPILE; + code = TCL_ERROR; goto done; } else { /* Lots of copying going on here. Need a ListObj wizard @@ -727,14 +727,14 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) &varcList[loopIndex], &varvList[loopIndex]); Tcl_DStringFree(&varList); if (code != TCL_OK) { - code = TCL_OUT_LINE_COMPILE; + code = TCL_ERROR; goto done; } numVars = varcList[loopIndex]; for (j = 0; j < numVars; j++) { CONST char *varName = varvList[loopIndex][j]; if (!TclIsLocalScalar(varName, (int) strlen(varName))) { - code = TCL_OUT_LINE_COMPILE; + code = TCL_ERROR; goto done; } } @@ -1014,7 +1014,7 @@ FreeForeachInfo(clientData) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "if" command @@ -1060,7 +1060,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) for (wordIdx = 0; wordIdx < numWords; wordIdx++) { if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } tokenPtr += 2; } @@ -1092,7 +1092,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) break; } if (wordIdx >= numWords) { - code = TCL_OUT_LINE_COMPILE; + code = TCL_ERROR; goto done; } @@ -1145,7 +1145,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) tokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1); wordIdx++; if (wordIdx >= numWords) { - code = TCL_OUT_LINE_COMPILE; + code = TCL_ERROR; goto done; } if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { @@ -1155,7 +1155,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) tokenPtr += (tokenPtr->numComponents + 1); wordIdx++; if (wordIdx >= numWords) { - code = TCL_OUT_LINE_COMPILE; + code = TCL_ERROR; goto done; } } @@ -1246,7 +1246,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) tokenPtr += (tokenPtr->numComponents + 1); wordIdx++; if (wordIdx >= numWords) { - code = TCL_OUT_LINE_COMPILE; + code = TCL_ERROR; goto done; } } @@ -1266,7 +1266,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) wordIdx++; if (wordIdx < numWords) { - code = TCL_OUT_LINE_COMPILE; + code = TCL_ERROR; goto done; } } else { @@ -1329,7 +1329,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "incr" command @@ -1349,7 +1349,7 @@ TclCompileIncrCmd(interp, parsePtr, envPtr) int simpleVarName, isScalar, localIndex, haveImmValue, immValue; if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } varTokenPtr = parsePtr->tokenPtr @@ -1457,7 +1457,7 @@ TclCompileIncrCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "lappend" command @@ -1480,18 +1480,18 @@ TclCompileLappendCmd(interp, parsePtr, envPtr) * If we're not in a procedure, don't compile. */ if (envPtr->procPtr == NULL) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } numWords = parsePtr->numWords; if (numWords == 1) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } if (numWords != 3) { /* * LAPPEND instructions currently only handle one value appends */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -1570,7 +1570,7 @@ TclCompileLappendCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "lassign" command @@ -1594,7 +1594,7 @@ TclCompileLassignCmd(interp, parsePtr, envPtr) * Check for command syntax error, but we'll punt that to runtime */ if (numWords < 3) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -1680,7 +1680,7 @@ TclCompileLassignCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "lindex" command @@ -1705,7 +1705,7 @@ TclCompileLindexCmd(interp, parsePtr, envPtr) */ if (numWords <= 1) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } varTokenPtr = parsePtr->tokenPtr @@ -1750,7 +1750,7 @@ TclCompileLindexCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "list" command @@ -1770,7 +1770,7 @@ TclCompileListCmd(interp, parsePtr, envPtr) * If we're not in a procedure, don't compile. */ if (envPtr->procPtr == NULL) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } if (parsePtr->numWords == 1) { @@ -1815,7 +1815,7 @@ TclCompileListCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "llength" command @@ -1834,7 +1834,7 @@ TclCompileLlengthCmd(interp, parsePtr, envPtr) Tcl_Token *varTokenPtr; if (parsePtr->numWords != 2) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } varTokenPtr = parsePtr->tokenPtr + (parsePtr->tokenPtr->numComponents + 1); @@ -1863,7 +1863,7 @@ TclCompileLlengthCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "lset" command @@ -1914,7 +1914,7 @@ TclCompileLsetCmd(interp, parsePtr, envPtr) if (parsePtr->numWords < 3) { /* Fail at run time, not in compilation */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -2044,7 +2044,7 @@ TclCompileLsetCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "regexp" command @@ -2072,7 +2072,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) * regexp ?-nocase? ?--? {^staticString$} $var */ if (parsePtr->numWords < 3) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } nocase = 0; @@ -2087,7 +2087,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { /* Not a simple string - punt to runtime. */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } str = (char *) varTokenPtr[1].start; len = varTokenPtr[1].size; @@ -2099,13 +2099,13 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) nocase = 1; } else { /* Not an option we recognize. */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } } if ((parsePtr->numWords - i) != 2) { /* We don't support capturing to variables */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -2116,7 +2116,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) str = (char *) varTokenPtr[1].start; len = varTokenPtr[1].size; if ((varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) || (*str == '-')) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } if (len == 0) { @@ -2176,7 +2176,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) if ((strpbrk(str + start, "*+?{}()[].\\|^$") != NULL) || (Tcl_RegExpCompile(NULL, str) == NULL)) { ckfree((char *) str); - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } if (anchorLeft && anchorRight) { @@ -2234,7 +2234,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "return" command @@ -2303,7 +2303,7 @@ cleanup: * must be interpreted at runtime. */ Tcl_ResetResult(interp); - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -2376,7 +2376,7 @@ cleanup: * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "set" command @@ -2397,7 +2397,7 @@ TclCompileSetCmd(interp, parsePtr, envPtr) numWords = parsePtr->numWords; if ((numWords != 2) && (numWords != 3)) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } isAssignment = (numWords == 3); @@ -2482,7 +2482,7 @@ TclCompileSetCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "string" command @@ -2521,7 +2521,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr) if (parsePtr->numWords < 2) { /* Fail at run time, not in compilation */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } opTokenPtr = parsePtr->tokenPtr + (parsePtr->tokenPtr->numComponents + 1); @@ -2531,7 +2531,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr) &index) != TCL_OK) { Tcl_DecrRefCount(opObj); Tcl_ResetResult(interp); - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } Tcl_DecrRefCount(opObj); @@ -2557,7 +2557,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr) /* * All other cases: compile out of line. */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; case STR_COMPARE: case STR_EQUAL: { @@ -2568,7 +2568,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr) */ if (parsePtr->numWords != 4) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -2595,7 +2595,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr) if (parsePtr->numWords != 4) { /* Fail at run time, not in compilation */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -2619,7 +2619,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr) case STR_LENGTH: { if (parsePtr->numWords != 3) { /* Fail at run time, not in compilation */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { @@ -2646,12 +2646,12 @@ TclCompileStringCmd(interp, parsePtr, envPtr) if (parsePtr->numWords < 4 || parsePtr->numWords > 5) { /* Fail at run time, not in compilation */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } if (parsePtr->numWords == 5) { if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } str = varTokenPtr[1].start; length = varTokenPtr[1].size; @@ -2660,7 +2660,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr) nocase = 1; } else { /* Fail at run time, not in compilation */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); } @@ -2714,7 +2714,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr) * Procedure called to compile the "switch" command. * * Results: - * Returns TCL_OK for successful compile, or TCL_OUT_LINE_COMPILE + * Returns TCL_OK for successful compile, or TCL_ERROR * to defer evaluation to runtime (either when it is too complex * to get the semantics right, or when we know for sure that it * is an error but need the error to happen at the right time). @@ -2794,7 +2794,7 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) */ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } else { register int size = tokenPtr[1].size; register CONST char *chrs = tokenPtr[1].start; @@ -2803,7 +2803,7 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) * Assume that -e and -g are unique prefixes of -exact and -glob */ if (size < 2) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } if ((size <= 6) && (numWords >= 4) && !strncmp(chrs, "-exact", (unsigned) TclMin(size, 6))) { @@ -2823,12 +2823,12 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) */ mode = Switch_Exact; } else { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } } if ((tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) || (tokenPtr[1].size != 2) || strncmp(tokenPtr[1].start, "--", 2)) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } tokenPtr += 2; numWords--; @@ -2865,19 +2865,19 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) */ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } Tcl_DStringInit(&bodyList); Tcl_DStringAppend(&bodyList, tokenPtr[1].start, tokenPtr[1].size); if (Tcl_SplitList(NULL, Tcl_DStringValue(&bodyList), &numWords, &argv) != TCL_OK) { Tcl_DStringFree(&bodyList); - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } Tcl_DStringFree(&bodyList); if (numWords == 0 || numWords % 2) { ckfree((char *) argv); - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } bodyTokenArray = (Tcl_Token *) ckalloc(sizeof(Tcl_Token) * numWords); bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * numWords); @@ -2910,7 +2910,7 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) ckfree((char *) argv); ckfree((char *) bodyToken); ckfree((char *) bodyTokenArray); - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } while (isspace(UCHAR(*tokenStartPtr))) { tokenStartPtr++; @@ -2934,10 +2934,10 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) if (tokenStartPtr != tokenPtr[1].start+tokenPtr[1].size) { ckfree((char *) bodyToken); ckfree((char *) bodyTokenArray); - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } } else if (numWords % 2 || numWords == 0) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } else { bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * numWords); bodyTokenArray = NULL; @@ -2950,7 +2950,7 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr->numComponents != 1) { ckfree((char *) bodyToken); - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } bodyToken[i] = tokenPtr+1; tokenPtr += tokenPtr->numComponents+1; @@ -2969,7 +2969,7 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) if (bodyTokenArray != NULL) { ckfree((char *) bodyTokenArray); } - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -3140,7 +3140,7 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) * "variable" command. The command itself is *not* compiled. * * Results: - * Always returns TCL_OUT_LINE_COMPILE. + * Always returns TCL_ERROR. * * Side effects: * Indexed local variables are added to the environment. @@ -3159,7 +3159,7 @@ TclCompileVariableCmd(interp, parsePtr, envPtr) CONST char *varName, *tail; if (envPtr->procPtr == NULL) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } numWords = parsePtr->numWords; @@ -3182,7 +3182,7 @@ TclCompileVariableCmd(interp, parsePtr, envPtr) varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); } } - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -3194,7 +3194,7 @@ TclCompileVariableCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "while" command @@ -3221,7 +3221,7 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) int boolVal; if (parsePtr->numWords != 3) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -3238,7 +3238,7 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) bodyTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1); if ((testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -3371,7 +3371,7 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "set" command diff --git a/generic/tclCompile.c b/generic/tclCompile.c index f539bf2..5d85b6d 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.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: tclCompile.c,v 1.78.2.4 2005/04/25 21:37:19 kennykb Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.78.2.5 2005/05/05 17:55:51 kennykb Exp $ */ #include "tclInt.h" @@ -1128,18 +1128,17 @@ TclCompileScript(interp, script, numBytes, envPtr) TclStoreInt4AtPtr(fixLen, fixPtr); } goto finishCommand; - } else if (code == TCL_OUT_LINE_COMPILE) { + } else { /* * Restore numCommands and codeNext to their * correct values, removing any commands - * compiled before TCL_OUT_LINE_COMPILE + * compiled before the failure to produce + * bytecode got reported. * [Bugs 705406 and 735055] */ envPtr->numCommands = savedNumCmds; envPtr->codeNext = envPtr->codeStart + savedCodeNext; - } else { /* an error */ - Tcl_Panic("TclCompileScript: compileProc returned TCL_ERROR\n"); } } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 8dacbb6..4d37ef7 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -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: tclDecls.h,v 1.107.2.4 2005/02/02 15:53:18 kennykb Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.107.2.5 2005/05/05 17:55:53 kennykb Exp $ */ #ifndef _TCLDECLS @@ -227,7 +227,7 @@ EXTERN void TclFreeObj _ANSI_ARGS_((Tcl_Obj * objPtr)); #define Tcl_GetBoolean_TCL_DECLARED /* 31 */ EXTERN int Tcl_GetBoolean _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * str, int * boolPtr)); + CONST char * src, int * boolPtr)); #endif #ifndef Tcl_GetBooleanFromObj_TCL_DECLARED #define Tcl_GetBooleanFromObj_TCL_DECLARED @@ -246,7 +246,7 @@ EXTERN unsigned char * Tcl_GetByteArrayFromObj _ANSI_ARGS_(( #define Tcl_GetDouble_TCL_DECLARED /* 34 */ EXTERN int Tcl_GetDouble _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * str, double * doublePtr)); + CONST char * src, double * doublePtr)); #endif #ifndef Tcl_GetDoubleFromObj_TCL_DECLARED #define Tcl_GetDoubleFromObj_TCL_DECLARED @@ -266,7 +266,7 @@ EXTERN int Tcl_GetIndexFromObj _ANSI_ARGS_((Tcl_Interp * interp, #define Tcl_GetInt_TCL_DECLARED /* 37 */ EXTERN int Tcl_GetInt _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * str, int * intPtr)); + CONST char * src, int * intPtr)); #endif #ifndef Tcl_GetIntFromObj_TCL_DECLARED #define Tcl_GetIntFromObj_TCL_DECLARED @@ -456,7 +456,7 @@ EXTERN void Tcl_AllowExceptions _ANSI_ARGS_((Tcl_Interp * interp)); #define Tcl_AppendElement_TCL_DECLARED /* 69 */ EXTERN void Tcl_AppendElement _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * string)); + CONST char * element)); #endif #ifndef Tcl_AppendResult_TCL_DECLARED #define Tcl_AppendResult_TCL_DECLARED @@ -772,13 +772,13 @@ EXTERN void Tcl_DoWhenIdle _ANSI_ARGS_((Tcl_IdleProc * proc, #define Tcl_DStringAppend_TCL_DECLARED /* 117 */ EXTERN char * Tcl_DStringAppend _ANSI_ARGS_((Tcl_DString * dsPtr, - CONST char * str, int length)); + CONST char * bytes, int length)); #endif #ifndef Tcl_DStringAppendElement_TCL_DECLARED #define Tcl_DStringAppendElement_TCL_DECLARED /* 118 */ EXTERN char * Tcl_DStringAppendElement _ANSI_ARGS_(( - Tcl_DString * dsPtr, CONST char * string)); + Tcl_DString * dsPtr, CONST char * element)); #endif #ifndef Tcl_DStringEndSublist_TCL_DECLARED #define Tcl_DStringEndSublist_TCL_DECLARED @@ -839,7 +839,7 @@ EXTERN CONST84_RETURN char * Tcl_ErrnoMsg _ANSI_ARGS_((int err)); #define Tcl_Eval_TCL_DECLARED /* 129 */ EXTERN int Tcl_Eval _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * string)); + CONST char * script)); #endif #ifndef Tcl_EvalFile_TCL_DECLARED #define Tcl_EvalFile_TCL_DECLARED @@ -876,7 +876,7 @@ EXTERN int Tcl_ExposeCommand _ANSI_ARGS_((Tcl_Interp * interp, #define Tcl_ExprBoolean_TCL_DECLARED /* 135 */ EXTERN int Tcl_ExprBoolean _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * str, int * ptr)); + CONST char * expr, int * ptr)); #endif #ifndef Tcl_ExprBooleanObj_TCL_DECLARED #define Tcl_ExprBooleanObj_TCL_DECLARED @@ -888,7 +888,7 @@ EXTERN int Tcl_ExprBooleanObj _ANSI_ARGS_((Tcl_Interp * interp, #define Tcl_ExprDouble_TCL_DECLARED /* 137 */ EXTERN int Tcl_ExprDouble _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * str, double * ptr)); + CONST char * expr, double * ptr)); #endif #ifndef Tcl_ExprDoubleObj_TCL_DECLARED #define Tcl_ExprDoubleObj_TCL_DECLARED @@ -900,7 +900,7 @@ EXTERN int Tcl_ExprDoubleObj _ANSI_ARGS_((Tcl_Interp * interp, #define Tcl_ExprLong_TCL_DECLARED /* 139 */ EXTERN int Tcl_ExprLong _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * str, long * ptr)); + CONST char * expr, long * ptr)); #endif #ifndef Tcl_ExprLongObj_TCL_DECLARED #define Tcl_ExprLongObj_TCL_DECLARED @@ -918,7 +918,7 @@ EXTERN int Tcl_ExprObj _ANSI_ARGS_((Tcl_Interp * interp, #define Tcl_ExprString_TCL_DECLARED /* 142 */ EXTERN int Tcl_ExprString _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * string)); + CONST char * expr)); #endif #ifndef Tcl_Finalize_TCL_DECLARED #define Tcl_Finalize_TCL_DECLARED @@ -1068,7 +1068,7 @@ EXTERN Tcl_Obj * Tcl_GetObjResult _ANSI_ARGS_((Tcl_Interp * interp)); #define Tcl_GetOpenFile_TCL_DECLARED /* 167 */ EXTERN int Tcl_GetOpenFile _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * str, int forWriting, + CONST char * chanID, int forWriting, int checkUsage, ClientData * filePtr)); #endif #endif /* UNIX */ @@ -1291,7 +1291,7 @@ EXTERN void Tcl_PrintDouble _ANSI_ARGS_((Tcl_Interp * interp, #ifndef Tcl_PutEnv_TCL_DECLARED #define Tcl_PutEnv_TCL_DECLARED /* 203 */ -EXTERN int Tcl_PutEnv _ANSI_ARGS_((CONST char * string)); +EXTERN int Tcl_PutEnv _ANSI_ARGS_((CONST char * assignment)); #endif #ifndef Tcl_PosixError_TCL_DECLARED #define Tcl_PosixError_TCL_DECLARED @@ -1353,20 +1353,20 @@ EXTERN void Tcl_RegisterObjType _ANSI_ARGS_(( #define Tcl_RegExpCompile_TCL_DECLARED /* 212 */ EXTERN Tcl_RegExp Tcl_RegExpCompile _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * string)); + CONST char * pattern)); #endif #ifndef Tcl_RegExpExec_TCL_DECLARED #define Tcl_RegExpExec_TCL_DECLARED /* 213 */ EXTERN int Tcl_RegExpExec _ANSI_ARGS_((Tcl_Interp * interp, - Tcl_RegExp regexp, CONST char * str, + Tcl_RegExp regexp, CONST char * text, CONST char * start)); #endif #ifndef Tcl_RegExpMatch_TCL_DECLARED #define Tcl_RegExpMatch_TCL_DECLARED /* 214 */ EXTERN int Tcl_RegExpMatch _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * str, CONST char * pattern)); + CONST char * text, CONST char * pattern)); #endif #ifndef Tcl_RegExpRange_TCL_DECLARED #define Tcl_RegExpRange_TCL_DECLARED @@ -1473,7 +1473,7 @@ EXTERN int Tcl_SetRecursionLimit _ANSI_ARGS_(( #define Tcl_SetResult_TCL_DECLARED /* 232 */ EXTERN void Tcl_SetResult _ANSI_ARGS_((Tcl_Interp * interp, - char * str, Tcl_FreeProc * freeProc)); + char * result, Tcl_FreeProc * freeProc)); #endif #ifndef Tcl_SetServiceMode_TCL_DECLARED #define Tcl_SetServiceMode_TCL_DECLARED @@ -1718,7 +1718,7 @@ EXTERN CONST84_RETURN char * Tcl_HashStats _ANSI_ARGS_(( #define Tcl_ParseVar_TCL_DECLARED /* 270 */ EXTERN CONST84_RETURN char * Tcl_ParseVar _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * str, CONST84 char ** termPtr)); + CONST char * start, CONST84 char ** termPtr)); #endif #ifndef Tcl_PkgPresent_TCL_DECLARED #define Tcl_PkgPresent_TCL_DECLARED @@ -1970,7 +1970,7 @@ EXTERN void Tcl_ConditionWait _ANSI_ARGS_(( #define Tcl_NumUtfChars_TCL_DECLARED /* 312 */ EXTERN int Tcl_NumUtfChars _ANSI_ARGS_((CONST char * src, - int len)); + int length)); #endif #ifndef Tcl_ReadChars_TCL_DECLARED #define Tcl_ReadChars_TCL_DECLARED @@ -2052,7 +2052,7 @@ EXTERN CONST84_RETURN char * Tcl_UtfAtIndex _ANSI_ARGS_((CONST char * src, #define Tcl_UtfCharComplete_TCL_DECLARED /* 326 */ EXTERN int Tcl_UtfCharComplete _ANSI_ARGS_((CONST char * src, - int len)); + int length)); #endif #ifndef Tcl_UtfBackslash_TCL_DECLARED #define Tcl_UtfBackslash_TCL_DECLARED @@ -2197,26 +2197,28 @@ EXTERN int Tcl_UniCharIsWordChar _ANSI_ARGS_((int ch)); #ifndef Tcl_UniCharLen_TCL_DECLARED #define Tcl_UniCharLen_TCL_DECLARED /* 352 */ -EXTERN int Tcl_UniCharLen _ANSI_ARGS_((CONST Tcl_UniChar * str)); +EXTERN int Tcl_UniCharLen _ANSI_ARGS_(( + CONST Tcl_UniChar * uniStr)); #endif #ifndef Tcl_UniCharNcmp_TCL_DECLARED #define Tcl_UniCharNcmp_TCL_DECLARED /* 353 */ -EXTERN int Tcl_UniCharNcmp _ANSI_ARGS_((CONST Tcl_UniChar * cs, - CONST Tcl_UniChar * ct, unsigned long n)); +EXTERN int Tcl_UniCharNcmp _ANSI_ARGS_((CONST Tcl_UniChar * ucs, + CONST Tcl_UniChar * uct, + unsigned long numChars)); #endif #ifndef Tcl_UniCharToUtfDString_TCL_DECLARED #define Tcl_UniCharToUtfDString_TCL_DECLARED /* 354 */ EXTERN char * Tcl_UniCharToUtfDString _ANSI_ARGS_(( - CONST Tcl_UniChar * string, int numChars, + CONST Tcl_UniChar * uniStr, int uniLength, Tcl_DString * dsPtr)); #endif #ifndef Tcl_UtfToUniCharDString_TCL_DECLARED #define Tcl_UtfToUniCharDString_TCL_DECLARED /* 355 */ EXTERN Tcl_UniChar * Tcl_UtfToUniCharDString _ANSI_ARGS_(( - CONST char * string, int length, + CONST char * src, int length, Tcl_DString * dsPtr)); #endif #ifndef Tcl_GetRegExpFromObj_TCL_DECLARED @@ -2248,7 +2250,7 @@ EXTERN void Tcl_LogCommandInfo _ANSI_ARGS_((Tcl_Interp * interp, #define Tcl_ParseBraces_TCL_DECLARED /* 360 */ EXTERN int Tcl_ParseBraces _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * string, int numBytes, + CONST char * start, int numBytes, Tcl_Parse * parsePtr, int append, CONST84 char ** termPtr)); #endif @@ -2256,21 +2258,21 @@ EXTERN int Tcl_ParseBraces _ANSI_ARGS_((Tcl_Interp * interp, #define Tcl_ParseCommand_TCL_DECLARED /* 361 */ EXTERN int Tcl_ParseCommand _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * string, int numBytes, - int nested, Tcl_Parse * parsePtr)); + CONST char * start, int numBytes, int nested, + Tcl_Parse * parsePtr)); #endif #ifndef Tcl_ParseExpr_TCL_DECLARED #define Tcl_ParseExpr_TCL_DECLARED /* 362 */ EXTERN int Tcl_ParseExpr _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * string, int numBytes, + CONST char * start, int numBytes, Tcl_Parse * parsePtr)); #endif #ifndef Tcl_ParseQuotedString_TCL_DECLARED #define Tcl_ParseQuotedString_TCL_DECLARED /* 363 */ EXTERN int Tcl_ParseQuotedString _ANSI_ARGS_(( - Tcl_Interp * interp, CONST char * string, + Tcl_Interp * interp, CONST char * start, int numBytes, Tcl_Parse * parsePtr, int append, CONST84 char ** termPtr)); #endif @@ -2278,7 +2280,7 @@ EXTERN int Tcl_ParseQuotedString _ANSI_ARGS_(( #define Tcl_ParseVarName_TCL_DECLARED /* 364 */ EXTERN int Tcl_ParseVarName _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * string, int numBytes, + CONST char * start, int numBytes, Tcl_Parse * parsePtr, int append)); #endif #ifndef Tcl_GetCwd_TCL_DECLARED @@ -2345,7 +2347,7 @@ EXTERN int Tcl_UniCharIsPunct _ANSI_ARGS_((int ch)); #define Tcl_RegExpExecObj_TCL_DECLARED /* 376 */ EXTERN int Tcl_RegExpExecObj _ANSI_ARGS_((Tcl_Interp * interp, - Tcl_RegExp regexp, Tcl_Obj * objPtr, + Tcl_RegExp regexp, Tcl_Obj * textObj, int offset, int nmatches, int flags)); #endif #ifndef Tcl_RegExpGetInfo_TCL_DECLARED @@ -2398,7 +2400,7 @@ EXTERN void Tcl_AppendUnicodeToObj _ANSI_ARGS_((Tcl_Obj * objPtr, #define Tcl_RegExpMatchObj_TCL_DECLARED /* 385 */ EXTERN int Tcl_RegExpMatchObj _ANSI_ARGS_((Tcl_Interp * interp, - Tcl_Obj * stringObj, Tcl_Obj * patternObj)); + Tcl_Obj * textObj, Tcl_Obj * patternObj)); #endif #ifndef Tcl_SetNotifier_TCL_DECLARED #define Tcl_SetNotifier_TCL_DECLARED @@ -2597,15 +2599,16 @@ EXTERN int Tcl_IsChannelExisting _ANSI_ARGS_(( #define Tcl_UniCharNcasecmp_TCL_DECLARED /* 419 */ EXTERN int Tcl_UniCharNcasecmp _ANSI_ARGS_(( - CONST Tcl_UniChar * cs, - CONST Tcl_UniChar * ct, unsigned long n)); + CONST Tcl_UniChar * ucs, + CONST Tcl_UniChar * uct, + unsigned long numChars)); #endif #ifndef Tcl_UniCharCaseMatch_TCL_DECLARED #define Tcl_UniCharCaseMatch_TCL_DECLARED /* 420 */ EXTERN int Tcl_UniCharCaseMatch _ANSI_ARGS_(( - CONST Tcl_UniChar * ustr, - CONST Tcl_UniChar * pattern, int nocase)); + CONST Tcl_UniChar * uniStr, + CONST Tcl_UniChar * uniPattern, int nocase)); #endif #ifndef Tcl_FindHashEntry_TCL_DECLARED #define Tcl_FindHashEntry_TCL_DECLARED @@ -3533,13 +3536,13 @@ typedef struct TclStubs { Tcl_Obj * (*tcl_DbNewStringObj) _ANSI_ARGS_((CONST char * bytes, int length, CONST char * file, int line)); /* 28 */ Tcl_Obj * (*tcl_DuplicateObj) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 29 */ void (*tclFreeObj) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 30 */ - int (*tcl_GetBoolean) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, int * boolPtr)); /* 31 */ + int (*tcl_GetBoolean) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * src, int * boolPtr)); /* 31 */ int (*tcl_GetBooleanFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int * boolPtr)); /* 32 */ unsigned char * (*tcl_GetByteArrayFromObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int * lengthPtr)); /* 33 */ - int (*tcl_GetDouble) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, double * doublePtr)); /* 34 */ + int (*tcl_GetDouble) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * src, double * doublePtr)); /* 34 */ int (*tcl_GetDoubleFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, double * doublePtr)); /* 35 */ int (*tcl_GetIndexFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, CONST84 char ** tablePtr, CONST char * msg, int flags, int * indexPtr)); /* 36 */ - int (*tcl_GetInt) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, int * intPtr)); /* 37 */ + int (*tcl_GetInt) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * src, int * intPtr)); /* 37 */ int (*tcl_GetIntFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int * intPtr)); /* 38 */ int (*tcl_GetLongFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, long * longPtr)); /* 39 */ Tcl_ObjType * (*tcl_GetObjType) _ANSI_ARGS_((CONST char * typeName)); /* 40 */ @@ -3571,7 +3574,7 @@ typedef struct TclStubs { void (*tcl_AddErrorInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * message)); /* 66 */ void (*tcl_AddObjErrorInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * message, int length)); /* 67 */ void (*tcl_AllowExceptions) _ANSI_ARGS_((Tcl_Interp * interp)); /* 68 */ - void (*tcl_AppendElement) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string)); /* 69 */ + void (*tcl_AppendElement) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * element)); /* 69 */ void (*tcl_AppendResult) _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 70 */ Tcl_AsyncHandler (*tcl_AsyncCreate) _ANSI_ARGS_((Tcl_AsyncProc * proc, ClientData clientData)); /* 71 */ void (*tcl_AsyncDelete) _ANSI_ARGS_((Tcl_AsyncHandler async)); /* 72 */ @@ -3624,8 +3627,8 @@ typedef struct TclStubs { void (*tcl_DontCallWhenDeleted) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_InterpDeleteProc * proc, ClientData clientData)); /* 114 */ int (*tcl_DoOneEvent) _ANSI_ARGS_((int flags)); /* 115 */ void (*tcl_DoWhenIdle) _ANSI_ARGS_((Tcl_IdleProc * proc, ClientData clientData)); /* 116 */ - char * (*tcl_DStringAppend) _ANSI_ARGS_((Tcl_DString * dsPtr, CONST char * str, int length)); /* 117 */ - char * (*tcl_DStringAppendElement) _ANSI_ARGS_((Tcl_DString * dsPtr, CONST char * string)); /* 118 */ + char * (*tcl_DStringAppend) _ANSI_ARGS_((Tcl_DString * dsPtr, CONST char * bytes, int length)); /* 117 */ + char * (*tcl_DStringAppendElement) _ANSI_ARGS_((Tcl_DString * dsPtr, CONST char * element)); /* 118 */ void (*tcl_DStringEndSublist) _ANSI_ARGS_((Tcl_DString * dsPtr)); /* 119 */ void (*tcl_DStringFree) _ANSI_ARGS_((Tcl_DString * dsPtr)); /* 120 */ void (*tcl_DStringGetResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * dsPtr)); /* 121 */ @@ -3636,20 +3639,20 @@ typedef struct TclStubs { int (*tcl_Eof) _ANSI_ARGS_((Tcl_Channel chan)); /* 126 */ CONST84_RETURN char * (*tcl_ErrnoId) _ANSI_ARGS_((void)); /* 127 */ CONST84_RETURN char * (*tcl_ErrnoMsg) _ANSI_ARGS_((int err)); /* 128 */ - int (*tcl_Eval) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string)); /* 129 */ + int (*tcl_Eval) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * script)); /* 129 */ int (*tcl_EvalFile) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * fileName)); /* 130 */ int (*tcl_EvalObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 131 */ void (*tcl_EventuallyFree) _ANSI_ARGS_((ClientData clientData, Tcl_FreeProc * freeProc)); /* 132 */ void (*tcl_Exit) _ANSI_ARGS_((int status)); /* 133 */ int (*tcl_ExposeCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * hiddenCmdToken, CONST char * cmdName)); /* 134 */ - int (*tcl_ExprBoolean) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, int * ptr)); /* 135 */ + int (*tcl_ExprBoolean) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * expr, int * ptr)); /* 135 */ int (*tcl_ExprBooleanObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int * ptr)); /* 136 */ - int (*tcl_ExprDouble) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, double * ptr)); /* 137 */ + int (*tcl_ExprDouble) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * expr, double * ptr)); /* 137 */ int (*tcl_ExprDoubleObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, double * ptr)); /* 138 */ - int (*tcl_ExprLong) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, long * ptr)); /* 139 */ + int (*tcl_ExprLong) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * expr, long * ptr)); /* 139 */ int (*tcl_ExprLongObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, long * ptr)); /* 140 */ int (*tcl_ExprObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_Obj ** resultPtrPtr)); /* 141 */ - int (*tcl_ExprString) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string)); /* 142 */ + int (*tcl_ExprString) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * expr)); /* 142 */ void (*tcl_Finalize) _ANSI_ARGS_((void)); /* 143 */ void (*tcl_FindExecutable) _ANSI_ARGS_((CONST char * argv0)); /* 144 */ Tcl_HashEntry * (*tcl_FirstHashEntry) _ANSI_ARGS_((Tcl_HashTable * tablePtr, Tcl_HashSearch * searchPtr)); /* 145 */ @@ -3675,7 +3678,7 @@ typedef struct TclStubs { CONST char * (*tcl_GetNameOfExecutable) _ANSI_ARGS_((void)); /* 165 */ Tcl_Obj * (*tcl_GetObjResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 166 */ #if !defined(__WIN32__) /* UNIX */ - int (*tcl_GetOpenFile) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, int forWriting, int checkUsage, ClientData * filePtr)); /* 167 */ + int (*tcl_GetOpenFile) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * chanID, int forWriting, int checkUsage, ClientData * filePtr)); /* 167 */ #endif /* UNIX */ #ifdef __WIN32__ void *reserved167; @@ -3720,7 +3723,7 @@ typedef struct TclStubs { Tcl_Channel (*tcl_OpenTcpServer) _ANSI_ARGS_((Tcl_Interp * interp, int port, CONST char * host, Tcl_TcpAcceptProc * acceptProc, ClientData callbackData)); /* 200 */ void (*tcl_Preserve) _ANSI_ARGS_((ClientData data)); /* 201 */ void (*tcl_PrintDouble) _ANSI_ARGS_((Tcl_Interp * interp, double value, char * dst)); /* 202 */ - int (*tcl_PutEnv) _ANSI_ARGS_((CONST char * string)); /* 203 */ + int (*tcl_PutEnv) _ANSI_ARGS_((CONST char * assignment)); /* 203 */ CONST84_RETURN char * (*tcl_PosixError) _ANSI_ARGS_((Tcl_Interp * interp)); /* 204 */ void (*tcl_QueueEvent) _ANSI_ARGS_((Tcl_Event * evPtr, Tcl_QueuePosition position)); /* 205 */ int (*tcl_Read) _ANSI_ARGS_((Tcl_Channel chan, char * bufPtr, int toRead)); /* 206 */ @@ -3734,9 +3737,9 @@ typedef struct TclStubs { int (*tcl_RecordAndEvalObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * cmdPtr, int flags)); /* 209 */ void (*tcl_RegisterChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 210 */ void (*tcl_RegisterObjType) _ANSI_ARGS_((Tcl_ObjType * typePtr)); /* 211 */ - Tcl_RegExp (*tcl_RegExpCompile) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string)); /* 212 */ - int (*tcl_RegExpExec) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_RegExp regexp, CONST char * str, CONST char * start)); /* 213 */ - int (*tcl_RegExpMatch) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, CONST char * pattern)); /* 214 */ + Tcl_RegExp (*tcl_RegExpCompile) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * pattern)); /* 212 */ + int (*tcl_RegExpExec) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_RegExp regexp, CONST char * text, CONST char * start)); /* 213 */ + int (*tcl_RegExpMatch) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * text, CONST char * pattern)); /* 214 */ void (*tcl_RegExpRange) _ANSI_ARGS_((Tcl_RegExp regexp, int index, CONST84 char ** startPtr, CONST84 char ** endPtr)); /* 215 */ void (*tcl_Release) _ANSI_ARGS_((ClientData clientData)); /* 216 */ void (*tcl_ResetResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 217 */ @@ -3754,7 +3757,7 @@ typedef struct TclStubs { void (*tcl_SetMaxBlockTime) _ANSI_ARGS_((Tcl_Time * timePtr)); /* 229 */ void (*tcl_SetPanicProc) _ANSI_ARGS_((Tcl_PanicProc * panicProc)); /* 230 */ int (*tcl_SetRecursionLimit) _ANSI_ARGS_((Tcl_Interp * interp, int depth)); /* 231 */ - void (*tcl_SetResult) _ANSI_ARGS_((Tcl_Interp * interp, char * str, Tcl_FreeProc * freeProc)); /* 232 */ + void (*tcl_SetResult) _ANSI_ARGS_((Tcl_Interp * interp, char * result, Tcl_FreeProc * freeProc)); /* 232 */ int (*tcl_SetServiceMode) _ANSI_ARGS_((int mode)); /* 233 */ void (*tcl_SetObjErrorCode) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * errorObjPtr)); /* 234 */ void (*tcl_SetObjResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * resultObjPtr)); /* 235 */ @@ -3792,7 +3795,7 @@ typedef struct TclStubs { void (*tcl_AppendResultVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 267 */ void (*tcl_AppendStringsToObjVA) _ANSI_ARGS_((Tcl_Obj * objPtr, va_list argList)); /* 268 */ CONST84_RETURN char * (*tcl_HashStats) _ANSI_ARGS_((Tcl_HashTable * tablePtr)); /* 269 */ - CONST84_RETURN char * (*tcl_ParseVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, CONST84 char ** termPtr)); /* 270 */ + CONST84_RETURN char * (*tcl_ParseVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * start, CONST84 char ** termPtr)); /* 270 */ CONST84_RETURN char * (*tcl_PkgPresent) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 271 */ CONST84_RETURN char * (*tcl_PkgPresentEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 272 */ int (*tcl_PkgProvide) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version)); /* 273 */ @@ -3834,7 +3837,7 @@ typedef struct TclStubs { void (*tcl_MutexUnlock) _ANSI_ARGS_((Tcl_Mutex * mutexPtr)); /* 309 */ void (*tcl_ConditionNotify) _ANSI_ARGS_((Tcl_Condition * condPtr)); /* 310 */ void (*tcl_ConditionWait) _ANSI_ARGS_((Tcl_Condition * condPtr, Tcl_Mutex * mutexPtr, Tcl_Time * timePtr)); /* 311 */ - int (*tcl_NumUtfChars) _ANSI_ARGS_((CONST char * src, int len)); /* 312 */ + int (*tcl_NumUtfChars) _ANSI_ARGS_((CONST char * src, int length)); /* 312 */ int (*tcl_ReadChars) _ANSI_ARGS_((Tcl_Channel channel, Tcl_Obj * objPtr, int charsToRead, int appendFlag)); /* 313 */ void (*tcl_RestoreResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_SavedResult * statePtr)); /* 314 */ void (*tcl_SaveResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_SavedResult * statePtr)); /* 315 */ @@ -3848,7 +3851,7 @@ typedef struct TclStubs { Tcl_UniChar (*tcl_UniCharToUpper) _ANSI_ARGS_((int ch)); /* 323 */ int (*tcl_UniCharToUtf) _ANSI_ARGS_((int ch, char * buf)); /* 324 */ CONST84_RETURN char * (*tcl_UtfAtIndex) _ANSI_ARGS_((CONST char * src, int index)); /* 325 */ - int (*tcl_UtfCharComplete) _ANSI_ARGS_((CONST char * src, int len)); /* 326 */ + int (*tcl_UtfCharComplete) _ANSI_ARGS_((CONST char * src, int length)); /* 326 */ int (*tcl_UtfBackslash) _ANSI_ARGS_((CONST char * src, int * readPtr, char * dst)); /* 327 */ CONST84_RETURN char * (*tcl_UtfFindFirst) _ANSI_ARGS_((CONST char * src, int ch)); /* 328 */ CONST84_RETURN char * (*tcl_UtfFindLast) _ANSI_ARGS_((CONST char * src, int ch)); /* 329 */ @@ -3874,19 +3877,19 @@ typedef struct TclStubs { int (*tcl_UniCharIsSpace) _ANSI_ARGS_((int ch)); /* 349 */ int (*tcl_UniCharIsUpper) _ANSI_ARGS_((int ch)); /* 350 */ int (*tcl_UniCharIsWordChar) _ANSI_ARGS_((int ch)); /* 351 */ - int (*tcl_UniCharLen) _ANSI_ARGS_((CONST Tcl_UniChar * str)); /* 352 */ - int (*tcl_UniCharNcmp) _ANSI_ARGS_((CONST Tcl_UniChar * cs, CONST Tcl_UniChar * ct, unsigned long n)); /* 353 */ - char * (*tcl_UniCharToUtfDString) _ANSI_ARGS_((CONST Tcl_UniChar * string, int numChars, Tcl_DString * dsPtr)); /* 354 */ - Tcl_UniChar * (*tcl_UtfToUniCharDString) _ANSI_ARGS_((CONST char * string, int length, Tcl_DString * dsPtr)); /* 355 */ + int (*tcl_UniCharLen) _ANSI_ARGS_((CONST Tcl_UniChar * uniStr)); /* 352 */ + int (*tcl_UniCharNcmp) _ANSI_ARGS_((CONST Tcl_UniChar * ucs, CONST Tcl_UniChar * uct, unsigned long numChars)); /* 353 */ + char * (*tcl_UniCharToUtfDString) _ANSI_ARGS_((CONST Tcl_UniChar * uniStr, int uniLength, Tcl_DString * dsPtr)); /* 354 */ + Tcl_UniChar * (*tcl_UtfToUniCharDString) _ANSI_ARGS_((CONST char * src, int length, Tcl_DString * dsPtr)); /* 355 */ Tcl_RegExp (*tcl_GetRegExpFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * patObj, int flags)); /* 356 */ Tcl_Obj * (*tcl_EvalTokens) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Token * tokenPtr, int count)); /* 357 */ void (*tcl_FreeParse) _ANSI_ARGS_((Tcl_Parse * parsePtr)); /* 358 */ void (*tcl_LogCommandInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * script, CONST char * command, int length)); /* 359 */ - int (*tcl_ParseBraces) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr, int append, CONST84 char ** termPtr)); /* 360 */ - int (*tcl_ParseCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, int nested, Tcl_Parse * parsePtr)); /* 361 */ - int (*tcl_ParseExpr) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr)); /* 362 */ - int (*tcl_ParseQuotedString) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr, int append, CONST84 char ** termPtr)); /* 363 */ - int (*tcl_ParseVarName) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr, int append)); /* 364 */ + int (*tcl_ParseBraces) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * start, int numBytes, Tcl_Parse * parsePtr, int append, CONST84 char ** termPtr)); /* 360 */ + int (*tcl_ParseCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * start, int numBytes, int nested, Tcl_Parse * parsePtr)); /* 361 */ + int (*tcl_ParseExpr) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * start, int numBytes, Tcl_Parse * parsePtr)); /* 362 */ + int (*tcl_ParseQuotedString) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * start, int numBytes, Tcl_Parse * parsePtr, int append, CONST84 char ** termPtr)); /* 363 */ + int (*tcl_ParseVarName) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * start, int numBytes, Tcl_Parse * parsePtr, int append)); /* 364 */ char * (*tcl_GetCwd) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 365 */ int (*tcl_Chdir) _ANSI_ARGS_((CONST char * dirName)); /* 366 */ int (*tcl_Access) _ANSI_ARGS_((CONST char * path, int mode)); /* 367 */ @@ -3898,7 +3901,7 @@ typedef struct TclStubs { int (*tcl_UniCharIsGraph) _ANSI_ARGS_((int ch)); /* 373 */ int (*tcl_UniCharIsPrint) _ANSI_ARGS_((int ch)); /* 374 */ int (*tcl_UniCharIsPunct) _ANSI_ARGS_((int ch)); /* 375 */ - int (*tcl_RegExpExecObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_RegExp regexp, Tcl_Obj * objPtr, int offset, int nmatches, int flags)); /* 376 */ + int (*tcl_RegExpExecObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_RegExp regexp, Tcl_Obj * textObj, int offset, int nmatches, int flags)); /* 376 */ void (*tcl_RegExpGetInfo) _ANSI_ARGS_((Tcl_RegExp regexp, Tcl_RegExpInfo * infoPtr)); /* 377 */ Tcl_Obj * (*tcl_NewUnicodeObj) _ANSI_ARGS_((CONST Tcl_UniChar * unicode, int numChars)); /* 378 */ void (*tcl_SetUnicodeObj) _ANSI_ARGS_((Tcl_Obj * objPtr, CONST Tcl_UniChar * unicode, int numChars)); /* 379 */ @@ -3907,7 +3910,7 @@ typedef struct TclStubs { Tcl_UniChar * (*tcl_GetUnicode) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 382 */ Tcl_Obj * (*tcl_GetRange) _ANSI_ARGS_((Tcl_Obj * objPtr, int first, int last)); /* 383 */ void (*tcl_AppendUnicodeToObj) _ANSI_ARGS_((Tcl_Obj * objPtr, CONST Tcl_UniChar * unicode, int length)); /* 384 */ - int (*tcl_RegExpMatchObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * stringObj, Tcl_Obj * patternObj)); /* 385 */ + int (*tcl_RegExpMatchObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * textObj, Tcl_Obj * patternObj)); /* 385 */ void (*tcl_SetNotifier) _ANSI_ARGS_((Tcl_NotifierProcs * notifierProcPtr)); /* 386 */ Tcl_Mutex * (*tcl_GetAllocMutex) _ANSI_ARGS_((void)); /* 387 */ int (*tcl_GetChannelNames) _ANSI_ARGS_((Tcl_Interp * interp)); /* 388 */ @@ -3941,8 +3944,8 @@ typedef struct TclStubs { void (*tcl_SpliceChannel) _ANSI_ARGS_((Tcl_Channel channel)); /* 416 */ void (*tcl_ClearChannelHandlers) _ANSI_ARGS_((Tcl_Channel channel)); /* 417 */ int (*tcl_IsChannelExisting) _ANSI_ARGS_((CONST char* channelName)); /* 418 */ - int (*tcl_UniCharNcasecmp) _ANSI_ARGS_((CONST Tcl_UniChar * cs, CONST Tcl_UniChar * ct, unsigned long n)); /* 419 */ - int (*tcl_UniCharCaseMatch) _ANSI_ARGS_((CONST Tcl_UniChar * ustr, CONST Tcl_UniChar * pattern, int nocase)); /* 420 */ + int (*tcl_UniCharNcasecmp) _ANSI_ARGS_((CONST Tcl_UniChar * ucs, CONST Tcl_UniChar * uct, unsigned long numChars)); /* 419 */ + int (*tcl_UniCharCaseMatch) _ANSI_ARGS_((CONST Tcl_UniChar * uniStr, CONST Tcl_UniChar * uniPattern, int nocase)); /* 420 */ Tcl_HashEntry * (*tcl_FindHashEntry) _ANSI_ARGS_((Tcl_HashTable * tablePtr, CONST char * key)); /* 421 */ Tcl_HashEntry * (*tcl_CreateHashEntry) _ANSI_ARGS_((Tcl_HashTable * tablePtr, CONST char * key, int * newPtr)); /* 422 */ void (*tcl_InitCustomHashTable) _ANSI_ARGS_((Tcl_HashTable * tablePtr, int keyType, Tcl_HashKeyType * typePtr)); /* 423 */ diff --git a/generic/tclEnv.c b/generic/tclEnv.c index af7ddcd..d831e6f 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.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: tclEnv.c,v 1.22 2004/04/06 22:25:50 dgp Exp $ + * RCS: @(#) $Id: tclEnv.c,v 1.22.2.1 2005/05/05 17:56:02 kennykb Exp $ */ #include "tclInt.h" @@ -320,15 +320,15 @@ TclSetEnv(name, value) */ int -Tcl_PutEnv(string) - CONST char *string; /* Info about environment variable in the +Tcl_PutEnv(assignment) + CONST char *assignment; /* Info about environment variable in the * form NAME=value. (native) */ { Tcl_DString nameString; CONST char *name; char *value; - if (string == NULL) { + if (assignment == NULL) { return 0; } @@ -338,7 +338,7 @@ Tcl_PutEnv(string) * all of the real work. */ - name = Tcl_ExternalToUtfDString(NULL, string, -1, &nameString); + name = Tcl_ExternalToUtfDString(NULL, assignment, -1, &nameString); value = strchr(name, '='); if ((value != NULL) && (value != name)) { diff --git a/generic/tclGet.c b/generic/tclGet.c index 0be4b7e..7451e6a 100644 --- a/generic/tclGet.c +++ b/generic/tclGet.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: tclGet.c,v 1.9.2.3 2005/04/25 21:37:20 kennykb Exp $ + * RCS: @(#) $Id: tclGet.c,v 1.9.2.4 2005/05/05 17:56:02 kennykb Exp $ */ #include "tclInt.h" @@ -26,8 +26,8 @@ * * Results: * The return value is normally TCL_OK; in this case *intPtr - * will be set to the integer value equivalent to string. If - * string is improperly formed then TCL_ERROR is returned and + * will be set to the integer value equivalent to src. If + * src is improperly formed then TCL_ERROR is returned and * an error message will be left in the interp's result. * * Side effects: @@ -37,9 +37,9 @@ */ int -Tcl_GetInt(interp, str, intPtr) +Tcl_GetInt(interp, src, intPtr) Tcl_Interp *interp; /* Interpreter to use for error reporting. */ - CONST char *str; /* String containing a (possibly signed) + CONST char *src; /* String containing a (possibly signed) * integer in a form acceptable to strtoul. */ int *intPtr; /* Place to store converted result. */ { @@ -47,8 +47,8 @@ Tcl_GetInt(interp, str, intPtr) int code; obj.refCount = 1; - obj.bytes = (char *) str; - obj.length = strlen(str); + obj.bytes = (char *) src; + obj.length = strlen(src); obj.typePtr = NULL; code = Tcl_GetIntFromObj(interp, &obj, intPtr); @@ -69,8 +69,8 @@ Tcl_GetInt(interp, str, intPtr) * * Results: * The return value is normally TCL_OK; in this case *longPtr - * will be set to the long integer value equivalent to string. If - * string is improperly formed then TCL_ERROR is returned and + * will be set to the long integer value equivalent to src. If + * src is improperly formed then TCL_ERROR is returned and * an error message will be left in the interp's result if interp * is non-NULL. * @@ -81,10 +81,10 @@ Tcl_GetInt(interp, str, intPtr) */ int -TclGetLong(interp, str, longPtr) +TclGetLong(interp, src, longPtr) Tcl_Interp *interp; /* Interpreter used for error reporting * if not NULL. */ - CONST char *str; /* String containing a (possibly signed) + CONST char *src; /* String containing a (possibly signed) * long integer in a form acceptable to * strtoul. */ long *longPtr; /* Place to store converted long result. */ @@ -93,8 +93,8 @@ TclGetLong(interp, str, longPtr) int code; obj.refCount = 1; - obj.bytes = (char *) str; - obj.length = strlen(str); + obj.bytes = (char *) src; + obj.length = strlen(src); obj.typePtr = NULL; code = Tcl_GetLongFromObj(interp, &obj, longPtr); @@ -114,8 +114,8 @@ TclGetLong(interp, str, longPtr) * * Results: * The return value is normally TCL_OK; in this case *doublePtr - * will be set to the double-precision value equivalent to string. - * If string is improperly formed then TCL_ERROR is returned and + * will be set to the double-precision value equivalent to src. + * If src is improperly formed then TCL_ERROR is returned and * an error message will be left in the interp's result. * * Side effects: @@ -125,9 +125,9 @@ TclGetLong(interp, str, longPtr) */ int -Tcl_GetDouble(interp, str, doublePtr) +Tcl_GetDouble(interp, src, doublePtr) Tcl_Interp *interp; /* Interpreter used for error reporting. */ - CONST char *str; /* String containing a floating-point number + CONST char *src; /* String containing a floating-point number * in a form acceptable to strtod. */ double *doublePtr; /* Place to store converted result. */ { @@ -135,8 +135,8 @@ Tcl_GetDouble(interp, str, doublePtr) int code; obj.refCount = 1; - obj.bytes = (char *) str; - obj.length = strlen(str); + obj.bytes = (char *) src; + obj.length = strlen(src); obj.typePtr = NULL; code = Tcl_GetDoubleFromObj(interp, &obj, doublePtr); @@ -156,8 +156,8 @@ Tcl_GetDouble(interp, str, doublePtr) * * Results: * The return value is normally TCL_OK; in this case *boolPtr - * will be set to the 0/1 value equivalent to string. If - * string is improperly formed then TCL_ERROR is returned and + * will be set to the 0/1 value equivalent to src. If + * src is improperly formed then TCL_ERROR is returned and * an error message will be left in the interp's result. * * Side effects: @@ -167,9 +167,9 @@ Tcl_GetDouble(interp, str, doublePtr) */ int -Tcl_GetBoolean(interp, str, boolPtr) +Tcl_GetBoolean(interp, src, boolPtr) Tcl_Interp *interp; /* Interpreter used for error reporting. */ - CONST char *str; /* String containing a boolean number + CONST char *src; /* String containing a boolean number * specified either as 1/0 or true/false or * yes/no. */ int *boolPtr; /* Place to store converted result, which @@ -179,8 +179,8 @@ Tcl_GetBoolean(interp, str, boolPtr) int code; obj.refCount = 1; - obj.bytes = (char *) str; - obj.length = strlen(str); + obj.bytes = (char *) src; + obj.length = strlen(src); obj.typePtr = NULL; code = Tcl_ConvertToType(interp, &obj, &tclBooleanType); diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 732b162..358c32b 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.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: tclIOCmd.c,v 1.22 2004/10/07 00:24:49 dgp Exp $ + * RCS: @(#) $Id: tclIOCmd.c,v 1.22.2.1 2005/05/05 17:56:03 kennykb Exp $ */ #include "tclInt.h" @@ -960,14 +960,14 @@ Tcl_OpenObjCmd(notUsed, interp, objc, objv) if (!pipeline) { chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot); } else { - int mode, seekFlag, cmdObjc; + int mode, seekFlag, cmdObjc, binary; CONST char **cmdArgv; if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) { return TCL_ERROR; } - mode = TclGetOpenMode(interp, modeString, &seekFlag); + mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary); if (mode == -1) { chan = NULL; } else { @@ -987,6 +987,9 @@ Tcl_OpenObjCmd(notUsed, interp, objc, objv) break; } chan = Tcl_OpenCommandChannel(interp, cmdObjc, cmdArgv, flags); + if (binary) { + Tcl_SetChannelOption(interp, chan, "-translation", "binary"); + } } ckfree((char *) cmdArgv); } diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 5e7863f..2eb01f8 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.113.2.2 2005/04/25 21:37:21 kennykb Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.113.2.3 2005/05/05 17:56:03 kennykb Exp $ */ #include "tclInt.h" @@ -1412,9 +1412,43 @@ TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr) * TclGetOpenMode -- * * Description: + * This routine is an obsolete, limited version of + * TclGetOpenModeEx() below. It exists only to satisfy any + * extensions imprudently using it via Tcl's internal stubs table. + * + * Results: + * Same as TclGetOpenModeEx(). + * + * Side effects: + * Same as TclGetOpenModeEx(). + * + *--------------------------------------------------------------------------- + */ + +int +TclGetOpenMode(interp, modeString, seekFlagPtr) + Tcl_Interp *interp; /* Interpreter to use for error + * reporting - may be NULL. */ + CONST char *modeString; /* Mode string, e.g. "r+" or + * "RDONLY CREAT". */ + int *seekFlagPtr; /* Set this to 1 if the caller + * should seek to EOF during the + * opening of the file. */ +{ + int binary = 0; + return TclGetOpenModeEx(interp, modeString, seekFlagPtr, &binary); +} + +/* + *--------------------------------------------------------------------------- + * + * TclGetOpenModeEx -- + * + * Description: * Computes a POSIX mode mask for opening a file, from a given string, - * and also sets a flag to indicate whether the caller should seek to - * EOF after opening the file. + * and also sets flags to indicate whether the caller should seek to + * EOF after opening the file, and whether the caller should + * configure the channel for binary data. * * Results: * On success, returns mode to pass to "open". If an error occurs, the @@ -1423,7 +1457,9 @@ TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr) * * Side effects: * Sets the integer referenced by seekFlagPtr to 1 to tell the caller - * to seek to EOF after opening the file. + * to seek to EOF after opening the file, or to 0 otherwise. Sets the + * integer referenced by binaryPtr to 1 to tell the caller to seek to + * configure the channel for binary data, or to 0 otherwise. * * Special note: * This code is based on a prototype implementation contributed @@ -1431,16 +1467,18 @@ TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr) * *--------------------------------------------------------------------------- */ - int -TclGetOpenMode(interp, string, seekFlagPtr) +TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr) Tcl_Interp *interp; /* Interpreter to use for error * reporting - may be NULL. */ - CONST char *string; /* Mode string, e.g. "r+" or + CONST char *modeString; /* Mode string, e.g. "r+" or * "RDONLY CREAT". */ int *seekFlagPtr; /* Set this to 1 if the caller * should seek to EOF during the * opening of the file. */ + int *binaryPtr; /* Set this to 1 if the caller + * should configure the opened + * channel for binary operations */ { int mode, modeArgc, c, i, gotRW; CONST char **modeArgv, *flag; @@ -1453,6 +1491,7 @@ TclGetOpenMode(interp, string, seekFlagPtr) */ *seekFlagPtr = 0; + *binaryPtr = 0; mode = 0; /* @@ -1460,9 +1499,9 @@ TclGetOpenMode(interp, string, seekFlagPtr) * routines. */ - if (!(string[0] & 0x80) - && islower(UCHAR(string[0]))) { /* INTL: ISO only. */ - switch (string[0]) { + if (!(modeString[0] & 0x80) + && islower(UCHAR(modeString[0]))) { /* INTL: ISO only. */ + switch (modeString[0]) { case 'r': mode = O_RDONLY; break; @@ -1475,20 +1514,33 @@ TclGetOpenMode(interp, string, seekFlagPtr) break; default: error: + *seekFlagPtr = 0; + *binaryPtr = 0; if (interp != (Tcl_Interp *) NULL) { Tcl_AppendResult(interp, - "illegal access mode \"", string, "\"", + "illegal access mode \"", modeString, "\"", (char *) NULL); } return -1; } - if (string[1] == '+') { - mode &= ~(O_RDONLY|O_WRONLY); - mode |= O_RDWR; - if (string[2] != 0) { + i=1; + while (i<3 && modeString[i]) { + if (modeString[i] == modeString[i-1]) { goto error; } - } else if (string[1] != 0) { + switch (modeString[i++]) { + case '+': + mode &= ~(O_RDONLY|O_WRONLY); + mode |= O_RDWR; + break; + case 'b': + *binaryPtr = 1; + break; + default: + goto error; + } + } + if (modeString[i] != 0) { goto error; } return mode; @@ -1502,11 +1554,11 @@ TclGetOpenMode(interp, string, seekFlagPtr) * a NULL interpreter is passed in. */ - if (Tcl_SplitList(interp, string, &modeArgc, &modeArgv) != TCL_OK) { + if (Tcl_SplitList(interp, modeString, &modeArgc, &modeArgv) != TCL_OK) { if (interp != (Tcl_Interp *) NULL) { Tcl_AddErrorInfo(interp, "\n while processing open access modes \""); - Tcl_AddErrorInfo(interp, string); + Tcl_AddErrorInfo(interp, modeString); Tcl_AddErrorInfo(interp, "\""); } return -1; @@ -1560,11 +1612,14 @@ TclGetOpenMode(interp, string, seekFlagPtr) #endif } else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) { mode |= O_TRUNC; + } else if ((c == 'B') && (strcmp(flag, "BINARY") == 0)) { + *binaryPtr = 1; } else { if (interp != (Tcl_Interp *) NULL) { Tcl_AppendResult(interp, "invalid access mode \"", flag, - "\": must be RDONLY, WRONLY, RDWR, APPEND, CREAT", - " EXCL, NOCTTY, NONBLOCK, or TRUNC", (char *) NULL); + "\": must be RDONLY, WRONLY, RDWR, APPEND, BINARY, " + "CREAT, EXCL, NOCTTY, NONBLOCK, or TRUNC", + (char *) NULL); } ckfree((char *) modeArgv); return -1; @@ -2086,8 +2141,8 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions) if (fsPtr != NULL) { Tcl_FSOpenFileChannelProc *proc = fsPtr->openFileChannelProc; if (proc != NULL) { - int mode, seekFlag; - mode = TclGetOpenMode(interp, modeString, &seekFlag); + int mode, seekFlag, binary; + mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary); if (mode == -1) { return NULL; } @@ -2106,6 +2161,10 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions) return NULL; } } + if (binary) { + Tcl_SetChannelOption(interp, retVal, + "-translation", "binary"); + } } return retVal; } diff --git a/generic/tclInt.h b/generic/tclInt.h index 04b80ec..35baea3 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -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: tclInt.h,v 1.202.2.11 2005/04/25 21:37:22 kennykb Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.202.2.12 2005/05/05 17:56:06 kennykb Exp $ */ #ifndef _TCLINT @@ -916,18 +916,21 @@ struct CompileEnv; * must be one of the following: * * TCL_OK Compilation completed normally. - * TCL_OUT_LINE_COMPILE Compilation could not be completed. This can + * TCL_ERROR Compilation could not be completed. This can * be just a judgment by the CompileProc that the * command is too complex to compile effectively, * or it can indicate that in the current state of * the interp, the command would raise an error. - * In the latter circumstance, we defer error reporting + * The bytecode compiler will not do any error reporting + * at compiler time. Error reporting is deferred * until the actual runtime, because by then changes * in the interp state may allow the command to be - * successfully evaluated. + * successfully evaluated. + * TCL_OUT_LINE_COMPILE A source-compatible alias for TCL_ERROR, kept + * for the sake of old code only. */ -#define TCL_OUT_LINE_COMPILE (TCL_CONTINUE + 1) +#define TCL_OUT_LINE_COMPILE TCL_ERROR typedef int (CompileProc) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Parse *parsePtr, struct CompileEnv *compEnvPtr)); @@ -1893,7 +1896,9 @@ MODULE_SCOPE int TclGetEncodingFromObj _ANSI_ARGS_((Tcl_Interp *interp, MODULE_SCOPE int TclGetNamespaceFromObj _ANSI_ARGS_(( Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr)); - +MODULE_SCOPE int TclGetOpenModeEx _ANSI_ARGS_((Tcl_Interp *interp, + CONST char *modeString, int *seekFlagPtr, + int *binaryPtr)); MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue _ANSI_ARGS_ (( ProcessGlobalValue *pgvPtr)); MODULE_SCOPE int TclGlob _ANSI_ARGS_((Tcl_Interp *interp, diff --git a/generic/tclNotify.c b/generic/tclNotify.c index e5a438f..de60076 100644 --- a/generic/tclNotify.c +++ b/generic/tclNotify.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: tclNotify.c,v 1.16 2004/11/30 19:34:49 dgp Exp $ + * RCS: @(#) $Id: tclNotify.c,v 1.16.2.1 2005/05/05 17:56:08 kennykb Exp $ */ #include "tclInt.h" @@ -67,6 +67,7 @@ typedef struct ThreadSpecificData { Tcl_ThreadId threadId; /* Thread that owns this notifier instance. */ ClientData clientData; /* Opaque handle for platform specific * notifier. */ + int initialized; /* 1 if notifier has been initialized. */ struct ThreadSpecificData *nextPtr; /* Next notifier in global list of notifiers. * Access is controlled by the listLock global @@ -124,6 +125,7 @@ TclInitNotifier() tsdPtr = TCL_TSD_INIT(&dataKey); tsdPtr->threadId = threadId; tsdPtr->clientData = tclStubs.tcl_InitNotifier(); + tsdPtr->initialized = 1; tsdPtr->nextPtr = firstNotifierPtr; firstNotifierPtr = tsdPtr; } @@ -163,7 +165,7 @@ TclFinalizeNotifier() ThreadSpecificData **prevPtrPtr; Tcl_Event *evPtr, *hold; - if (tsdPtr->threadId == (Tcl_ThreadId)0) { + if (!tsdPtr->initialized) { return; /* Notifier not initialized for the current thread */ } @@ -190,6 +192,7 @@ TclFinalizeNotifier() break; } } + tsdPtr->initialized = 0; Tcl_MutexUnlock(&listLock); } diff --git a/generic/tclParse.c b/generic/tclParse.c index 2a5f3ef..0b5463c 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.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: tclParse.c,v 1.39.2.1 2005/04/10 23:14:55 kennykb Exp $ + * RCS: @(#) $Id: tclParse.c,v 1.39.2.2 2005/05/05 17:56:08 kennykb Exp $ */ #include "tclInt.h" @@ -243,11 +243,11 @@ TclParseInit(interp, string, numBytes, parsePtr) */ int -Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) +Tcl_ParseCommand(interp, start, numBytes, nested, parsePtr) Tcl_Interp *interp; /* Interpreter to use for error reporting; * if NULL, then no error message is * provided. */ - CONST char *string; /* First character of string containing + CONST char *start; /* First character of string containing * one or more Tcl commands. */ register int numBytes; /* Total number of bytes in string. If < 0, * the script consists of all bytes up to @@ -273,16 +273,16 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) * point to char after terminating one. */ int scanned; - if ((string == NULL) && (numBytes>0)) { + if ((start == NULL) && (numBytes>0)) { if (interp != NULL) { Tcl_SetResult(interp, "can't parse a NULL pointer", TCL_STATIC); } return TCL_ERROR; } if (numBytes < 0) { - numBytes = strlen(string); + numBytes = strlen(start); } - TclParseInit(interp, string, numBytes, parsePtr); + TclParseInit(interp, start, numBytes, parsePtr); parsePtr->commentStart = NULL; parsePtr->commentSize = 0; parsePtr->commandStart = NULL; @@ -298,8 +298,8 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) * command. */ - scanned = ParseComment(string, numBytes, parsePtr); - src = (string + scanned); numBytes -= scanned; + scanned = ParseComment(start, numBytes, parsePtr); + src = (start + scanned); numBytes -= scanned; if (numBytes == 0) { if (nested) { parsePtr->incomplete = nested; @@ -1148,12 +1148,12 @@ TclExpandTokenArray(parsePtr) */ int -Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) +Tcl_ParseVarName(interp, start, numBytes, parsePtr, append) Tcl_Interp *interp; /* Interpreter to use for error reporting; * if NULL, then no error message is * provided. */ - CONST char *string; /* String containing variable name. First - * character must be "$". */ + CONST char *start; /* Start of variable substitution string. + * First character must be "$". */ register int numBytes; /* Total number of bytes in string. If < 0, * the string consists of all bytes up to the * first null character. */ @@ -1171,15 +1171,15 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) Tcl_UniChar ch; unsigned array; - if ((numBytes == 0) || (string == NULL)) { + if ((numBytes == 0) || (start == NULL)) { return TCL_ERROR; } if (numBytes < 0) { - numBytes = strlen(string); + numBytes = strlen(start); } if (!append) { - TclParseInit(interp, string, numBytes, parsePtr); + TclParseInit(interp, start, numBytes, parsePtr); } /* @@ -1188,7 +1188,7 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) * there is one. */ - src = string; + src = start; if ((parsePtr->numTokens + 2) > parsePtr->tokensAvailable) { TclExpandTokenArray(parsePtr); } @@ -1354,9 +1354,9 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) */ CONST char * -Tcl_ParseVar(interp, string, termPtr) +Tcl_ParseVar(interp, start, termPtr) Tcl_Interp *interp; /* Context for looking up variable. */ - register CONST char *string; /* String containing variable name. + register CONST char *start; /* Start of variable substitution. * First character must be "$". */ CONST char **termPtr; /* If non-NULL, points to word to fill * in with character just after last @@ -1367,12 +1367,12 @@ Tcl_ParseVar(interp, string, termPtr) register Tcl_Obj *objPtr; int code; - if (Tcl_ParseVarName(interp, string, -1, &parse, 0) != TCL_OK) { + if (Tcl_ParseVarName(interp, start, -1, &parse, 0) != TCL_OK) { return NULL; } if (termPtr != NULL) { - *termPtr = string + parse.tokenPtr->size; + *termPtr = start + parse.tokenPtr->size; } if (parse.numTokens == 1) { /* @@ -1436,12 +1436,12 @@ Tcl_ParseVar(interp, string, termPtr) */ int -Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) +Tcl_ParseBraces(interp, start, numBytes, parsePtr, append, termPtr) Tcl_Interp *interp; /* Interpreter to use for error reporting; * if NULL, then no error message is * provided. */ - CONST char *string; /* String containing the string in braces. - * The first character must be '{'. */ + CONST char *start; /* Start of string enclosed in braces. + * The first character must be {'. */ register int numBytes; /* Total number of bytes in string. If < 0, * the string consists of all bytes up to * the first null character. */ @@ -1462,18 +1462,18 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) register CONST char *src; int startIndex, level, length; - if ((numBytes == 0) || (string == NULL)) { + if ((numBytes == 0) || (start == NULL)) { return TCL_ERROR; } if (numBytes < 0) { - numBytes = strlen(string); + numBytes = strlen(start); } if (!append) { - TclParseInit(interp, string, numBytes, parsePtr); + TclParseInit(interp, start, numBytes, parsePtr); } - src = string; + src = start; startIndex = parsePtr->numTokens; if (parsePtr->numTokens == parsePtr->tokensAvailable) { @@ -1494,7 +1494,7 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) register int openBrace = 0; parsePtr->errorType = TCL_PARSE_MISSING_BRACE; - parsePtr->term = string; + parsePtr->term = start; parsePtr->incomplete = 1; if (interp == NULL) { /* @@ -1514,7 +1514,7 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) * by a '<whitespace>#' on the same line. */ - for (; src > string; src--) { + for (; src > start; src--) { switch (*src) { case '{': openBrace = 1; @@ -1640,11 +1640,11 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) */ int -Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr) +Tcl_ParseQuotedString(interp, start, numBytes, parsePtr, append, termPtr) Tcl_Interp *interp; /* Interpreter to use for error reporting; * if NULL, then no error message is * provided. */ - CONST char *string; /* String containing the quoted string. + CONST char *start; /* Start of the quoted string. * The first character must be '"'. */ register int numBytes; /* Total number of bytes in string. If < 0, * the string consists of all bytes up to @@ -1661,18 +1661,18 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr) * after the quoted string's terminating * close-quote if the parse succeeds. */ { - if ((numBytes == 0) || (string == NULL)) { + if ((numBytes == 0) || (start == NULL)) { return TCL_ERROR; } if (numBytes < 0) { - numBytes = strlen(string); + numBytes = strlen(start); } if (!append) { - TclParseInit(interp, string, numBytes, parsePtr); + TclParseInit(interp, start, numBytes, parsePtr); } - if (TCL_OK != ParseTokens(string+1, numBytes-1, TYPE_QUOTE, + if (TCL_OK != ParseTokens(start+1, numBytes-1, TYPE_QUOTE, TCL_SUBST_ALL, parsePtr)) { goto error; } @@ -1681,7 +1681,7 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr) Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC); } parsePtr->errorType = TCL_PARSE_MISSING_QUOTE; - parsePtr->term = string; + parsePtr->term = start; parsePtr->incomplete = 1; goto error; } diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c index eb7f80c..8375b78 100644 --- a/generic/tclParseExpr.c +++ b/generic/tclParseExpr.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: tclParseExpr.c,v 1.23.2.6 2005/03/15 19:41:45 kennykb Exp $ + * RCS: @(#) $Id: tclParseExpr.c,v 1.23.2.7 2005/05/05 17:56:09 kennykb Exp $ */ #include "tclInt.h" @@ -205,7 +205,7 @@ static void PrependSubExprTokens _ANSI_ARGS_((CONST char *op, * Given a string, this procedure parses the first Tcl expression * in the string and returns information about the structure of * the expression. This procedure is the top-level interface to the - * the expression parsing module. No more that numBytes bytes will + * the expression parsing module. No more than numBytes bytes will * be scanned. * * Results: @@ -226,9 +226,9 @@ static void PrependSubExprTokens _ANSI_ARGS_((CONST char *op, */ int -Tcl_ParseExpr(interp, string, numBytes, parsePtr) +Tcl_ParseExpr(interp, start, numBytes, parsePtr) Tcl_Interp *interp; /* Used for error reporting. */ - CONST char *string; /* The source string to parse. */ + CONST char *start; /* Start of source string to parse. */ int numBytes; /* Number of bytes in string. If < 0, the * string consists of all bytes up to the * first null character. */ @@ -241,16 +241,16 @@ Tcl_ParseExpr(interp, string, numBytes, parsePtr) int code; if (numBytes < 0) { - numBytes = (string? strlen(string) : 0); + numBytes = (start? strlen(start) : 0); } #ifdef TCL_COMPILE_DEBUG if (traceParseExpr) { fprintf(stderr, "Tcl_ParseExpr: string=\"%.*s\"\n", - numBytes, string); + numBytes, start); } #endif /* TCL_COMPILE_DEBUG */ - TclParseInit(interp, string, numBytes, parsePtr); + TclParseInit(interp, start, numBytes, parsePtr); /* * Initialize the ParseInfo structure that holds state while parsing @@ -261,10 +261,10 @@ Tcl_ParseExpr(interp, string, numBytes, parsePtr) info.lexeme = UNKNOWN; info.start = NULL; info.size = 0; - info.next = string; - info.prevEnd = string; - info.originalExpr = string; - info.lastChar = (string + numBytes); /* just after last char of expr */ + info.next = start; + info.prevEnd = start; + info.originalExpr = start; + info.lastChar = (start + numBytes); /* just after last char of expr */ /* * Get the first lexeme then parse the expression. diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index 1909ed6..1ec55d2 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.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: tclRegexp.c,v 1.17 2004/09/29 22:23:25 dkf Exp $ + * RCS: @(#) $Id: tclRegexp.c,v 1.17.2.1 2005/05/05 17:56:10 kennykb Exp $ */ #include "tclInt.h" @@ -137,13 +137,13 @@ Tcl_ObjType tclRegexpType = { */ Tcl_RegExp -Tcl_RegExpCompile(interp, string) +Tcl_RegExpCompile(interp, pattern) Tcl_Interp *interp; /* For use in error reporting and * to access the interp regexp cache. */ - CONST char *string; /* String for which to produce + CONST char *pattern; /* String for which to produce * compiled regular expression. */ { - return (Tcl_RegExp) CompileRegexp(interp, string, (int) strlen(string), + return (Tcl_RegExp) CompileRegexp(interp, pattern, (int) strlen(pattern), REG_ADVANCED); } @@ -169,13 +169,13 @@ Tcl_RegExpCompile(interp, string) */ int -Tcl_RegExpExec(interp, re, string, start) +Tcl_RegExpExec(interp, re, text, start) Tcl_Interp *interp; /* Interpreter to use for error reporting. */ Tcl_RegExp re; /* Compiled regular expression; must have * been returned by previous call to * Tcl_GetRegExpFromObj. */ - CONST char *string; /* String against which to match re. */ - CONST char *start; /* If string is part of a larger string, + CONST char *text; /* Text against which to match re. */ + CONST char *start; /* If text is part of a larger string, * this identifies beginning of larger * string, so that "^" won't match. */ { @@ -189,7 +189,7 @@ Tcl_RegExpExec(interp, re, string, start) * then we need to tell the regexp engine not to match "^". */ - if (string > start) { + if (text > start) { flags = REG_NOTBOL; } else { flags = 0; @@ -199,7 +199,7 @@ Tcl_RegExpExec(interp, re, string, start) * Remember the string for use by Tcl_RegExpRange(). */ - regexp->string = string; + regexp->string = text; regexp->objPtr = NULL; /* @@ -207,7 +207,7 @@ Tcl_RegExpExec(interp, re, string, start) */ Tcl_DStringInit(&ds); - ustr = Tcl_UtfToUniCharDString(string, -1, &ds); + ustr = Tcl_UtfToUniCharDString(text, -1, &ds); numChars = Tcl_DStringLength(&ds) / sizeof(Tcl_UniChar); result = RegExpExecUniChar(interp, re, ustr, numChars, -1 /* nmatches */, flags); @@ -385,7 +385,7 @@ TclRegExpRangeUniChar(re, index, startPtr, endPtr) * Results: * If an error occurs during the matching operation then -1 * is returned and the interp's result contains an error message. - * Otherwise the return value is 1 if "string" matches "pattern" + * Otherwise the return value is 1 if "text" matches "pattern" * and 0 otherwise. * * Side effects: @@ -395,11 +395,10 @@ TclRegExpRangeUniChar(re, index, startPtr, endPtr) */ int -Tcl_RegExpMatch(interp, string, pattern) +Tcl_RegExpMatch(interp, text, pattern) Tcl_Interp *interp; /* Used for error reporting. May be NULL. */ - CONST char *string; /* String. */ - CONST char *pattern; /* Regular expression to match against - * string. */ + CONST char *text; /* Text to search for pattern matches. */ + CONST char *pattern; /* Regular expression to match against text. */ { Tcl_RegExp re; @@ -407,7 +406,7 @@ Tcl_RegExpMatch(interp, string, pattern) if (re == NULL) { return -1; } - return Tcl_RegExpExec(interp, re, string, string); + return Tcl_RegExpExec(interp, re, text, text); } /* @@ -430,12 +429,12 @@ Tcl_RegExpMatch(interp, string, pattern) */ int -Tcl_RegExpExecObj(interp, re, objPtr, offset, nmatches, flags) +Tcl_RegExpExecObj(interp, re, textObj, offset, nmatches, flags) Tcl_Interp *interp; /* Interpreter to use for error reporting. */ Tcl_RegExp re; /* Compiled regular expression; must have * been returned by previous call to * Tcl_GetRegExpFromObj. */ - Tcl_Obj *objPtr; /* String against which to match re. */ + Tcl_Obj *textObj; /* Text against which to match re. */ int offset; /* Character index that marks where matching * should begin. */ int nmatches; /* How many subexpression matches (counting @@ -452,9 +451,9 @@ Tcl_RegExpExecObj(interp, re, objPtr, offset, nmatches, flags) */ regexpPtr->string = NULL; - regexpPtr->objPtr = objPtr; + regexpPtr->objPtr = textObj; - udata = Tcl_GetUnicodeFromObj(objPtr, &length); + udata = Tcl_GetUnicodeFromObj(textObj, &length); if (offset > length) { offset = length; @@ -475,7 +474,7 @@ Tcl_RegExpExecObj(interp, re, objPtr, offset, nmatches, flags) * Results: * If an error occurs during the matching operation then -1 * is returned and the interp's result contains an error message. - * Otherwise the return value is 1 if "string" matches "pattern" + * Otherwise the return value is 1 if "text" matches "pattern" * and 0 otherwise. * * Side effects: @@ -485,9 +484,9 @@ Tcl_RegExpExecObj(interp, re, objPtr, offset, nmatches, flags) */ int -Tcl_RegExpMatchObj(interp, stringObj, patternObj) +Tcl_RegExpMatchObj(interp, textObj, patternObj) Tcl_Interp *interp; /* Used for error reporting. May be NULL. */ - Tcl_Obj *stringObj; /* Object containing the String to search. */ + Tcl_Obj *textObj; /* Object containing the String to search. */ Tcl_Obj *patternObj; /* Regular expression to match against * string. */ { @@ -498,7 +497,7 @@ Tcl_RegExpMatchObj(interp, stringObj, patternObj) if (re == NULL) { return -1; } - return Tcl_RegExpExecObj(interp, re, stringObj, 0 /* offset */, + return Tcl_RegExpExecObj(interp, re, textObj, 0 /* offset */, 0 /* nmatches */, 0 /* flags */); } diff --git a/generic/tclResult.c b/generic/tclResult.c index 28f994d..ab35df4 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.23 2004/11/23 00:12:57 dkf Exp $ + * RCS: @(#) $Id: tclResult.c,v 1.23.2.1 2005/05/05 17:56:10 kennykb Exp $ */ #include "tclInt.h" @@ -381,23 +381,23 @@ Tcl_DiscardResult(statePtr) * * Tcl_SetResult -- * - * Arrange for "string" to be the Tcl return value. + * Arrange for "result" to be the Tcl return value. * * Results: * None. * * Side effects: - * interp->result is left pointing either to "string" (if "copy" is 0) - * or to a copy of string. Also, the object result is reset. + * interp->result is left pointing either to "result" + * or to a copy of it. Also, the object result is reset. * *---------------------------------------------------------------------- */ void -Tcl_SetResult(interp, stringPtr, freeProc) +Tcl_SetResult(interp, result, freeProc) Tcl_Interp *interp; /* Interpreter with which to associate the * return value. */ - register char *stringPtr; /* Value to be returned. If NULL, the + register char *result; /* Value to be returned. If NULL, the * result is set to an empty string. */ Tcl_FreeProc *freeProc; /* Gives information about the string: * TCL_STATIC, TCL_VOLATILE, or the address @@ -408,12 +408,12 @@ Tcl_SetResult(interp, stringPtr, freeProc) register Tcl_FreeProc *oldFreeProc = iPtr->freeProc; char *oldResult = iPtr->result; - if (stringPtr == NULL) { + if (result == NULL) { iPtr->resultSpace[0] = 0; iPtr->result = iPtr->resultSpace; iPtr->freeProc = 0; } else if (freeProc == TCL_VOLATILE) { - length = strlen(stringPtr); + length = strlen(result); if (length > TCL_RESULT_SIZE) { iPtr->result = (char *) ckalloc((unsigned) length+1); iPtr->freeProc = TCL_DYNAMIC; @@ -421,9 +421,9 @@ Tcl_SetResult(interp, stringPtr, freeProc) iPtr->result = iPtr->resultSpace; iPtr->freeProc = 0; } - strcpy(iPtr->result, stringPtr); + strcpy(iPtr->result, result); } else { - iPtr->result = stringPtr; + iPtr->result = result; iPtr->freeProc = freeProc; } @@ -706,10 +706,10 @@ Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1) */ void -Tcl_AppendElement(interp, stringPtr) +Tcl_AppendElement(interp, element) Tcl_Interp *interp; /* Interpreter whose result is to be * extended. */ - CONST char *stringPtr; /* String to convert to list element and + CONST char *element; /* String to convert to list element and * add to result. */ { Interp *iPtr = (Interp *) interp; @@ -729,7 +729,7 @@ Tcl_AppendElement(interp, stringPtr) * needed to accommodate the list element. */ - size = Tcl_ScanElement(stringPtr, &flags) + 1; + size = Tcl_ScanElement(element, &flags) + 1; if ((iPtr->result != iPtr->appendResult) || (iPtr->appendResult[iPtr->appendUsed] != 0) || ((size + iPtr->appendUsed) >= iPtr->appendAvl)) { @@ -753,7 +753,7 @@ Tcl_AppendElement(interp, stringPtr) */ flags |= TCL_DONT_QUOTE_HASH; } - iPtr->appendUsed += Tcl_ConvertElement(stringPtr, dst, flags); + iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags); } /* diff --git a/generic/tclUtf.c b/generic/tclUtf.c index f0acdd2..6b7029c 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.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: tclUtf.c,v 1.32 2003/10/08 14:24:41 dkf Exp $ + * RCS: @(#) $Id: tclUtf.c,v 1.32.2.1 2005/05/05 17:56:11 kennykb Exp $ */ #include "tclInt.h" @@ -157,54 +157,54 @@ UtfCount(ch) */ INLINE int -Tcl_UniCharToUtf(ch, str) +Tcl_UniCharToUtf(ch, buf) int ch; /* The Tcl_UniChar to be stored in the * buffer. */ - char *str; /* Buffer in which the UTF-8 representation + char *buf; /* Buffer in which the UTF-8 representation * of the Tcl_UniChar is stored. Buffer must * be large enough to hold the UTF-8 character * (at most TCL_UTF_MAX bytes). */ { if ((ch > 0) && (ch < UNICODE_SELF)) { - str[0] = (char) ch; + buf[0] = (char) ch; return 1; } if (ch <= 0x7FF) { - str[1] = (char) ((ch | 0x80) & 0xBF); - str[0] = (char) ((ch >> 6) | 0xC0); + buf[1] = (char) ((ch | 0x80) & 0xBF); + buf[0] = (char) ((ch >> 6) | 0xC0); return 2; } if (ch <= 0xFFFF) { three: - str[2] = (char) ((ch | 0x80) & 0xBF); - str[1] = (char) (((ch >> 6) | 0x80) & 0xBF); - str[0] = (char) ((ch >> 12) | 0xE0); + buf[2] = (char) ((ch | 0x80) & 0xBF); + buf[1] = (char) (((ch >> 6) | 0x80) & 0xBF); + buf[0] = (char) ((ch >> 12) | 0xE0); return 3; } #if TCL_UTF_MAX > 3 if (ch <= 0x1FFFFF) { - str[3] = (char) ((ch | 0x80) & 0xBF); - str[2] = (char) (((ch >> 6) | 0x80) & 0xBF); - str[1] = (char) (((ch >> 12) | 0x80) & 0xBF); - str[0] = (char) ((ch >> 18) | 0xF0); + buf[3] = (char) ((ch | 0x80) & 0xBF); + buf[2] = (char) (((ch >> 6) | 0x80) & 0xBF); + buf[1] = (char) (((ch >> 12) | 0x80) & 0xBF); + buf[0] = (char) ((ch >> 18) | 0xF0); return 4; } if (ch <= 0x3FFFFFF) { - str[4] = (char) ((ch | 0x80) & 0xBF); - str[3] = (char) (((ch >> 6) | 0x80) & 0xBF); - str[2] = (char) (((ch >> 12) | 0x80) & 0xBF); - str[1] = (char) (((ch >> 18) | 0x80) & 0xBF); - str[0] = (char) ((ch >> 24) | 0xF8); + buf[4] = (char) ((ch | 0x80) & 0xBF); + buf[3] = (char) (((ch >> 6) | 0x80) & 0xBF); + buf[2] = (char) (((ch >> 12) | 0x80) & 0xBF); + buf[1] = (char) (((ch >> 18) | 0x80) & 0xBF); + buf[0] = (char) ((ch >> 24) | 0xF8); return 5; } if (ch <= 0x7FFFFFFF) { - str[5] = (char) ((ch | 0x80) & 0xBF); - str[4] = (char) (((ch >> 6) | 0x80) & 0xBF); - str[3] = (char) (((ch >> 12) | 0x80) & 0xBF); - str[2] = (char) (((ch >> 18) | 0x80) & 0xBF); - str[1] = (char) (((ch >> 24) | 0x80) & 0xBF); - str[0] = (char) ((ch >> 30) | 0xFC); + buf[5] = (char) ((ch | 0x80) & 0xBF); + buf[4] = (char) (((ch >> 6) | 0x80) & 0xBF); + buf[3] = (char) (((ch >> 12) | 0x80) & 0xBF); + buf[2] = (char) (((ch >> 18) | 0x80) & 0xBF); + buf[1] = (char) (((ch >> 24) | 0x80) & 0xBF); + buf[0] = (char) ((ch >> 30) | 0xFC); return 6; } #endif @@ -232,9 +232,9 @@ Tcl_UniCharToUtf(ch, str) */ char * -Tcl_UniCharToUtfDString(wString, numChars, dsPtr) - CONST Tcl_UniChar *wString; /* Unicode string to convert to UTF-8. */ - int numChars; /* Length of Unicode string in Tcl_UniChars +Tcl_UniCharToUtfDString(uniStr, uniLength, dsPtr) + CONST Tcl_UniChar *uniStr; /* Unicode string to convert to UTF-8. */ + int uniLength; /* Length of Unicode string in Tcl_UniChars * (must be >= 0). */ Tcl_DString *dsPtr; /* UTF-8 representation of string is * appended to this previously initialized @@ -250,12 +250,12 @@ Tcl_UniCharToUtfDString(wString, numChars, dsPtr) */ oldLength = Tcl_DStringLength(dsPtr); - Tcl_DStringSetLength(dsPtr, (oldLength + numChars + 1) * TCL_UTF_MAX); + Tcl_DStringSetLength(dsPtr, (oldLength + uniLength + 1) * TCL_UTF_MAX); string = Tcl_DStringValue(dsPtr) + oldLength; p = string; - wEnd = wString + numChars; - for (w = wString; w < wEnd; ) { + wEnd = uniStr + uniLength; + for (w = uniStr; w < wEnd; ) { p += Tcl_UniCharToUtf(*w, p); w++; } @@ -291,8 +291,8 @@ Tcl_UniCharToUtfDString(wString, numChars, dsPtr) */ int -Tcl_UtfToUniChar(str, chPtr) - register CONST char *str; /* The UTF-8 string. */ +Tcl_UtfToUniChar(src, chPtr) + register CONST char *src; /* The UTF-8 string. */ register Tcl_UniChar *chPtr; /* Filled with the Tcl_UniChar represented * by the UTF-8 string. */ { @@ -302,7 +302,7 @@ Tcl_UtfToUniChar(str, chPtr) * Unroll 1 to 3 byte UTF-8 sequences, use loop to handle longer ones. */ - byte = *((unsigned char *) str); + byte = *((unsigned char *) src); if (byte < 0xC0) { /* * Handles properly formed UTF-8 characters between 0x01 and 0x7F. @@ -313,12 +313,12 @@ Tcl_UtfToUniChar(str, chPtr) *chPtr = (Tcl_UniChar) byte; return 1; } else if (byte < 0xE0) { - if ((str[1] & 0xC0) == 0x80) { + if ((src[1] & 0xC0) == 0x80) { /* * Two-byte-character lead-byte followed by a trail-byte. */ - *chPtr = (Tcl_UniChar) (((byte & 0x1F) << 6) | (str[1] & 0x3F)); + *chPtr = (Tcl_UniChar) (((byte & 0x1F) << 6) | (src[1] & 0x3F)); return 2; } /* @@ -329,13 +329,13 @@ Tcl_UtfToUniChar(str, chPtr) *chPtr = (Tcl_UniChar) byte; return 1; } else if (byte < 0xF0) { - if (((str[1] & 0xC0) == 0x80) && ((str[2] & 0xC0) == 0x80)) { + if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80)) { /* * Three-byte-character lead byte followed by two trail bytes. */ *chPtr = (Tcl_UniChar) (((byte & 0x0F) << 12) - | ((str[1] & 0x3F) << 6) | (str[2] & 0x3F)); + | ((src[1] & 0x3F) << 6) | (src[2] & 0x3F)); return 3; } /* @@ -355,13 +355,13 @@ Tcl_UtfToUniChar(str, chPtr) if (trail > 0) { ch = byte & (0x3F >> trail); do { - str++; - if ((*str & 0xC0) != 0x80) { + src++; + if ((*src & 0xC0) != 0x80) { *chPtr = byte; return 1; } ch <<= 6; - ch |= (*str & 0x3F); + ch |= (*src & 0x3F); trail--; } while (trail > 0); *chPtr = ch; @@ -394,8 +394,8 @@ Tcl_UtfToUniChar(str, chPtr) */ Tcl_UniChar * -Tcl_UtfToUniCharDString(string, length, dsPtr) - CONST char *string; /* UTF-8 string to convert to Unicode. */ +Tcl_UtfToUniCharDString(src, length, dsPtr) + CONST char *src; /* UTF-8 string to convert to Unicode. */ int length; /* Length of UTF-8 string in bytes, or -1 * for strlen(). */ Tcl_DString *dsPtr; /* Unicode representation of string is @@ -407,7 +407,7 @@ Tcl_UtfToUniCharDString(string, length, dsPtr) int oldLength; if (length < 0) { - length = strlen(string); + length = strlen(src); } /* @@ -421,8 +421,8 @@ Tcl_UtfToUniCharDString(string, length, dsPtr) wString = (Tcl_UniChar *) (Tcl_DStringValue(dsPtr) + oldLength); w = wString; - end = string + length; - for (p = string; p < end; ) { + end = src + length; + for (p = src; p < end; ) { p += TclUtfToUniChar(p, w); w++; } @@ -453,15 +453,15 @@ Tcl_UtfToUniCharDString(string, length, dsPtr) */ int -Tcl_UtfCharComplete(str, len) - CONST char *str; /* String to check if first few bytes +Tcl_UtfCharComplete(src, length) + CONST char *src; /* String to check if first few bytes * contain a complete UTF-8 character. */ - int len; /* Length of above string in bytes. */ + int length; /* Length of above string in bytes. */ { int ch; - ch = *((unsigned char *) str); - return len >= totalBytes[ch]; + ch = *((unsigned char *) src); + return length >= totalBytes[ch]; } /* @@ -483,9 +483,9 @@ Tcl_UtfCharComplete(str, len) */ int -Tcl_NumUtfChars(str, len) - register CONST char *str; /* The UTF-8 string to measure. */ - int len; /* The length of the string in bytes, or -1 +Tcl_NumUtfChars(src, length) + register CONST char *src; /* The UTF-8 string to measure. */ + int length; /* The length of the string in bytes, or -1 * for strlen(string). */ { Tcl_UniChar ch; @@ -500,22 +500,22 @@ Tcl_NumUtfChars(str, len) */ i = 0; - if (len < 0) { - while (*str != '\0') { - str += TclUtfToUniChar(str, chPtr); + if (length < 0) { + while (*src != '\0') { + src += TclUtfToUniChar(src, chPtr); i++; } } else { register int n; - while (len > 0) { - if (UCHAR(*str) < 0xC0) { - len--; - str++; + while (length > 0) { + if (UCHAR(*src) < 0xC0) { + length--; + src++; } else { - n = Tcl_UtfToUniChar(str, chPtr); - len -= n; - str += n; + n = Tcl_UtfToUniChar(src, chPtr); + length -= n; + src += n; } i++; } @@ -543,22 +543,22 @@ Tcl_NumUtfChars(str, len) *--------------------------------------------------------------------------- */ CONST char * -Tcl_UtfFindFirst(string, ch) - CONST char *string; /* The UTF-8 string to be searched. */ +Tcl_UtfFindFirst(src, ch) + CONST char *src; /* The UTF-8 string to be searched. */ int ch; /* The Tcl_UniChar to search for. */ { int len; Tcl_UniChar find; while (1) { - len = TclUtfToUniChar(string, &find); + len = TclUtfToUniChar(src, &find); if (find == ch) { - return string; + return src; } - if (*string == '\0') { + if (*src == '\0') { return NULL; } - string += len; + src += len; } } @@ -583,8 +583,8 @@ Tcl_UtfFindFirst(string, ch) */ CONST char * -Tcl_UtfFindLast(string, ch) - CONST char *string; /* The UTF-8 string to be searched. */ +Tcl_UtfFindLast(src, ch) + CONST char *src; /* The UTF-8 string to be searched. */ int ch; /* The Tcl_UniChar to search for. */ { int len; @@ -593,14 +593,14 @@ Tcl_UtfFindLast(string, ch) last = NULL; while (1) { - len = TclUtfToUniChar(string, &find); + len = TclUtfToUniChar(src, &find); if (find == ch) { - last = string; + last = src; } - if (*string == '\0') { + if (*src == '\0') { break; } - string += len; + src += len; } return last; } @@ -626,12 +626,12 @@ Tcl_UtfFindLast(string, ch) */ CONST char * -Tcl_UtfNext(str) - CONST char *str; /* The current location in the string. */ +Tcl_UtfNext(src) + CONST char *src; /* The current location in the string. */ { Tcl_UniChar ch; - return str + TclUtfToUniChar(str, &ch); + return src + TclUtfToUniChar(src, &ch); } /* @@ -656,8 +656,8 @@ Tcl_UtfNext(str) */ CONST char * -Tcl_UtfPrev(str, start) - CONST char *str; /* The current location in the string. */ +Tcl_UtfPrev(src, start) + CONST char *src; /* The current location in the string. */ CONST char *start; /* Pointer to the beginning of the * string, to avoid going backwards too * far. */ @@ -665,12 +665,12 @@ Tcl_UtfPrev(str, start) CONST char *look; int i, byte; - str--; - look = str; + src--; + look = src; for (i = 0; i < TCL_UTF_MAX; i++) { if (look < start) { - if (str < start) { - str = start; + if (src < start) { + src = start; } break; } @@ -683,7 +683,7 @@ Tcl_UtfPrev(str, start) } look--; } - return str; + return src; } /* @@ -1017,8 +1017,8 @@ TclpUtfNcmp2(cs, ct, n) * * Tcl_UtfNcmp -- * - * Compare at most n UTF chars of string cs to string ct. Both cs - * and ct are assumed to be at least n UTF chars long. + * Compare at most numChars UTF chars of string cs to string ct. + * Both cs and ct are assumed to be at least numChars UTF chars long. * * Results: * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct. @@ -1030,10 +1030,10 @@ TclpUtfNcmp2(cs, ct, n) */ int -Tcl_UtfNcmp(cs, ct, n) +Tcl_UtfNcmp(cs, ct, numChars) CONST char *cs; /* UTF string to compare to ct. */ CONST char *ct; /* UTF string cs is compared to. */ - unsigned long n; /* Number of UTF chars to compare. */ + unsigned long numChars; /* Number of UTF chars to compare. */ { Tcl_UniChar ch1, ch2; /* @@ -1041,7 +1041,7 @@ Tcl_UtfNcmp(cs, ct, n) * \u0000 (the pair of bytes 0xc0,0x80) is larger than byte * representation of \u0001 (the byte 0x01.) */ - while (n-- > 0) { + while (numChars-- > 0) { /* * n must be interpreted as chars, not bytes. * This should be called only when both strings are of @@ -1061,8 +1061,8 @@ Tcl_UtfNcmp(cs, ct, n) * * Tcl_UtfNcasecmp -- * - * Compare at most n UTF chars of string cs to string ct case - * insensitive. Both cs and ct are assumed to be at least n + * Compare at most numChars UTF chars of string cs to string ct case + * insensitive. Both cs and ct are assumed to be at least numChars * UTF chars long. * * Results: @@ -1075,13 +1075,13 @@ Tcl_UtfNcmp(cs, ct, n) */ int -Tcl_UtfNcasecmp(cs, ct, n) +Tcl_UtfNcasecmp(cs, ct, numChars) CONST char *cs; /* UTF string to compare to ct. */ CONST char *ct; /* UTF string cs is compared to. */ - unsigned long n; /* Number of UTF chars to compare. */ + unsigned long numChars; /* Number of UTF chars to compare. */ { Tcl_UniChar ch1, ch2; - while (n-- > 0) { + while (numChars-- > 0) { /* * n must be interpreted as chars, not bytes. * This should be called only when both strings are of @@ -1212,14 +1212,14 @@ Tcl_UniCharToTitle(ch) */ int -Tcl_UniCharLen(str) - CONST Tcl_UniChar *str; /* Unicode string to find length of. */ +Tcl_UniCharLen(uniStr) + CONST Tcl_UniChar *uniStr; /* Unicode string to find length of. */ { int len = 0; - while (*str != '\0') { + while (*uniStr != '\0') { len++; - str++; + uniStr++; } return len; } @@ -1229,11 +1229,11 @@ Tcl_UniCharLen(str) * * Tcl_UniCharNcmp -- * - * Compare at most n unichars of string cs to string ct. Both cs - * and ct are assumed to be at least n unichars long. + * Compare at most numChars unichars of string ucs to string uct. + * Both ucs and uct are assumed to be at least numChars unichars long. * * Results: - * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct. + * Return <0 if ucs < uct, 0 if ucs == uct, or >0 if ucs > uct. * * Side effects: * None. @@ -1242,24 +1242,24 @@ Tcl_UniCharLen(str) */ int -Tcl_UniCharNcmp(cs, ct, n) - CONST Tcl_UniChar *cs; /* Unicode string to compare to ct. */ - CONST Tcl_UniChar *ct; /* Unicode string cs is compared to. */ - unsigned long n; /* Number of unichars to compare. */ +Tcl_UniCharNcmp(ucs, uct, numChars) + CONST Tcl_UniChar *ucs; /* Unicode string to compare to uct. */ + CONST Tcl_UniChar *uct; /* Unicode string ucs is compared to. */ + unsigned long numChars; /* Number of unichars to compare. */ { #ifdef WORDS_BIGENDIAN /* * We are definitely on a big-endian machine; memcmp() is safe */ - return memcmp(cs, ct, n*sizeof(Tcl_UniChar)); + return memcmp(ucs, uct, numChars*sizeof(Tcl_UniChar)); #else /* !WORDS_BIGENDIAN */ /* * We can't simply call memcmp() because that is not lexically correct. */ - for ( ; n != 0; cs++, ct++, n--) { - if (*cs != *ct) { - return (*cs - *ct); + for ( ; numChars != 0; ucs++, uct++, numChars--) { + if (*ucs != *uct) { + return (*ucs - *uct); } } return 0; @@ -1271,12 +1271,12 @@ Tcl_UniCharNcmp(cs, ct, n) * * Tcl_UniCharNcasecmp -- * - * Compare at most n unichars of string cs to string ct case - * insensitive. Both cs and ct are assumed to be at least n + * Compare at most numChars unichars of string ucs to string uct case + * insensitive. Both ucs and uct are assumed to be at least numChars * unichars long. * * Results: - * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct. + * Return <0 if ucs < uct, 0 if ucs == uct, or >0 if ucs > uct. * * Side effects: * None. @@ -1285,15 +1285,15 @@ Tcl_UniCharNcmp(cs, ct, n) */ int -Tcl_UniCharNcasecmp(cs, ct, n) - CONST Tcl_UniChar *cs; /* Unicode string to compare to ct. */ - CONST Tcl_UniChar *ct; /* Unicode string cs is compared to. */ - unsigned long n; /* Number of unichars to compare. */ +Tcl_UniCharNcasecmp(ucs, uct, numChars) + CONST Tcl_UniChar *ucs; /* Unicode string to compare to uct. */ + CONST Tcl_UniChar *uct; /* Unicode string ucs is compared to. */ + unsigned long numChars; /* Number of unichars to compare. */ { - for ( ; n != 0; n--, cs++, ct++) { - if (*cs != *ct) { - Tcl_UniChar lcs = Tcl_UniCharToLower(*cs); - Tcl_UniChar lct = Tcl_UniCharToLower(*ct); + for ( ; numChars != 0; numChars--, ucs++, uct++) { + if (*ucs != *uct) { + Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs); + Tcl_UniChar lct = Tcl_UniCharToLower(*uct); if (lcs != lct) { return (lcs - lct); } @@ -1602,16 +1602,16 @@ Tcl_UniCharIsWordChar(ch) */ int -Tcl_UniCharCaseMatch(string, pattern, nocase) - CONST Tcl_UniChar *string; /* Unicode String. */ - CONST Tcl_UniChar *pattern; /* Pattern, which may contain special - * characters. */ +Tcl_UniCharCaseMatch(uniStr, uniPattern, nocase) + CONST Tcl_UniChar *uniStr; /* Unicode String. */ + CONST Tcl_UniChar *uniPattern; /* Pattern, which may contain special + * characters. */ int nocase; /* 0 for case sensitive, 1 for insensitive */ { Tcl_UniChar ch1, p; while (1) { - p = *pattern; + p = *uniPattern; /* * See if we're at the end of both the pattern and the string. If @@ -1620,9 +1620,9 @@ Tcl_UniCharCaseMatch(string, pattern, nocase) */ if (p == 0) { - return (*string == 0); + return (*uniStr == 0); } - if ((*string == 0) && (p != '*')) { + if ((*uniStr == 0) && (p != '*')) { return 0; } @@ -1638,8 +1638,8 @@ Tcl_UniCharCaseMatch(string, pattern, nocase) /* * Skip all successive *'s in the pattern */ - while (*(++pattern) == '*') {} - p = *pattern; + while (*(++uniPattern) == '*') {} + p = *uniPattern; if (p == 0) { return 1; } @@ -1654,21 +1654,21 @@ Tcl_UniCharCaseMatch(string, pattern, nocase) */ if ((p != '[') && (p != '?') && (p != '\\')) { if (nocase) { - while (*string && (p != *string) - && (p != Tcl_UniCharToLower(*string))) { - string++; + while (*uniStr && (p != *uniStr) + && (p != Tcl_UniCharToLower(*uniStr))) { + uniStr++; } } else { - while (*string && (p != *string)) { string++; } + while (*uniStr && (p != *uniStr)) { uniStr++; } } } - if (Tcl_UniCharCaseMatch(string, pattern, nocase)) { + if (Tcl_UniCharCaseMatch(uniStr, uniPattern, nocase)) { return 1; } - if (*string == 0) { + if (*uniStr == 0) { return 0; } - string++; + uniStr++; } } @@ -1678,8 +1678,8 @@ Tcl_UniCharCaseMatch(string, pattern, nocase) */ if (p == '?') { - pattern++; - string++; + uniPattern++; + uniStr++; continue; } @@ -1692,23 +1692,23 @@ Tcl_UniCharCaseMatch(string, pattern, nocase) if (p == '[') { Tcl_UniChar startChar, endChar; - pattern++; - ch1 = (nocase ? Tcl_UniCharToLower(*string) : *string); - string++; + uniPattern++; + ch1 = (nocase ? Tcl_UniCharToLower(*uniStr) : *uniStr); + uniStr++; while (1) { - if ((*pattern == ']') || (*pattern == 0)) { + if ((*uniPattern == ']') || (*uniPattern == 0)) { return 0; } - startChar = (nocase ? Tcl_UniCharToLower(*pattern) : *pattern); - pattern++; - if (*pattern == '-') { - pattern++; - if (*pattern == 0) { + startChar = (nocase ? Tcl_UniCharToLower(*uniPattern) : *uniPattern); + uniPattern++; + if (*uniPattern == '-') { + uniPattern++; + if (*uniPattern == 0) { return 0; } - endChar = (nocase ? Tcl_UniCharToLower(*pattern) - : *pattern); - pattern++; + endChar = (nocase ? Tcl_UniCharToLower(*uniPattern) + : *uniPattern); + uniPattern++; if (((startChar <= ch1) && (ch1 <= endChar)) || ((endChar <= ch1) && (ch1 <= startChar))) { /* @@ -1720,14 +1720,14 @@ Tcl_UniCharCaseMatch(string, pattern, nocase) break; } } - while (*pattern != ']') { - if (*pattern == 0) { - pattern--; + while (*uniPattern != ']') { + if (*uniPattern == 0) { + uniPattern--; break; } - pattern++; + uniPattern++; } - pattern++; + uniPattern++; continue; } @@ -1737,7 +1737,7 @@ Tcl_UniCharCaseMatch(string, pattern, nocase) */ if (p == '\\') { - if (*(++pattern) == '\0') { + if (*(++uniPattern) == '\0') { return 0; } } @@ -1748,14 +1748,14 @@ Tcl_UniCharCaseMatch(string, pattern, nocase) */ if (nocase) { - if (Tcl_UniCharToLower(*string) != Tcl_UniCharToLower(*pattern)) { + if (Tcl_UniCharToLower(*uniStr) != Tcl_UniCharToLower(*uniPattern)) { return 0; } - } else if (*string != *pattern) { + } else if (*uniStr != *uniPattern) { return 0; } - string++; - pattern++; + uniStr++; + uniPattern++; } } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 0d538e0..c00ac1e 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.51.2.10 2005/04/25 21:37:22 kennykb Exp $ + * RCS: @(#) $Id: tclUtil.c,v 1.51.2.11 2005/05/05 17:56:11 kennykb Exp $ */ #include "tclInt.h" @@ -1196,12 +1196,12 @@ Tcl_ConcatObj(objc, objv) */ int -Tcl_StringMatch(string, pattern) - CONST char *string; /* String. */ +Tcl_StringMatch(str, pattern) + CONST char *str; /* String. */ CONST char *pattern; /* Pattern, which may contain special * characters. */ { - return Tcl_StringCaseMatch(string, pattern, 0); + return Tcl_StringCaseMatch(str, pattern, 0); } /* @@ -1225,8 +1225,8 @@ Tcl_StringMatch(string, pattern) */ int -Tcl_StringCaseMatch(string, pattern, nocase) - CONST char *string; /* String. */ +Tcl_StringCaseMatch(str, pattern, nocase) + CONST char *str; /* String. */ CONST char *pattern; /* Pattern, which may contain special * characters. */ int nocase; /* 0 for case sensitive, 1 for insensitive */ @@ -1245,9 +1245,9 @@ Tcl_StringCaseMatch(string, pattern, nocase) */ if (p == '\0') { - return (*string == '\0'); + return (*str == '\0'); } - if ((*string == '\0') && (p != '*')) { + if ((*str == '\0') && (p != '*')) { return 0; } @@ -1287,12 +1287,12 @@ Tcl_StringCaseMatch(string, pattern, nocase) */ if ((p != '[') && (p != '?') && (p != '\\')) { if (nocase) { - while (*string) { - charLen = TclUtfToUniChar(string, &ch1); + while (*str) { + charLen = TclUtfToUniChar(str, &ch1); if (ch2==ch1 || ch2==Tcl_UniCharToLower(ch1)) { break; } - string += charLen; + str += charLen; } } else { /* @@ -1300,22 +1300,22 @@ Tcl_StringCaseMatch(string, pattern, nocase) * shorter, as the number of bytes you want to * compare each time is non-constant. */ - while (*string) { - charLen = TclUtfToUniChar(string, &ch1); + while (*str) { + charLen = TclUtfToUniChar(str, &ch1); if (ch2 == ch1) { break; } - string += charLen; + str += charLen; } } } - if (Tcl_StringCaseMatch(string, pattern, nocase)) { + if (Tcl_StringCaseMatch(str, pattern, nocase)) { return 1; } - if (*string == '\0') { + if (*str == '\0') { return 0; } - string += TclUtfToUniChar(string, &ch1); + str += TclUtfToUniChar(str, &ch1); } } @@ -1326,7 +1326,7 @@ Tcl_StringCaseMatch(string, pattern, nocase) if (p == '?') { pattern++; - string += TclUtfToUniChar(string, &ch1); + str += TclUtfToUniChar(str, &ch1); continue; } @@ -1340,12 +1340,12 @@ Tcl_StringCaseMatch(string, pattern, nocase) Tcl_UniChar startChar, endChar; pattern++; - if (UCHAR(*string) < 0x80) { + if (UCHAR(*str) < 0x80) { ch1 = (Tcl_UniChar) - (nocase ? tolower(UCHAR(*string)) : UCHAR(*string)); - string++; + (nocase ? tolower(UCHAR(*str)) : UCHAR(*str)); + str++; } else { - string += Tcl_UtfToUniChar(string, &ch1); + str += Tcl_UtfToUniChar(str, &ch1); if (nocase) { ch1 = Tcl_UniCharToLower(ch1); } @@ -1420,7 +1420,7 @@ Tcl_StringCaseMatch(string, pattern, nocase) * bytes of each string match. */ - string += TclUtfToUniChar(string, &ch1); + str += TclUtfToUniChar(str, &ch1); pattern += TclUtfToUniChar(pattern, &ch2); if (nocase) { if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) { @@ -1502,13 +1502,13 @@ Tcl_DStringInit(dsPtr) * * Tcl_DStringAppend -- * - * Append more characters to the current value of a dynamic string. + * Append more bytes to the current value of a dynamic string. * * Results: * The return value is a pointer to the dynamic string's new value. * * Side effects: - * Length bytes from string (or all of string if length is less + * Length bytes from "bytes" (or all of "bytes" if length is less * than zero) are added to the current value of the string. Memory * gets reallocated if needed to accomodate the string's new size. * @@ -1516,12 +1516,12 @@ Tcl_DStringInit(dsPtr) */ char * -Tcl_DStringAppend(dsPtr, string, length) +Tcl_DStringAppend(dsPtr, bytes, length) Tcl_DString *dsPtr; /* Structure describing dynamic string. */ - CONST char *string; /* String to append. If length is -1 then + CONST char *bytes; /* String to append. If length is -1 then * this must be null-terminated. */ - int length; /* Number of characters from string to - * append. If < 0, then append all of string, + int length; /* Number of bytes from "bytes" to + * append. If < 0, then append all of bytes, * up to null at end. */ { int newSize; @@ -1529,7 +1529,7 @@ Tcl_DStringAppend(dsPtr, string, length) CONST char *end; if (length < 0) { - length = strlen(string); + length = strlen(bytes); } newSize = length + dsPtr->length; @@ -1559,9 +1559,9 @@ Tcl_DStringAppend(dsPtr, string, length) * one. */ - for (dst = dsPtr->string + dsPtr->length, end = string+length; - string < end; string++, dst++) { - *dst = *string; + for (dst = dsPtr->string + dsPtr->length, end = bytes+length; + bytes < end; bytes++, dst++) { + *dst = *bytes; } *dst = '\0'; dsPtr->length += length; @@ -1587,16 +1587,16 @@ Tcl_DStringAppend(dsPtr, string, length) */ char * -Tcl_DStringAppendElement(dsPtr, string) +Tcl_DStringAppendElement(dsPtr, element) Tcl_DString *dsPtr; /* Structure describing dynamic string. */ - CONST char *string; /* String to append. Must be + CONST char *element; /* String to append. Must be * null-terminated. */ { int newSize, flags, strSize; char *dst; - strSize = ((string == NULL) ? 0 : strlen(string)); - newSize = Tcl_ScanCountedElement(string, strSize, &flags) + strSize = ((element== NULL) ? 0 : strlen(element)); + newSize = Tcl_ScanCountedElement(element, strSize, &flags) + dsPtr->length + 1; /* @@ -1640,7 +1640,7 @@ Tcl_DStringAppendElement(dsPtr, string) */ flags |= TCL_DONT_QUOTE_HASH; } - dsPtr->length += Tcl_ConvertCountedElement(string, strSize, dst, flags); + dsPtr->length += Tcl_ConvertCountedElement(element, strSize, dst, flags); return dsPtr->string; } @@ -2375,15 +2375,14 @@ TclLooksLikeInt(bytes, length) * * This procedure returns an integer corresponding to the list index * held in a Tcl object. The Tcl object's value is expected to be - * either an integer or a string of the form "end([+-]integer)?". + * in the format integer([+-]integer)? or the format end([+-]integer)?. * * Results: * The return value is normally TCL_OK, which means that the index was * successfully stored into the location referenced by "indexPtr". If * the Tcl object referenced by "objPtr" has the value "end", the - * value stored is "endValue". If "objPtr"s values is not of the form - * "end([+-]integer)?" and - * can not be converted to an integer, TCL_ERROR is returned and, if + * value stored is "endValue". If "objPtr"s values is not of one + * of the expected formats, TCL_ERROR is returned and, if * "interp" is non-NULL, an error message is left in the interpreter's * result object. * @@ -2419,10 +2418,51 @@ TclGetIntForIndex(interp, objPtr, endValue, indexPtr) *indexPtr = endValue + objPtr->internalRep.longValue; } else { + int opIdx, length; + char *bytes = Tcl_GetStringFromObj(objPtr, &length); + char *p = bytes; + + while (length && isspace(UCHAR(*p))) { /* INTL: ISO space. */ + length--; p++; + } + if (length == 0) { + goto parseError; + } + if ((*p == '+') || (*p == '-')) { + p++; length--; + } + opIdx = TclParseInteger(p, length) + (int) (p-bytes); + if (opIdx) { + int code, first, second; + char savedOp = bytes[opIdx]; + if ((savedOp != '+') && (savedOp != '-')) { + goto parseError; + } + if (isspace(UCHAR(bytes[opIdx+1]))) { + goto parseError; + } + bytes[opIdx] = '\0'; + code = Tcl_GetInt(interp, bytes, &first); + bytes[opIdx] = savedOp; + if (code == TCL_ERROR) { + goto parseError; + } + if (TCL_ERROR == Tcl_GetInt(interp, bytes+opIdx+1, &second)) { + goto parseError; + } + if (savedOp == '+') { + *indexPtr = first + second; + } else { + *indexPtr = first - second; + } + return TCL_OK; + } + /* * Report a parse error. */ +parseError: if (interp != NULL) { char *bytes = Tcl_GetString(objPtr); /* @@ -2432,7 +2472,8 @@ TclGetIntForIndex(interp, objPtr, endValue, indexPtr) */ Tcl_ResetResult(interp); Tcl_AppendResult(interp, "bad index \"", bytes, - "\": must be integer or end?-integer?", (char *) NULL); + "\": must be integer?[+-]integer? or end?[+-]integer?", + (char *) NULL); if (!strncmp(bytes, "end-", 3)) { bytes += 3; } @@ -2489,7 +2530,7 @@ UpdateStringOfEndOffset(objPtr) * * SetEndOffsetFromAny -- * - * Look for a string of the form "end-offset" and convert it + * Look for a string of the form "end[+-]offset" and convert it * to an internal representation holding the offset. * * Results: @@ -2525,7 +2566,7 @@ SetEndOffsetFromAny(interp, objPtr) if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "bad index \"", bytes, - "\": must be end?-integer?", (char*) NULL); + "\": must be end?[+-]integer?", (char*) NULL); } return TCL_ERROR; } @@ -2534,15 +2575,20 @@ SetEndOffsetFromAny(interp, objPtr) if (length <= 3) { offset = 0; - } else if ((length > 4) && (bytes[3] == '-')) { + } else if ((length > 4) && ((bytes[3] == '-') || (bytes[3] == '+'))) { /* * This is our limited string expression evaluator. Pass everything * after "end-" to Tcl_GetInt, then reverse for offset. */ + if (isspace(UCHAR(bytes[4]))) { + return TCL_ERROR; + } if (Tcl_GetInt(interp, bytes+4, &offset) != TCL_OK) { return TCL_ERROR; } - offset = -offset; + if (bytes[3] == '-') { + offset = -offset; + } } else { /* * Conversion failed. Report the error. @@ -2550,7 +2596,7 @@ SetEndOffsetFromAny(interp, objPtr) if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "bad index \"", bytes, - "\": must be integer or end?-integer?", (char *) NULL); + "\": must be end?[+-]integer?", (char *) NULL); } return TCL_ERROR; } diff --git a/library/init.tcl b/library/init.tcl index 9536b7e..b2dc17e 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.69.2.1 2005/04/25 21:37:23 kennykb Exp $ +# RCS: @(#) $Id: init.tcl,v 1.69.2.2 2005/05/05 17:56:13 kennykb Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -342,7 +342,7 @@ proc unknown args { } } if {[llength $cmds] == 1} { - return [uplevel 1 [lreplace $args 0 0 $cmds]] + return [uplevel 1 [lreplace $args 0 0 [lindex $cmds 0]]] } if {[llength $cmds]} { if {$name eq ""} { diff --git a/tests/appendComp.test b/tests/appendComp.test index 4f4cb8b..f91a778 100644 --- a/tests/appendComp.test +++ b/tests/appendComp.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: appendComp.test,v 1.7 2004/09/22 03:19:52 dgp Exp $ +# RCS: @(#) $Id: appendComp.test,v 1.7.2.1 2005/05/05 17:56:14 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -351,7 +351,7 @@ test appendComp-7.9 {append var does not trigger read trace} { bar } {0} -test appendComp-8.1 {TCL_OUT_LINE_COMPILE, not TCL_ERROR} -setup { +test appendComp-8.1 {defer error to runtime} -setup { interp create slave } -body { slave eval { diff --git a/tests/cmdIL.test b/tests/cmdIL.test index 156c4dd..299ed71 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.23 2004/10/14 17:20:11 dkf Exp $ +# RCS: @(#) $Id: cmdIL.test,v 1.23.2.1 2005/05/05 17:56:14 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -59,7 +59,7 @@ test cmdIL-1.11 {Tcl_LsortObjCmd procedure, -index option} { } {1 {"-index" option must be followed by list index}} test cmdIL-1.12 {Tcl_LsortObjCmd procedure, -index option} { list [catch {lsort -index foo {1 3 2 5}} msg] $msg -} {1 {bad index "foo": must be integer or end?-integer?}} +} {1 {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}} test cmdIL-1.13 {Tcl_LsortObjCmd procedure, -index option} { lsort -index end -integer {{2 25} {10 20 50 100} {3 16 42} 1} } {1 {2 25} {3 16 42} {10 20 50 100}} diff --git a/tests/compile.test b/tests/compile.test index 93d370a..294bf88 100644 --- a/tests/compile.test +++ b/tests/compile.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: compile.test,v 1.34.2.2 2005/03/15 19:41:46 kennykb Exp $ +# RCS: @(#) $Id: compile.test,v 1.34.2.3 2005/05/05 17:56:15 kennykb Exp $ package require tcltest 2 namespace import -force ::tcltest::* @@ -236,15 +236,15 @@ test compile-11.1 {Tcl_Append*: ensure Tcl_ResetResult is used properly} { lindex a bogus } list [catch {p} msg] $msg -} {1 {bad index "bogus": must be integer or end?-integer?}} +} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} { proc p {} { set r [list foobar] ; string index a bogus } list [catch {p} msg] $msg -} {1 {bad index "bogus": must be integer or end?-integer?}} +} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} { proc p {} { set r [list foobar] ; string index a 09 } list [catch {p} msg] $msg -} {1 {bad index "09": must be integer or end?-integer? (looks like invalid octal number)}} +} {1 {bad index "09": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} { proc p {} { set r [list foobar] ; array set var {one two many} } list [catch {p} msg] $msg diff --git a/tests/expr-old.test b/tests/expr-old.test index 5dddef8..a8489c8 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -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: expr-old.test,v 1.22.2.4 2005/03/15 19:41:46 kennykb Exp $ +# RCS: @(#) $Id: expr-old.test,v 1.22.2.5 2005/05/05 17:56:16 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -1040,6 +1040,13 @@ test expr-old-38.1 {Verify Tcl_ExprString's basic operation} testexprstring { list [testexprstring "1+4"] [testexprstring "2*3+4.2"] \ [catch {testexprstring "1+"} msg] $msg } {5 10.2 1 {syntax error in expression "1+": premature end of expression}} +test expr-old-38.2 {Tcl_ExprString} testexprstring { + # This one is "magical" + testexprstring {} +} 0 +test expr-old-38.3 {Tcl_ExprString} -constraints testexprstring -body { + testexprstring { } +} -returnCodes error -match glob -result * # # Test for bug #908375: rounding numbers that do not fit in a diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 45f889d..23eaeca 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -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: ioCmd.test,v 1.21 2004/06/23 15:36:57 dkf Exp $ +# RCS: @(#) $Id: ioCmd.test,v 1.21.2.1 2005/05/05 17:56:16 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -426,11 +426,36 @@ unmatched open brace in list \"open \$path(test3) \"FOO \\{BAR BAZ\"\"" test iocmd-12.7 {POSIX open access modes: errors} { list [catch {open $path(test3) {FOO BAR BAZ}} msg] $msg -} {1 {invalid access mode "FOO": must be RDONLY, WRONLY, RDWR, APPEND, CREAT EXCL, NOCTTY, NONBLOCK, or TRUNC}} +} {1 {invalid access mode "FOO": must be RDONLY, WRONLY, RDWR, APPEND, BINARY, CREAT, EXCL, NOCTTY, NONBLOCK, or TRUNC}} test iocmd-12.8 {POSIX open access modes: errors} { list [catch {open $path(test3) {TRUNC CREAT}} msg] $msg } {1 {access mode must include either RDONLY, WRONLY, or RDWR}} close [open $path(test3) w] +test iocmd-12.9 {POSIX open access modes: BINARY} { + list [catch {open $path(test1) BINARY} msg] $msg +} {1 {access mode must include either RDONLY, WRONLY, or RDWR}} +test iocmd-12.10 {POSIX open access modes: BINARY} { + set f [open $path(test1) {WRONLY BINARY TRUNC}] + puts $f a + puts $f b + puts -nonewline $f c ;# contents are now 5 bytes: a\nb\nc + close $f + set f [open $path(test1) r] + fconfigure $f -translation binary + set result [string length [read $f]] + close $f + set result +} 5 +test iocmd-12.11 {POSIX open access modes: BINARY} { + set f [open $path(test1) {WRONLY BINARY TRUNC}] + puts $f \u0248 ;# gets truncated to \u0048 + close $f + set f [open $path(test1) r] + fconfigure $f -translation binary + set result [read -nonewline $f] + close $f + set result +} \u0048 test iocmd-13.1 {errors in open command} { list [catch {open} msg] $msg @@ -452,6 +477,15 @@ test iocmd-13.6 {errors in open command} { regsub [file join {} _non_existent_] $msg "_non_existent_" msg string tolower $msg } {1 {couldn't open "_non_existent_": no such file or directory} {posix enoent {no such file or directory}}} +test iocmd-13.7 {errors in open command} { + list [catch {open $path(test1) b} msg] $msg +} {1 {illegal access mode "b"}} +test iocmd-13.8 {errors in open command} { + list [catch {open $path(test1) rbb} msg] $msg +} {1 {illegal access mode "rbb"}} +test iocmd-13.9 {errors in open command} { + list [catch {open $path(test1) r++} msg] $msg +} {1 {illegal access mode "r++"}} test iocmd-14.1 {file id parsing errors} { list [catch {eof gorp} msg] $msg $errorCode diff --git a/tests/lindex.test b/tests/lindex.test index 63d1548..5068912 100644 --- a/tests/lindex.test +++ b/tests/lindex.test @@ -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: lindex.test,v 1.11 2003/11/14 20:44:46 dgp Exp $ +# RCS: @(#) $Id: lindex.test,v 1.11.2.1 2005/05/05 17:56:17 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -49,7 +49,7 @@ test lindex-2.3 {multiple indices in list} testevalex { test lindex-2.4 {malformed index list} testevalex { set x \{ list [catch { testevalex {lindex {a b c} $x} } result] $result -} {1 bad\ index\ \"\{\":\ must\ be\ integer\ or\ end?-integer?} +} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?} # Indices that are integers or convertible to integers @@ -76,12 +76,12 @@ test lindex-3.4 {integer 3} testevalex { test lindex-3.5 {bad octal} testevalex { set x 08 list [catch { testevalex {lindex {a b c} $x} } result] $result -} "1 {bad index \"08\": must be integer or end?-integer? (looks like invalid octal number)}" +} {1 {bad index "08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test lindex-3.6 {bad octal} testevalex { set x -09 list [catch { testevalex {lindex {a b c} $x} } result] $result -} "1 {bad index \"-09\": must be integer or end?-integer? (looks like invalid octal number)}" +} {1 {bad index "-09": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test lindex-3.7 {indexes don't shimmer wide ints} { set x [expr {(wide(1)<<31) - 2}] @@ -118,31 +118,31 @@ test lindex-4.5 {index = end-3} testevalex { test lindex-4.6 {bad octal} testevalex { set x end-08 list [catch { testevalex {lindex {a b c} $x} } result] $result -} "1 {bad index \"end-08\": must be integer or end?-integer? (looks like invalid octal number)}" +} {1 {bad index "end-08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test lindex-4.7 {bad octal} testevalex { set x end--09 list [catch { testevalex {lindex {a b c} $x} } result] $result -} "1 {bad index \"end--09\": must be integer or end?-integer?}" +} {1 {bad index "end--09": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-4.8 {bad integer, not octal} testevalex { set x end-0a2 list [catch { testevalex {lindex {a b c} $x} } result] $result -} "1 {bad index \"end-0a2\": must be integer or end?-integer?}" +} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}} -test lindex-4.9 {incomplete end} testevalex { - set x en +test lindex-4.9 {obsolete test} testevalex { + set x end list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] } {c c} test lindex-4.10 {incomplete end-} testevalex { set x end- list [catch { testevalex {lindex {a b c} $x} } result] $result -} "1 {bad index \"end-\": must be integer or end?-integer?}" +} {1 {bad index "end-": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-5.1 {bad second index} testevalex { list [catch { testevalex {lindex {a b c} 0 0a2} } result] $result -} "1 {bad index \"0a2\": must be integer or end?-integer?}" +} {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-5.2 {good second index} testevalex { testevalex {lindex {{a b c} {d e f} {g h i}} 1 2} @@ -245,7 +245,7 @@ test lindex-10.3 {multiple indices in list} { test lindex-10.4 {malformed index list} { set x \{ list [catch { lindex {a b c} $x } result] $result -} {1 bad\ index\ \"\{\":\ must\ be\ integer\ or\ end?-integer?} +} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?} # Indices that are integers or convertible to integers @@ -284,12 +284,12 @@ test lindex-11.4 {integer 3} { test lindex-11.5 {bad octal} { set x 08 list [catch { lindex {a b c} $x } result] $result -} "1 {bad index \"08\": must be integer or end?-integer? (looks like invalid octal number)}" +} {1 {bad index "08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test lindex-11.6 {bad octal} { set x -09 list [catch { lindex {a b c} $x } result] $result -} "1 {bad index \"-09\": must be integer or end?-integer? (looks like invalid octal number)}" +} {1 {bad index "-09": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} # Indices relative to end @@ -336,20 +336,20 @@ test lindex-12.5 {index = end-3} { test lindex-12.6 {bad octal} { set x end-08 list [catch { lindex {a b c} $x } result] $result -} "1 {bad index \"end-08\": must be integer or end?-integer? (looks like invalid octal number)}" +} {1 {bad index "end-08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test lindex-12.7 {bad octal} { set x end--09 list [catch { lindex {a b c} $x } result] $result -} "1 {bad index \"end--09\": must be integer or end?-integer?}" +} {1 {bad index "end--09": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-12.8 {bad integer, not octal} { set x end-0a2 list [catch { lindex {a b c} $x } result] $result -} "1 {bad index \"end-0a2\": must be integer or end?-integer?}" +} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}} -test lindex-12.9 {incomplete end} { - set x en +test lindex-12.9 {obsolete test} { + set x end catch { list [lindex {a b c} $x] [lindex {a b c} $x] } result @@ -359,11 +359,11 @@ test lindex-12.9 {incomplete end} { test lindex-12.10 {incomplete end-} { set x end- list [catch { lindex {a b c} $x } result] $result -} "1 {bad index \"end-\": must be integer or end?-integer?}" +} {1 {bad index "end-": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-13.1 {bad second index} { list [catch { lindex {a b c} 0 0a2 } result] $result -} "1 {bad index \"0a2\": must be integer or end?-integer?}" +} {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-13.2 {good second index} { catch { diff --git a/tests/linsert.test b/tests/linsert.test index b3dcb6b..9b249d3 100644 --- a/tests/linsert.test +++ b/tests/linsert.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: linsert.test,v 1.8 2000/04/10 17:19:01 ericm Exp $ +# RCS: @(#) $Id: linsert.test,v 1.8.28.1 2005/05/05 17:56:18 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -90,7 +90,7 @@ test linsert-2.2 {linsert errors} { } {1 {wrong # args: should be "linsert list index element ?element ...?"}} test linsert-2.3 {linsert errors} { list [catch {linsert a 12x 2} msg] $msg -} {1 {bad index "12x": must be integer or end?-integer?}} +} {1 {bad index "12x": must be integer?[+-]integer? or end?[+-]integer?}} test linsert-2.4 {linsert errors} { list [catch {linsert \{ 12 2} msg] $msg } {1 {unmatched open brace in list}} diff --git a/tests/lrange.test b/tests/lrange.test index 68e5d5e..7e31347 100644 --- a/tests/lrange.test +++ b/tests/lrange.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: lrange.test,v 1.7 2000/04/10 17:19:01 ericm Exp $ +# RCS: @(#) $Id: lrange.test,v 1.7.28.1 2005/05/05 17:56:18 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -43,7 +43,7 @@ test lrange-1.8 {range of list elements} { lrange {a b c d e} -2 -1 } {} test lrange-1.9 {range of list elements} { - lrange {a b c d e} -2 e + lrange {a b c d e} -2 end } {a b c d e} test lrange-1.10 {range of list elements} { lrange "a b\{c d" 1 2 @@ -55,7 +55,7 @@ test lrange-1.12 {range of list elements} { lrange "a b c d" end 100000 } d test lrange-1.13 {range of list elements} { - lrange "a b c d" e 3 + lrange "a b c d" end 3 } d test lrange-1.14 {range of list elements} { lrange "a b c d" end 2 @@ -75,10 +75,10 @@ test lrange-2.2 {error conditions} { } {1 {wrong # args: should be "lrange list first last"}} test lrange-2.3 {error conditions} { list [catch {lrange a b 6} msg] $msg -} {1 {bad index "b": must be integer or end?-integer?}} +} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}} test lrange-2.4 {error conditions} { list [catch {lrange a 0 enigma} msg] $msg -} {1 {bad index "enigma": must be integer or end?-integer?}} +} {1 {bad index "enigma": must be integer?[+-]integer? or end?[+-]integer?}} test lrange-2.5 {error conditions} { list [catch {lrange "a \{b c" 3 4} msg] $msg } {1 {unmatched open brace in list}} diff --git a/tests/lreplace.test b/tests/lreplace.test index d3ca611..cdd99c2 100644 --- a/tests/lreplace.test +++ b/tests/lreplace.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: lreplace.test,v 1.7 2000/04/10 17:19:01 ericm Exp $ +# RCS: @(#) $Id: lreplace.test,v 1.7.28.1 2005/05/05 17:56:18 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -110,13 +110,13 @@ test lreplace-2.2 {lreplace errors} { } {1 {wrong # args: should be "lreplace list first last ?element element ...?"}} test lreplace-2.3 {lreplace errors} { list [catch {lreplace x a 10} msg] $msg -} {1 {bad index "a": must be integer or end?-integer?}} +} {1 {bad index "a": must be integer?[+-]integer? or end?[+-]integer?}} test lreplace-2.4 {lreplace errors} { list [catch {lreplace x 10 x} msg] $msg -} {1 {bad index "x": must be integer or end?-integer?}} +} {1 {bad index "x": must be integer?[+-]integer? or end?[+-]integer?}} test lreplace-2.5 {lreplace errors} { list [catch {lreplace x 10 1x} msg] $msg -} {1 {bad index "1x": must be integer or end?-integer?}} +} {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}} test lreplace-2.6 {lreplace errors} { list [catch {lreplace x 3 2} msg] $msg } {1 {list doesn't contain element 3}} diff --git a/tests/lsearch.test b/tests/lsearch.test index aded40b..ac19a10 100644 --- a/tests/lsearch.test +++ b/tests/lsearch.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: lsearch.test,v 1.13 2003/10/15 13:15:45 dkf Exp $ +# RCS: @(#) $Id: lsearch.test,v 1.13.2.1 2005/05/05 17:56:18 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -284,7 +284,7 @@ test lsearch-10.3 {offset searching} { } 3 test lsearch-10.4 {offset searching} { list [catch {lsearch -start foobar {a b c a b c} a} msg] $msg -} {1 {bad index "foobar": must be integer or end?-integer?}} +} {1 {bad index "foobar": must be integer?[+-]integer? or end?[+-]integer?}} test lsearch-10.5 {offset searching} { list [catch {lsearch -start 1 2} msg] $msg } {1 {missing starting index}} @@ -415,7 +415,7 @@ test lsearch-20.1 {lsearch -index option, index larger than sublists} { } {1 {element 2 missing from sublist "a c"}} test lsearch-20.2 {lsearch -index option, malformed index} { list [catch {lsearch -index foo {{a c} {a b} {a a}} a} msg] $msg -} {1 {bad index "foo": must be integer or end?-integer?}} +} {1 {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}} test lsearch-20.3 {lsearch -index option, malformed index} { list [catch {lsearch -index \{ {{a c} {a b} {a a}} a} msg] $msg } {1 {unmatched open brace in list}} diff --git a/tests/lset.test b/tests/lset.test index 048e9ba..00facb2 100644 --- a/tests/lset.test +++ b/tests/lset.test @@ -51,7 +51,7 @@ test lset-2.2 {lset, not compiled, 3 args, second arg neither index nor list} te list [catch { testevalex {lset x {{bad}1} 3} } msg] $msg -} "1 {bad index \"{bad}1\": must be integer or end?-integer?}" +} {1 {bad index "{bad}1": must be integer?[+-]integer? or end?[+-]integer?}} test lset-3.1 {lset, not compiled, 3 args, data duplicated} testevalex { set x {0 1 2} @@ -99,7 +99,7 @@ test lset-4.2 {lset, not compiled, 3 args, bad index} testevalex { list [catch { testevalex {lset a [list 2a2] w} } msg] $msg -} {1 {bad index "2a2": must be integer or end?-integer?}} +} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} test lset-4.3 {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} @@ -141,7 +141,7 @@ test lset-4.8 {lset, not compiled, 3 args, bad index} testevalex { list [catch { testevalex {lset a 2a2 w} } msg] $msg -} {1 {bad index "2a2": must be integer or end?-integer?}} +} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} test lset-4.9 {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} @@ -300,12 +300,12 @@ test lset-8.2 {lset, not compiled, malformed sublist} testevalex { test lset-8.3 {lset, not compiled, bad second index} testevalex { set a {{b c} {d e}} list [catch {testevalex {lset a 0 2a2 f}} msg] $msg -} {1 {bad index "2a2": must be integer or end?-integer?}} +} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} test lset-8.4 {lset, not compiled, bad second index} testevalex { set a {{b c} {d e}} list [catch {testevalex {lset a {0 2a2} f}} msg] $msg -} {1 {bad index "2a2": must be integer or end?-integer?}} +} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} test lset-8.5 {lset, not compiled, second index out of range} testevalex { set a {{b c} {d e} {f g}} diff --git a/tests/main.test b/tests/main.test index 30de5ed..04b5a82 100644 --- a/tests/main.test +++ b/tests/main.test @@ -1,6 +1,6 @@ # This file contains a collection of tests for generic/tclMain.c. # -# RCS: @(#) $Id: main.test,v 1.15 2003/10/07 21:45:39 dgp Exp $ +# RCS: @(#) $Id: main.test,v 1.15.2.1 2005/05/05 17:56:19 kennykb Exp $ if {[catch {package require tcltest 2.0.2}]} { puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required." @@ -906,6 +906,22 @@ namespace eval ::tcl::test::main { file delete result } -result "1\n% " + test Tcl_Main-6.7 { + [unknown]: interactive auto-completion. + } -constraints { + exec + } -body { + exec [interpreter] << { + proc foo\{ x {} + set tcl_interactive 1 + foo y} >& result + set f [open result] + read $f + } -cleanup { + close $f + file delete result + } -result "1\n% % " + # Tests Tcl_Main-7.*: exiting test Tcl_Main-7.1 { diff --git a/tests/regexp.test b/tests/regexp.test index fe4221b..6bc8ad1 100644 --- a/tests/regexp.test +++ b/tests/regexp.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: regexp.test,v 1.25 2003/10/14 18:23:31 vincentdarley Exp $ +# RCS: @(#) $Id: regexp.test,v 1.25.2.1 2005/05/05 17:56:19 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -220,7 +220,7 @@ test regexp-6.8 {regexp errors} { } {1 {couldn't set variable "f1(f2)"}} test regexp-6.9 {regexp errors, -start bad int check} { list [catch {regexp -start bogus {^$} {}} msg] $msg -} {1 {expected integer but got "bogus"}} +} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} test regexp-7.1 {basic regsub operation} { list [regsub aa+ xaxaaaxaa 111&222 foo] $foo @@ -377,7 +377,7 @@ test regexp-11.7 {regsub errors} { } {1 {couldn't set variable "f1(f2)"}} test regexp-11.8 {regsub errors, -start bad int check} { list [catch {regsub -start bogus pattern string rep var} msg] $msg -} {1 {expected integer but got "bogus"}} +} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} test regexp-11.9 {regsub without final variable name returns value} { regsub b abaca X } {aXaca} @@ -467,6 +467,20 @@ test regexp-15.5 {regexp -start, over end of string} { test regexp-15.6 {regexp -start, loss of ^$ behavior} { list [regexp -start 2 {^$} {}] } {0} +test regexp-15.7 {regexp -start, double option} { + regexp -start 2 -start 0 a abc +} 1 +test regexp-15.8 {regexp -start, double option} { + regexp -start 0 -start 2 a abc +} 0 +test regexp-15.9 {regexp -start, end relative index} { + catch {unset x} + list [regexp -start end {\d} 1abc2de3 x] [info exists x] +} {0 0} +test regexp-15.10 {regexp -start, end relative index} { + catch {unset x} + list [regexp -start end-1 {\d} 1abc2de3 x] [info exists x] $x +} {1 1 3} test regexp-16.1 {regsub -start} { catch {unset x} @@ -485,6 +499,18 @@ test regexp-16.4 {regsub -start, \A behavior} { lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x } {5 /a/b/c/d/e 3 ab/c/d/e} +test regexp-16.5 {regsub -start, double option} { + list [regsub -start 2 -start 0 a abc c x] $x +} {1 cbc} +test regexp-16.6 {regsub -start, double option} { + list [regsub -start 0 -start 2 a abc c x] $x +} {0 abc} +test regexp-16.7 {regexp -start, end relative index} { + list [regsub -start end a aaa b x] $x +} {0 aaa} +test regexp-16.8 {regexp -start, end relative index} { + list [regsub -start end-1 a aaa b x] $x +} {1 aab} test regexp-17.1 {regexp -inline} { regexp -inline b ababa diff --git a/tests/regexpComp.test b/tests/regexpComp.test index 6580d60..a84099e 100644 --- a/tests/regexpComp.test +++ b/tests/regexpComp.test @@ -301,7 +301,7 @@ test regexpComp-6.9 {regexp errors, -start bad int check} { evalInProc { list [catch {regexp -start bogus {^$} {}} msg] $msg } -} {1 {expected integer but got "bogus"}} +} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} test regexpComp-7.1 {basic regsub operation} { evalInProc { @@ -542,7 +542,7 @@ test regexpComp-11.8 {regsub errors, -start bad int check} { evalInProc { list [catch {regsub -start bogus pattern string rep var} msg] $msg } -} {1 {expected integer but got "bogus"}} +} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} # This test crashes on the Mac unless you increase the Stack Space to about 1 # Meg. This is probably bigger than most users want... diff --git a/tests/string.test b/tests/string.test index 43e8fa3..25d7800 100644 --- a/tests/string.test +++ b/tests/string.test @@ -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: string.test,v 1.43.2.2 2005/04/25 21:37:30 kennykb Exp $ +# RCS: @(#) $Id: string.test,v 1.43.2.3 2005/05/05 17:56:35 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -176,7 +176,7 @@ test string-4.1 {string first, too few args} { } {1 {wrong # args: should be "string first subString string ?startIndex?"}} test string-4.2 {string first, bad args} { list [catch {string first a b c} msg] $msg -} {1 {bad index "c": must be integer or end?-integer?}} +} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}} test string-4.3 {string first, too many args} { list [catch {string first a b 5 d} msg] $msg } {1 {wrong # args: should be "string first subString string ?startIndex?"}} @@ -241,7 +241,7 @@ test string-5.6 {string index} { } {0 {}} test string-5.7 {string index} { list [catch {string index a xyz} msg] $msg -} {1 {bad index "xyz": must be integer or end?-integer?}} +} {1 {bad index "xyz": must be integer?[+-]integer? or end?[+-]integer?}} test string-5.8 {string index} { string index abc end } c @@ -276,10 +276,10 @@ test string-5.16 {string index, bytearray object with string obj shimmering} { } 0 test string-5.17 {string index, bad integer} { list [catch {string index "abc" 08} msg] $msg -} {1 {bad index "08": must be integer or end?-integer? (looks like invalid octal number)}} +} {1 {bad index "08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test string-5.18 {string index, bad integer} { list [catch {string index "abc" end-00289} msg] $msg -} {1 {bad index "end-00289": must be integer or end?-integer? (looks like invalid octal number)}} +} {1 {bad index "end-00289": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test string-5.19 {string index, bytearray object out of bounds} { string index [binary format I* {0x50515253 0x52}] -1 } {} @@ -664,7 +664,7 @@ test string-7.1 {string last, too few args} { } {1 {wrong # args: should be "string last subString string ?startIndex?"}} test string-7.2 {string last, bad args} { list [catch {string last a b c} msg] $msg -} {1 {bad index "c": must be integer or end?-integer?}} +} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}} test string-7.3 {string last, too many args} { list [catch {string last a b c d} msg] $msg } {1 {wrong # args: should be "string last subString string ?startIndex?"}} @@ -1019,7 +1019,7 @@ test string-12.5 {string range, last > length} { string range abcdefghijklmnop 7 1000 } {hijklmnop} test string-12.6 {string range} { - string range abcdefghijklmnop 10 e + string range abcdefghijklmnop 10 end } {klmnop} test string-12.7 {string range, last < first} { string range abcdefghijklmnop 10 9 @@ -1038,15 +1038,15 @@ test string-12.11 {string range} { } {abcdefghijklmnop} test string-12.12 {string range} { list [catch {string range abc abc 1} msg] $msg -} {1 {bad index "abc": must be integer or end?-integer?}} +} {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}} test string-12.13 {string range} { list [catch {string range abc 1 eof} msg] $msg -} {1 {bad index "eof": must be integer or end?-integer?}} +} {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}} test string-12.14 {string range} { string range abcdefghijklmnop end-1 end } {op} test string-12.15 {string range} { - string range abcdefghijklmnop e 1000 + string range abcdefghijklmnop end 1000 } {p} test string-12.16 {string range} { string range abcdefghijklmnop end end-1 @@ -1129,7 +1129,7 @@ test string-14.6 {string replace} { string replace abcdefghijklmnop 7 1000 } {abcdefg} test string-14.7 {string replace} { - string replace abcdefghijklmnop 10 e + string replace abcdefghijklmnop 10 end } {abcdefghij} test string-14.8 {string replace} { string replace abcdefghijklmnop 10 9 @@ -1148,15 +1148,15 @@ test string-14.12 {string replace} { } {} test string-14.13 {string replace} { list [catch {string replace abc abc 1} msg] $msg -} {1 {bad index "abc": must be integer or end?-integer?}} +} {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}} test string-14.14 {string replace} { list [catch {string replace abc 1 eof} msg] $msg -} {1 {bad index "eof": must be integer or end?-integer?}} +} {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}} test string-14.15 {string replace} { string replace abcdefghijklmnop end-10 end-2 NEW } {abcdeNEWop} test string-14.16 {string replace} { - string replace abcdefghijklmnop 0 e foo + string replace abcdefghijklmnop 0 end foo } {foo} test string-14.17 {string replace} { string replace abcdefghijklmnop end end-1 @@ -1167,7 +1167,7 @@ test string-15.1 {string tolower too few args} { } {1 {wrong # args: should be "string tolower string ?first? ?last?"}} test string-15.2 {string tolower bad args} { list [catch {string tolower a b} msg] $msg -} {1 {bad index "b": must be integer or end?-integer?}} +} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}} test string-15.3 {string tolower too many args} { list [catch {string tolower ABC 1 end oops} msg] $msg } {1 {wrong # args: should be "string tolower string ?first? ?last?"}} @@ -1198,7 +1198,7 @@ test string-16.1 {string toupper} { } {1 {wrong # args: should be "string toupper string ?first? ?last?"}} test string-16.2 {string toupper} { list [catch {string toupper a b} msg] $msg -} {1 {bad index "b": must be integer or end?-integer?}} +} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}} test string-16.3 {string toupper} { list [catch {string toupper a 1 end oops} msg] $msg } {1 {wrong # args: should be "string toupper string ?first? ?last?"}} @@ -1229,7 +1229,7 @@ test string-17.1 {string totitle} { } {1 {wrong # args: should be "string totitle string ?first? ?last?"}} test string-17.2 {string totitle} { list [catch {string totitle a b} msg] $msg -} {1 {bad index "b": must be integer or end?-integer?}} +} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}} test string-17.3 {string totitle} { string totitle abCDEf } {Abcdef} @@ -1311,7 +1311,7 @@ test string-21.2 {string wordend} { } {1 {wrong # args: should be "string wordend string index"}} test string-21.3 {string wordend} { list [catch {string wordend a gorp} msg] $msg -} {1 {bad index "gorp": must be integer or end?-integer?}} +} {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}} test string-21.4 {string wordend} { string wordend abc. -1 } 3 @@ -1357,7 +1357,7 @@ test string-22.3 {string wordstart} { } {1 {wrong # args: should be "string wordstart string index"}} test string-22.4 {string wordstart} { list [catch {string wordstart a gorp} msg] $msg -} {1 {bad index "gorp": must be integer or end?-integer?}} +} {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}} test string-22.5 {string wordstart} { string wordstart "one two three_words" 400 } 8 diff --git a/tests/stringComp.test b/tests/stringComp.test index e2cd121..ddfd387 100644 --- a/tests/stringComp.test +++ b/tests/stringComp.test @@ -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: stringComp.test,v 1.8 2004/05/25 18:58:05 dgp Exp $ +# RCS: @(#) $Id: stringComp.test,v 1.8.2.1 2005/05/05 17:56:36 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -226,7 +226,7 @@ test stringComp-4.1 {string first, too few args} { test stringComp-4.2 {string first, bad args} { proc foo {} {string first a b c} list [catch {foo} msg] $msg -} {1 {bad index "c": must be integer or end?-integer?}} +} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}} test stringComp-4.3 {string first, too many args} { proc foo {} {string first a b 5 d} list [catch {foo} msg] $msg @@ -303,7 +303,7 @@ test stringComp-5.6 {string index} { test stringComp-5.7 {string index} { proc foo {} {string index a xyz} list [catch {foo} msg] $msg -} {1 {bad index "xyz": must be integer or end?-integer?}} +} {1 {bad index "xyz": must be integer?[+-]integer? or end?[+-]integer?}} test stringComp-5.8 {string index} { proc foo {} {string index abc end} foo @@ -352,11 +352,11 @@ test stringComp-5.16 {string index, bytearray object with string obj shimmering} test stringComp-5.17 {string index, bad integer} { proc foo {} {string index "abc" 08} list [catch {foo} msg] $msg -} {1 {bad index "08": must be integer or end?-integer? (looks like invalid octal number)}} +} {1 {bad index "08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test stringComp-5.18 {string index, bad integer} { proc foo {} {string index "abc" end-00289} list [catch {foo} msg] $msg -} {1 {bad index "end-00289": must be integer or end?-integer? (looks like invalid octal number)}} +} {1 {bad index "end-00289": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test stringComp-5.19 {string index, bytearray object out of bounds} { proc foo {} {string index [binary format I* {0x50515253 0x52}] -1} foo diff --git a/tests/unixInit.test b/tests/unixInit.test index f5a93c8..92be990 100644 --- a/tests/unixInit.test +++ b/tests/unixInit.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: unixInit.test,v 1.44.2.2 2005/04/25 21:37:30 kennykb Exp $ +# RCS: @(#) $Id: unixInit.test,v 1.44.2.3 2005/05/05 17:56:37 kennykb Exp $ package require tcltest 2.2 namespace import -force ::tcltest::* @@ -429,12 +429,12 @@ test unixInit-7.1 {closed standard channel: Bug 772288} -constraints { unix stdio } -body { set tclsh [interpreter] - makeFile {puts [open /dev/null]} crash.tcl - makeFile " + set crash [makeFile {puts [open /dev/null]} crash.tcl] + set crashtest [makeFile " close stdin - [list exec $tclsh [file join [temporaryDirectory] crash.tcl]] - " crashtest.tcl - exec $tclsh [file join [temporaryDirectory] crashtest.tcl] + [list exec $tclsh $crash] + " crashtest.tcl] + exec $tclsh $crashtest } -cleanup { removeFile crash.tcl removeFile crashtest.tcl diff --git a/tests/util.test b/tests/util.test index 6351fce..dcbaf20 100644 --- a/tests/util.test +++ b/tests/util.test @@ -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: util.test,v 1.14.2.2 2005/03/08 17:04:06 kennykb Exp $ +# RCS: @(#) $Id: util.test,v 1.14.2.3 2005/05/05 17:56:39 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -489,440 +489,623 @@ test util-8.6 {TclNeedSpace - correct UTF8 handling} testdstring { list [llength [testdstring get]] [string length [testdstring get]] } {2 9} -test util-9.1 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-9.0.0 {TclGetIntForIndex} { + string index abcd 0 +} a +test util-9.0.1 {TclGetIntForIndex} { + string index abcd 0x0 +} a +test util-9.0.2 {TclGetIntForIndex} { + string index abcd -0x0 +} a +test util-9.0.3 {TclGetIntForIndex} { + string index abcd { 0 } +} a +test util-9.0.4 {TclGetIntForIndex} { + string index abcd { 0x0 } +} a +test util-9.0.5 {TclGetIntForIndex} { + string index abcd { -0x0 } +} a +test util-9.0.6 {TclGetIntForIndex} { + string index abcd 01 +} b +test util-9.0.7 {TclGetIntForIndex} { + string index abcd { 01 } +} b +test util-9.1.0 {TclGetIntForIndex} { + string index abcd 3 +} d +test util-9.1.1 {TclGetIntForIndex} { + string index abcd { 3 } +} d +test util-9.1.2 {TclGetIntForIndex} { + string index abcdefghijk 0xa +} k +test util-9.1.3 {TclGetIntForIndex} { + string index abcdefghijk { 0xa } +} k +test util-9.2.0 {TclGetIntForIndex} { + string index abcd end +} d +test util-9.2.1 {TclGetIntForIndex} -body { + string index abcd { end} +} -returnCodes error -match glob -result * +test util-9.2.2 {TclGetIntForIndex} -body { + string index abcd {end } +} -returnCodes error -match glob -result * +test util-9.3 {TclGetIntForIndex} { + # Deprecated + string index abcd en +} d +test util-9.4 {TclGetIntForIndex} { + # Deprecated + string index abcd e +} d +test util-9.5.0 {TclGetIntForIndex} { + string index abcd end-1 +} c +test util-9.5.1 {TclGetIntForIndex} { + string index abcd {end-1 } +} c +test util-9.5.2 {TclGetIntForIndex} -body { + string index abcd { end-1} +} -returnCodes error -match glob -result * +test util-9.6 {TclGetIntForIndex} { + string index abcd end+-1 +} c +test util-9.7 {TclGetIntForIndex} { + string index abcd end+1 +} {} +test util-9.8 {TclGetIntForIndex} { + string index abcd end--1 +} {} +test util-9.9.0 {TclGetIntForIndex} { + string index abcd 0+0 +} a +test util-9.9.1 {TclGetIntForIndex} { + string index abcd { 0+0 } +} a +test util-9.10 {TclGetIntForIndex} { + string index abcd 0-0 +} a +test util-9.11 {TclGetIntForIndex} { + string index abcd 1+0 +} b +test util-9.12 {TclGetIntForIndex} { + string index abcd 1-0 +} b +test util-9.13 {TclGetIntForIndex} { + string index abcd 1+1 +} c +test util-9.14 {TclGetIntForIndex} { + string index abcd 1-1 +} a +test util-9.15 {TclGetIntForIndex} { + string index abcd -1+2 +} b +test util-9.16 {TclGetIntForIndex} { + string index abcd -1--2 +} b +test util-9.17 {TclGetIntForIndex} { + string index abcd { -1+2 } +} b +test util-9.18 {TclGetIntForIndex} { + string index abcd { -1--2 } +} b +test util-9.19 {TclGetIntForIndex} -body { + string index a {} +} -returnCodes error -match glob -result * +test util-9.20 {TclGetIntForIndex} -body { + string index a { } +} -returnCodes error -match glob -result * +test util-9.21 {TclGetIntForIndex} -body { + string index a " \r\t\n" +} -returnCodes error -match glob -result * +test util-9.22 {TclGetIntForIndex} -body { + string index a + +} -returnCodes error -match glob -result * +test util-9.23 {TclGetIntForIndex} -body { + string index a - +} -returnCodes error -match glob -result * +test util-9.24 {TclGetIntForIndex} -body { + string index a x +} -returnCodes error -match glob -result * +test util-9.25 {TclGetIntForIndex} -body { + string index a +x +} -returnCodes error -match glob -result * +test util-9.26 {TclGetIntForIndex} -body { + string index a -x +} -returnCodes error -match glob -result * +test util-9.27 {TclGetIntForIndex} -body { + string index a 0y +} -returnCodes error -match glob -result * +test util-9.28 {TclGetIntForIndex} -body { + string index a 1* +} -returnCodes error -match glob -result * +test util-9.29 {TclGetIntForIndex} -body { + string index a 0+ +} -returnCodes error -match glob -result * +test util-9.30 {TclGetIntForIndex} -body { + string index a {0+ } +} -returnCodes error -match glob -result * +test util-9.31 {TclGetIntForIndex} -body { + string index a 0x +} -returnCodes error -match glob -result * +test util-9.32 {TclGetIntForIndex} -body { + string index a 0x1FFFFFFFF+0 +} -returnCodes error -match glob -result * +test util-9.33 {TclGetIntForIndex} -body { + string index a 100000000000+0 +} -returnCodes error -match glob -result * +test util-9.34 {TclGetIntForIndex} -body { + string index a 1.0 +} -returnCodes error -match glob -result * +test util-9.35 {TclGetIntForIndex} -body { + string index a 1e23 +} -returnCodes error -match glob -result * +test util-9.36 {TclGetIntForIndex} -body { + string index a 1.5e2 +} -returnCodes error -match glob -result * +test util-9.37 {TclGetIntForIndex} -body { + string index a 0+x +} -returnCodes error -match glob -result * +test util-9.38 {TclGetIntForIndex} -body { + string index a 0+0x +} -returnCodes error -match glob -result * +test util-9.39 {TclGetIntForIndex} -body { + string index a 0+0xg +} -returnCodes error -match glob -result * +test util-9.40 {TclGetIntForIndex} -body { + string index a 0+0xg +} -returnCodes error -match glob -result * +test util-9.41 {TclGetIntForIndex} -body { + string index a 0+1.0 +} -returnCodes error -match glob -result * +test util-9.42 {TclGetIntForIndex} -body { + string index a 0+1e2 +} -returnCodes error -match glob -result * +test util-9.43 {TclGetIntForIndex} -body { + string index a 0+1.5e1 +} -returnCodes error -match glob -result * +test util-9.44 {TclGetIntForIndex} -body { + string index a 0+1000000000000 +} -returnCodes error -match glob -result * + +test util-10.1 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x0000000000000000 } {0.0} -test util-9.2 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.2 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x8000000000000000 } {-0.0} -test util-9.3 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.3 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x7ef754e31cd072da } {4e+303} -test util-9.4 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.4 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xd08afcef51f0fb5f } {-1e+80} -test util-9.5 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.5 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x7ed754e31cd072da } {1e+303} -test util-9.6 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.6 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xfee754e31cd072da } {-2e+303} -test util-9.7 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.7 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x0afe07b27dd78b14 } {1e-255} -test util-9.8 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.8 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x93ae29e9c56687fe } {-7e-214} -test util-9.9 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.9 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x376be03d0bf225c7 } {1e-41} -test util-9.10 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.10 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xa0ca2fe76a3f9475 } {-1e-150} -test util-9.11 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.11 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x7fa9a2028368022e } {9e+306} -test util-9.12 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.12 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xdfc317e5ef3ab327 } {-2e+153} -test util-9.13 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.13 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x5fd317e5ef3ab327 } {4e+153} -test util-9.14 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.14 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xdfe317e5ef3ab327 } {-8e+153} -test util-9.15 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.15 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x00feb8e84fa0b278 } {7e-304} -test util-9.16 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.16 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x8133339131c46f8b } {-7e-303} -test util-9.17 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.17 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x35dc0f92a6276c9d } {3e-49} -test util-9.18 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.18 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xa445ce1f143d7ad2 } {-6e-134} -test util-9.19 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.19 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x2d2c0794d9d40e96 } {4.3e-91} -test util-9.20 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.20 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xad3c0794d9d40e96 } {-8.6e-91} -test util-9.21 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.21 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x30ecd5bee57763e6 } {5.1e-73} -test util-9.22 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.22 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x68ad1c26db7d0dae } {1.7e+196} -test util-9.23 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.23 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbfa3f7ced916872b } {-0.039} -test util-9.24 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.24 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x64b7d93193f78fc6 } {1.51e+177} -test util-9.25 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.25 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x98ea82a1631eeb30 } {-1.19e-188} -test util-9.26 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.26 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xd216c309024bab4b } {-2.83e+87} -test util-9.27 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.27 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x0dfdbbac6f83a821 } {2.7869147e-241} -test util-9.28 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.28 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xdadc569e968e0944 } {-4.91080654e+129} -test util-9.29 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.29 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x5acc569e968e0944 } {2.45540327e+129} -test util-9.30 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.30 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xab5fc575867314ee } {-9.078555839e-100} -test util-9.31 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.31 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xdabc569e968e0944 } {-1.227701635e+129} -test util-9.32 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.32 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x2b6fc575867314ee } {1.8157111678e-99} -test util-9.33 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.33 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xb3b8bf7e7fa6f02a } {-1.5400733123779e-59} -test util-9.34 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.34 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xcd83de005bd620df } {-2.6153245263757307e+65} -test util-9.35 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.35 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x6cdf92bacb3cb40c } {2.7210404151224248e+216} -test util-9.36 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.36 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xecef92bacb3cb40c } {-5.4420808302448496e+216} -test util-9.37 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.37 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x49342dbf25096cf5 } {4.5e+44} -test util-9.38 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.38 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xd06afcef51f0fb5f } {-2.5e+79} -test util-9.39 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.39 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x49002498ea6df0c4 } {4.5e+43} -test util-9.40 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.40 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xfeb754e31cd072da } {-2.5e+302} -test util-9.41 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.41 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x1d22deac01e2b4f7 } {2.5e-168} -test util-9.42 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.42 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xaccb1df536c13eee } {-6.5e-93} -test util-9.43 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.43 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3650711fed5b19a4 } {4.5e-47} -test util-9.44 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.44 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xb6848d67e8b1e00d } {-4.5e-46} -test util-9.45 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.45 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x4bac8c574c0c6be7 } {3.5e+56} -test util-9.46 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.46 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xccd756183c147514 } {-1.5e+62} -test util-9.47 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.47 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x4ca2ab469676c410 } {1.5e+61} -test util-9.48 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.48 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xcf5539684e774b48 } {-1.5e+74} -test util-9.49 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.49 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x2e12e5f5dfa4fe9d } {9.5e-87} -test util-9.50 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.50 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x8b9bdc2417bf7787 } {-9.5e-253} -test util-9.51 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.51 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x00eeb8e84fa0b278 } {3.5e-304} -test util-9.52 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.52 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xadde3cbc9907fdc8 } {-9.5e-88} -test util-9.53 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.53 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x2bb0ad836f269a17 } {3.05e-98} -test util-9.54 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.54 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x950b39ae1909c31b } {-2.65e-207} -test util-9.55 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.55 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x1bfb2ab18615fcc6 } {6.865e-174} -test util-9.56 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.56 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x98f3e1f90a573064 } {-1.785e-188} -test util-9.57 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.57 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x5206c309024bab4b } {1.415e+87} -test util-9.58 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.58 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xcc059bd3ad46e346 } {-1.6955e+58} -test util-9.59 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.59 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x47bdf4170f0fdecc } {3.9815e+37} -test util-9.60 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.60 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x59e7e1e0f1c7a4ac } {1.263005e+125} -test util-9.61 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.61 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xda1dda592e398dd7 } {-1.263005e+126} -test util-9.62 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.62 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xdc4e597c0b94b7ae } {-4.4118455e+136} -test util-9.63 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.63 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x5aac569e968e0944 } {6.138508175e+128} -test util-9.64 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.64 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xdabc569e968e0944 } {-1.227701635e+129} -test util-9.65 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.65 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x6ce7ae0c186d8709 } {4.081560622683637e+216} -test util-9.66 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.66 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x44b52d02c7e14af7 } {1.0000000000000001e+23} -test util-9.67 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.67 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc589d971e4fe8402 } {-1e+27} -test util-9.68 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.68 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x4599d971e4fe8402 } {2e+27} -test util-9.69 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.69 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc5a9d971e4fe8402 } {-4e+27} -test util-9.70 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.70 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3e45798ee2308c3a } {1e-8} -test util-9.71 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.71 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbe55798ee2308c3a } {-2e-8} -test util-9.72 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.72 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3e65798ee2308c3a } {4e-8} -test util-9.73 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.73 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbabef2d0f5da7dd9 } {-1e-25} -test util-9.74 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.74 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x44da784379d99db4 } {5e+23} -test util-9.75 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.75 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc4fa784379d99db4 } {-2e+24} -test util-9.76 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.76 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x4503da329b633647 } {3e+24} -test util-9.77 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.77 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc54cf389cd46047d } {-7e+25} -test util-9.78 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.78 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3fc999999999999a } {0.2} -test util-9.79 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.79 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbfd3333333333333 } {-0.3} -test util-9.80 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.80 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3cf6849b86a12b9b } {5e-15} -test util-9.81 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.81 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbd16849b86a12b9b } {-2e-14} -test util-9.82 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.82 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3b87ccfc73126788 } {6.3e-22} -test util-9.83 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.83 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbbbdc03b8fd7016a } {-6.3e-21} -test util-9.84 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.84 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3fa3f7ced916872b } {0.039} -test util-9.85 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.85 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x460b297cad9f70b6 } {2.69e+29} -test util-9.86 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.86 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc61b297cad9f70b6 } {-5.38e+29} -test util-9.87 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.87 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3adcdc06b20ef183 } {3.73e-25} -test util-9.88 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.88 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x45fb297cad9f70b6 } {1.345e+29} -test util-9.89 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.89 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc60b297cad9f70b6 } {-2.69e+29} -test util-9.90 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.90 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbc050a246ecd44f3 } {-1.4257e-19} -test util-9.91 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.91 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbec19b96f36ec68b } {-2.09901e-6} -test util-9.92 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.92 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3dcc06d366394441 } {5.0980203373e-11} -test util-9.93 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.93 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc79f58ac4db68c90 } {-1.04166211811e+37} -test util-9.94 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.94 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x4569d971e4fe8402 } {2.5e+26} -test util-9.95 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.95 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc50dc74be914d16b } {-4.5e+24} -test util-9.96 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.96 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x4534adf4b7320335 } {2.5e+25} -test util-9.97 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.97 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc54ae22487c1042b } {-6.5e+25} -test util-9.98 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.98 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3c987fe49aab41e0 } {8.5e-17} -test util-9.99 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.99 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbc2f5c05e4b23fd7 } {-8.5e-19} -test util-9.100 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.100 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3d5faa7ab552a552 } {4.5e-13} -test util-9.101 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.101 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbdbb7cdfd9d7bdbb } {-2.5e-11} -test util-9.102 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.102 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x44f3da329b633647 } {1.5e+24} -test util-9.103 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.103 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc53cf389cd46047d } {-3.5e+25} -test util-9.104 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.104 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x454f04ef12cb04cf } {7.5e+25} -test util-9.105 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.105 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc55f04ef12cb04cf } {-1.5e+26} -test util-9.106 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.106 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3fc3333333333333 } {0.15} -test util-9.107 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.107 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbdb07e1fe91b0b70 } {-1.5e-11} -test util-9.108 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.108 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3de49da7e361ce4c } {1.5e-10} -test util-9.109 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.109 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbe19c511dc3a41df } {-1.5e-9} -test util-9.110 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.110 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc5caa83d74267822 } {-1.65e+28} -test util-9.111 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.111 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x4588f1d5969453de } {9.65e+26} -test util-9.112 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.112 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3b91d9bd564dcda6 } {9.45e-22} -test util-9.113 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.113 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbcfa58973ecbede6 } {-5.85e-15} -test util-9.114 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.114 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x45eb297cad9f70b6 } {6.725e+28} -test util-9.115 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.115 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc5fb297cad9f70b6 } {-1.345e+29} -test util-9.116 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.116 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3accdc06b20ef183 } {1.865e-25} -test util-9.117 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.117 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xbd036071dcae4565 } {-8.605e-15} -test util-9.118 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.118 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x462cb968d297dde8 } {1.137885e+30} -test util-9.119 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.119 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0xc661f3e1839eeab1 } {-1.137885e+31} -test util-9.120 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.120 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x474e9cec176c96f8 } {3.179033335e+35} -test util-9.121 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.121 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x3dbc06d366394441 } {2.54901016865e-11} -test util-9.122 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { +test util-10.122 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x478f58ac4db68c90 } {5.20831059055e+36} -test util-10.1 {Tcl_PrintDouble - scaling} { +test util-11.1 {Tcl_PrintDouble - scaling} { expr 1.1e-5 } {1.1e-5} -test util-10.2 {Tcl_PrintDouble - scaling} { +test util-11.2 {Tcl_PrintDouble - scaling} { expr 1.1e-4 } {0.00011} -test util-10.3 {Tcl_PrintDouble - scaling} { +test util-11.3 {Tcl_PrintDouble - scaling} { expr 1.1e-3 } {0.0011} -test util-10.4 {Tcl_PrintDouble - scaling} { +test util-11.4 {Tcl_PrintDouble - scaling} { expr 1.1e-2 } {0.011} -test util-10.5 {Tcl_PrintDouble - scaling} { +test util-11.5 {Tcl_PrintDouble - scaling} { expr 1.1e-1 } {0.11} -test util-10.6 {Tcl_PrintDouble - scaling} { +test util-11.6 {Tcl_PrintDouble - scaling} { expr 1.1e0 } {1.1} -test util-10.7 {Tcl_PrintDouble - scaling} { +test util-11.7 {Tcl_PrintDouble - scaling} { expr 1.1e1 } {11.0} -test util-10.8 {Tcl_PrintDouble - scaling} { +test util-11.8 {Tcl_PrintDouble - scaling} { expr 1.1e2 } {110.0} -test util-10.9 {Tcl_PrintDouble - scaling} { +test util-11.9 {Tcl_PrintDouble - scaling} { expr 1.1e3 } {1100.0} -test util-10.10 {Tcl_PrintDouble - scaling} { +test util-11.10 {Tcl_PrintDouble - scaling} { expr 1.1e4 } {11000.0} -test util-10.11 {Tcl_PrintDouble - scaling} { +test util-11.11 {Tcl_PrintDouble - scaling} { expr 1.1e5 } {110000.0} -test util-10.12 {Tcl_PrintDouble - scaling} { +test util-11.12 {Tcl_PrintDouble - scaling} { expr 1.1e6 } {1100000.0} -test util-10.13 {Tcl_PrintDouble - scaling} { +test util-11.13 {Tcl_PrintDouble - scaling} { expr 1.1e7 } {11000000.0} -test util-10.14 {Tcl_PrintDouble - scaling} { +test util-11.14 {Tcl_PrintDouble - scaling} { expr 1.1e8 } {110000000.0} -test util-10.15 {Tcl_PrintDouble - scaling} { +test util-11.15 {Tcl_PrintDouble - scaling} { expr 1.1e9 } {1100000000.0} -test util-10.16 {Tcl_PrintDouble - scaling} { +test util-11.16 {Tcl_PrintDouble - scaling} { expr 1.1e10 } {11000000000.0} -test util-10.17 {Tcl_PrintDouble - scaling} { +test util-11.17 {Tcl_PrintDouble - scaling} { expr 1.1e11 } {110000000000.0} -test util-10.18 {Tcl_PrintDouble - scaling} { +test util-11.18 {Tcl_PrintDouble - scaling} { expr 1.1e12 } {1100000000000.0} -test util-10.19 {Tcl_PrintDouble - scaling} { +test util-11.19 {Tcl_PrintDouble - scaling} { expr 1.1e13 } {11000000000000.0} -test util-10.20 {Tcl_PrintDouble - scaling} { +test util-11.20 {Tcl_PrintDouble - scaling} { expr 1.1e14 } {110000000000000.0} -test util-10.21 {Tcl_PrintDouble - scaling} { +test util-11.21 {Tcl_PrintDouble - scaling} { expr 1.1e15 } {1100000000000000.0} -test util-10.22 {Tcl_PrintDouble - scaling} { +test util-11.22 {Tcl_PrintDouble - scaling} { expr 1.1e16 } {11000000000000000.0} -test util-10.21 {Tcl_PrintDouble - scaling} { +test util-11.21 {Tcl_PrintDouble - scaling} { expr 1.1e17 } {1.1e+17} diff --git a/unix/Makefile.in b/unix/Makefile.in index a9cf213..e86b0de 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -5,7 +5,7 @@ # "autoconf" program (constructs like "@foo@" will get replaced in the # actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.157.2.8 2005/03/09 15:57:20 kennykb Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.157.2.9 2005/05/05 17:56:39 kennykb Exp $ VERSION = @TCL_VERSION@ MAJOR_VERSION = @TCL_MAJOR_VERSION@ @@ -488,7 +488,6 @@ UNIX_SRCS = \ $(UNIX_DIR)/tclUnixEvent.c \ $(UNIX_DIR)/tclUnixFCmd.c \ $(UNIX_DIR)/tclUnixFile.c \ - $(UNIX_DIR)/tclUnixNotfy.c \ $(UNIX_DIR)/tclUnixPipe.c \ $(UNIX_DIR)/tclUnixSock.c \ $(UNIX_DIR)/tclUnixTest.c \ @@ -496,6 +495,9 @@ UNIX_SRCS = \ $(UNIX_DIR)/tclUnixTime.c \ $(UNIX_DIR)/tclUnixInit.c +NOTIFY_SRCS = \ + $(UNIX_DIR)/tclUnixNotfy.c + DL_SRCS = \ $(UNIX_DIR)/tclLoadAix.c \ $(UNIX_DIR)/tclLoadAout.c \ @@ -515,7 +517,9 @@ MAC_OSX_SRCS = \ # files won't compile on the current machine, and they will cause # problems for things like "make depend". -SRCS = $(GENERIC_SRCS) $(TOMMATH_SRCS) $(UNIX_SRCS) $(STUB_SRCS) +SRCS = $(GENERIC_SRCS) $(TOMMATH_SRCS) \ + $(UNIX_SRCS) $(NOTIFY_SRCS) $(STUB_SRCS) \ + @PLAT_SRCS@ all: binaries libraries doc @@ -1348,7 +1352,7 @@ tclUnixInit.o: $(UNIX_DIR)/tclUnixInit.c tclConfig.sh -DTCL_PACKAGE_PATH="\"${TCL_PACKAGE_PATH}\"" \ $(UNIX_DIR)/tclUnixInit.c -# This is the CFBundle interface. It is only used on Mac OS X. +# The following are Mac OS X only sources: tclMacOSXBundle.o: $(MAC_OSX_DIR)/tclMacOSXBundle.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tclMacOSXBundle.c diff --git a/unix/configure b/unix/configure index 0851cb9..1ccbc15 100755 --- a/unix/configure +++ b/unix/configure @@ -308,7 +308,7 @@ ac_includes_default="\ # include <unistd.h> #endif" -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 MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS RANLIB ac_ct_RANLIB AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB INSTALL_STUB_LIB 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_SRC_DIR CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX TCL_SHARED_BUILD LD_LIBRARY_PATH_VAR TCL_BUILD_LIB_SPEC TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_SHARED_LIB_SUFFIX TCL_UNSHARED_LIB_SUFFIX TCL_HAS_LONGLONG BUILD_DLTEST TCL_PACKAGE_PATH' +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 MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS RANLIB ac_ct_RANLIB AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB INSTALL_STUB_LIB 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_SRC_DIR CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX TCL_SHARED_BUILD LD_LIBRARY_PATH_VAR TCL_BUILD_LIB_SPEC TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_SHARED_LIB_SUFFIX TCL_UNSHARED_LIB_SUFFIX TCL_HAS_LONGLONG BUILD_DLTEST TCL_PACKAGE_PATH' ac_subst_files='' # Initialize some variables set by options. @@ -2351,7 +2351,6 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu # Do this early, otherwise an autoconf bug throws errors on configure #-------------------------------------------------------------------- - ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' @@ -2843,7 +2842,11 @@ done echo "$as_me:$LINENO: checking dirent.h" >&5 echo $ECHO_N "checking dirent.h... $ECHO_C" >&6 - cat >conftest.$ac_ext <<_ACEOF + if test "${tcl_cv_dirent_h+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 @@ -2899,17 +2902,19 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then - tcl_ok=yes + tcl_cv_dirent_h=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -tcl_ok=no +tcl_cv_dirent_h=no fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext +fi - if test $tcl_ok = no; then + + if test $tcl_cv_dirent_h = no; then cat >>confdefs.h <<\_ACEOF #define NO_DIRENT_H 1 @@ -6546,6 +6551,7 @@ echo "$as_me: error: Required archive tool 'ar' not found on PATH." >&2;} STLIB_LD='${AR} cr' LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH" PLAT_OBJS="" + PLAT_SRCS="" case $system in AIX-*) if test "${TCL_THREADS}" = "1" -a "$GCC" != "yes" ; then @@ -7774,20 +7780,144 @@ rm -f conftest* esac ;; Darwin-*) + CFLAGS_OPTIMIZE="-Os" SHLIB_CFLAGS="-fno-common" SHLIB_LD="cc -dynamiclib \${LDFLAGS}" - TCL_SHLIB_LD_EXTRAS="-compatibility_version ${TCL_VERSION} -current_version \${VERSION} -install_name \${DYLIB_INSTALL_DIR}/\${TCL_LIB_FILE} -prebind -seg1addr 0xa000000 -Wl,-single_module" - TK_SHLIB_LD_EXTRAS="-compatibility_version ${TK_VERSION} -current_version \${VERSION} -install_name \${DYLIB_INSTALL_DIR}/\${TK_LIB_FILE} -prebind -seg1addr 0xb000000 -Wl,-single_module" + echo "$as_me:$LINENO: checking if ld accepts -single_module flag" >&5 +echo $ECHO_N "checking if ld accepts -single_module flag... $ECHO_C" >&6 +if test "${tcl_cv_ld_single_module+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + + hold_ldflags=$LDFLAGS + LDFLAGS="$LDFLAGS -dynamiclib -Wl,-single_module" + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ +int i; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 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_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 + tcl_cv_ld_single_module=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_ld_single_module=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$hold_ldflags +fi +echo "$as_me:$LINENO: result: $tcl_cv_ld_single_module" >&5 +echo "${ECHO_T}$tcl_cv_ld_single_module" >&6 + if test $tcl_cv_ld_single_module = yes; then + SHLIB_LD="${SHLIB_LD} -Wl,-single_module" + fi SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".dylib" DL_OBJS="tclLoadDyld.o" - PLAT_OBJS=\$\(MAC\_OSX_OBJS\) DL_LIBS="" - LDFLAGS="$LDFLAGS -prebind -Wl,-search_paths_first" + LDFLAGS="$LDFLAGS -prebind" + echo "$as_me:$LINENO: checking if ld accepts -search_paths_first flag" >&5 +echo $ECHO_N "checking if ld accepts -search_paths_first flag... $ECHO_C" >&6 +if test "${tcl_cv_ld_search_paths_first+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + + hold_ldflags=$LDFLAGS + LDFLAGS="$LDFLAGS -Wl,-search_paths_first" + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ +int i; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 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_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 + tcl_cv_ld_search_paths_first=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_ld_search_paths_first=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$hold_ldflags +fi +echo "$as_me:$LINENO: result: $tcl_cv_ld_search_paths_first" >&5 +echo "${ECHO_T}$tcl_cv_ld_search_paths_first" >&6 + if test $tcl_cv_ld_search_paths_first = yes; then + LDFLAGS="$LDFLAGS -Wl,-search_paths_first" + fi CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" - CFLAGS_OPTIMIZE="-Os" LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH" + PLAT_OBJS="\${MAC_OSX_OBJS}" + PLAT_SRCS="\${MAC_OSX_SRCS}" + TCL_SHLIB_LD_EXTRAS='-compatibility_version ${VERSION} -current_version ${VERSION} -install_name ${DYLIB_INSTALL_DIR}/${TCL_LIB_FILE} -seg1addr 0xa000000' + TK_SHLIB_LD_EXTRAS=' -compatibility_version ${VERSION} -current_version ${VERSION} -install_name ${DYLIB_INSTALL_DIR}/${TK_LIB_FILE} -seg1addr 0xb000000 -unexported_symbols_list $$(f=$(TCL_STUB_LIB_FILE).E && nm -gjp $(TCL_BIN_DIR)/$(TCL_STUB_LIB_FILE) | tail +3 > $$f && echo $$f)' + LIBS="$LIBS -framework CoreFoundation" cat >>confdefs.h <<\_ACEOF #define MAC_OSX_TCL 1 @@ -7808,7 +7938,11 @@ cat >>confdefs.h <<\_ACEOF #define TCL_DEFAULT_ENCODING "utf-8" _ACEOF - LIBS="$LIBS -framework CoreFoundation" + +cat >>confdefs.h <<\_ACEOF +#define MODULE_SCOPE __private_extern__ +_ACEOF + ;; NEXTSTEP-*) SHLIB_CFLAGS="" @@ -8518,6 +8652,7 @@ fi; + cat >>confdefs.h <<_ACEOF #define TCL_SHLIB_EXT "${SHLIB_SUFFIX}" _ACEOF @@ -15557,6 +15692,7 @@ s,@TCL_LIBS@,$TCL_LIBS,;t t s,@DL_LIBS@,$DL_LIBS,;t t s,@DL_OBJS@,$DL_OBJS,;t t s,@PLAT_OBJS@,$PLAT_OBJS,;t t +s,@PLAT_SRCS@,$PLAT_SRCS,;t t s,@CFLAGS_DEBUG@,$CFLAGS_DEBUG,;t t s,@CFLAGS_OPTIMIZE@,$CFLAGS_OPTIMIZE,;t t s,@CFLAGS_WARNING@,$CFLAGS_WARNING,;t t diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 2ed36b1..778beee 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -908,6 +908,7 @@ dnl AC_CHECK_TOOL(AR, ar) STLIB_LD='${AR} cr' LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH" PLAT_OBJS="" + PLAT_SRCS="" case $system in AIX-*) if test "${TCL_THREADS}" = "1" -a "$GCC" != "yes" ; then @@ -1378,26 +1379,44 @@ dnl AC_CHECK_TOOL(AR, ar) esac ;; Darwin-*) + CFLAGS_OPTIMIZE="-Os" SHLIB_CFLAGS="-fno-common" SHLIB_LD="cc -dynamiclib \${LDFLAGS}" - TCL_SHLIB_LD_EXTRAS="-compatibility_version ${TCL_VERSION} -current_version \${VERSION} -install_name \${DYLIB_INSTALL_DIR}/\${TCL_LIB_FILE} -prebind -seg1addr 0xa000000 -Wl,-single_module" - TK_SHLIB_LD_EXTRAS="-compatibility_version ${TK_VERSION} -current_version \${VERSION} -install_name \${DYLIB_INSTALL_DIR}/\${TK_LIB_FILE} -prebind -seg1addr 0xb000000 -Wl,-single_module" + AC_CACHE_CHECK([if ld accepts -single_module flag], tcl_cv_ld_single_module, [ + hold_ldflags=$LDFLAGS + LDFLAGS="$LDFLAGS -dynamiclib -Wl,-single_module" + AC_TRY_LINK(, [int i;], tcl_cv_ld_single_module=yes, tcl_cv_ld_single_module=no) + LDFLAGS=$hold_ldflags]) + if test $tcl_cv_ld_single_module = yes; then + SHLIB_LD="${SHLIB_LD} -Wl,-single_module" + fi SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".dylib" DL_OBJS="tclLoadDyld.o" - PLAT_OBJS=\$\(MAC\_OSX_OBJS\) DL_LIBS="" - LDFLAGS="$LDFLAGS -prebind -Wl,-search_paths_first" + LDFLAGS="$LDFLAGS -prebind" + AC_CACHE_CHECK([if ld accepts -search_paths_first flag], tcl_cv_ld_search_paths_first, [ + hold_ldflags=$LDFLAGS + LDFLAGS="$LDFLAGS -Wl,-search_paths_first" + AC_TRY_LINK(, [int i;], tcl_cv_ld_search_paths_first=yes, tcl_cv_ld_search_paths_first=no) + LDFLAGS=$hold_ldflags]) + if test $tcl_cv_ld_search_paths_first = yes; then + LDFLAGS="$LDFLAGS -Wl,-search_paths_first" + fi CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" - CFLAGS_OPTIMIZE="-Os" LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH" + PLAT_OBJS="\${MAC_OSX_OBJS}" + PLAT_SRCS="\${MAC_OSX_SRCS}" + TCL_SHLIB_LD_EXTRAS='-compatibility_version ${VERSION} -current_version ${VERSION} -install_name ${DYLIB_INSTALL_DIR}/${TCL_LIB_FILE} -seg1addr 0xa000000' + TK_SHLIB_LD_EXTRAS=' -compatibility_version ${VERSION} -current_version ${VERSION} -install_name ${DYLIB_INSTALL_DIR}/${TK_LIB_FILE} -seg1addr 0xb000000 -unexported_symbols_list $$(f=$(TCL_STUB_LIB_FILE).E && nm -gjp $(TCL_BIN_DIR)/$(TCL_STUB_LIB_FILE) | tail +3 > $$f && echo $$f)' + LIBS="$LIBS -framework CoreFoundation" AC_DEFINE(MAC_OSX_TCL, 1, ["Is this a Mac I see before me?"]) AC_DEFINE(HAVE_CFBUNDLE, 1, [Do we have access to Mac bundles?]) AC_DEFINE(USE_VFORK, 1, [Should we use vfork() instead of fork()?]) AC_DEFINE(TCL_DEFAULT_ENCODING,"utf-8", [Are we to override what our default encoding is?]) - LIBS="$LIBS -framework CoreFoundation" + AC_DEFINE(MODULE_SCOPE, __private_extern__, [Linker support for module scope symbols]) ;; NEXTSTEP-*) SHLIB_CFLAGS="" @@ -1879,6 +1898,7 @@ dnl esac AC_SUBST(DL_OBJS) AC_SUBST(PLAT_OBJS) + AC_SUBST(PLAT_SRCS) AC_SUBST(CFLAGS) AC_SUBST(CFLAGS_DEBUG) AC_SUBST(CFLAGS_OPTIMIZE) @@ -2059,6 +2079,7 @@ int main() { AC_DEFUN(SC_MISSING_POSIX_HEADERS, [ AC_MSG_CHECKING(dirent.h) + AC_CACHE_VAL(tcl_cv_dirent_h, AC_TRY_LINK([#include <sys/types.h> #include <dirent.h>], [ #ifndef _POSIX_SOURCE @@ -2078,9 +2099,9 @@ d = opendir("foobar"); entryPtr = readdir(d); p = entryPtr->d_name; closedir(d); -], tcl_ok=yes, tcl_ok=no) +], tcl_cv_dirent_h=yes, tcl_cv_dirent_h=no)) - if test $tcl_ok = no; then + if test $tcl_cv_dirent_h = no; then AC_DEFINE(NO_DIRENT_H, 1, [Do we have <dirent.h>?]) fi diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index 170be72..4fc9c8f 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.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: tclUnixChan.c,v 1.53.2.1 2005/02/02 15:54:01 kennykb Exp $ + * RCS: @(#) $Id: tclUnixChan.c,v 1.53.2.2 2005/05/05 17:56:57 kennykb Exp $ */ #include "tclInt.h" /* Internal definitions for Tcl. */ @@ -3033,9 +3033,9 @@ TclpGetDefaultStdChannel(type) */ int -Tcl_GetOpenFile(interp, string, forWriting, checkUsage, filePtr) +Tcl_GetOpenFile(interp, chanID, forWriting, checkUsage, filePtr) Tcl_Interp *interp; /* Interpreter in which to find file. */ - CONST char *string; /* String that identifies file. */ + CONST char *chanID; /* String that identifies file. */ int forWriting; /* 1 means the file is going to be used * for writing, 0 means for reading. */ int checkUsage; /* 1 means verify that the file was opened @@ -3052,17 +3052,17 @@ Tcl_GetOpenFile(interp, string, forWriting, checkUsage, filePtr) int fd; FILE *f; - chan = Tcl_GetChannel(interp, string, &chanMode); + chan = Tcl_GetChannel(interp, chanID, &chanMode); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } if ((forWriting) && ((chanMode & TCL_WRITABLE) == 0)) { Tcl_AppendResult(interp, - "\"", string, "\" wasn't opened for writing", (char *) NULL); + "\"", chanID, "\" wasn't opened for writing", (char *) NULL); return TCL_ERROR; } else if ((!(forWriting)) && ((chanMode & TCL_READABLE) == 0)) { Tcl_AppendResult(interp, - "\"", string, "\" wasn't opened for reading", (char *) NULL); + "\"", chanID, "\" wasn't opened for reading", (char *) NULL); return TCL_ERROR; } @@ -3092,7 +3092,7 @@ Tcl_GetOpenFile(interp, string, forWriting, checkUsage, filePtr) f = fdopen(fd, (forWriting ? "w" : "r")); if (f == NULL) { - Tcl_AppendResult(interp, "cannot get a FILE * for \"", string, + Tcl_AppendResult(interp, "cannot get a FILE * for \"", chanID, "\"", (char *) NULL); return TCL_ERROR; } @@ -3101,7 +3101,7 @@ Tcl_GetOpenFile(interp, string, forWriting, checkUsage, filePtr) } } - Tcl_AppendResult(interp, "\"", string, + Tcl_AppendResult(interp, "\"", chanID, "\" cannot be used to get a FILE *", (char *) NULL); return TCL_ERROR; } diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c index 0c76d2a..943118e 100644 --- a/unix/tclUnixNotfy.c +++ b/unix/tclUnixNotfy.c @@ -2,16 +2,16 @@ * tclUnixNotify.c -- * * This file contains the implementation of the select-based - * Unix-specific notifier, which is the lowest-level part of the - * Tcl event loop. This file works together with - * ../generic/tclNotify.c. + * Unix-specific notifier, which is the lowest-level part + * of the Tcl event loop. This file works together with + * generic/tclNotify.c. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixNotfy.c,v 1.18.2.2 2005/02/02 15:54:01 kennykb Exp $ + * RCS: @(#) $Id: tclUnixNotfy.c,v 1.18.2.3 2005/05/05 17:56:59 kennykb Exp $ */ #include "tclInt.h" @@ -74,7 +74,7 @@ typedef struct SelectMasks { typedef struct ThreadSpecificData { FileHandler *firstFileHandlerPtr; /* Pointer to head of file handler list. */ - + SelectMasks checkMasks; /* This structure is used to build up the masks * to be used in the next call to select. * Bits are set in response to calls to @@ -91,18 +91,18 @@ typedef struct ThreadSpecificData { * handshake between each thread and the * notifier thread. Bits defined below. */ struct ThreadSpecificData *nextPtr, *prevPtr; - /* All threads that are currently waiting on - * an event have their ThreadSpecificData - * structure on a doubly-linked listed formed - * from these pointers. You must hold the - * notifierMutex lock before accessing these - * fields. */ - Tcl_Condition waitCV; /* Any other thread alerts a notifier + /* All threads that are currently waiting on + * an event have their ThreadSpecificData + * structure on a doubly-linked listed formed + * from these pointers. You must hold the + * notifierMutex lock before accessing these + * fields. */ + Tcl_Condition waitCV; /* Any other thread alerts a notifier * that an event is ready to be processed * by signaling this condition variable. */ - int eventReady; /* True if an event is ready to be processed. - * Used as condition flag together with - * waitCV above. */ + int eventReady; /* True if an event is ready to be processed. + * Used as condition flag together with + * waitCV above. */ #endif } ThreadSpecificData; @@ -183,10 +183,9 @@ static Tcl_ThreadId notifierThread; */ #ifdef TCL_THREADS -static void NotifierThreadProc _ANSI_ARGS_((ClientData clientData)); +static void NotifierThreadProc(ClientData clientData); #endif -static int FileHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr, - int flags)); +static int FileHandlerEventProc(Tcl_Event *evPtr, int flags); /* *---------------------------------------------------------------------- @@ -219,7 +218,7 @@ Tcl_InitNotifier() Tcl_MutexLock(¬ifierMutex); if (notifierCount == 0) { if (TclpThreadCreate(¬ifierThread, NotifierThreadProc, NULL, - TCL_THREAD_STACK_DEFAULT, TCL_THREAD_NOFLAGS) != TCL_OK) { + TCL_THREAD_STACK_DEFAULT, TCL_THREAD_NOFLAGS) != TCL_OK) { Tcl_Panic("Tcl_InitNotifier: unable to start notifier thread"); } } @@ -276,7 +275,7 @@ Tcl_FinalizeNotifier(clientData) Tcl_Panic("Tcl_FinalizeNotifier: notifier pipe not initialized"); } - /* + /* * Send "q" message to the notifier thread so that it will * terminate. The notifier will return from its call to select() * and notice that a "q" message has arrived, it will then close @@ -428,7 +427,7 @@ Tcl_CreateFileHandler(fd, mask, proc, clientData) } for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL; - filePtr = filePtr->nextPtr) { + filePtr = filePtr->nextPtr) { if (filePtr->fd == fd) { break; } @@ -448,20 +447,20 @@ Tcl_CreateFileHandler(fd, mask, proc, clientData) * Update the check masks for this file. */ - if ( mask & TCL_READABLE ) { - FD_SET( fd, &(tsdPtr->checkMasks.readable) ); + if (mask & TCL_READABLE) { + FD_SET(fd, &(tsdPtr->checkMasks.readable)); } else { - FD_CLR( fd, &(tsdPtr->checkMasks.readable) ); + FD_CLR(fd, &(tsdPtr->checkMasks.readable)); } - if ( mask & TCL_WRITABLE ) { - FD_SET( fd, &(tsdPtr->checkMasks.writable) ); + if (mask & TCL_WRITABLE) { + FD_SET(fd, &(tsdPtr->checkMasks.writable)); } else { - FD_CLR( fd, &(tsdPtr->checkMasks.writable) ); + FD_CLR(fd, &(tsdPtr->checkMasks.writable)); } - if ( mask & TCL_EXCEPTION ) { - FD_SET( fd, &(tsdPtr->checkMasks.exceptional) ); + if (mask & TCL_EXCEPTION) { + FD_SET(fd, &(tsdPtr->checkMasks.exceptional)); } else { - FD_CLR( fd, &(tsdPtr->checkMasks.exceptional) ); + FD_CLR(fd, &(tsdPtr->checkMasks.exceptional)); } if (tsdPtr->numFdBits <= fd) { tsdPtr->numFdBits = fd+1; @@ -517,13 +516,13 @@ Tcl_DeleteFileHandler(fd) */ if (filePtr->mask & TCL_READABLE) { - FD_CLR( fd, &(tsdPtr->checkMasks.readable) ); + FD_CLR(fd, &(tsdPtr->checkMasks.readable)); } if (filePtr->mask & TCL_WRITABLE) { - FD_CLR( fd, &(tsdPtr->checkMasks.writable) ); + FD_CLR(fd, &(tsdPtr->checkMasks.writable)); } if (filePtr->mask & TCL_EXCEPTION) { - FD_CLR( fd, &(tsdPtr->checkMasks.exceptional) ); + FD_CLR(fd, &(tsdPtr->checkMasks.exceptional)); } /* @@ -533,9 +532,9 @@ Tcl_DeleteFileHandler(fd) if (fd+1 == tsdPtr->numFdBits) { tsdPtr->numFdBits = 0; for (i = fd-1; i >= 0; i--) { - if ( FD_ISSET( i, &(tsdPtr->checkMasks.readable) ) - || FD_ISSET( i, &(tsdPtr->checkMasks.writable) ) - || FD_ISSET( i, &(tsdPtr->checkMasks.exceptional ) ) ) { + if (FD_ISSET(i, &(tsdPtr->checkMasks.readable)) + || FD_ISSET(i, &(tsdPtr->checkMasks.writable)) + || FD_ISSET(i, &(tsdPtr->checkMasks.exceptional))) { tsdPtr->numFdBits = i+1; break; } @@ -600,7 +599,7 @@ FileHandlerEventProc(evPtr, flags) tsdPtr = TCL_TSD_INIT(&dataKey); for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL; - filePtr = filePtr->nextPtr) { + filePtr = filePtr->nextPtr) { if (filePtr->fd != fileEvPtr->fd) { continue; } @@ -677,15 +676,17 @@ Tcl_WaitForEvent(timePtr) * forever. */ - if (timePtr) { + if (timePtr != NULL) { /* TIP #233 (Virtualized Time). Is virtual time in effect ? * And do we actually have something to scale ? If yes to both * then we call the handler to do this scaling */ - myTime.sec = timePtr->sec; + myTime.sec = timePtr->sec; myTime.usec = timePtr->usec; - (*tclScaleTimeProcPtr) (&myTime, tclTimeClientData); + if (myTime.sec != 0 || myTime.usec != 0) { + (*tclScaleTimeProcPtr) (&myTime, tclTimeClientData); + } #ifdef TCL_THREADS myTimePtr = &myTime; @@ -709,7 +710,7 @@ Tcl_WaitForEvent(timePtr) #endif } else { #ifdef TCL_THREADS - myTimePtr = NULL; + myTimePtr = NULL; #else timeoutPtr = NULL; #endif @@ -741,27 +742,26 @@ Tcl_WaitForEvent(timePtr) } if (waitForFiles) { - /* - * Add the ThreadSpecificData structure of this thread to the list - * of ThreadSpecificData structures of all threads that are waiting - * on file events. - */ - - - tsdPtr->nextPtr = waitingListPtr; - if (waitingListPtr) { - waitingListPtr->prevPtr = tsdPtr; - } - tsdPtr->prevPtr = 0; - waitingListPtr = tsdPtr; + /* + * Add the ThreadSpecificData structure of this thread to the list + * of ThreadSpecificData structures of all threads that are waiting + * on file events. + */ + + tsdPtr->nextPtr = waitingListPtr; + if (waitingListPtr) { + waitingListPtr->prevPtr = tsdPtr; + } + tsdPtr->prevPtr = 0; + waitingListPtr = tsdPtr; tsdPtr->onList = 1; - + write(triggerPipe, "", 1); } - FD_ZERO( &(tsdPtr->readyMasks.readable) ); - FD_ZERO( &(tsdPtr->readyMasks.writable) ); - FD_ZERO( &(tsdPtr->readyMasks.exceptional) ); + FD_ZERO(&(tsdPtr->readyMasks.readable)); + FD_ZERO(&(tsdPtr->readyMasks.writable)); + FD_ZERO(&(tsdPtr->readyMasks.exceptional)); if (!tsdPtr->eventReady) { Tcl_ConditionWait(&tsdPtr->waitCV, ¬ifierMutex, myTimePtr); @@ -776,15 +776,15 @@ Tcl_WaitForEvent(timePtr) * which the notifier thread was still doing a select on. */ - if (tsdPtr->prevPtr) { - tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr; - } else { - waitingListPtr = tsdPtr->nextPtr; - } - if (tsdPtr->nextPtr) { - tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr; - } - tsdPtr->nextPtr = tsdPtr->prevPtr = NULL; + if (tsdPtr->prevPtr) { + tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr; + } else { + waitingListPtr = tsdPtr->nextPtr; + } + if (tsdPtr->nextPtr) { + tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr; + } + tsdPtr->nextPtr = tsdPtr->prevPtr = NULL; tsdPtr->onList = 0; write(triggerPipe, "", 1); } @@ -815,16 +815,16 @@ Tcl_WaitForEvent(timePtr) */ for (filePtr = tsdPtr->firstFileHandlerPtr; (filePtr != NULL); - filePtr = filePtr->nextPtr) { + filePtr = filePtr->nextPtr) { mask = 0; - if ( FD_ISSET( filePtr->fd, &(tsdPtr->readyMasks.readable) ) ) { + if (FD_ISSET(filePtr->fd, &(tsdPtr->readyMasks.readable))) { mask |= TCL_READABLE; } - if ( FD_ISSET( filePtr->fd, &(tsdPtr->readyMasks.writable) ) ) { + if (FD_ISSET(filePtr->fd, &(tsdPtr->readyMasks.writable))) { mask |= TCL_WRITABLE; } - if ( FD_ISSET( filePtr->fd, &(tsdPtr->readyMasks.exceptional) ) ) { + if (FD_ISSET(filePtr->fd, &(tsdPtr->readyMasks.exceptional))) { mask |= TCL_EXCEPTION; } @@ -838,8 +838,7 @@ Tcl_WaitForEvent(timePtr) */ if (filePtr->readyMask == 0) { - fileEvPtr = (FileHandlerEvent *) ckalloc( - sizeof(FileHandlerEvent)); + fileEvPtr = (FileHandlerEvent *) ckalloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); @@ -937,10 +936,9 @@ NotifierThreadProc(clientData) */ while (1) { - - FD_ZERO( &readableMask ); - FD_ZERO( &writableMask ); - FD_ZERO( &exceptionalMask ); + FD_ZERO(&readableMask); + FD_ZERO(&writableMask); + FD_ZERO(&exceptionalMask); /* * Compute the logical OR of the select masks from all the @@ -949,19 +947,19 @@ NotifierThreadProc(clientData) Tcl_MutexLock(¬ifierMutex); timePtr = NULL; - for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) { - for ( i = tsdPtr->numFdBits-1; i >= 0; --i ) { - if ( FD_ISSET( i, &(tsdPtr->checkMasks.readable) ) ) { - FD_SET( i, &readableMask ); + for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) { + for (i = tsdPtr->numFdBits-1; i >= 0; --i) { + if (FD_ISSET(i, &(tsdPtr->checkMasks.readable))) { + FD_SET(i, &readableMask); } - if ( FD_ISSET( i, &(tsdPtr->checkMasks.writable) ) ) { - FD_SET( i, &writableMask ); + if (FD_ISSET(i, &(tsdPtr->checkMasks.writable))) { + FD_SET(i, &writableMask); } - if ( FD_ISSET( i, &(tsdPtr->checkMasks.exceptional) ) ) { - FD_SET( i, &exceptionalMask ); + if (FD_ISSET(i, &(tsdPtr->checkMasks.exceptional))) { + FD_SET(i, &exceptionalMask); } } - if ( tsdPtr->numFdBits > numFdBits ) { + if (tsdPtr->numFdBits > numFdBits) { numFdBits = tsdPtr->numFdBits; } if (tsdPtr->pollState & POLL_WANT) { @@ -980,48 +978,48 @@ NotifierThreadProc(clientData) * Set up the select mask to include the receive pipe. */ - if ( receivePipe >= numFdBits ) { + if (receivePipe >= numFdBits) { numFdBits = receivePipe + 1; } - FD_SET( receivePipe, &readableMask ); + FD_SET(receivePipe, &readableMask); - if ( select( numFdBits, &readableMask, &writableMask, - &exceptionalMask, timePtr) == -1 ) { + if (select(numFdBits, &readableMask, &writableMask, &exceptionalMask, + timePtr) == -1) { /* * Try again immediately on an error. */ continue; - } + } /* * Alert any threads that are waiting on a ready file descriptor. */ Tcl_MutexLock(¬ifierMutex); - for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) { + for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) { found = 0; - for ( i = tsdPtr->numFdBits-1; i >= 0; --i ) { - if ( FD_ISSET( i, &(tsdPtr->checkMasks.readable) ) - && FD_ISSET( i, &readableMask ) ) { - FD_SET( i, &(tsdPtr->readyMasks.readable) ); + for (i = tsdPtr->numFdBits-1; i >= 0; --i) { + if (FD_ISSET(i, &(tsdPtr->checkMasks.readable)) + && FD_ISSET(i, &readableMask)) { + FD_SET(i, &(tsdPtr->readyMasks.readable)); found = 1; } - if ( FD_ISSET( i, &(tsdPtr->checkMasks.writable) ) - && FD_ISSET( i, &writableMask ) ) { - FD_SET( i, &(tsdPtr->readyMasks.writable) ); + if (FD_ISSET(i, &(tsdPtr->checkMasks.writable)) + && FD_ISSET(i, &writableMask)) { + FD_SET(i, &(tsdPtr->readyMasks.writable)); found = 1; } - if ( FD_ISSET( i, &(tsdPtr->checkMasks.exceptional) ) - && FD_ISSET( i, &exceptionalMask ) ) { - FD_SET( i, &(tsdPtr->readyMasks.exceptional) ); + if (FD_ISSET(i, &(tsdPtr->checkMasks.exceptional)) + && FD_ISSET(i, &exceptionalMask)) { + FD_SET(i, &(tsdPtr->readyMasks.exceptional)); found = 1; } } - - if (found || (tsdPtr->pollState & POLL_DONE)) { - tsdPtr->eventReady = 1; + + if (found || (tsdPtr->pollState & POLL_DONE)) { + tsdPtr->eventReady = 1; if (tsdPtr->onList) { /* * Remove the ThreadSpecificData structure of this @@ -1029,7 +1027,7 @@ NotifierThreadProc(clientData) * continuously spining on select until the other * threads runs and services the file event. */ - + if (tsdPtr->prevPtr) { tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr; } else { @@ -1043,17 +1041,17 @@ NotifierThreadProc(clientData) tsdPtr->pollState = 0; } Tcl_ConditionNotify(&tsdPtr->waitCV); - } - } + } + } Tcl_MutexUnlock(¬ifierMutex); - + /* * Consume the next byte from the notifier pipe if the pipe was * readable. Note that there may be multiple bytes pending, but * to avoid a race condition we only read one at a time. */ - if ( FD_ISSET( receivePipe, &readableMask ) ) { + if (FD_ISSET(receivePipe, &readableMask)) { i = read(receivePipe, buf, 1); if ((i == 0) || ((i == 1) && (buf[0] == 'q'))) { diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index 3979e4a..bbca2b1 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.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: tclWinNotify.c,v 1.16.2.1 2005/02/02 15:54:04 kennykb Exp $ + * RCS: @(#) $Id: tclWinNotify.c,v 1.16.2.2 2005/05/05 17:56:59 kennykb Exp $ */ #include "tclInt.h" @@ -452,7 +452,9 @@ Tcl_WaitForEvent( myTime.sec = timePtr->sec; myTime.usec = timePtr->usec; - (*tclScaleTimeProcPtr) (&myTime, tclTimeClientData); + if (myTime.sec != 0 || myTime.usec != 0) { + (*tclScaleTimeProcPtr) (&myTime, tclTimeClientData); + } timeout = myTime.sec * 1000 + myTime.usec / 1000; } else { diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index 01c7b5c..e99b92c 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -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: tclWinThrd.c,v 1.34.2.1 2005/04/25 21:37:30 kennykb Exp $ + * RCS: @(#) $Id: tclWinThrd.c,v 1.34.2.2 2005/05/05 17:57:00 kennykb Exp $ */ #include "tclWinInt.h" @@ -112,6 +112,19 @@ typedef struct WinCondition { struct ThreadSpecificData *lastPtr; } WinCondition; +/* + * Additions by AOL for specialized thread memory allocator. + */ +#ifdef USE_THREAD_ALLOC +static int once; +static DWORD key; + +typedef struct allocMutex { + Tcl_Mutex tlock; + CRITICAL_SECTION wlock; +} allocMutex; + +#endif /* *---------------------------------------------------------------------- @@ -1044,13 +1057,6 @@ TclpFinalizeCondition(condPtr) * Additions by AOL for specialized thread memory allocator. */ #ifdef USE_THREAD_ALLOC -static int once; -static DWORD key; - -typedef struct allocMutex { - Tcl_Mutex tlock; - CRITICAL_SECTION wlock; -} allocMutex; Tcl_Mutex * TclpNewAllocMutex(void) |