From cda8b14a36f467923692a9571083c9203233355a Mon Sep 17 00:00:00 2001 From: hobbs Date: Fri, 19 Nov 1999 06:34:22 +0000 Subject: * generic/tclProc.c: corrected error reporting for default case at the global level for uplevel command. * generic/tclIOSock.c: changed int to size_t type for len in TclSockMinimumBuffers. * generic/tclCkalloc.c: fixed Tcl_DbCkfree to return a value on NULL input. [Bug: 3400] * generic/tclStringObj.c: fixed support for passing in negative length to Tcl_SetUnicodeObj, et al handling routines. [Bug: 3380] * doc/scan.n: * tests/scan.test: * generic/tclScan.c: finished support for inline scan by supporting XPG identifiers. * doc/http.n: * library/http2.1/http.tcl: added register and unregister commands to http:: package (better support for tls/SSL), as well as -type argument to http::geturl. [RFE: 2617] * generic/tclBasic.c: removed extra decr of numLevels in Tcl_EvalObjEx that could cause seg fault. (mjansen@wendt.de) * generic/tclEvent.c: fixed possible lack of MutexUnlock in Tcl_DeleteExitHandler [Bug: 3545] --- generic/tclBasic.c | 4 +--- generic/tclCkalloc.c | 6 +++--- generic/tclEvent.c | 7 ++++--- generic/tclIOSock.c | 6 +++--- generic/tclProc.c | 6 +++--- generic/tclScan.c | 41 ++++++++++++++++++++++++++++++++--------- generic/tclStringObj.c | 44 +++++++++++++++++++++++++++++++++++--------- 7 files changed, 81 insertions(+), 33 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 8de3a0d..20b37dc 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.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: tclBasic.c,v 1.21 1999/05/14 23:16:54 surles Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.22 1999/11/19 06:34:22 hobbs Exp $ */ #include "tclInt.h" @@ -2581,7 +2581,6 @@ Tcl_EvalObjEx(interp, objPtr, flags) iPtr->numLevels++; if (iPtr->numLevels > iPtr->maxNestingDepth) { - iPtr->numLevels--; Tcl_AppendToObj(Tcl_GetObjResult(interp), "too many nested calls to Tcl_EvalObj (infinite loop?)", -1); result = TCL_ERROR; @@ -2595,7 +2594,6 @@ Tcl_EvalObjEx(interp, objPtr, flags) if (TclpCheckStackSpace() == 0) { /*NOTREACHED*/ - iPtr->numLevels--; Tcl_AppendToObj(Tcl_GetObjResult(interp), "too many nested calls to Tcl_EvalObj (infinite loop?)", -1); result = TCL_ERROR; diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index c24d9e0..a12f0cd 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -13,7 +13,7 @@ * * This code contributed by Karl Lehenbauer and Mark Diekhans * - * RCS: @(#) $Id: tclCkalloc.c,v 1.6 1999/09/21 04:20:39 hobbs Exp $ + * RCS: @(#) $Id: tclCkalloc.c,v 1.7 1999/11/19 06:34:23 hobbs Exp $ */ #include "tclInt.h" @@ -451,7 +451,7 @@ Tcl_DbCkfree(ptr, file, line) struct mem_header *memp; if (ptr == NULL) { - return; + return 0; } /* @@ -546,7 +546,7 @@ Tcl_DbCkrealloc(ptr, size, file, line) new = Tcl_DbCkalloc(size, file, line); memcpy((VOID *) new, (VOID *) ptr, (size_t) copySize); Tcl_DbCkfree(ptr, file, line); - return(new); + return new; } diff --git a/generic/tclEvent.c b/generic/tclEvent.c index f237cd2..95f0abb 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.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: tclEvent.c,v 1.5 1999/04/23 01:57:08 stanton Exp $ + * RCS: @(#) $Id: tclEvent.c,v 1.6 1999/11/19 06:34:23 hobbs Exp $ */ #include "tclInt.h" @@ -453,11 +453,12 @@ Tcl_DeleteExitHandler(proc, clientData) } else { prevPtr->nextPtr = exitPtr->nextPtr; } - Tcl_MutexUnlock(&exitMutex); ckfree((char *) exitPtr); - return; + break; } } + Tcl_MutexUnlock(&exitMutex); + return; } /* diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index 3fb9e8d..1d6c642 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.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: tclIOSock.c,v 1.3 1999/04/16 00:46:47 stanton Exp $ + * RCS: @(#) $Id: tclIOSock.c,v 1.4 1999/11/19 06:34:23 hobbs Exp $ */ #include "tclInt.h" @@ -91,8 +91,8 @@ TclSockMinimumBuffers(sock, size) int size; /* Minimum buffer size */ { int current; - int len; - + size_t len; + len = sizeof(int); getsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)¤t, &len); if (current < size) { diff --git a/generic/tclProc.c b/generic/tclProc.c index ac07cae..901476a 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.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: tclProc.c,v 1.20 1999/09/02 16:26:33 hobbs Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.21 1999/11/19 06:34:24 hobbs Exp $ */ #include "tclInt.h" @@ -502,8 +502,8 @@ TclGetFrame(interp, string, framePtrPtr) } if (level < 0) { levelError: - Tcl_AppendResult(interp, "bad level \"", string, "\"", - (char *) NULL); + Tcl_AppendResult(interp, "bad level \"", + (result ? string : "1"), "\"", (char *) NULL); return -1; } } else if (isdigit(UCHAR(*string))) { /* INTL: digit */ diff --git a/generic/tclScan.c b/generic/tclScan.c index be4f8c4..3d7b37e 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.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: tclScan.c,v 1.4 1999/10/29 04:34:22 hobbs Exp $ + * RCS: @(#) $Id: tclScan.c,v 1.5 1999/11/19 06:34:24 hobbs Exp $ */ #include "tclInt.h" @@ -269,7 +269,7 @@ ValidateFormat(interp, format, numVars, totalSubs) Tcl_UniChar ch; int staticAssign[STATIC_LIST_SIZE]; int *nassign = staticAssign; - int objIndex, nspace = STATIC_LIST_SIZE; + int objIndex, xpgSize, nspace = STATIC_LIST_SIZE; /* * Initialize an array that records the number of times a variable @@ -285,7 +285,7 @@ ValidateFormat(interp, format, numVars, totalSubs) nassign[i] = 0; } - objIndex = gotXpg = gotSequential = 0; + xpgSize = objIndex = gotXpg = gotSequential = 0; while (*format != '\0') { format += Tcl_UtfToUniChar(format, &ch); @@ -323,8 +323,16 @@ ValidateFormat(interp, format, numVars, totalSubs) goto mixedXPG; } objIndex = value - 1; - if ((objIndex < 0) || (objIndex >= numVars)) { + if ((objIndex < 0) || (numVars && (objIndex >= numVars))) { goto badIndex; + } else if (numVars == 0) { + /* + * In the case where no vars are specified, the user can + * specify %9999$ legally, so we have to consider special + * rules for growing the assign array. 'value' is + * guaranteed to be > 0. + */ + xpgSize = (xpgSize > value) ? xpgSize : value; } goto xpgCheckDone; } @@ -425,9 +433,16 @@ ValidateFormat(interp, format, numVars, totalSubs) if (!(flags & SCAN_SUPPRESS)) { if (objIndex >= nspace) { /* - * Expand the nassign buffer + * Expand the nassign buffer. If we are using XPG specifiers, + * make sure that we grow to a large enough size. xpgSize is + * guaranteed to be at least one larger than objIndex. */ - nspace += STATIC_LIST_SIZE; + value = nspace; + if (xpgSize) { + nspace = xpgSize; + } else { + nspace += STATIC_LIST_SIZE; + } if (nassign == staticAssign) { nassign = (void *)ckalloc(nspace * sizeof(int)); for (i = 0; i < STATIC_LIST_SIZE; ++i) { @@ -437,7 +452,7 @@ ValidateFormat(interp, format, numVars, totalSubs) nassign = (void *)ckrealloc((void *)nassign, nspace * sizeof(int)); } - for (i = nspace-STATIC_LIST_SIZE; i < nspace; i++) { + for (i = value; i < nspace; i++) { nassign[i] = 0; } } @@ -451,7 +466,11 @@ ValidateFormat(interp, format, numVars, totalSubs) */ if (numVars == 0) { - numVars = objIndex; + if (xpgSize) { + numVars = xpgSize; + } else { + numVars = objIndex; + } } if (totalSubs) { *totalSubs = numVars; @@ -460,7 +479,11 @@ ValidateFormat(interp, format, numVars, totalSubs) if (nassign[i] > 1) { Tcl_SetResult(interp, "variable is assigned by multiple \"%n$\" conversion specifiers", TCL_STATIC); goto error; - } else if (nassign[i] == 0) { + } else if (!xpgSize && (nassign[i] == 0)) { + /* + * If the space is empty, and xpgSize is 0 (means XPG wasn't + * used, and/or numVars != 0), then too many vars were given + */ Tcl_SetResult(interp, "variable is not assigned by any conversion specifiers", TCL_STATIC); goto error; } diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index f9c9589..62cdef1 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -33,7 +33,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStringObj.c,v 1.14 1999/10/29 03:04:00 hobbs Exp $ */ + * RCS: @(#) $Id: tclStringObj.c,v 1.15 1999/11/19 06:34:25 hobbs Exp $ */ #include "tclInt.h" @@ -275,7 +275,15 @@ Tcl_NewUnicodeObj(unicode, numChars) { Tcl_Obj *objPtr; String *stringPtr; - int uallocated = (numChars + 1) * sizeof(Tcl_UniChar); + size_t uallocated; + + if (numChars < 0) { + numChars = 0; + if (unicode) { + while (unicode[numChars] != 0) { numChars++; } + } + } + uallocated = (numChars + 1) * sizeof(Tcl_UniChar); /* * Create a new obj with an invalid string rep. @@ -289,8 +297,7 @@ Tcl_NewUnicodeObj(unicode, numChars) stringPtr->numChars = numChars; stringPtr->uallocated = uallocated; stringPtr->allocated = 0; - memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, - (size_t) (numChars * sizeof(Tcl_UniChar))); + memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated); stringPtr->unicode[numChars] = 0; SET_STRING(objPtr, stringPtr); return objPtr; @@ -338,7 +345,7 @@ Tcl_GetCharLength(objPtr) * UTF chars are 1-byte long, we don't need to store the * unicode string. */ - + stringPtr->uallocated = 0; } else { @@ -427,7 +434,7 @@ Tcl_GetUniChar(objPtr, index) * * Tcl_GetUnicode -- * - * Get the index'th Unicode character from the String object. If + * Get the Unicode form of the String object. If * the object is not already a String object, it will be converted * to one. If the String object does not have a Unicode rep, then * one is create from the UTF string format. @@ -703,7 +710,15 @@ Tcl_SetUnicodeObj(objPtr, unicode, numChars) { Tcl_ObjType *typePtr; String *stringPtr; - size_t uallocated = (numChars + 1) * sizeof(Tcl_UniChar); + size_t uallocated; + + if (numChars < 0) { + numChars = 0; + if (unicode) { + while (unicode[numChars] != 0) { numChars++; } + } + } + uallocated = (numChars + 1) * sizeof(Tcl_UniChar); /* * Free the internal rep if one exists, and invalidate the string rep. @@ -723,8 +738,7 @@ Tcl_SetUnicodeObj(objPtr, unicode, numChars) stringPtr->numChars = numChars; stringPtr->uallocated = uallocated; stringPtr->allocated = 0; - memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, - (size_t) (numChars * sizeof(Tcl_UniChar))); + memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated); stringPtr->unicode[numChars] = 0; SET_STRING(objPtr, stringPtr); Tcl_InvalidateStringRep(objPtr); @@ -963,6 +977,12 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars) int numChars; size_t newSize; + if (appendNumChars < 0) { + appendNumChars = 0; + if (unicode) { + while (unicode[appendNumChars] != 0) { appendNumChars++; } + } + } if (appendNumChars == 0) { return; } @@ -1027,6 +1047,12 @@ AppendUnicodeToUtfRep(objPtr, unicode, numChars) Tcl_DString dsPtr; char *bytes; + if (numChars < 0) { + numChars = 0; + if (unicode) { + while (unicode[numChars] != 0) { numChars++; } + } + } if (numChars == 0) { return; } -- cgit v0.12