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.decls10
-rw-r--r--generic/tcl.h4
-rw-r--r--generic/tclDecls.h18
-rw-r--r--generic/tclGet.c26
-rw-r--r--generic/tclIndexObj.c8
-rw-r--r--generic/tclObj.c67
-rw-r--r--generic/tclStubInit.c4
-rw-r--r--generic/tclTestObj.c27
11 files changed, 146 insertions, 52 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 3b00f4a..95cecdf 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2502,8 +2502,14 @@ declare 673 {
int TclGetUniChar(Tcl_Obj *objPtr, int index)
}
-# slot 674 and 675 are reserved for TIP #618
-
+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 c8a76c5..dbe2b51 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -991,14 +991,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 62b9604..80131e8 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1983,8 +1983,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,
@@ -2718,8 +2722,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 */
@@ -4105,8 +4109,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..bb3f8f1 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,23 @@ Tcl_GetDouble(
*----------------------------------------------------------------------
*/
+#undef Tcl_GetBool
+#undef Tcl_GetBoolFromObj
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 +148,22 @@ 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. */
+{
+ return Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof(int), (char *)(void *)intPtr);
+}
/*
* Local Variables:
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index b564add..70c50cd 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_NULL_OK or TCL_INDEX_TEMP_TABLE */
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..4963b22 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -97,7 +97,7 @@ typedef struct {
static Tcl_ThreadDataKey dataKey;
-static void TclThreadFinalizeContLines(ClientData clientData);
+static void TclThreadFinalizeContLines(void *clientData);
static ThreadSpecificData *TclGetContLineTable(void);
/*
@@ -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,43 @@ 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) {
+ flags &= (TCL_NULL_OK-2);
+ if (flags) {
+ if (flags == (int)sizeof(int)) {
+ *(int *)charPtr = result;
+ return TCL_OK;
+ } else if (flags == (int)sizeof(short)) {
+ *(short *)charPtr = result;
+ return TCL_OK;
+ }
+ }
+ *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. */
+{
+ return Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof(int), (char *)(void *)intPtr);
+}
+
/*
*----------------------------------------------------------------------
*
@@ -3877,7 +3918,7 @@ int
TclGetNumberFromObj(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
- ClientData *clientDataPtr,
+ void **clientDataPtr,
int *typePtr)
{
do {
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index a3c5a49..c7f178f 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -2039,8 +2039,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/tclTestObj.c b/generic/tclTestObj.c
index 93af3c0..721237b 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -848,7 +848,7 @@ TestintobjCmd(
* level tests do not suffice as Tcl list commands do not execute
* the same exact code path as the exported C API.
*
- * Note these new commands are only useful when Tcl is compiled with
+ * Note these new commands are only useful when Tcl is compiled with
* TCL_MEM_DEBUG defined.
*
* indexmemcheck - loops calling Tcl_ListObjIndex on each element. This
@@ -887,7 +887,7 @@ TestlistobjCmd(
Tcl_Obj *const objv[]) /* Argument objects */
{
/* Subcommands supported by this command */
- const char* subcommands[] = {
+ const char* const subcommands[] = {
"set",
"get",
"replace",
@@ -907,12 +907,7 @@ TestlistobjCmd(
Tcl_WideInt first; /* First index in the list */
Tcl_WideInt count; /* Count of elements in a list */
Tcl_Obj **varPtr;
- int i;
-#if TCL_VERSION_MAJOR < 9
- int len;
-#else
- size_t len;
-#endif
+ int i, len;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg...?");
@@ -982,10 +977,9 @@ TestlistobjCmd(
return TCL_ERROR;
}
if (objP->refCount <= 0) {
- Tcl_SetResult(
- interp,
- "Tcl_ListObjIndex returned object with ref count <= 0",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Tcl_ListObjIndex returned object with ref count <= 0",
+ TCL_INDEX_NONE));
/* Keep looping since we are also looping for leaks */
}
}
@@ -1006,10 +1000,9 @@ TestlistobjCmd(
}
for (i = 0; i < len; ++i) {
if (elems[i]->refCount <= 0) {
- Tcl_SetResult(
- interp,
- "Tcl_ListObjGetElements element has ref count <= 0",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Tcl_ListObjGetElements element has ref count <= 0",
+ TCL_INDEX_NONE));
break;
}
}
@@ -1233,6 +1226,8 @@ TestobjCmd(
varPtr[varIndex]->typePtr->name, -1);
}
break;
+ default:
+ break;
}
return TCL_OK;
generated by cgit v0.12 at 2024-11-15 06:20:41 (GMT)