diff options
| -rw-r--r-- | generic/tclAssembly.c | 1 | ||||
| -rw-r--r-- | generic/tclCompCmdsSZ.c | 51 | ||||
| -rw-r--r-- | generic/tclCompile.c | 3 | ||||
| -rw-r--r-- | generic/tclCompile.h | 3 | ||||
| -rw-r--r-- | generic/tclExecute.c | 11 |
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(); |