From ae37f9b450b457ba32bf5e217d37ff30fac41799 Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Wed, 12 Jun 2024 19:01:35 +0000
Subject: more fixes for [f05f5ef759c1f7f9]: don't swallow expr errors, further
 code review and simplification

---
 generic/tclCmdIL.c | 173 ++++++++++++++++++++++++-----------------------------
 tests/lseq.test    |  13 +++-
 2 files changed, 87 insertions(+), 99 deletions(-)

diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 135ee28..19bc596 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -101,11 +101,11 @@ typedef struct {
 static const char *const seq_operations[] = {
     "..", "to", "count", "by", NULL
 };
-typedef enum Sequence_Operators {
+typedef enum {
     LSEQ_DOTS, LSEQ_TO, LSEQ_COUNT, LSEQ_BY
 } SequenceOperators;
-typedef enum Sequence_Decoded {
-     NoneArg, NumericArg, RangeKeywordArg
+typedef enum {
+     NoneArg, NumericArg, RangeKeywordArg, ErrArg, LastArg = 8
 } SequenceDecoded;
 
 /*
@@ -4020,47 +4020,54 @@ static SequenceDecoded
 SequenceIdentifyArgument(
      Tcl_Interp *interp,        /* for error reporting  */
      Tcl_Obj *argPtr,           /* Argument to decode   */
+     int allowedArgs,		/* Flags if keyword or numeric allowed. */
      Tcl_Obj **numValuePtr,     /* Return numeric value */
      int *keywordIndexPtr)      /* Return keyword enum  */
 {
-    int result;
+    int result = TCL_ERROR;
     SequenceOperators opmode;
     void *internalPtr;
 
-    result = Tcl_GetNumberFromObj(NULL, argPtr, &internalPtr, keywordIndexPtr);
-    if (result == TCL_OK) {
-	*numValuePtr = argPtr;
-	Tcl_IncrRefCount(argPtr);
-	return NumericArg;
+    if (allowedArgs & NumericArg) {
+	result = Tcl_GetNumberFromObj(NULL, argPtr, &internalPtr, keywordIndexPtr);
+	if (result == TCL_OK) {
+	    *numValuePtr = argPtr;
+	    Tcl_IncrRefCount(argPtr);
+	    return NumericArg;
+	}
+    }
+    if (allowedArgs & RangeKeywordArg) {
+	result = Tcl_GetIndexFromObj(NULL, argPtr, seq_operations,
+			"range operation", 0, &opmode);
     }
-
-    result = Tcl_GetIndexFromObj(NULL, argPtr, seq_operations,
-				 "range operation", 0, &opmode);
     if (result == TCL_OK) {
+	if (allowedArgs & LastArg) {
+	    /* keyword found, but no followed number */
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		  "missing \"%s\" value.", TclGetString(argPtr)));
+	    return ErrArg;
+	}
 	*keywordIndexPtr = opmode;
 	return RangeKeywordArg;
     } else {
-	/* Check for an index expression */
-	SequenceDecoded ret = NoneArg;
 	Tcl_Obj *exprValueObj;
+	if (!(allowedArgs & NumericArg)) {
+	    return NoneArg;
+	}
+	/* Check for an index expression */
 	int keyword;
-	Tcl_InterpState savedstate;
-	savedstate = Tcl_SaveInterpState(interp, result);
 	if (Tcl_ExprObj(interp, argPtr, &exprValueObj) != TCL_OK) {
-	    goto done;
+	    return ErrArg;
 	}
 	/* Determine if result of expression is double or int */
-	if (Tcl_GetNumberFromObj(NULL, exprValueObj, &internalPtr,
+	if (Tcl_GetNumberFromObj(interp, exprValueObj, &internalPtr,
 		&keyword) != TCL_OK
 	) {
-	    goto done;
+	    return ErrArg;
 	}
 	*numValuePtr = exprValueObj; /* incremented in Tcl_ExprObj */
 	*keywordIndexPtr = keyword; /* type of expression result */
-	ret = NumericArg;
-    done:
-	(void)Tcl_RestoreInterpState(interp, savedstate);
-	return ret;
+	return NumericArg;
     }
 }
 
@@ -4112,7 +4119,8 @@ Tcl_LseqObjCmd(
     Tcl_WideInt values[5];
     Tcl_Obj *numValues[5];
     Tcl_Obj *numberObj;
-    int status, keyword, useDoubles = 0;
+    int status, keyword, useDoubles = 0, allowedArgs = NumericArg;
+    int remNums = 3;
     Tcl_Obj *arithSeriesPtr;
     SequenceOperators opmode;
     SequenceDecoded decoded;
@@ -4127,42 +4135,50 @@ Tcl_LseqObjCmd(
      * digit.
      */
     if (objc > 6) {
-	 /* Too many arguments */
-	 arg_key=0;
-    } else for (i=1; i<objc; i++) {
-	 arg_key = (arg_key * 10);
-	 numValues[value_i] = NULL;
-	 decoded = SequenceIdentifyArgument(interp, objv[i], &numberObj, &keyword);
-	 switch (decoded) {
-
-	 case NoneArg:
-	      /*
-	       * Unrecognizable argument
-	       * Reproduce operation error message
-	       */
-	      status = Tcl_GetIndexFromObj(interp, objv[i], seq_operations,
-		           "operation", 0, &opmode);
-	      goto done;
-
-	 case NumericArg:
-	      arg_key += NumericArg;
-	      numValues[value_i] = numberObj;
-	      values[value_i] = keyword;  // This is the TCL_NUMBER_* value
-	      useDoubles = useDoubles ? useDoubles : keyword == TCL_NUMBER_DOUBLE;
-	      value_i++;
-	      break;
-
-	 case RangeKeywordArg:
-	      arg_key += RangeKeywordArg;
-	      values[value_i] = keyword;
-	      value_i++;
-	      break;
-
-	 default:
-	      arg_key += 9; // Error state
-	      value_i++;
-	      break;
-	 }
+	/* Too many arguments */
+	goto syntax;
+    }
+    for (i = 1; i < objc; i++) {
+	arg_key = (arg_key * 10);
+	numValues[value_i] = NULL;
+	decoded = SequenceIdentifyArgument(interp, objv[i],
+			allowedArgs | (i == objc-1 ? LastArg : 0),
+			&numberObj, &keyword);
+	switch (decoded) {
+	  case NoneArg:
+	    /*
+	     * Unrecognizable argument
+	     * Reproduce operation error message
+	     */
+	    status = Tcl_GetIndexFromObj(interp, objv[i], seq_operations,
+			"operation", 0, &opmode);
+	    goto done;
+
+	  case NumericArg:
+	    remNums--;
+	    arg_key += NumericArg;
+	    allowedArgs = RangeKeywordArg;
+	    /* if last number but 2 arguments remain, next is not numeric */
+	    if ((remNums != 1) || ((objc-1-i) != 2)) {
+		allowedArgs |= NumericArg;
+	    }
+	    numValues[value_i] = numberObj;
+	    values[value_i] = keyword;  /* TCL_NUMBER_* */
+	    useDoubles |= (keyword == TCL_NUMBER_DOUBLE) ? 1 : 0;
+	    value_i++;
+	    break;
+
+	  case RangeKeywordArg:
+	    arg_key += RangeKeywordArg;
+	    allowedArgs = NumericArg;   /* after keyword always numeric only */
+	    values[value_i] = keyword;  /* SequenceOperators */
+	    value_i++;
+	    break;
+
+	  default: /* Error state */
+	    status = TCL_ERROR;
+	    goto done;
+	}
     }
 
     /*
@@ -4171,14 +4187,6 @@ Tcl_LseqObjCmd(
      */
     switch (arg_key) {
 
-/*    No argument */
-    case 0:
-	 Tcl_WrongNumArgs(interp, 1, objv,
-	     "n ??op? n ??by? n??");
-	 status = TCL_ERROR;
-	 goto done;
-	 break;
-
 /*    lseq n */
     case 1:
 	start = zero;
@@ -4306,36 +4314,9 @@ Tcl_LseqObjCmd(
 	}
 	break;
 
-/*    Error cases: incomplete arguments */
-    case 12:
-	 opmode = (SequenceOperators)values[1]; goto KeywordError; break;
-    case 112:
-	 opmode = (SequenceOperators)values[2]; goto KeywordError; break;
-    case 1212:
-	 opmode = (SequenceOperators)values[3]; goto KeywordError; break;
-    KeywordError:
-	 status = TCL_ERROR;
-	 switch (opmode) {
-	 case LSEQ_DOTS:
-	 case LSEQ_TO:
-	      Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		  "missing \"to\" value."));
-	      break;
-	 case LSEQ_COUNT:
-	      Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		  "missing \"count\" value."));
-	      break;
-	 case LSEQ_BY:
-	      Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		  "missing \"by\" value."));
-	      break;
-	 }
-	 status = TCL_ERROR;
-	 goto done;
-	 break;
-
 /*    All other argument errors */
     default:
+      syntax:
 	 Tcl_WrongNumArgs(interp, 1, objv, "n ??op? n ??by? n??");
 	 status = TCL_ERROR;
 	 goto done;
diff --git a/tests/lseq.test b/tests/lseq.test
index 72f765f..09d4885 100644
--- a/tests/lseq.test
+++ b/tests/lseq.test
@@ -262,6 +262,10 @@ test lseq-2.20 {expressions as indices, no duplicative eval of expr} {
     list [lseq {[incr i]}] $i [lseq {0 + [incr i]}] $i [lseq {0.0 + [incr i]}] $i
 } {{0 1} 2 {0 1 2} 3 {0.0 1.0 2.0 3.0} 4}
 
+test lseq-3.0 {expr error: don't swalow expr error (here: divide by zero)} -body {
+    set i 0; lseq {3/$i}
+} -returnCodes [catch {expr {3/0}} res] -result $res
+
 test lseq-3.1 {experiement} -body {
     set ans {}
     foreach factor [lseq 2.0 10.0] {
@@ -286,15 +290,15 @@ test lseq-3.1 {experiement} -body {
 
 test lseq-3.2 {error case} -body {
     lseq foo
-} -returnCodes 1 -result {bad operation "foo": must be .., to, count, or by}
+} -returnCodes 1 -match glob -result {invalid bareword "foo"*}
 
 test lseq-3.3 {error case} -body {
     lseq 10 foo
-} -returnCodes 1 -result {bad operation "foo": must be .., to, count, or by}
+} -returnCodes 1 -match glob -result {invalid bareword "foo"*}
 
 test lseq-3.4 {error case} -body {
     lseq 25 or 6
-} -returnCodes 1 -result {bad operation "or": must be .., to, count, or by}
+} -returnCodes 1 -match glob -result {invalid bareword "or"*}
 
 test lseq-3.5 {simple count and step arguments} -body {
     set s [lseq 25 by 6]
@@ -306,6 +310,9 @@ test lseq-3.5 {simple count and step arguments} -body {
 test lseq-3.6 {error case} -body {
     lseq 1 7 or 3
 } -returnCodes 1  -result {bad operation "or": must be .., to, count, or by}
+test lseq-3.6b {error case} -body {
+    lseq 1 to 7 or 3
+} -returnCodes 1  -result {bad operation "or": must be .., to, count, or by}
 
 test lseq-3.7 {lmap lseq} -body {
     lmap x [lseq 5] { expr {$x * $x} }
-- 
cgit v0.12