From 0ad3b13e2663019e4ff8d3dc944fd030e33eb358 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 5 Apr 2018 13:34:58 +0000 Subject: Failed to mutex protect all multi-thread access to the hash tables in the [tcl::process] implementation. This was causing segfaults in thread-8.1. --- generic/tclProcess.c | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/generic/tclProcess.c b/generic/tclProcess.c index 7187ee4..604b7ce 100644 --- a/generic/tclProcess.c +++ b/generic/tclProcess.c @@ -887,6 +887,7 @@ TclProcessWait( * First search for pid in table. */ + Tcl_MutexLock(&infoTablesMutex); entry = Tcl_FindHashEntry(&infoTablePerPid, pid); if (!entry) { /* @@ -897,6 +898,7 @@ TclProcessWait( msgObjPtr, errorObjPtr); if (msgObjPtr && *msgObjPtr) Tcl_IncrRefCount(*msgObjPtr); if (errorObjPtr && *errorObjPtr) Tcl_IncrRefCount(*errorObjPtr); + Tcl_MutexUnlock(&infoTablesMutex); return result; } @@ -906,6 +908,7 @@ TclProcessWait( * Process has completed but TclProcessWait has already been called, * so report no change. */ + Tcl_MutexUnlock(&infoTablesMutex); return TCL_PROCESS_UNCHANGED; } @@ -915,6 +918,7 @@ TclProcessWait( /* * No change, stop there. */ + Tcl_MutexUnlock(&infoTablesMutex); return TCL_PROCESS_UNCHANGED; } @@ -948,5 +952,6 @@ TclProcessWait( info->purge = 1; } + Tcl_MutexUnlock(&infoTablesMutex); return result; } -- cgit v0.12 From eb8817687f0753816e8308b93b3e992414afeca4 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 5 Apr 2018 15:37:40 +0000 Subject: [string cat] was failing to NUL terminate string reps. Stopped "string" values triggering false valgrind alarms when tests make use of [tcl::unsupported::representation]. --- generic/tclStringObj.c | 2 ++ generic/tclStringRep.h | 1 + 2 files changed, 3 insertions(+) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 2ebec64..a2a1d41 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -3205,6 +3205,8 @@ TclStringCat( dst += more; } } + /* Must NUL-terminate! */ + *dst = '\0'; } return objResultPtr; diff --git a/generic/tclStringRep.h b/generic/tclStringRep.h index 1ef1957..fc5a713 100644 --- a/generic/tclStringRep.h +++ b/generic/tclStringRep.h @@ -86,6 +86,7 @@ typedef struct { #define GET_STRING(objPtr) \ ((String *) (objPtr)->internalRep.twoPtrValue.ptr1) #define SET_STRING(objPtr, stringPtr) \ + ((objPtr)->internalRep.twoPtrValue.ptr2 = NULL), \ ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr)) /* -- cgit v0.12 From 43507f353b82f414fff3810cc0d781a44e7ae3e9 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 5 Apr 2018 16:37:35 +0000 Subject: Plug memleak when [scan] raises an error. --- generic/tclScan.c | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/generic/tclScan.c b/generic/tclScan.c index 113b4c6..0e3da17 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -941,11 +941,24 @@ Tcl_ScanObjCmd( } else if (flags & SCAN_BIG) { if (flags & SCAN_UNSIGNED) { mp_int big; - if ((Tcl_GetBignumFromObj(interp, objPtr, &big) != TCL_OK) - || mp_isneg(&big)) { + int code = Tcl_GetBignumFromObj(interp, objPtr, &big); + + if (code == TCL_OK) { + if (mp_isneg(&big)) { + code = TCL_ERROR; + } + mp_clear(&big); + } + + if (code == TCL_ERROR) { + if (objs != NULL) { + ckfree(objs); + } + Tcl_DecrRefCount(objPtr); Tcl_SetObjResult(interp, Tcl_NewStringObj( "unsigned bignum scans are invalid", -1)); - Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", + "BADUNSIGNED",NULL); return TCL_ERROR; } } -- cgit v0.12 From 634c443219ba3420c6a3403b7c1565076d86dbae Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 5 Apr 2018 17:22:09 +0000 Subject: Plug memleak in [format] applied to bignums. --- generic/tclStringObj.c | 1 + 1 file changed, 1 insertion(+) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index a2a1d41..fa50d6d 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -1972,6 +1972,7 @@ Tcl_AppendFormatToObj( if (cmpResult == MP_EQ) gotHash = 0; if (ch == 'u') { if (isNegative) { + mp_clear(&big); msg = "unsigned bignum format is invalid"; errCode = "BADUNSIGNED"; goto errorMsg; -- cgit v0.12 From 689f5653f9349eb55b176a83f0daf2762a353a2b Mon Sep 17 00:00:00 2001 From: dgp Date: Sat, 7 Apr 2018 16:55:53 +0000 Subject: Correct out-of-date documentation for [string is]. --- doc/string.n | 8 +++----- generic/tclCmdMZ.c | 1 - 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/doc/string.n b/doc/string.n index 7e427ab..d4e2833 100644 --- a/doc/string.n +++ b/doc/string.n @@ -136,9 +136,7 @@ Any Unicode control character. Any Unicode digit character. Note that this includes characters outside of the [0\-9] range. .IP \fBdouble\fR 12 -Any of the valid forms for a double in Tcl, with optional surrounding -whitespace. In case of under/overflow in the value, 0 is returned and -the \fIvarname\fR will contain \-1. +Any of the forms allowed to \fBTcl_GetDoubleFromObj\fR. .IP \fBfalse\fR 12 Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is false. @@ -146,7 +144,7 @@ false. Any Unicode printing character, except space. .IP \fBinteger\fR 12 Any of the valid string formats for a 32-bit integer value in Tcl, -with optional surrounding whitespace. In case of under/overflow in +with optional surrounding whitespace. In case of overflow in the value, 0 is returned and the \fIvarname\fR will contain \-1. .IP \fBlist\fR 12 Any proper list structure, with optional surrounding whitespace. In @@ -171,7 +169,7 @@ Any upper case alphabet character in the Unicode character set. .VS 8.5 .IP \fBwideinteger\fR 12 Any of the valid forms for a wide integer in Tcl, with optional -surrounding whitespace. In case of under/overflow in the value, 0 is +surrounding whitespace. In case of overflow in the value, 0 is returned and the \fIvarname\fR will contain \-1. .VE 8.5 .IP \fBwordchar\fR 12 diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index de953aa..db4e57b 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1515,7 +1515,6 @@ StringIsCmd( chcomp = Tcl_UniCharIsDigit; break; case STR_IS_DOUBLE: { - /* TODO */ if ((objPtr->typePtr == &tclDoubleType) || (objPtr->typePtr == &tclIntType) || #ifndef NO_WIDE_TYPE -- cgit v0.12