summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2009-08-19 23:23:21 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2009-08-19 23:23:21 (GMT)
commit13295adc2421cdeacbac60fd9556f3ab27c609d8 (patch)
treef1c663ab0ea380d9860116ae8b0bb639f96111ba /generic
parent0b0318425b93c4cab2b6a356d7f196dce6393883 (diff)
downloadtcl-13295adc2421cdeacbac60fd9556f3ab27c609d8.zip
tcl-13295adc2421cdeacbac60fd9556f3ab27c609d8.tar.gz
tcl-13295adc2421cdeacbac60fd9556f3ab27c609d8.tar.bz2
Interpreted [if] is now fully NRE-enabled. [Bug 2823276]
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCmdIL.c114
1 files changed, 78 insertions, 36 deletions
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 0049b18..274d9b8 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -16,7 +16,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdIL.c,v 1.168 2009/07/16 21:24:39 dgp Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.169 2009/08/19 23:23:22 dkf Exp $
*/
#include "tclInt.h"
@@ -104,6 +104,8 @@ typedef struct SortInfo {
*/
static int DictionaryCompare(const char *left, const char *right);
+static int IfConditionCallback(ClientData data[],
+ Tcl_Interp *interp, int result);
static int InfoArgsCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int InfoBodyCmd(ClientData dummy, Tcl_Interp *interp,
@@ -219,40 +221,55 @@ TclNRIfObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- int thenScriptIndex = 0; /* "then" script to be evaled after syntax
- * check. */
+ Tcl_Obj *boolObj;
+
+ if (objc <= 1) {
+ Tcl_AppendResult(interp, "wrong # args: no expression after \"",
+ TclGetString(objv[0]), "\" argument", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * At this point, objv[1] refers to the main expression to test. The
+ * arguments after the expression must be "then" (optional) and a script
+ * to execute if the expression is true.
+ */
+
+ TclNewObj(boolObj);
+ Tcl_NRAddCallback(interp, IfConditionCallback, INT2PTR(objc),
+ (ClientData) objv, INT2PTR(1), boolObj);
+ return Tcl_NRExprObj(interp, objv[1], boolObj);
+}
+
+static int
+IfConditionCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
Interp *iPtr = (Interp *) interp;
- int i, result, value;
+ int objc = PTR2INT(data[0]);
+ Tcl_Obj *const *objv = data[1];
+ int i = PTR2INT(data[2]);
+ Tcl_Obj *boolObj = data[3];
+ int value, thenScriptIndex = 0;
const char *clause;
- i = 1;
- while (1) {
- /*
- * At this point in the loop, objv and objc refer to an expression to
- * test, either for the main expression or an expression following an
- * "elseif". The arguments after the expression must be "then"
- * (optional) and a script to execute if the expression is true.
- */
+ if (result != TCL_OK) {
+ TclDecrRefCount(boolObj);
+ return result;
+ }
+ if (Tcl_GetBooleanFromObj(interp, boolObj, &value) != TCL_OK) {
+ TclDecrRefCount(boolObj);
+ return TCL_ERROR;
+ }
+ TclDecrRefCount(boolObj);
- if (i >= objc) {
- clause = TclGetString(objv[i-1]);
- Tcl_AppendResult(interp, "wrong # args: ",
- "no expression after \"", clause, "\" argument", NULL);
- return TCL_ERROR;
- }
- if (!thenScriptIndex) {
- result = Tcl_ExprBooleanObj(interp, objv[i], &value);
- if (result != TCL_OK) {
- return result;
- }
- }
+ while (1) {
i++;
if (i >= objc) {
- missingScript:
- clause = TclGetString(objv[i-1]);
- Tcl_AppendResult(interp, "wrong # args: ",
- "no script following \"", clause, "\" argument", NULL);
- return TCL_ERROR;
+ goto missingScript;
}
clause = TclGetString(objv[i]);
if ((i < objc) && (strcmp(clause, "then") == 0)) {
@@ -284,11 +301,30 @@ TclNRIfObjCmd(
return TCL_OK;
}
clause = TclGetString(objv[i]);
- if ((clause[0] == 'e') && (strcmp(clause, "elseif") == 0)) {
- i++;
- continue;
+ if ((clause[0] != 'e') || (strcmp(clause, "elseif") != 0)) {
+ break;
+ }
+ i++;
+
+ /*
+ * At this point in the loop, objv and objc refer to an expression to
+ * test, either for the main expression or an expression following an
+ * "elseif". The arguments after the expression must be "then"
+ * (optional) and a script to execute if the expression is true.
+ */
+
+ if (i >= objc) {
+ Tcl_AppendResult(interp, "wrong # args: ",
+ "no expression after \"", clause, "\" argument", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
+ return TCL_ERROR;
+ }
+ if (!thenScriptIndex) {
+ TclNewObj(boolObj);
+ Tcl_NRAddCallback(interp, IfConditionCallback, data[0], data[1],
+ INT2PTR(i), boolObj);
+ return Tcl_NRExprObj(interp, objv[i], boolObj);
}
- break;
}
/*
@@ -300,14 +336,13 @@ TclNRIfObjCmd(
if (strcmp(clause, "else") == 0) {
i++;
if (i >= objc) {
- Tcl_AppendResult(interp, "wrong # args: ",
- "no script following \"else\" argument", NULL);
- return TCL_ERROR;
+ goto missingScript;
}
}
if (i < objc - 1) {
Tcl_AppendResult(interp, "wrong # args: ",
"extra words after \"else\" clause in \"if\" command", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
return TCL_ERROR;
}
if (thenScriptIndex) {
@@ -319,6 +354,13 @@ TclNRIfObjCmd(
iPtr->cmdFramePtr, thenScriptIndex);
}
return TclNREvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr, i);
+
+ missingScript:
+ clause = TclGetString(objv[i-1]);
+ Tcl_AppendResult(interp, "wrong # args: no script following \"", clause,
+ "\" argument", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
+ return TCL_ERROR;
}
/*