* tests/assemble.test: Added more "white box" tests.

* generic/tclAssembly.c: Fixed bugs exposed by the new tests.
(a) [eval] and [expr] had incorrect stack balance computed if
the arg was not a simple word. (b) [concat] accepted a negative
operand count. (c) [invoke] accepted a zero or negative operand
count. (d) more misspelt error messages.

1 files changed, 43 insertions, 16 deletions

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index c83f5d6..660f101 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -50,6 +50,7 @@ static int CheckNamespaceQualifiers(Tcl_Interp*, const char*, int);
 static int CheckOneByte(Tcl_Interp*, int);
 static int CheckSignedOneByte(Tcl_Interp*, int);
 static int CheckStack(AssembleEnv*);
+static int CheckStrictlyPositive(Tcl_Interp*, int);
 static ByteCode * CompileAssembleObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
 static int DefineLabel(AssembleEnv* envPtr, const char* label);
 static void DupAssembleCodeInternalRep(Tcl_Obj* src, Tcl_Obj* dest);
@@ -130,7 +131,7 @@ talInstDesc talInstructionTable[] = {
     {"div",     ASSEM_1BYTE,    INST_DIV,       2,      1},
     {"dup",     ASSEM_1BYTE ,   INST_DUP    ,   1   ,   2}, 
     {"eq",      ASSEM_1BYTE ,   INST_EQ     ,   2   ,   1},
-    {"eval",	ASSEM_EVAL,	INST_EVAL_STK,	0,	1},
+    {"eval",	ASSEM_EVAL,	INST_EVAL_STK,	1,	1},
     {"evalStk",	ASSEM_1BYTE,	INST_EVAL_STK,	1,	1},
     {"exist",	ASSEM_LVT4,	INST_EXIST_SCALAR,
                                                 0,      1},
@@ -143,7 +144,7 @@ talInstDesc talInstructionTable[] = {
     {"existStk",
 		ASSEM_1BYTE,	INST_EXIST_STK,	1,	1},
     {"expon",   ASSEM_1BYTE,    INST_EXPON,     2,      1},
-    {"expr",	ASSEM_EVAL,	INST_EXPR_STK,	0,	1},
+    {"expr",	ASSEM_EVAL,	INST_EXPR_STK,	1,	1},
     {"exprStk", ASSEM_1BYTE,	INST_EXPR_STK,	1,	1},
     {"ge",      ASSEM_1BYTE ,   INST_GE     ,   2   ,   1},
     {"gt",      ASSEM_1BYTE ,   INST_GT     ,   2   ,   1},
@@ -1023,15 +1024,8 @@ AssembleOneLine(AssembleEnv* assemEnvPtr)
 	    goto cleanup;
 	}
 	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
-	    || CheckOneByte(interp, opnd) != TCL_OK) {
-	    goto cleanup;
-	}
-	if (opnd == 0) {
-	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
-		Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot concatenate "
-							  "zero objects", -1));
-		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "EMPTYCONCAT", NULL);
-	    }
+	    || CheckOneByte(interp, opnd) != TCL_OK
+	    || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
 	    goto cleanup;
 	}
 	BBEmitInstInt1(assemEnvPtr, tblind, opnd, opnd);
@@ -1093,10 +1087,11 @@ AssembleOneLine(AssembleEnv* assemEnvPtr)
 	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
 	    goto cleanup;
 	}
-	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK
-	    || Tcl_GetIntFromObj(interp, operand1Obj, &opnd) != TCL_OK) {
+	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+	    || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
 	    goto cleanup;
 	}
+	
 	BBEmitInst1or4(assemEnvPtr, tblind, opnd, opnd);
 	break;
 		 
@@ -1583,7 +1578,7 @@ CheckOneByte(Tcl_Interp* interp,
     if (value < 0 || value > 0xff) {
 	result = Tcl_NewStringObj("operand does not fit in one byte", -1);
 	Tcl_SetObjResult(interp, result);
-	Tcl_SetErrorCode(interp, "TCL", "ASSEMBLE", "1BYTE", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -1615,9 +1610,41 @@ CheckSignedOneByte(Tcl_Interp* interp,
 {
     Tcl_Obj* result;		/* Error message */
     if (value > 0x7f || value < -0x80) {
-	result = Tcl_NewStringObj("operand does not fit in 1 byte", -1);
+	result = Tcl_NewStringObj("operand does not fit in one byte", -1);
+	Tcl_SetObjResult(interp, result);
+	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CheckStrictlyPositive --
+ *
+ *	Verify that a constant is positive
+ *
+ * Results:
+ *	On success, returns TCL_OK. On failure, returns TCL_ERROR and
+ *	stores an error message in the interpreter result.
+ *
+ * This code is here primarily to verify that instructions like INCR_INVOKE
+ * are consuming a positive number of operands
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CheckStrictlyPositive(Tcl_Interp* interp,
+				/* Tcl interpreter for error reporting */
+		      int value)	/* Value to check */
+{
+    Tcl_Obj* result;		/* Error message */
+    if (value <= 0) {
+	result = Tcl_NewStringObj("operand must be positive", -1);
 	Tcl_SetObjResult(interp, result);
-	Tcl_SetErrorCode(interp, "TCL", "ASSEMBLE", "1BYTE", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "POSITIVE", NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;