diff options
author | hobbs <hobbs@noemail.net> | 1999-11-19 06:34:22 (GMT) |
---|---|---|
committer | hobbs <hobbs@noemail.net> | 1999-11-19 06:34:22 (GMT) |
commit | c8e2fa0a0cb6a56c4230ed83d837f14321e3028a (patch) | |
tree | 24fe6a335f832b13881e6e2ab69caad9effa3445 /generic | |
parent | 3f1ba7bc8afad575630b99f9a1b38dd9c44bf530 (diff) | |
download | tcl-c8e2fa0a0cb6a56c4230ed83d837f14321e3028a.zip tcl-c8e2fa0a0cb6a56c4230ed83d837f14321e3028a.tar.gz tcl-c8e2fa0a0cb6a56c4230ed83d837f14321e3028a.tar.bz2 |
* 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]
FossilOrigin-Name: 907f606957a5b4abeaf4a1331ba2e63f73b0a4ea
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclBasic.c | 4 | ||||
-rw-r--r-- | generic/tclCkalloc.c | 6 | ||||
-rw-r--r-- | generic/tclEvent.c | 7 | ||||
-rw-r--r-- | generic/tclIOSock.c | 6 | ||||
-rw-r--r-- | generic/tclProc.c | 6 | ||||
-rw-r--r-- | generic/tclScan.c | 41 | ||||
-rw-r--r-- | 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; } |