summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/BoolObj.321
-rw-r--r--doc/GetIndex.34
-rw-r--r--doc/GetInt.323
-rw-r--r--generic/tcl.decls9
-rw-r--r--generic/tcl.h4
-rw-r--r--generic/tclCmdMZ.c2
-rw-r--r--generic/tclDecls.h27
-rw-r--r--generic/tclExecute.c8
-rw-r--r--generic/tclGet.c23
-rw-r--r--generic/tclIndexObj.c8
-rw-r--r--generic/tclInt.h4
-rw-r--r--generic/tclObj.c62
-rw-r--r--generic/tclStubInit.c7
-rw-r--r--generic/tclTest.c29
14 files changed, 183 insertions, 48 deletions
diff --git a/doc/BoolObj.3 b/doc/BoolObj.3
index 9bbdc7e..c5bb05f 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 <tcl.h>\fR
@@ -20,7 +20,10 @@ Tcl_Obj *
\fBTcl_SetBooleanObj\fR(\fIobjPtr, boolValue\fR)
.sp
int
-\fBTcl_GetBooleanFromObj\fR(\fIinterp, objPtr, boolPtr\fR)
+\fBTcl_GetBooleanFromObj\fR(\fIinterp, objPtr, intPtr\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,16 @@ 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
+.AP int *intPtr out
Points to place where \fBTcl_GetBooleanFromObj\fR
stores the boolean value (0 or 1) obtained from \fIobjPtr\fR.
+.AP int | short | char *boolPtr out
+Points to place where \fBTcl_GetBoolFromObj\fR
+stores the boolean value (0 or 1) obtained from \fIobjPtr\fR.
+.AP int flags in
+sizeof(*(boolPtr)), possibly combined with TCL_NULL_OK. If TCL_NULL_OK
+is used, 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
@@ -76,6 +86,11 @@ fields of \fI*objPtr\fR so that future calls to
\fBTcl_GetBooleanFromObj\fR on the same \fIobjPtr\fR can be
performed more efficiently.
.PP
+\fBTcl_GetBoolFromObj\fR functions almost the same as
+\fBTcl_GetBooleanFromObj\fR, but it has an additional parameter
+\fBflags\fR, which can be used to specify the size of the \fBboolPtr\fR
+variable, and also whether the empty string or NULL is accepted as valid.
+.PP
Note that the routines \fBTcl_GetBooleanFromObj\fR and
\fBTcl_GetBoolean\fR are not functional equivalents.
The set of values for which \fBTcl_GetBooleanFromObj\fR
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/doc/GetInt.3 b/doc/GetInt.3
index eba549d..edce6c1 100644
--- a/doc/GetInt.3
+++ b/doc/GetInt.3
@@ -21,7 +21,10 @@ int
\fBTcl_GetDouble\fR(\fIinterp, src, doublePtr\fR)
.sp
int
-\fBTcl_GetBoolean\fR(\fIinterp, src, boolPtr\fR)
+\fBTcl_GetBoolean\fR(\fIinterp, src, intPtr\fR)
+.sp
+int
+\fBTcl_GetBool\fR(\fIinterp, src, flags, boolPtr\fR)
.SH ARGUMENTS
.AS Tcl_Interp *doublePtr out
.AP Tcl_Interp *interp in
@@ -33,8 +36,12 @@ Points to place to store integer value converted from \fIsrc\fR.
.AP double *doublePtr out
Points to place to store double-precision floating-point
value converted from \fIsrc\fR.
-.AP int *boolPtr out
-Points to place to store boolean value (0 or 1) converted from \fIsrc\fR.
+.AP int | short | char *boolPtr out
+Points to place to store boolean value (0 or 1) value converted from \fIsrc\fR.
+.AP int flags in
+sizeof(*(boolPtr)), possibly combined with TCL_NULL_OK. If TCL_NULL_OK
+is used, then the empty string or NULL will result in \fBTcl_GetBool\fR
+return TCL_OK, the *boolPtr filled with the value -1;
.BE
.SH DESCRIPTION
@@ -94,11 +101,15 @@ inter-digit separator be present.
\fBTcl_GetBoolean\fR expects \fIsrc\fR to specify a boolean
value. If \fIsrc\fR is any of \fB0\fR, \fBfalse\fR,
\fBno\fR, or \fBoff\fR, then \fBTcl_GetBoolean\fR stores a zero
-value at \fI*boolPtr\fR.
+value at \fI*intPtr\fR.
If \fIsrc\fR is any of \fB1\fR, \fBtrue\fR, \fByes\fR, or \fBon\fR,
-then 1 is stored at \fI*boolPtr\fR.
+then 1 is stored at \fI*intPtr\fR.
Any of these values may be abbreviated, and upper-case spellings
are also acceptable.
-
+.PP
+\fBTcl_GetBool\fR functions almost the same as \fBTcl_GetBoolean\fR,
+but it has an additional parameter \fBflags\fR, which can be used
+to specify the size of the \fBboolPtr\fR variable, and also whether
+the empty string or NULL is accepted as valid.
.SH KEYWORDS
boolean, conversion, double, floating-point, integer
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 3cf794e..a450130 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2455,6 +2455,15 @@ declare 668 {
int Tcl_UniCharLen(const int *uniStr)
}
+declare 674 {
+ int Tcl_GetBool(Tcl_Interp *interp, const char *src, int flags,
+ void *boolPtr)
+}
+declare 675 {
+ 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 eff58b3..3182275 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 32
+#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 790cddb..790af99 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1963,6 +1963,17 @@ EXTERN int Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async,
/* Slot 667 is reserved */
/* 668 */
EXTERN int Tcl_UniCharLen(const int *uniStr);
+/* Slot 669 is reserved */
+/* Slot 670 is reserved */
+/* Slot 671 is reserved */
+/* Slot 672 is reserved */
+/* Slot 673 is reserved */
+/* 674 */
+EXTERN int Tcl_GetBool(Tcl_Interp *interp, const char *src,
+ int flags, void *boolPtr);
+/* 675 */
+EXTERN int Tcl_GetBoolFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, int flags, void *boolPtr);
typedef struct {
const struct TclPlatStubs *tclPlatStubs;
@@ -2667,6 +2678,13 @@ typedef struct TclStubs {
void (*reserved666)(void);
void (*reserved667)(void);
int (*tcl_UniCharLen) (const int *uniStr); /* 668 */
+ void (*reserved669)(void);
+ void (*reserved670)(void);
+ void (*reserved671)(void);
+ void (*reserved672)(void);
+ void (*reserved673)(void);
+ int (*tcl_GetBool) (Tcl_Interp *interp, const char *src, int flags, void *boolPtr); /* 674 */
+ int (*tcl_GetBoolFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, void *boolPtr); /* 675 */
} TclStubs;
extern const TclStubs *tclStubsPtr;
@@ -4028,6 +4046,15 @@ extern const TclStubs *tclStubsPtr;
/* Slot 667 is reserved */
#define Tcl_UniCharLen \
(tclStubsPtr->tcl_UniCharLen) /* 668 */
+/* Slot 669 is reserved */
+/* Slot 670 is reserved */
+/* Slot 671 is reserved */
+/* Slot 672 is reserved */
+/* Slot 673 is reserved */
+#define Tcl_GetBool \
+ (tclStubsPtr->tcl_GetBool) /* 674 */
+#define Tcl_GetBoolFromObj \
+ (tclStubsPtr->tcl_GetBoolFromObj) /* 675 */
#endif /* defined(USE_TCL_STUBS) */
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 0ec2404..552442d 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();
@@ -6223,7 +6223,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..9a1b3c0 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')) {
+ return (Tcl_GetBoolFromObj)(interp, 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. */
+ int *boolPtr) /* Place to store converted result, which will
+ * be 0 or 1. */
+{
+ return Tcl_GetBool(interp, src, sizeof(int), 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 af839fc..e3ebe57 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2507,12 +2507,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..89b576c 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,35 @@ 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;
+ } else if (objPtr == NULL) {
+ if (interp) {
+ TclNewObj(objPtr);
+ TclParseNumber(interp, objPtr, "boolean value", NULL,-1,NULL,0);
+ Tcl_DecrRefCount(objPtr);
+ }
+ return TCL_ERROR;
+ }
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 +2199,28 @@ 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) {
+ flags &= (TCL_NULL_OK - 1);
+ if (flags & (int)~sizeof(int8_t)) {
+ if (flags == sizeof(int64_t)) {
+ *(int64_t *)boolPtr = result;
+ return TCL_OK;
+ } else if (flags == sizeof(int32_t)) {
+ *(int32_t *)boolPtr = result;
+ return TCL_OK;
+ } else if (flags == sizeof(int16_t)) {
+ *(int16_t *)boolPtr = result;
+ return TCL_OK;
+ }
+ }
+ *(int8_t *)boolPtr = result;
+ }
return TCL_OK;
}
} while ((ParseBoolean(objPtr) == TCL_OK) || (TCL_OK ==
@@ -2196,6 +2228,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. */
+ int *boolPtr) /* Place to store resulting boolean. */
+{
+ return Tcl_GetBoolFromObj(interp, objPtr, sizeof(int), boolPtr);
+}
+
/*
*----------------------------------------------------------------------
*
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 257c3ce..1f62d39 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -1950,6 +1950,13 @@ const TclStubs tclStubs = {
0, /* 666 */
0, /* 667 */
Tcl_UniCharLen, /* 668 */
+ 0, /* 669 */
+ 0, /* 670 */
+ 0, /* 671 */
+ 0, /* 672 */
+ 0, /* 673 */
+ Tcl_GetBool, /* 674 */
+ Tcl_GetBoolFromObj, /* 675 */
};
/* !END!: Do not edit above this line. */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 0ce5e83..4cd9bab 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -2262,7 +2262,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,
@@ -2270,19 +2270,19 @@ TesteventProc(
Tcl_BackgroundException(interp, TCL_ERROR);
return 1; /* Avoid looping on errors */
}
- if (Tcl_GetBooleanFromObj(interp, Tcl_GetObjResult(interp),
- &retval) != TCL_OK) {
+ if (Tcl_GetBoolFromObj(interp, Tcl_GetObjResult(interp),
+ sizeof(retval[1]), &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];
}
/*
@@ -5276,7 +5276,8 @@ TestsaveresultCmd(
Tcl_Obj *const objv[]) /* The argument objects. */
{
Interp* iPtr = (Interp*) interp;
- int discard, result, index;
+ int result, index;
+ char b[3];
Tcl_SavedResult state;
Tcl_Obj *objPtr;
static const char *const optionStrings[] = {
@@ -5298,11 +5299,17 @@ TestsaveresultCmd(
&index) != TCL_OK) {
return TCL_ERROR;
}
- if (Tcl_GetBooleanFromObj(interp, objv[3], &discard) != TCL_OK) {
- return TCL_ERROR;
- }
+ b[0] = b[1] = b[2] = 100;
+ if (Tcl_GetBoolFromObj(interp, objv[3], sizeof(b[1]), b + 1) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+ if (b[0] != 100 || b[2] != 100) {
+ Tcl_Panic("MEMORY OVERWRITE IN Tcl_GetBoolFromObj");
+ return TCL_ERROR;
+ }
- freeCount = 0;
+ freeCount = 0;
objPtr = NULL; /* Lint. */
switch ((enum options) index) {
case RESULT_SMALL:
@@ -5335,7 +5342,7 @@ TestsaveresultCmd(
result = Tcl_EvalEx(interp, Tcl_GetString(objv[2]), -1, 0);
}
- if (discard) {
+ if (b[1]) {
Tcl_DiscardResult(&state);
} else {
Tcl_RestoreResult(interp, &state);
generated by cgit v0.12 at 2025-09-07 16:26:41 (GMT)