From 327e02ad1cc6bfefba154d135beb3cf7356e557c Mon Sep 17 00:00:00 2001 From: hobbs Date: Fri, 19 Nov 1999 23:32:02 +0000 Subject: * 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] * tests/http.test: updated http package to 2.2 * 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] * library/http2.1/http.tcl: Correctly fixed the -timeout problem mentioned in the 10-29 change. Also added error handling for failed writes on the socket during the protocol. * 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/tcl.h | 6 +++--- generic/tclBasic.c | 4 +--- generic/tclCkalloc.c | 46 ++++++++++++++++++++++++---------------------- generic/tclEvent.c | 7 ++++--- generic/tclStringObj.c | 44 +++++++++++++++++++++++++++++++++++--------- 5 files changed, 67 insertions(+), 40 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 5c2308e..8aa8320 100644 --- a/generic/tcl.h +++ b/generic/tcl.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: tcl.h,v 1.57.2.2 1999/10/30 11:05:57 hobbs Exp $ + * RCS: @(#) $Id: tcl.h,v 1.57.2.3 1999/11/19 23:32:02 hobbs Exp $ */ #ifndef _TCL @@ -56,10 +56,10 @@ extern "C" { #define TCL_MAJOR_VERSION 8 #define TCL_MINOR_VERSION 2 #define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE -#define TCL_RELEASE_SERIAL 2 +#define TCL_RELEASE_SERIAL 3 #define TCL_VERSION "8.2" -#define TCL_PATCH_LEVEL "8.2.2" +#define TCL_PATCH_LEVEL "8.2.3" /* * The following definitions set up the proper options for Windows diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 8de3a0d..ecd2224 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.21.4.1 1999/11/19 23:32:03 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 070ca37..ed79355 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.5.4.1 1999/09/22 04:12:45 hobbs Exp $ + * RCS: @(#) $Id: tclCkalloc.c,v 1.5.4.2 1999/11/19 23:32:04 hobbs Exp $ */ #include "tclInt.h" @@ -165,18 +165,18 @@ void TclDumpMemoryInfo(outFile) FILE *outFile; { - fprintf(outFile,"total mallocs %10d\n", - total_mallocs); - fprintf(outFile,"total frees %10d\n", - total_frees); - fprintf(outFile,"current packets allocated %10d\n", - current_malloc_packets); - fprintf(outFile,"current bytes allocated %10d\n", - current_bytes_malloced); - fprintf(outFile,"maximum packets allocated %10d\n", - maximum_malloc_packets); - fprintf(outFile,"maximum bytes allocated %10d\n", - maximum_bytes_malloced); + fprintf(outFile,"total mallocs %10d\n", + total_mallocs); + fprintf(outFile,"total frees %10d\n", + total_frees); + fprintf(outFile,"current packets allocated %10d\n", + current_malloc_packets); + fprintf(outFile,"current bytes allocated %10d\n", + current_bytes_malloced); + fprintf(outFile,"maximum packets allocated %10d\n", + maximum_malloc_packets); + fprintf(outFile,"maximum bytes allocated %10d\n", + maximum_bytes_malloced); } /* @@ -354,8 +354,7 @@ Tcl_DbCkalloc(size, file, line) if (result == NULL) { fflush(stdout); TclDumpMemoryInfo(stderr); - panic("unable to alloc %d bytes, %s line %d", size, file, - line); + panic("unable to alloc %d bytes, %s line %d", size, file, line); } /* @@ -452,7 +451,7 @@ Tcl_DbCkfree(ptr, file, line) struct mem_header *memp; if (ptr == NULL) { - return; + return 0; } /* @@ -465,12 +464,14 @@ Tcl_DbCkfree(ptr, file, line) memp = (struct mem_header *) (((unsigned long) ptr) - BODY_OFFSET); - if (alloc_tracing) + if (alloc_tracing) { fprintf(stderr, "ckfree %lx %ld %s %d\n", (long unsigned int) memp->body, memp->length, file, line); + } - if (validate_memory) + if (validate_memory) { Tcl_ValidateAllMemory(file, line); + } Tcl_MutexLock(ckallocMutexPtr); ValidateMemory(memp, file, line, TRUE); @@ -528,7 +529,7 @@ Tcl_DbCkrealloc(ptr, size, file, line) struct mem_header *memp; if (ptr == NULL) { - return Tcl_DbCkalloc(size, file, line); + return Tcl_DbCkalloc(size, file, line); } /* @@ -545,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; } @@ -786,6 +787,8 @@ Tcl_InitMemory(interp) #else /* TCL_MEM_DEBUG */ +/* This is the !TCL_MEM_DEBUG case */ + #undef Tcl_InitMemory #undef Tcl_DumpActiveMemory #undef Tcl_ValidateAllMemory @@ -835,8 +838,7 @@ Tcl_DbCkalloc(size, file, line) if ((result == NULL) && size) { fflush(stdout); - panic("unable to alloc %d bytes, %s line %d", size, file, - line); + panic("unable to alloc %d bytes, %s line %d", size, file, line); } return result; } diff --git a/generic/tclEvent.c b/generic/tclEvent.c index f237cd2..87b5fd3 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.5.6.1 1999/11/19 23:32:04 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/tclStringObj.c b/generic/tclStringObj.c index a5f8ffc..e743f13 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.12.4.2 1999/10/30 11:06:01 hobbs Exp $ */ + * RCS: @(#) $Id: tclStringObj.c,v 1.12.4.3 1999/11/19 23:32:05 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