summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c6
-rw-r--r--generic/tclCompCmds.c6
-rw-r--r--generic/tclDictObj.c4
-rw-r--r--generic/tclExecute.c10
-rw-r--r--generic/tclGet.c7
-rw-r--r--generic/tclInt.h4
-rw-r--r--generic/tclObj.c62
7 files changed, 34 insertions, 65 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 43a0a2a..8df8d17 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.146 2005/04/21 21:24:03 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.147 2005/04/22 15:46:52 dgp Exp $
*/
#include "tclInt.h"
@@ -4042,7 +4042,7 @@ Tcl_ExprBoolean(interp, string, ptr)
/*
* Store a boolean based on the expression result.
*/
- result = TclGetTruthValueFromObj(interp, resultPtr, ptr);
+ result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr);
Tcl_DecrRefCount(resultPtr); /* discard the result object */
}
if (result != TCL_OK) {
@@ -4152,7 +4152,7 @@ Tcl_ExprBooleanObj(interp, objPtr, ptr)
result = Tcl_ExprObj(interp, objPtr, &resultPtr);
if (result == TCL_OK) {
- result = TclGetTruthValueFromObj(interp, resultPtr, ptr);
+ result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr);
Tcl_DecrRefCount(resultPtr); /* discard the result object */
}
return result;
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index def3851..b04c845 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompCmds.c,v 1.63 2005/04/21 21:24:07 dgp Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.64 2005/04/22 15:46:53 dgp Exp $
*/
#include "tclInt.h"
@@ -1113,7 +1113,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
Tcl_Obj *boolObj = Tcl_NewStringObj(testTokenPtr[1].start,
testTokenPtr[1].size);
Tcl_IncrRefCount(boolObj);
- code = TclGetTruthValueFromObj(NULL, boolObj, &boolVal);
+ code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
Tcl_DecrRefCount(boolObj);
if (code == TCL_OK) {
/*
@@ -3247,7 +3247,7 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
boolObj = Tcl_NewStringObj(testTokenPtr[1].start, testTokenPtr[1].size);
Tcl_IncrRefCount(boolObj);
- code = TclGetTruthValueFromObj(NULL, boolObj, &boolVal);
+ code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
Tcl_DecrRefCount(boolObj);
if (code == TCL_OK) {
if (boolVal) {
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 043e1d3..2f1b1cd 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclDictObj.c,v 1.28 2005/04/21 21:29:18 dgp Exp $
+ * RCS: @(#) $Id: tclDictObj.c,v 1.29 2005/04/22 15:46:54 dgp Exp $
*/
#include "tclInt.h"
@@ -2645,7 +2645,7 @@ DictFilterCmd(interp, objc, objv)
boolObj = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(boolObj);
Tcl_ResetResult(interp);
- if (TclGetTruthValueFromObj(interp, boolObj,
+ if (Tcl_GetBooleanFromObj(interp, boolObj,
&satisfied) != TCL_OK) {
TclDecrRefCount(boolObj);
result = TCL_ERROR;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 961566c..8e4a04d 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclExecute.c,v 1.183 2005/04/21 20:24:11 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.184 2005/04/22 15:46:54 dgp Exp $
*/
#include "tclInt.h"
@@ -2539,7 +2539,7 @@ TclExecuteByteCode(interp, codePtr)
*/
int b1;
- result = TclGetTruthValueFromObj(interp, valuePtr, &b1);
+ result = Tcl_GetBooleanFromObj(interp, valuePtr, &b1);
if (result != TCL_OK) {
if ((*pc == INST_JUMP_FALSE1) || (*pc == INST_JUMP_FALSE4)) {
jmpOffset[1] = jmpOffset[0];
@@ -2616,7 +2616,7 @@ TclExecuteByteCode(interp, codePtr)
i1 = (w != W0);
}
} else {
- result = TclGetTruthValueFromObj((Tcl_Interp *) NULL,
+ result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL,
valuePtr, &i1);
i1 = (i1 != 0);
}
@@ -2647,7 +2647,7 @@ TclExecuteByteCode(interp, codePtr)
i2 = (w != W0);
}
} else {
- result = TclGetTruthValueFromObj((Tcl_Interp *) NULL, value2Ptr, &i2);
+ result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL, value2Ptr, &i2);
}
if (result != TCL_OK) {
TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr),
@@ -4302,7 +4302,7 @@ TclExecuteByteCode(interp, codePtr)
valuePtr, &d);
}
if (result == TCL_ERROR && *pc == INST_LNOT) {
- result = TclGetTruthValueFromObj((Tcl_Interp *)NULL,
+ result = Tcl_GetBooleanFromObj((Tcl_Interp *)NULL,
valuePtr, &boolvar);
i = (long)boolvar; /* i is long, not int! */
}
diff --git a/generic/tclGet.c b/generic/tclGet.c
index bad8289..bfc3501 100644
--- a/generic/tclGet.c
+++ b/generic/tclGet.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclGet.c,v 1.12 2005/04/21 20:24:13 dgp Exp $
+ * RCS: @(#) $Id: tclGet.c,v 1.13 2005/04/22 15:46:57 dgp Exp $
*/
#include "tclInt.h"
@@ -183,9 +183,12 @@ Tcl_GetBoolean(interp, str, boolPtr)
obj.length = strlen(str);
obj.typePtr = NULL;
- code = Tcl_GetBooleanFromObj(interp, &obj, boolPtr);
+ code = Tcl_ConvertToType(interp, &obj, &tclBooleanType);
if (obj.refCount > 1) {
Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
+ if (code == TCL_OK) {
+ *boolPtr = obj.internalRep.longValue;
+ }
return code;
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 68c2827..727b879 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.224 2005/04/21 20:24:13 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.225 2005/04/22 15:46:57 dgp Exp $
*/
#ifndef _TCLINT
@@ -1892,8 +1892,6 @@ MODULE_SCOPE int TclGetNamespaceFromObj _ANSI_ARGS_((
MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue _ANSI_ARGS_ ((
ProcessGlobalValue *pgvPtr));
-MODULE_SCOPE int TclGetTruthValueFromObj _ANSI_ARGS_ ((
- Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr));
MODULE_SCOPE int TclGlob _ANSI_ARGS_((Tcl_Interp *interp,
char *pattern, Tcl_Obj *unquotedPrefix,
int globFlags, Tcl_GlobTypeData* types));
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 42acb01..bc073c2 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclObj.c,v 1.80 2005/04/21 20:35:04 dgp Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.81 2005/04/22 15:46:59 dgp Exp $
*/
#include "tclInt.h"
@@ -1233,50 +1233,6 @@ Tcl_SetBooleanObj(objPtr, boolValue)
*
* Tcl_GetBooleanFromObj --
*
- * Attempt to return a boolean from the Tcl object "objPtr". If the
- * object is not already of the "boolean" Tcl_ObjType, an attempt
- * will be made to convert it to one.
- *
- * Note that only exact boolean values are recognized, not all
- * numeric values (use TclGetTruthValueFromObj() for that).
- *
- * Results:
- * The return value is a standard Tcl object result. If an error occurs
- * during conversion, an error message is left in the interpreter's
- * result unless "interp" is NULL.
- *
- * Side effects:
- * If the object is not already a boolean, the conversion will free
- * any old internal representation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr; /* The object from which to get boolean. */
- register int *boolPtr; /* Place to store resulting boolean. */
-{
- register int result;
-
- if (objPtr->typePtr == &tclBooleanType) {
- result = TCL_OK;
- } else {
- result = SetBooleanFromAny(interp, objPtr);
- }
-
- if (result == TCL_OK) {
- *boolPtr = (int) objPtr->internalRep.longValue;
- }
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetTruthValueFromObj --
- *
* Attempt to return a boolean from the Tcl object "objPtr". This
* includes conversion from any of Tcl's numeric types.
*
@@ -1292,7 +1248,7 @@ Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
*/
int
-TclGetTruthValueFromObj(interp, objPtr, boolPtr)
+Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
Tcl_Interp *interp; /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr; /* The object from which to get boolean. */
register int *boolPtr; /* Place to store resulting boolean. */
@@ -1300,12 +1256,19 @@ TclGetTruthValueFromObj(interp, objPtr, boolPtr)
double d;
long l;
+ if (objPtr->typePtr == &tclBooleanType) {
+ *boolPtr = (int) objPtr->internalRep.longValue;
+ return TCL_OK;
+ }
/*
* The following call retrieves a numeric value without shimmering
* away any existing numeric intrep Tcl_ObjTypes.
*/
if (Tcl_GetDoubleFromObj(NULL, objPtr, &d) == TCL_OK) {
*boolPtr = (d != 0.0);
+
+ /* Attempt shimmer to "boolean" objType */
+ SetBooleanFromAny(NULL, objPtr);
return TCL_OK;
}
/*
@@ -1331,8 +1294,13 @@ TclGetTruthValueFromObj(interp, objPtr, boolPtr)
#endif
/*
* Finally, check for the string values like "yes"
+ * and generate error message for non-boolean values.
*/
- return Tcl_GetBooleanFromObj(interp, objPtr, boolPtr);
+ if (SetBooleanFromAny(interp, objPtr) == TCL_OK) {
+ *boolPtr = (int) objPtr->internalRep.longValue;
+ return TCL_OK;
+ }
+ return TCL_ERROR;
}
/*
generated by cgit v0.12 at 2024-11-06 13:52:31 (GMT)