From e3074edc8ab3d499540f736d2beebe02d46200aa Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 22 Feb 2022 21:01:20 +0000 Subject: TIP #618: New Tcl_GetBool* functions with INDEX_NULL_OK flag --- doc/BoolObj.3 | 13 ++++++++--- doc/GetIndex.3 | 4 ++-- generic/tcl.decls | 13 +++++++++-- generic/tcl.h | 4 ++-- generic/tclCmdMZ.c | 2 +- generic/tclDecls.h | 61 +++++++++++++++++++++++++++++++++++++++++++++++---- generic/tclExecute.c | 8 +++---- generic/tclGet.c | 23 ++++++++++++++++--- generic/tclIndexObj.c | 8 +++---- generic/tclInt.h | 4 ++-- generic/tclObj.c | 57 ++++++++++++++++++++++++++++++++++++++--------- generic/tclStubInit.c | 9 ++++++++ generic/tclTest.c | 15 +++++++------ tests/indexObj.test | 4 ++-- 14 files changed, 179 insertions(+), 46 deletions(-) diff --git a/doc/BoolObj.3 b/doc/BoolObj.3 index 9bbdc7e..afbd1d1 100644 --- a/doc/BoolObj.3 +++ b/doc/BoolObj.3 @@ -9,7 +9,7 @@ .so man.macros .BS .SH NAME -Tcl_NewBooleanObj, Tcl_SetBooleanObj, Tcl_GetBooleanFromObj \- store/retrieve boolean value in a Tcl_Obj +Tcl_NewBooleanObj, Tcl_SetBooleanObj, Tcl_GetBooleanFromObj, Tcl_GetBoolFromObj \- store/retrieve boolean value in a Tcl_Obj .SH SYNOPSIS .nf \fB#include \fR @@ -21,6 +21,9 @@ Tcl_Obj * .sp int \fBTcl_GetBooleanFromObj\fR(\fIinterp, objPtr, boolPtr\fR) +.sp +int +\fBTcl_GetBoolFromObj\fR(\fIinterp, objPtr, flags. boolPtr\fR) .SH ARGUMENTS .AS Tcl_Interp boolValue in/out .AP int boolValue in @@ -32,9 +35,13 @@ retrieve a boolean value. If a boolean value cannot be retrieved, an error message is left in the interpreter's result value unless \fIinterp\fR is NULL. -.AP int *boolPtr out -Points to place where \fBTcl_GetBooleanFromObj\fR +.AP int | short | char *boolPtr out +Points to place where \fBTcl_GetBooleanFromObj\fR/\fBTcl_GetBoolFromObj\fR stores the boolean value (0 or 1) obtained from \fIobjPtr\fR. +.AP int flags in +Value 0 or TCL_NULL_OK. If TCL_NULL_OK, then the empty +string or NULL will result in \fBTcl_GetBoolFromObj\fR return +TCL_OK, the *boolPtr filled with the value -1; .BE .SH DESCRIPTION diff --git a/doc/GetIndex.3 b/doc/GetIndex.3 index 1169c6c..176b0b2 100644 --- a/doc/GetIndex.3 +++ b/doc/GetIndex.3 @@ -54,7 +54,7 @@ Null-terminated string describing what is being looked up, such as .AP int flags in OR-ed combination of bits providing additional information for operation. The only bits that are currently defined are \fBTCL_EXACT\fR -, \fBTCL_INDEX_TEMP_TABLE\fR, and \fBTCL_INDEX_NULL_OK\fR. +, \fBTCL_INDEX_TEMP_TABLE\fR, and \fBTCL_NULL_OK\fR. .AP enum|char|short|int|long *indexPtr out If not (int *)NULL, the index of the string in \fItablePtr\fR that matches the value of \fIobjPtr\fR is returned here. The variable can @@ -93,7 +93,7 @@ operation. Note: \fBTcl_GetIndexFromObj\fR assumes that the entries in \fItablePtr\fR are static: they must not change between invocations. This caching mechanism can be disallowed by specifying the \fBTCL_INDEX_TEMP_TABLE\fR flag. -If the \fBTCL_INDEX_NULL_OK\fR flag was specified, objPtr is allowed +If the \fBTCL_NULL_OK\fR flag was specified, objPtr is allowed to be NULL or the empty string. The resulting index is -1. Otherwise, if the value of \fIobjPtr\fR is the empty string, \fBTcl_GetIndexFromObj\fR will treat it as a non-matching value diff --git a/generic/tcl.decls b/generic/tcl.decls index c137a88..4d630ca 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -136,11 +136,11 @@ declare 30 { void TclFreeObj(Tcl_Obj *objPtr) } declare 31 { - int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *boolPtr) + int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, void *boolPtr) } declare 32 { int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, - int *boolPtr) + void *boolPtr) } declare 33 { unsigned char *Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, int *numBytesPtr) @@ -2442,6 +2442,15 @@ declare 660 { int Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async, int sigNumber) } +declare 668 { + int Tcl_GetBool(Tcl_Interp *interp, const char *src, int flags, + void *boolPtr) +} +declare 669 { + int Tcl_GetBoolFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, + int flags, void *boolPtr) +} + # ----- BASELINE -- FOR -- 8.7.0 ----- # ############################################################################## diff --git a/generic/tcl.h b/generic/tcl.h index b82cf0a..560d441 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -979,13 +979,13 @@ typedef struct Tcl_DString { * TCL_EXACT disallows abbreviated strings. * TCL_INDEX_TEMP_TABLE disallows caching of lookups. A possible use case is * a table that will not live long enough to make it worthwhile. - * TCL_INDEX_NULL_OK allows the empty string or NULL to return TCL_OK. + * TCL_NULL_OK allows the empty string or NULL to return TCL_OK. * The returned value will be -1; */ #define TCL_EXACT 1 #define TCL_INDEX_TEMP_TABLE 2 -#define TCL_INDEX_NULL_OK 4 +#define TCL_NULL_OK 32 /* *---------------------------------------------------------------------------- diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index f394035..6b991eb 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1620,7 +1620,7 @@ StringIsCmd( result = length1 == 0; } } else if (index != STR_IS_BOOL) { - TclGetBooleanFromObj(NULL, objPtr, &i); + TclGetBoolFromObj(NULL, objPtr, 0, &i); if ((index == STR_IS_TRUE) ^ i) { result = 0; } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index b5697ea..da28cb7 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -146,10 +146,10 @@ EXTERN Tcl_Obj * Tcl_DuplicateObj(Tcl_Obj *objPtr); EXTERN void TclFreeObj(Tcl_Obj *objPtr); /* 31 */ EXTERN int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, - int *boolPtr); + void *boolPtr); /* 32 */ EXTERN int Tcl_GetBooleanFromObj(Tcl_Interp *interp, - Tcl_Obj *objPtr, int *boolPtr); + Tcl_Obj *objPtr, void *boolPtr); /* 33 */ EXTERN unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, int *numBytesPtr); @@ -1948,6 +1948,19 @@ EXTERN int Tcl_UniCharIsUnicode(int ch); /* 660 */ EXTERN int Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async, int sigNumber); +/* Slot 661 is reserved */ +/* Slot 662 is reserved */ +/* Slot 663 is reserved */ +/* Slot 664 is reserved */ +/* Slot 665 is reserved */ +/* Slot 666 is reserved */ +/* Slot 667 is reserved */ +/* 668 */ +EXTERN int Tcl_GetBool(Tcl_Interp *interp, const char *src, + int flags, void *boolPtr); +/* 669 */ +EXTERN int Tcl_GetBoolFromObj(Tcl_Interp *interp, + Tcl_Obj *objPtr, int flags, void *boolPtr); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2006,8 +2019,8 @@ typedef struct TclStubs { Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, int length, const char *file, int line); /* 28 */ Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */ void (*tclFreeObj) (Tcl_Obj *objPtr); /* 30 */ - int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *boolPtr); /* 31 */ - int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr); /* 32 */ + int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, void *boolPtr); /* 31 */ + int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, void *boolPtr); /* 32 */ unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *numBytesPtr); /* 33 */ int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */ int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */ @@ -2644,6 +2657,15 @@ typedef struct TclStubs { void (*reserved658)(void); void (*reserved659)(void); int (*tcl_AsyncMarkFromSignal) (Tcl_AsyncHandler async, int sigNumber); /* 660 */ + void (*reserved661)(void); + void (*reserved662)(void); + void (*reserved663)(void); + void (*reserved664)(void); + void (*reserved665)(void); + void (*reserved666)(void); + void (*reserved667)(void); + int (*tcl_GetBool) (Tcl_Interp *interp, const char *src, int flags, void *boolPtr); /* 668 */ + int (*tcl_GetBoolFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, void *boolPtr); /* 669 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -3994,6 +4016,17 @@ extern const TclStubs *tclStubsPtr; /* Slot 659 is reserved */ #define Tcl_AsyncMarkFromSignal \ (tclStubsPtr->tcl_AsyncMarkFromSignal) /* 660 */ +/* Slot 661 is reserved */ +/* Slot 662 is reserved */ +/* Slot 663 is reserved */ +/* Slot 664 is reserved */ +/* Slot 665 is reserved */ +/* Slot 666 is reserved */ +/* Slot 667 is reserved */ +#define Tcl_GetBool \ + (tclStubsPtr->tcl_GetBool) /* 668 */ +#define Tcl_GetBoolFromObj \ + (tclStubsPtr->tcl_GetBoolFromObj) /* 669 */ #endif /* defined(USE_TCL_STUBS) */ @@ -4210,6 +4243,10 @@ extern const TclStubs *tclStubsPtr; Tcl_GetUnicodeFromObj(objPtr, (int *)NULL) #undef Tcl_GetBytesFromObj #undef Tcl_GetIndexFromObjStruct +#undef Tcl_GetBoolFromObj +#undef Tcl_GetBool +#undef Tcl_GetBooleanFromObj +#undef Tcl_GetBoolean #ifdef TCL_NO_DEPRECATED #undef Tcl_GetStringFromObj #undef Tcl_GetUnicodeFromObj @@ -4220,6 +4257,14 @@ extern const TclStubs *tclStubsPtr; (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))) +#define Tcl_GetBoolFromObj(interp, objPtr, flags, boolPtr) \ + (tclStubsPtr->tcl_GetBoolFromObj((interp), (objPtr), (flags)|(int)(sizeof(*boolPtr)<<8), (boolPtr))) +#define Tcl_GetBool(interp, objPtr, flags, boolPtr) \ + (tclStubsPtr->tcl_GetBool((interp), (objPtr), (flags)|(int)(sizeof(*boolPtr)<<8), (boolPtr))) +#define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \ + (sizeof(*boolPtr) == sizeof(int) ? tclStubsPtr->tcl_GetBooleanFromObj(interp, objPtr, (int *)boolPtr) : Tcl_GetBoolFromObj(interp, objPtr, 0, boolPtr)) +#define Tcl_GetBoolean(interp, src, boolPtr) \ + (sizeof(*boolPtr) == sizeof(int) ? tclStubsPtr->tcl_GetBoolean(interp, src, (int *)boolPtr) : Tcl_GetBool(interp, src, 0, boolPtr)) #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)) @@ -4233,6 +4278,14 @@ extern const TclStubs *tclStubsPtr; (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))) +#define Tcl_GetBoolFromObj(interp, objPtr, flags, boolPtr) \ + ((Tcl_GetBoolFromObj)((interp), (objPtr), (flags)|(int)(sizeof(*boolPtr)<<8), (boolPtr))) +#define Tcl_GetBool(interp, objPtr, flags, boolPtr) \ + ((Tcl_GetBool)((interp), (objPtr), (flags)|(int)(sizeof(*boolPtr)<<8), (boolPtr))) +#define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \ + (sizeof(*boolPtr) == sizeof(int) ? (Tcl_GetBooleanFromObj)(interp, objPtr, (int *)boolPtr) : Tcl_GetBoolFromObj(interp, objPtr, 0, boolPtr)) +#define Tcl_GetBoolean(interp, src, boolPtr) \ + (sizeof(*boolPtr) == sizeof(int) ? (Tcl_GetBoolean)(interp, src, (int *)boolPtr) : Tcl_GetBool(interp, src, 0, boolPtr)) #ifdef TCL_NO_DEPRECATED #define Tcl_GetStringFromObj(objPtr, sizePtr) \ (sizeof(*sizePtr) <= sizeof(int) ? (Tcl_GetStringFromObj)(objPtr, (int *)sizePtr) : (TclGetStringFromObj)(objPtr, (size_t *)sizePtr)) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index dfb195a..2c4cde4 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -4346,7 +4346,7 @@ TEBCresume( /* TODO - check claim that taking address of b harms performance */ /* TODO - consider optimization search for constants */ - if (TclGetBooleanFromObj(interp, valuePtr, &b) != TCL_OK) { + if (TclGetBoolFromObj(interp, valuePtr, 0, &b) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } @@ -4414,7 +4414,7 @@ TEBCresume( value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; - if (TclGetBooleanFromObj(NULL, valuePtr, &i1) != TCL_OK) { + if (TclGetBoolFromObj(NULL, valuePtr, 0, &i1) != TCL_OK) { TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); DECACHE_STACK_INFO(); @@ -4423,7 +4423,7 @@ TEBCresume( goto gotError; } - if (TclGetBooleanFromObj(NULL, value2Ptr, &i2) != TCL_OK) { + if (TclGetBoolFromObj(NULL, value2Ptr, 0, &i2) != TCL_OK) { TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr), (value2Ptr->typePtr? value2Ptr->typePtr->name : "null"))); DECACHE_STACK_INFO(); @@ -6222,7 +6222,7 @@ TEBCresume( /* TODO - check claim that taking address of b harms performance */ /* TODO - consider optimization search for constants */ - if (TclGetBooleanFromObj(NULL, valuePtr, &b) != TCL_OK) { + if (TclGetBoolFromObj(NULL, valuePtr, 0, &b) != TCL_OK) { TRACE(("\"%.20s\" => ERROR: illegal type %s\n", O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); DECACHE_STACK_INFO(); diff --git a/generic/tclGet.c b/generic/tclGet.c index 970e093..1beac24 100644 --- a/generic/tclGet.c +++ b/generic/tclGet.c @@ -121,17 +121,22 @@ Tcl_GetDouble( *---------------------------------------------------------------------- */ +#undef Tcl_GetBool int -Tcl_GetBoolean( +Tcl_GetBool( Tcl_Interp *interp, /* Interpreter used for error reporting. */ const char *src, /* String containing one of the boolean values * 1, 0, true, false, yes, no, on, off. */ - int *boolPtr) /* Place to store converted result, which will + int flags, + void *boolPtr) /* Place to store converted result, which will * be 0 or 1. */ { Tcl_Obj obj; int code; + if (((src == NULL) || (*src == '\0')) && (flags & TCL_NULL_OK)) { + return (Tcl_GetBoolFromObj)(NULL, NULL, flags, boolPtr); + } obj.refCount = 1; obj.bytes = (char *) src; obj.length = strlen(src); @@ -142,10 +147,22 @@ Tcl_GetBoolean( Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); } if (code == TCL_OK) { - TclGetBooleanFromObj(NULL, &obj, boolPtr); + (Tcl_GetBoolFromObj)(NULL, &obj, flags, boolPtr); } return code; } + +#undef Tcl_GetBoolean +int +Tcl_GetBoolean( + Tcl_Interp *interp, /* Interpreter used for error reporting. */ + const char *src, /* String containing one of the boolean values + * 1, 0, true, false, yes, no, on, off. */ + void *boolPtr) /* Place to store converted result, which will + * be 0 or 1. */ +{ + return Tcl_GetBool(interp, src, 0, boolPtr); +} /* * Local Variables: diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 1f600c5..f5e3958 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -263,7 +263,7 @@ Tcl_GetIndexFromObjStruct( int offset, /* The number of bytes between entries */ const char *msg, /* Identifying word to use in error * messages. */ - int flags, /* 0, TCL_EXACT, TCL_INDEX_TEMP_TABLE or TCL_INDEX_NULL_OK */ + int flags, /* 0, TCL_EXACT, TCL_INDEX_TEMP_TABLE or TCL_NULL_OK */ void *indexPtr) /* Place to store resulting index. */ { int index, idx, numAbbrev; @@ -304,7 +304,7 @@ Tcl_GetIndexFromObjStruct( index = -1; numAbbrev = 0; - if (!*key && (flags & TCL_INDEX_NULL_OK)) { + if (!*key && (flags & TCL_NULL_OK)) { goto uncachedDone; } /* @@ -411,7 +411,7 @@ Tcl_GetIndexFromObjStruct( *entryPtr, NULL); entryPtr = NEXT_ENTRY(entryPtr, offset); while (*entryPtr != NULL) { - if ((*NEXT_ENTRY(entryPtr, offset) == NULL) && !(flags & TCL_INDEX_NULL_OK)) { + if ((*NEXT_ENTRY(entryPtr, offset) == NULL) && !(flags & TCL_NULL_OK)) { Tcl_AppendStringsToObj(resultPtr, (count > 0 ? "," : ""), " or ", *entryPtr, NULL); } else if (**entryPtr) { @@ -420,7 +420,7 @@ Tcl_GetIndexFromObjStruct( } entryPtr = NEXT_ENTRY(entryPtr, offset); } - if ((flags & TCL_INDEX_NULL_OK)) { + if ((flags & TCL_NULL_OK)) { Tcl_AppendStringsToObj(resultPtr, ", or \"\"", NULL); } } diff --git a/generic/tclInt.h b/generic/tclInt.h index 75cd6e5..25593b2 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2504,12 +2504,12 @@ typedef struct List { * WARNING: these macros eval their args more than once. */ -#define TclGetBooleanFromObj(interp, objPtr, boolPtr) \ +#define TclGetBoolFromObj(interp, objPtr, flags, boolPtr) \ (((objPtr)->typePtr == &tclIntType) \ ? (*(boolPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \ : ((objPtr)->typePtr == &tclBooleanType) \ ? (*(boolPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \ - : Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr))) + : Tcl_GetBoolFromObj((interp), (objPtr), (flags), (boolPtr))) #ifdef TCL_WIDE_INT_IS_LONG #define TclGetLongFromObj(interp, objPtr, longPtr) \ diff --git a/generic/tclObj.c b/generic/tclObj.c index a06b8fd..636f8e0 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -2139,7 +2139,7 @@ Tcl_SetBooleanObj( /* *---------------------------------------------------------------------- * - * Tcl_GetBooleanFromObj -- + * Tcl_GetBoolFromObj, Tcl_GetBooleanFromObj -- * * Attempt to return a boolean from the Tcl object "objPtr". This * includes conversion from any of Tcl's numeric types. @@ -2155,20 +2155,28 @@ Tcl_SetBooleanObj( *---------------------------------------------------------------------- */ +#undef Tcl_GetBoolFromObj int -Tcl_GetBooleanFromObj( +Tcl_GetBoolFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* The object from which to get boolean. */ - int *boolPtr) /* Place to store resulting boolean. */ + int flags, + void *boolPtr) /* Place to store resulting boolean. */ { + int result; + + if ((flags & TCL_NULL_OK) && (objPtr == NULL || Tcl_GetString(objPtr)[0] == '\0')) { + result = -1; + goto boolEnd; + } do { if (objPtr->typePtr == &tclIntType) { - *boolPtr = (objPtr->internalRep.wideValue != 0); - return TCL_OK; + result = (objPtr->internalRep.wideValue != 0); + goto boolEnd; } if (objPtr->typePtr == &tclBooleanType) { - *boolPtr = objPtr->internalRep.longValue != 0; - return TCL_OK; + result = objPtr->internalRep.longValue != 0; + goto boolEnd; } if (objPtr->typePtr == &tclDoubleType) { /* @@ -2184,11 +2192,30 @@ Tcl_GetBooleanFromObj( if (Tcl_GetDoubleFromObj(interp, objPtr, &d) != TCL_OK) { return TCL_ERROR; } - *boolPtr = (d != 0.0); - return TCL_OK; + result = (d != 0.0); + goto boolEnd; } if (objPtr->typePtr == &tclBignumType) { - *boolPtr = 1; + result = 1; + boolEnd: + if (boolPtr != NULL) { + if ((flags>>8) & (int)~sizeof(int)) { + if ((flags>>8) == sizeof(uint64_t)) { + *(uint64_t *)boolPtr = result; + return TCL_OK; + } else if ((flags>>8) == sizeof(uint32_t)) { + *(uint32_t *)boolPtr = result; + return TCL_OK; + } else if ((flags>>8) == sizeof(uint16_t)) { + *(uint16_t *)boolPtr = result; + return TCL_OK; + } else if ((flags>>8) == sizeof(uint8_t)) { + *(uint8_t *)boolPtr = result; + return TCL_OK; + } + } + *(int *)boolPtr = result; + } return TCL_OK; } } while ((ParseBoolean(objPtr) == TCL_OK) || (TCL_OK == @@ -2196,6 +2223,16 @@ Tcl_GetBooleanFromObj( return TCL_ERROR; } +#undef Tcl_GetBooleanFromObj +int +Tcl_GetBooleanFromObj( + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr, /* The object from which to get boolean. */ + void *boolPtr) /* Place to store resulting boolean. */ +{ + return Tcl_GetBoolFromObj(interp, objPtr, 0, boolPtr); +} + /* *---------------------------------------------------------------------- * diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index a1878c1..ff2b296 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1944,6 +1944,15 @@ const TclStubs tclStubs = { 0, /* 658 */ 0, /* 659 */ Tcl_AsyncMarkFromSignal, /* 660 */ + 0, /* 661 */ + 0, /* 662 */ + 0, /* 663 */ + 0, /* 664 */ + 0, /* 665 */ + 0, /* 666 */ + 0, /* 667 */ + Tcl_GetBool, /* 668 */ + Tcl_GetBoolFromObj, /* 669 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclTest.c b/generic/tclTest.c index 009c95f..97fd57f 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -2174,7 +2174,7 @@ TesteventProc( Tcl_Obj *command = ev->command; int result = Tcl_EvalObjEx(interp, command, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); - int retval; + char retval[3]; if (result != TCL_OK) { Tcl_AddErrorInfo(interp, @@ -2183,18 +2183,18 @@ TesteventProc( return 1; /* Avoid looping on errors */ } if (Tcl_GetBooleanFromObj(interp, Tcl_GetObjResult(interp), - &retval) != TCL_OK) { + &retval[1]) != TCL_OK) { Tcl_AddErrorInfo(interp, " (return value from \"testevent\" callback)"); Tcl_BackgroundException(interp, TCL_ERROR); return 1; } - if (retval) { + if (retval[1]) { Tcl_DecrRefCount(ev->tag); Tcl_DecrRefCount(ev->command); } - return retval; + return retval[1]; } /* @@ -5188,7 +5188,8 @@ TestsaveresultCmd( Tcl_Obj *const objv[]) /* The argument objects. */ { Interp* iPtr = (Interp*) interp; - int discard, result, index; + int result, index; + short discard[3]; Tcl_SavedResult state; Tcl_Obj *objPtr; static const char *const optionStrings[] = { @@ -5210,7 +5211,7 @@ TestsaveresultCmd( &index) != TCL_OK) { return TCL_ERROR; } - if (Tcl_GetBooleanFromObj(interp, objv[3], &discard) != TCL_OK) { + if (Tcl_GetBooleanFromObj(interp, objv[3], &discard[1]) != TCL_OK) { return TCL_ERROR; } @@ -5247,7 +5248,7 @@ TestsaveresultCmd( result = Tcl_EvalEx(interp, Tcl_GetString(objv[2]), -1, 0); } - if (discard) { + if (discard[1]) { Tcl_DiscardResult(&state); } else { Tcl_RestoreResult(interp, &state); diff --git a/tests/indexObj.test b/tests/indexObj.test index c327274..f10bd2a 100644 --- a/tests/indexObj.test +++ b/tests/indexObj.test @@ -142,8 +142,8 @@ test indexObj-6.6 {Tcl_GetIndexFromObjStruct with NULL input} -constraints testi } -returnCodes error -result {ambiguous dummy "": must be a, c, or ee} test indexObj-6.7 {Tcl_GetIndexFromObjStruct} testindexobj { set x "" - testgetindexfromobjstruct $x -1 4 -} "wrong # args: should be \"testgetindexfromobjstruct {} -1 4\"" + testgetindexfromobjstruct $x -1 32 +} "wrong # args: should be \"testgetindexfromobjstruct {} -1 32\"" test indexObj-7.1 {Tcl_ParseArgsObjv} testparseargs { testparseargs -- cgit v0.12