diff options
| -rw-r--r-- | doc/string.n | 8 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 1 | ||||
| -rw-r--r-- | generic/tclProcess.c | 5 | ||||
| -rw-r--r-- | generic/tclScan.c | 19 | ||||
| -rw-r--r-- | generic/tclStringObj.c | 3 | ||||
| -rw-r--r-- | generic/tclStringRep.h | 1 |
6 files changed, 28 insertions, 9 deletions
diff --git a/doc/string.n b/doc/string.n index 00ce85c..7e666ea 100644 --- a/doc/string.n +++ b/doc/string.n @@ -115,9 +115,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 \fBentier\fR 12 .VS 8.6 Any of the valid string formats for an integer value of arbitrary size @@ -131,7 +129,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 @@ -156,7 +154,7 @@ true. Any upper case alphabet character in the Unicode character set. .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. .IP \fBwordchar\fR 12 Any Unicode word character. That is any alphanumeric character, and diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index cf2691b..d2304b2 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1590,7 +1590,6 @@ StringIsCmd( chcomp = Tcl_UniCharIsDigit; break; case STR_IS_DOUBLE: { - /* TODO */ if ((objPtr->typePtr == &tclDoubleType) || (objPtr->typePtr == &tclIntType) || (objPtr->typePtr == &tclBignumType)) { 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; } 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; } } diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 0d9732e..c09457d 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2020,6 +2020,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; @@ -3253,6 +3254,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)) /* |