From 64e68a04f46b82826e8f501c58dc45fbf940f413 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 4 Apr 2022 08:51:12 +0000 Subject: Fix TIP #613 implementation, when (indexPtr) is more than a simple variable name. Thanks, @ashok! --- generic/tclDecls.h | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 57574b8..6161bff 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4250,29 +4250,29 @@ extern const TclStubs *tclStubsPtr; #endif #if defined(USE_TCL_STUBS) #define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ - (sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)sizePtr) : tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (size_t *)sizePtr)) + (sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)sizePtr) : tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (size_t *)sizePtr)) #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ - (tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), (flags)|(int)(sizeof(*indexPtr)<<8), (indexPtr))) + (tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), (flags)|(int)(sizeof(*(indexPtr))<<8), (indexPtr))) #ifdef TCL_NO_DEPRECATED #define Tcl_GetStringFromObj(objPtr, sizePtr) \ - (sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tcl_GetStringFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tclGetStringFromObj(objPtr, (size_t *)sizePtr)) + (sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tcl_GetStringFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tclGetStringFromObj(objPtr, (size_t *)sizePtr)) #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ - (sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tclGetByteArrayFromObj(objPtr, (size_t *)sizePtr)) + (sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tclGetByteArrayFromObj(objPtr, (size_t *)sizePtr)) #define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ - (sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tclGetUnicodeFromObj(objPtr, (size_t *)sizePtr)) + (sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tclGetUnicodeFromObj(objPtr, (size_t *)sizePtr)) #endif #else #define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ - (sizeof(*sizePtr) <= sizeof(int) ? (TclGetBytesFromObj)(interp, objPtr, (int *)sizePtr) : (Tcl_GetBytesFromObj)(interp, objPtr, (size_t *)sizePtr)) + (sizeof(*(sizePtr)) <= sizeof(int) ? (TclGetBytesFromObj)(interp, objPtr, (int *)sizePtr) : (Tcl_GetBytesFromObj)(interp, objPtr, (size_t *)sizePtr)) #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ - ((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), (flags)|(int)(sizeof(*indexPtr)<<8), (indexPtr))) + ((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), (flags)|(int)(sizeof(*(indexPtr))<<8), (indexPtr))) #ifdef TCL_NO_DEPRECATED #define Tcl_GetStringFromObj(objPtr, sizePtr) \ - (sizeof(*sizePtr) <= sizeof(int) ? (Tcl_GetStringFromObj)(objPtr, (int *)sizePtr) : (TclGetStringFromObj)(objPtr, (size_t *)sizePtr)) + (sizeof(*(sizePtr)) <= sizeof(int) ? (Tcl_GetStringFromObj)(objPtr, (int *)sizePtr) : (TclGetStringFromObj)(objPtr, (size_t *)sizePtr)) #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ - (sizeof(*sizePtr) <= sizeof(int) ? (Tcl_GetByteArrayFromObj)(objPtr, (int *)sizePtr) : TclGetByteArrayFromObj(objPtr, (size_t *)sizePtr)) + (sizeof(*(sizePtr)) <= sizeof(int) ? (Tcl_GetByteArrayFromObj)(objPtr, (int *)sizePtr) : TclGetByteArrayFromObj(objPtr, (size_t *)sizePtr)) #define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ - (sizeof(*sizePtr) <= sizeof(int) ? (Tcl_GetUnicodeFromObj)(objPtr, (int *)sizePtr) : TclGetUnicodeFromObj(objPtr, (size_t *)sizePtr)) + (sizeof(*(sizePtr)) <= sizeof(int) ? (Tcl_GetUnicodeFromObj)(objPtr, (int *)sizePtr) : TclGetUnicodeFromObj(objPtr, (size_t *)sizePtr)) #endif #endif -- cgit v0.12 From 3899582e36ab11dba2246f3fe06e894adfaecb2c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 4 Apr 2022 11:16:27 +0000 Subject: Fix [e5ed1bb28b]: Issue if URL contains numeric IPv6 address. http -> 2.9.6 --- library/http/http.tcl | 5 ++--- library/http/pkgIndex.tcl | 2 +- unix/Makefile.in | 4 ++-- win/Makefile.in | 4 ++-- 4 files changed, 7 insertions(+), 8 deletions(-) diff --git a/library/http/http.tcl b/library/http/http.tcl index b0f87de..c4f165b 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -11,7 +11,7 @@ package require Tcl 8.6- # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles -package provide http 2.9.5 +package provide http 2.9.6 namespace eval http { # Allow resourcing to not clobber existing data @@ -1310,8 +1310,7 @@ proc http::Connected {token proto phost srvurl} { set sock $state(sock) set isQueryChannel [info exists state(-querychannel)] set isQuery [info exists state(-query)] - set host [lindex [split $state(socketinfo) :] 0] - set port [lindex [split $state(socketinfo) :] 1] + regexp {^(.+):([^:]+)$} $state(socketinfo) {} host port set lower [string tolower $proto] set defport [lindex $urlTypes($lower) 0] diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index 74c4841..7249547 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -1,2 +1,2 @@ if {![package vsatisfies [package provide Tcl] 8.6-]} {return} -package ifneeded http 2.9.5 [list tclPkgSetup $dir http 2.9.5 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] +package ifneeded http 2.9.6 [list tclPkgSetup $dir http 2.9.6 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] diff --git a/unix/Makefile.in b/unix/Makefile.in index 0ab3e9b..2acaf8a 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -950,9 +950,9 @@ install-libraries: libraries do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done - @echo "Installing package http 2.9.5 as a Tcl Module"; + @echo "Installing package http 2.9.6 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl \ - "$(MODULE_INSTALL_DIR)/8.6/http-2.9.5.tm" + "$(MODULE_INSTALL_DIR)/8.6/http-2.9.6.tm" @echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/" @for i in $(TOP_DIR)/library/opt/*.tcl; do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ diff --git a/win/Makefile.in b/win/Makefile.in index ed2ee68..99f04c8 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -735,8 +735,8 @@ install-libraries: libraries install-tzdata install-msgs do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; - @echo "Installing package http 2.9.5 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.5.tm"; + @echo "Installing package http 2.9.6 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.6.tm"; @echo "Installing library opt0.4 directory"; @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ -- cgit v0.12 From 403ba3fe0d4ff125a0eb88ae9ee245e328c09350 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 4 Apr 2022 11:30:15 +0000 Subject: Additional braces for (sizePtr), just to be sure --- generic/tclDecls.h | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 6161bff..790cddb 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4250,29 +4250,29 @@ extern const TclStubs *tclStubsPtr; #endif #if defined(USE_TCL_STUBS) #define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)sizePtr) : tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (size_t *)sizePtr)) + (sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)(sizePtr)) : tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (size_t *)(sizePtr))) #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ (tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), (flags)|(int)(sizeof(*(indexPtr))<<8), (indexPtr))) #ifdef TCL_NO_DEPRECATED #define Tcl_GetStringFromObj(objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tcl_GetStringFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tclGetStringFromObj(objPtr, (size_t *)sizePtr)) + (sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tcl_GetStringFromObj(objPtr, (int *)(sizePtr)) : tclStubsPtr->tclGetStringFromObj(objPtr, (size_t *)(sizePtr))) #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tclGetByteArrayFromObj(objPtr, (size_t *)sizePtr)) + (sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (int *)(sizePtr)) : tclStubsPtr->tclGetByteArrayFromObj(objPtr, (size_t *)(sizePtr))) #define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tclGetUnicodeFromObj(objPtr, (size_t *)sizePtr)) + (sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (int *)(sizePtr)) : tclStubsPtr->tclGetUnicodeFromObj(objPtr, (size_t *)(sizePtr))) #endif #else #define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? (TclGetBytesFromObj)(interp, objPtr, (int *)sizePtr) : (Tcl_GetBytesFromObj)(interp, objPtr, (size_t *)sizePtr)) + (sizeof(*(sizePtr)) <= sizeof(int) ? (TclGetBytesFromObj)(interp, objPtr, (int *)(sizePtr)) : (Tcl_GetBytesFromObj)(interp, objPtr, (size_t *)(sizePtr))) #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ ((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), (flags)|(int)(sizeof(*(indexPtr))<<8), (indexPtr))) #ifdef TCL_NO_DEPRECATED #define Tcl_GetStringFromObj(objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? (Tcl_GetStringFromObj)(objPtr, (int *)sizePtr) : (TclGetStringFromObj)(objPtr, (size_t *)sizePtr)) + (sizeof(*(sizePtr)) <= sizeof(int) ? (Tcl_GetStringFromObj)(objPtr, (int *)(sizePtr)) : (TclGetStringFromObj)(objPtr, (size_t *)(sizePtr))) #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? (Tcl_GetByteArrayFromObj)(objPtr, (int *)sizePtr) : TclGetByteArrayFromObj(objPtr, (size_t *)sizePtr)) + (sizeof(*(sizePtr)) <= sizeof(int) ? (Tcl_GetByteArrayFromObj)(objPtr, (int *)(sizePtr)) : TclGetByteArrayFromObj(objPtr, (size_t *)(sizePtr))) #define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? (Tcl_GetUnicodeFromObj)(objPtr, (int *)sizePtr) : TclGetUnicodeFromObj(objPtr, (size_t *)sizePtr)) + (sizeof(*(sizePtr)) <= sizeof(int) ? (Tcl_GetUnicodeFromObj)(objPtr, (int *)(sizePtr)) : TclGetUnicodeFromObj(objPtr, (size_t *)(sizePtr))) #endif #endif -- cgit v0.12 From 18ce686ba411d43ed7e95ce8d497e04c38d1414e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 4 Apr 2022 14:09:51 +0000 Subject: In tclCkalloc.c, count malloc/free's using size_t in stead of unsigned int. --- generic/tclCkalloc.c | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index 6a6ed31..9ecce13 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -71,7 +71,7 @@ struct mem_header { static struct mem_header *allocHead = NULL; /* List of allocated structures */ -#define GUARD_VALUE 0141 +#define GUARD_VALUE 0x61 /* * The following macro determines the amount of guard space *above* each chunk @@ -89,14 +89,14 @@ static struct mem_header *allocHead = NULL; /* List of allocated structures */ #define BODY_OFFSET \ ((size_t) (&((struct mem_header *) 0)->body)) -static unsigned int total_mallocs = 0; -static unsigned int total_frees = 0; +static size_t total_mallocs = 0; +static size_t total_frees = 0; static size_t current_bytes_malloced = 0; static size_t maximum_bytes_malloced = 0; static size_t current_malloc_packets = 0; static size_t maximum_malloc_packets = 0; -static unsigned int break_on_malloc = 0; -static unsigned int trace_on_at_malloc = 0; +static size_t break_on_malloc = 0; +static size_t trace_on_at_malloc = 0; static int alloc_tracing = FALSE; static int init_malloced_bodies = TRUE; #ifdef MEM_VALIDATE @@ -186,8 +186,8 @@ TclDumpMemoryInfo( return 0; } sprintf(buf, - "total mallocs %10u\n" - "total frees %10u\n" + "total mallocs %10" TCL_Z_MODIFIER "u\n" + "total frees %10" TCL_Z_MODIFIER "u\n" "current packets allocated %10" TCL_Z_MODIFIER "u\n" "current bytes allocated %10" TCL_Z_MODIFIER "u\n" "maximum packets allocated %10" TCL_Z_MODIFIER "u\n" @@ -406,7 +406,7 @@ Tcl_DbCkalloc( } /* Don't let size argument to TclpAlloc overflow */ - if (size <= UINT_MAX - offsetof(struct mem_header, body) - 1U - HIGH_GUARD_SIZE) { + if (size <= (size_t)-2 - offsetof(struct mem_header, body) - HIGH_GUARD_SIZE) { result = (struct mem_header *) TclpAlloc(size + offsetof(struct mem_header, body) + 1U + HIGH_GUARD_SIZE); } @@ -451,7 +451,7 @@ Tcl_DbCkalloc( total_mallocs++; if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) { (void) fflush(stdout); - fprintf(stderr, "reached malloc trace enable point (%u)\n", + fprintf(stderr, "reached malloc trace enable point (%" TCL_Z_MODIFIER "u)\n", total_mallocs); fflush(stderr); alloc_tracing = TRUE; @@ -466,7 +466,7 @@ Tcl_DbCkalloc( if (break_on_malloc && (total_mallocs >= break_on_malloc)) { break_on_malloc = 0; (void) fflush(stdout); - Tcl_Panic("reached malloc break limit (%u)", total_mallocs); + Tcl_Panic("reached malloc break limit (%" TCL_Z_MODIFIER "u)", total_mallocs); } current_malloc_packets++; @@ -496,7 +496,7 @@ Tcl_AttemptDbCkalloc( } /* Don't let size argument to TclpAlloc overflow */ - if (size <= UINT_MAX - offsetof(struct mem_header, body) - 1U - HIGH_GUARD_SIZE) { + if (size <= (size_t)-2 - offsetof(struct mem_header, body) - HIGH_GUARD_SIZE) { result = (struct mem_header *) TclpAlloc(size + offsetof(struct mem_header, body) + 1U + HIGH_GUARD_SIZE); } @@ -540,7 +540,7 @@ Tcl_AttemptDbCkalloc( total_mallocs++; if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) { (void) fflush(stdout); - fprintf(stderr, "reached malloc trace enable point (%d)\n", + fprintf(stderr, "reached malloc trace enable point (%" TCL_Z_MODIFIER "u)\n", total_mallocs); fflush(stderr); alloc_tracing = TRUE; @@ -555,7 +555,7 @@ Tcl_AttemptDbCkalloc( if (break_on_malloc && (total_mallocs >= break_on_malloc)) { break_on_malloc = 0; (void) fflush(stdout); - Tcl_Panic("reached malloc break limit (%d)", total_mallocs); + Tcl_Panic("reached malloc break limit (%" TCL_Z_MODIFIER "u)", total_mallocs); } current_malloc_packets++; @@ -845,19 +845,19 @@ MemoryCmd( return TCL_OK; } if (strcmp(TclGetString(objv[1]),"break_on_malloc") == 0) { - int value; + Tcl_WideInt value; if (objc != 3) { goto argError; } - if (Tcl_GetIntFromObj(interp, objv[2], &value) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[2], &value) != TCL_OK) { return TCL_ERROR; } - break_on_malloc = (unsigned int) value; + break_on_malloc = value; return TCL_OK; } if (strcmp(TclGetString(objv[1]),"info") == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "%-25s %10u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n", + "%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n", "total mallocs", total_mallocs, "total frees", total_frees, "current packets allocated", current_malloc_packets, "current bytes allocated", current_bytes_malloced, @@ -930,11 +930,11 @@ MemoryCmd( } if (strcmp(TclGetString(objv[1]),"trace_on_at_malloc") == 0) { - int value; + Tcl_WideInt value; if (objc != 3) { goto argError; } - if (Tcl_GetIntFromObj(interp, objv[2], &value) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[2], &value) != TCL_OK) { return TCL_ERROR; } trace_on_at_malloc = value; -- cgit v0.12 From 84ff1fb2d98ae85007f676e3872803497dbea1fe Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 4 Apr 2022 14:32:57 +0000 Subject: In tclCkalloc.c, count malloc/free's using size_t in stead of unsigned int. --- generic/tclCkalloc.c | 44 ++++++++++++++++++++++---------------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index fbf7b81..18a6400 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -33,7 +33,7 @@ * "memory tag" command is invoked, to hold the current tag. */ -typedef struct MemTag { +typedef struct { size_t refCount; /* Number of mem_headers referencing this * tag. */ char string[TCLFLEXARRAY]; /* Actual size of string will be as large as @@ -71,7 +71,7 @@ struct mem_header { static struct mem_header *allocHead = NULL; /* List of allocated structures */ -#define GUARD_VALUE 0141 +#define GUARD_VALUE 0x61 /* * The following macro determines the amount of guard space *above* each chunk @@ -89,14 +89,14 @@ static struct mem_header *allocHead = NULL; /* List of allocated structures */ #define BODY_OFFSET \ ((size_t) (&((struct mem_header *) 0)->body)) -static unsigned int total_mallocs = 0; -static unsigned int total_frees = 0; +static size_t total_mallocs = 0; +static size_t total_frees = 0; static size_t current_bytes_malloced = 0; static size_t maximum_bytes_malloced = 0; static size_t current_malloc_packets = 0; static size_t maximum_malloc_packets = 0; -static unsigned int break_on_malloc = 0; -static unsigned int trace_on_at_malloc = 0; +static size_t break_on_malloc = 0; +static size_t trace_on_at_malloc = 0; static int alloc_tracing = FALSE; static int init_malloced_bodies = TRUE; #ifdef MEM_VALIDATE @@ -186,8 +186,8 @@ TclDumpMemoryInfo( return 0; } sprintf(buf, - "total mallocs %10u\n" - "total frees %10u\n" + "total mallocs %10" TCL_Z_MODIFIER "u\n" + "total frees %10" TCL_Z_MODIFIER "u\n" "current packets allocated %10" TCL_Z_MODIFIER "u\n" "current bytes allocated %10" TCL_Z_MODIFIER "u\n" "maximum packets allocated %10" TCL_Z_MODIFIER "u\n" @@ -247,7 +247,7 @@ ValidateMemory( guard_failed = TRUE; fflush(stdout); byte &= 0xFF; - fprintf(stderr, "low guard byte %d is 0x%x \t%c\n", (int)idx, byte, + fprintf(stderr, "low guard byte %" TCL_Z_MODIFIER "u is 0x%x \t%c\n", idx, byte, (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */ } } @@ -268,7 +268,7 @@ ValidateMemory( guard_failed = TRUE; fflush(stdout); byte &= 0xFF; - fprintf(stderr, "hi guard byte %d is 0x%x \t%c\n", (int)idx, byte, + fprintf(stderr, "hi guard byte %" TCL_Z_MODIFIER "u is 0x%x \t%c\n", idx, byte, (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */ } } @@ -451,7 +451,7 @@ Tcl_DbCkalloc( total_mallocs++; if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) { (void) fflush(stdout); - fprintf(stderr, "reached malloc trace enable point (%u)\n", + fprintf(stderr, "reached malloc trace enable point (%" TCL_Z_MODIFIER "u)\n", total_mallocs); fflush(stderr); alloc_tracing = TRUE; @@ -466,7 +466,7 @@ Tcl_DbCkalloc( if (break_on_malloc && (total_mallocs >= break_on_malloc)) { break_on_malloc = 0; (void) fflush(stdout); - Tcl_Panic("reached malloc break limit (%u)", total_mallocs); + Tcl_Panic("reached malloc break limit (%" TCL_Z_MODIFIER "u)", total_mallocs); } current_malloc_packets++; @@ -540,7 +540,7 @@ Tcl_AttemptDbCkalloc( total_mallocs++; if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) { (void) fflush(stdout); - fprintf(stderr, "reached malloc trace enable point (%d)\n", + fprintf(stderr, "reached malloc trace enable point (%" TCL_Z_MODIFIER "u)\n", total_mallocs); fflush(stderr); alloc_tracing = TRUE; @@ -555,7 +555,7 @@ Tcl_AttemptDbCkalloc( if (break_on_malloc && (total_mallocs >= break_on_malloc)) { break_on_malloc = 0; (void) fflush(stdout); - Tcl_Panic("reached malloc break limit (%d)", total_mallocs); + Tcl_Panic("reached malloc break limit (%" TCL_Z_MODIFIER "u)", total_mallocs); } current_malloc_packets++; @@ -692,7 +692,7 @@ Tcl_DbCkrealloc( if (copySize > memp->length) { copySize = memp->length; } - newPtr = Tcl_DbCkalloc(size, file, line); + newPtr = (char *)Tcl_DbCkalloc(size, file, line); memcpy(newPtr, ptr, copySize); Tcl_DbCkfree(ptr, file, line); return newPtr; @@ -723,7 +723,7 @@ Tcl_AttemptDbCkrealloc( if (copySize > memp->length) { copySize = memp->length; } - newPtr = Tcl_AttemptDbCkalloc(size, file, line); + newPtr = (char *)Tcl_AttemptDbCkalloc(size, file, line); if (newPtr == NULL) { return NULL; } @@ -845,19 +845,19 @@ MemoryCmd( return TCL_OK; } if (strcmp(TclGetString(objv[1]),"break_on_malloc") == 0) { - int value; + Tcl_WideInt value; if (objc != 3) { goto argError; } - if (Tcl_GetIntFromObj(interp, objv[2], &value) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[2], &value) != TCL_OK) { return TCL_ERROR; } - break_on_malloc = (unsigned int) value; + break_on_malloc = value; return TCL_OK; } if (strcmp(TclGetString(objv[1]),"info") == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "%-25s %10u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n", + "%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n", "total mallocs", total_mallocs, "total frees", total_frees, "current packets allocated", current_malloc_packets, "current bytes allocated", current_bytes_malloced, @@ -930,11 +930,11 @@ MemoryCmd( } if (strcmp(TclGetString(objv[1]),"trace_on_at_malloc") == 0) { - int value; + Tcl_WideInt value; if (objc != 3) { goto argError; } - if (Tcl_GetIntFromObj(interp, objv[2], &value) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[2], &value) != TCL_OK) { return TCL_ERROR; } trace_on_at_malloc = value; -- cgit v0.12 From 616b93b0239bfc54be3cc05955f22e6a07ed0127 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 8 Apr 2022 09:10:22 +0000 Subject: Fix [05ff16e799]: signed integer overflow in ExtendStringRepWithUnicode() --- generic/tclStringObj.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 4afd12a..b81e711 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -3341,7 +3341,7 @@ ExtendStringRepWithUnicode( } for (i = 0; i < numChars && size >= 0; i++) { - size += Tcl_UniCharToUtf((int) unicode[i], buf); + size += (unsigned int)Tcl_UniCharToUtf((int) unicode[i], buf); } if (size < 0) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); -- cgit v0.12