summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/BoolObj.317
-rw-r--r--doc/GetIndex.34
-rw-r--r--doc/GetInt.313
-rw-r--r--generic/tcl.decls8
-rw-r--r--generic/tcl.h4
-rw-r--r--generic/tclDecls.h18
-rw-r--r--generic/tclGet.c30
-rw-r--r--generic/tclIndexObj.c8
-rw-r--r--generic/tclObj.c58
-rw-r--r--generic/tclStubInit.c4
-rw-r--r--generic/tclTest.c11
11 files changed, 138 insertions, 37 deletions
diff --git a/doc/BoolObj.3 b/doc/BoolObj.3
index c05048c..47a2189 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
@@ -21,6 +21,9 @@ Tcl_Obj *
.sp
int
\fBTcl_GetBooleanFromObj\fR(\fIinterp, objPtr, intPtr\fR)
+.sp
+int
+\fBTcl_GetBoolFromObj\fR(\fIinterp, objPtr, flags. charPtr\fR)
.SH ARGUMENTS
.AS Tcl_Interp intValue in/out
.AP int intValue in
@@ -35,6 +38,13 @@ unless \fIinterp\fR is NULL.
.AP int *intPtr out
Points to place where \fBTcl_GetBooleanFromObj\fR
stores the boolean value (0 or 1) obtained from \fIobjPtr\fR.
+.AP char *charPtr out
+Points to place where \fBTcl_GetBoolFromObj\fR
+stores the boolean value (0 or 1) obtained from \fIobjPtr\fR.
+.AP int flags in
+0 or 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 *charPtr filled with the value \fB'\exFF'\fR;
.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 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 4b486de..f15c12d 100644
--- a/doc/GetInt.3
+++ b/doc/GetInt.3
@@ -22,6 +22,9 @@ int
.sp
int
\fBTcl_GetBoolean\fR(\fIinterp, src, intPtr\fR)
+.sp
+int
+\fBTcl_GetBool\fR(\fIinterp, src, flags, charPtr\fR)
.SH ARGUMENTS
.AS Tcl_Interp *doublePtr out
.AP Tcl_Interp *interp in
@@ -33,6 +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 char *charPtr out
+Points to place to store boolean value (0 or 1) value converted from \fIsrc\fR.
+.AP int flags in
+0 or 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 *charPtr filled with the value \fB'\exFF'\fR;
.BE
.SH DESCRIPTION
@@ -97,6 +106,10 @@ If \fIsrc\fR is any of \fB1\fR, \fBtrue\fR, \fByes\fR, or \fBon\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 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 d08ba0a..680a24d 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2502,6 +2502,14 @@ declare 673 {
int TclGetUniChar(Tcl_Obj *objPtr, int index)
}
+declare 674 {
+ int Tcl_GetBool(Tcl_Interp *interp, const char *src, int flags,
+ char *charPtr)
+}
+declare 675 {
+ int Tcl_GetBoolFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ int flags, char *charPtr)
+}
declare 676 {
Tcl_Command Tcl_CreateObjCommand2(Tcl_Interp *interp,
const char *cmdName,
diff --git a/generic/tcl.h b/generic/tcl.h
index f17d43e..5a04aa0 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -989,14 +989,14 @@ typedef struct Tcl_DString {
/*
* Flags that may be passed to Tcl_GetIndexFromObj.
* TCL_EXACT disallows abbreviated strings.
- * 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;
* 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.
*/
#define TCL_EXACT 1
-#define TCL_INDEX_NULL_OK 32
+#define TCL_NULL_OK 32
#define TCL_INDEX_TEMP_TABLE 64
/*
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 3917d0f..47ca48c 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1975,8 +1975,12 @@ EXTERN const char * TclUtfAtIndex(const char *src, int index);
EXTERN Tcl_Obj * TclGetRange(Tcl_Obj *objPtr, int first, int last);
/* 673 */
EXTERN int TclGetUniChar(Tcl_Obj *objPtr, int index);
-/* Slot 674 is reserved */
-/* Slot 675 is reserved */
+/* 674 */
+EXTERN int Tcl_GetBool(Tcl_Interp *interp, const char *src,
+ int flags, char *charPtr);
+/* 675 */
+EXTERN int Tcl_GetBoolFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, int flags, char *charPtr);
/* 676 */
EXTERN Tcl_Command Tcl_CreateObjCommand2(Tcl_Interp *interp,
const char *cmdName, Tcl_ObjCmdProc2 *proc2,
@@ -2705,8 +2709,8 @@ typedef struct TclStubs {
const char * (*tclUtfAtIndex) (const char *src, int index); /* 671 */
Tcl_Obj * (*tclGetRange) (Tcl_Obj *objPtr, int first, int last); /* 672 */
int (*tclGetUniChar) (Tcl_Obj *objPtr, int index); /* 673 */
- void (*reserved674)(void);
- void (*reserved675)(void);
+ int (*tcl_GetBool) (Tcl_Interp *interp, const char *src, int flags, char *charPtr); /* 674 */
+ int (*tcl_GetBoolFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, char *charPtr); /* 675 */
Tcl_Command (*tcl_CreateObjCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 676 */
Tcl_Trace (*tcl_CreateObjTrace2) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc2 *objProc2, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 677 */
Tcl_Command (*tcl_NRCreateCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 678 */
@@ -4089,8 +4093,10 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tclGetRange) /* 672 */
#define TclGetUniChar \
(tclStubsPtr->tclGetUniChar) /* 673 */
-/* Slot 674 is reserved */
-/* Slot 675 is reserved */
+#define Tcl_GetBool \
+ (tclStubsPtr->tcl_GetBool) /* 674 */
+#define Tcl_GetBoolFromObj \
+ (tclStubsPtr->tcl_GetBoolFromObj) /* 675 */
#define Tcl_CreateObjCommand2 \
(tclStubsPtr->tcl_CreateObjCommand2) /* 676 */
#define Tcl_CreateObjTrace2 \
diff --git a/generic/tclGet.c b/generic/tclGet.c
index 905038f..3c458dc 100644
--- a/generic/tclGet.c
+++ b/generic/tclGet.c
@@ -110,7 +110,7 @@ Tcl_GetDouble(
* string.
*
* Results:
- * The return value is normally TCL_OK; in this case *intPtr will be set
+ * The return value is normally TCL_OK; in this case *charPtr will be set
* to the 0/1 value equivalent to src. If src is improperly formed then
* TCL_ERROR is returned and an error message will be left in the
* interp's result.
@@ -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 *intPtr) /* Place to store converted result, which will
+ int flags,
+ char *charPtr) /* 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, charPtr);
+ }
obj.refCount = 1;
obj.bytes = (char *) src;
obj.length = strlen(src);
@@ -142,10 +147,27 @@ Tcl_GetBoolean(
Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
if (code == TCL_OK) {
- TclGetBooleanFromObj(NULL, &obj, intPtr);
+ (Tcl_GetBoolFromObj)(NULL, &obj, flags, charPtr);
}
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 *intPtr) /* Place to store converted result, which will
+ * be 0 or 1. */
+{
+ char charValue;
+ int result = Tcl_GetBool(interp, src, 0, &charValue);
+ if (intPtr) {
+ *intPtr = charValue;
+ }
+ return result;
+}
/*
* Local Variables:
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index b564add..a9d9518 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;
}
/*
@@ -412,7 +412,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) {
@@ -421,7 +421,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/tclObj.c b/generic/tclObj.c
index 5726596..4a9fb7e 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -2141,7 +2141,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.
@@ -2157,20 +2157,36 @@ 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 *intPtr) /* Place to store resulting boolean. */
+ int flags,
+ char *charPtr) /* 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, (flags & TCL_NULL_OK)
+ ? "boolean value or \"\"" : "boolean value", NULL, -1, NULL, 0);
+ Tcl_DecrRefCount(objPtr);
+ }
+ return TCL_ERROR;
+ }
do {
if (objPtr->typePtr == &tclIntType) {
- *intPtr = (objPtr->internalRep.wideValue != 0);
- return TCL_OK;
+ result = (objPtr->internalRep.wideValue != 0);
+ goto boolEnd;
}
if (objPtr->typePtr == &tclBooleanType) {
- *intPtr = objPtr->internalRep.longValue != 0;
- return TCL_OK;
+ result = objPtr->internalRep.longValue != 0;
+ goto boolEnd;
}
if (objPtr->typePtr == &tclDoubleType) {
/*
@@ -2186,18 +2202,38 @@ Tcl_GetBooleanFromObj(
if (Tcl_GetDoubleFromObj(interp, objPtr, &d) != TCL_OK) {
return TCL_ERROR;
}
- *intPtr = (d != 0.0);
- return TCL_OK;
+ result = (d != 0.0);
+ goto boolEnd;
}
if (objPtr->typePtr == &tclBignumType) {
- *intPtr = 1;
+ result = 1;
+ boolEnd:
+ if (charPtr != NULL) {
+ *charPtr = result;
+ }
return TCL_OK;
}
} while ((ParseBoolean(objPtr) == TCL_OK) || (TCL_OK ==
- TclParseNumber(interp, objPtr, "boolean value", NULL,-1,NULL,0)));
+ TclParseNumber(interp, objPtr, (flags & TCL_NULL_OK)
+ ? "boolean value or \"\"" : "boolean value", NULL,-1,NULL,0)));
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 *intPtr) /* Place to store resulting boolean. */
+{
+ char charValue;
+ int result = Tcl_GetBoolFromObj(interp, objPtr, 0, &charValue);
+ if (intPtr) {
+ *intPtr = charValue;
+ }
+ return result;
+}
+
/*
*----------------------------------------------------------------------
*
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index ae00b04..829b9c1 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -2037,8 +2037,8 @@ const TclStubs tclStubs = {
TclUtfAtIndex, /* 671 */
TclGetRange, /* 672 */
TclGetUniChar, /* 673 */
- 0, /* 674 */
- 0, /* 675 */
+ Tcl_GetBool, /* 674 */
+ Tcl_GetBoolFromObj, /* 675 */
Tcl_CreateObjCommand2, /* 676 */
Tcl_CreateObjTrace2, /* 677 */
Tcl_NRCreateCommand2, /* 678 */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index f6515c1..3345fcb 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -2317,7 +2317,7 @@ TesteventProc(
Tcl_Obj *command = ev->command;
int result = Tcl_EvalObjEx(interp, command,
TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
- int retval;
+ char retval;
if (result != TCL_OK) {
Tcl_AddErrorInfo(interp,
@@ -2325,8 +2325,8 @@ 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),
+ 0, &retval) != TCL_OK) {
Tcl_AddErrorInfo(interp,
" (return value from \"testevent\" callback)");
Tcl_BackgroundException(interp, TCL_ERROR);
@@ -5521,7 +5521,8 @@ TestsaveresultCmd(
Tcl_Obj *const objv[]) /* The argument objects. */
{
Interp* iPtr = (Interp*) interp;
- int discard, result, index;
+ int result, index;
+ char discard;
Tcl_SavedResult state;
Tcl_Obj *objPtr;
static const char *const optionStrings[] = {
@@ -5543,7 +5544,7 @@ TestsaveresultCmd(
&index) != TCL_OK) {
return TCL_ERROR;
}
- if (Tcl_GetBooleanFromObj(interp, objv[3], &discard) != TCL_OK) {
+ if (Tcl_GetBoolFromObj(interp, objv[3], 0, &discard) != TCL_OK) {
return TCL_ERROR;
}
generated by cgit v0.12 at 2025-12-09 09:06:29 (GMT)