summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2014-01-13 08:06:43 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2014-01-13 08:06:43 (GMT)
commitaa2c40934df3fdefbb39338f7eef44e79c3c551e (patch)
treeb9160847863784dfe55e508ea2eab9da956df310
parentc3c6e803684022dcc788ddbfc4a59a6d0dfde102 (diff)
downloadtcl-aa2c40934df3fdefbb39338f7eef44e79c3c551e.zip
tcl-aa2c40934df3fdefbb39338f7eef44e79c3c551e.tar.gz
tcl-aa2c40934df3fdefbb39338f7eef44e79c3c551e.tar.bz2
extend [string is] to booleans
-rw-r--r--generic/tclAssembly.c1
-rw-r--r--generic/tclCompCmdsSZ.c51
-rw-r--r--generic/tclCompile.c3
-rw-r--r--generic/tclCompile.h3
-rw-r--r--generic/tclExecute.c11
5 files changed, 64 insertions, 5 deletions
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 70379c6..f10bca8 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -478,6 +478,7 @@ static const TalInstDesc TalInstructionTable[] = {
{"tclooIsObject", ASSEM_1BYTE, INST_TCLOO_IS_OBJECT, 1, 1},
{"tclooNamespace", ASSEM_1BYTE, INST_TCLOO_NS, 1, 1},
{"tclooSelf", ASSEM_1BYTE, INST_TCLOO_SELF, 0, 1},
+ {"tryCvtToBoolean", ASSEM_1BYTE, INST_TRY_CVT_TO_BOOLEAN,1, 2},
{"tryCvtToNumeric", ASSEM_1BYTE, INST_TRY_CVT_TO_NUMERIC,1, 1},
{"uminus", ASSEM_1BYTE, INST_UMINUS, 1, 1},
{"unset", ASSEM_BOOL_LVT4,INST_UNSET_SCALAR, 0, 0},
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 1436a20..91bb94c 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -514,14 +514,57 @@ TclCompileStringIsCmd(
case STR_IS_UPPER:
case STR_IS_WORD:
case STR_IS_XDIGIT:
- /* Not yet implemented */
- return TCL_ERROR;
+ return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
case STR_IS_BOOL:
case STR_IS_FALSE:
case STR_IS_TRUE:
- /* Not yet implemented */
- return TCL_ERROR;
+ CompileWord(envPtr, tokenPtr, interp, parsePtr->numWords-1);
+ OP( TRY_CVT_TO_BOOLEAN);
+ switch (t) {
+ int over, over2;
+
+ case STR_IS_BOOL:
+ if (allowEmpty) {
+ JUMP1( JUMP_TRUE, over);
+ PUSH( "");
+ OP( STR_EQ);
+ JUMP1( JUMP, over2);
+ FIXJUMP1(over);
+ OP( POP);
+ PUSH( "1");
+ FIXJUMP1(over2);
+ } else {
+ OP4( REVERSE, 2);
+ OP( POP);
+ }
+ return TCL_OK;
+ case STR_IS_TRUE:
+ JUMP1( JUMP_TRUE, over);
+ if (allowEmpty) {
+ PUSH( "");
+ OP( STR_EQ);
+ } else {
+ OP( POP);
+ PUSH( "0");
+ }
+ FIXJUMP1( over);
+ OP( LNOT);
+ OP( LNOT);
+ return TCL_OK;
+ case STR_IS_FALSE:
+ JUMP1( JUMP_TRUE, over);
+ if (allowEmpty) {
+ PUSH( "");
+ OP( STR_NEQ);
+ } else {
+ OP( POP);
+ PUSH( "1");
+ }
+ FIXJUMP1( over);
+ OP( LNOT);
+ return TCL_OK;
+ }
case STR_IS_DOUBLE: {
int satisfied, isEmpty;
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index c01571f..39fa241 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -624,6 +624,9 @@ InstructionDesc const tclInstructionTable[] = {
{"numericType", 1, 0, 0, {OPERAND_NONE}},
/* Pushes the numeric type code of the word at the top of the stack.
* Stack: ... value => ... typeCode */
+ {"tryCvtToBoolean", 1, +1, 0, {OPERAND_NONE}},
+ /* Try converting stktop to boolean if possible. No errors.
+ * Stack: ... value => ... value isStrictBool */
{NULL, 0, 0, 0, {OPERAND_NONE}}
};
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 6bf5daf..a08a93a 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -793,9 +793,10 @@ typedef struct ByteCode {
#define INST_TCLOO_NEXT 179
#define INST_NUM_TYPE 180
+#define INST_TRY_CVT_TO_BOOLEAN 181
/* The last opcode */
-#define LAST_INST_OPCODE 180
+#define LAST_INST_OPCODE 181
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 2707ec1..989b7b6 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6461,6 +6461,17 @@ TEBCresume(
* -----------------------------------------------------------------
*/
+ case INST_TRY_CVT_TO_BOOLEAN:
+ valuePtr = OBJ_AT_TOS;
+ if (valuePtr->typePtr == &tclBooleanType) {
+ objResultPtr = TCONST(1);
+ } else {
+ int result = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
+ objResultPtr = TCONST(result);
+ }
+ TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr);
+ NEXT_INST_F(1, 0, 1);
+
case INST_BREAK:
/*
DECACHE_STACK_INFO();