merge 8.7

4 files changed, 114 insertions, 101 deletions

diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index ad8eb94..836b859 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -102,11 +102,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;
 
 /*
@@ -4030,47 +4030,59 @@ 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) {
+	/* speed-up a bit (and avoid shimmer for compiled expressions) */
+	if (TclHasInternalRep(argPtr, &tclExprCodeType)) {
+	   goto doExpr;
+	}
+	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;
+	}
+    doExpr:
+	/* 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;
     }
 }
 
@@ -4122,7 +4134,8 @@ Tcl_LseqObjCmd(
     Tcl_WideInt values[5];
     Tcl_Obj *numValues[5];
     Tcl_Obj *numberObj;
-    int status = TCL_ERROR, keyword, useDoubles = 0;
+    int status = TCL_ERROR, keyword, useDoubles = 0, allowedArgs = NumericArg;
+    int remNums = 3;
     Tcl_Obj *arithSeriesPtr;
     SequenceOperators opmode;
     SequenceDecoded decoded;
@@ -4137,42 +4150,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;
+	}
     }
 
     /*
@@ -4181,13 +4202,6 @@ Tcl_LseqObjCmd(
      */
     switch (arg_key) {
 
-/*    No argument */
-    case 0:
-	 Tcl_WrongNumArgs(interp, 1, objv,
-	     "n ??op? n ??by? n??");
-	 goto done;
-	 break;
-
 /*    lseq n */
     case 1:
 	start = zero;
@@ -4309,34 +4323,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:
-	 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;
-	 }
-	 goto done;
-	 break;
-
 /*    All other argument errors */
     default:
+      syntax:
 	 Tcl_WrongNumArgs(interp, 1, objv, "n ??op? n ??by? n??");
 	 goto done;
 	 break;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 5d4bff3..fab8590 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -659,7 +659,7 @@ static Tcl_NRPostProc   TEBCresume;
  * compiled bytecode for Tcl expressions.
  */
 
-static const Tcl_ObjType exprCodeType = {
+const Tcl_ObjType tclExprCodeType = {
     "exprcode",
     FreeExprCodeInternalRep,	/* freeIntRepProc */
     DupExprCodeInternalRep,	/* dupIntRepProc */
@@ -1417,7 +1417,7 @@ CompileExprObj(
      * is valid in the current context.
      */
 
-    ByteCodeGetInternalRep(objPtr, &exprCodeType, codePtr);
+    ByteCodeGetInternalRep(objPtr, &tclExprCodeType, codePtr);
 
     if (codePtr != NULL) {
 	Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
@@ -1427,7 +1427,7 @@ CompileExprObj(
 		|| (codePtr->nsPtr != namespacePtr)
 		|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)
 		|| (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) {
-	    Tcl_StoreInternalRep(objPtr, &exprCodeType, NULL);
+	    Tcl_StoreInternalRep(objPtr, &tclExprCodeType, NULL);
 	    codePtr = NULL;
 	}
     }
@@ -1460,7 +1460,7 @@ CompileExprObj(
 	 */
 
 	TclEmitOpcode(INST_DONE, &compEnv);
-	codePtr = TclInitByteCodeObj(objPtr, &exprCodeType, &compEnv);
+	codePtr = TclInitByteCodeObj(objPtr, &tclExprCodeType, &compEnv);
 	TclFreeCompileEnv(&compEnv);
 	if (iPtr->varFramePtr->localCachePtr) {
 	    codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
@@ -1529,7 +1529,7 @@ FreeExprCodeInternalRep(
     Tcl_Obj *objPtr)
 {
     ByteCode *codePtr;
-    ByteCodeGetInternalRep(objPtr, &exprCodeType, codePtr);
+    ByteCodeGetInternalRep(objPtr, &tclExprCodeType, codePtr);
     assert(codePtr != NULL);
 
     TclReleaseByteCode(codePtr);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 70bc4b8..ae91625 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3109,6 +3109,7 @@ MODULE_SCOPE const Tcl_ObjType tclBignumType;
 MODULE_SCOPE const Tcl_ObjType tclBooleanType;
 MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
 MODULE_SCOPE const Tcl_ObjType tclDoubleType;
+MODULE_SCOPE const Tcl_ObjType tclExprCodeType;
 MODULE_SCOPE const Tcl_ObjType tclIntType;
 MODULE_SCOPE const Tcl_ObjType tclIndexType;
 MODULE_SCOPE const Tcl_ObjType tclListType;
diff --git a/tests/lseq.test b/tests/lseq.test
index 569af95..b617d7a 100644
--- a/tests/lseq.test
+++ b/tests/lseq.test
@@ -152,6 +152,22 @@ test lseq-1.25 {consistence, use double (even if representable as integer) in al
     list [lseq double(0) 2] [lseq 0 double(2)] [lseq double(0) count 3] \
 	 [lseq 0 count 3 by double(1)] [lseq 0 .. double(2)] [lseq 0 to 2 by double(1)]
 } [lrepeat 6 {0.0 1.0 2.0}]
+test lseq-1.26 {consistence, double always remains double} {
+    list [lseq        1              3.0      ] \
+	 [lseq        1       [expr {3.0+0}]  ] \
+	 [lseq        1             {3.0+0}   ] \
+	 [lseq        1.0            3.0     1] \
+	 [lseq [expr {1.0+0}] [expr {3.0+0}] 1] \
+	 [lseq       {1.0+0}        {3.0+0}  1]
+} [lrepeat 6 {1.0 2.0 3.0}]
+test lseq-1.27 {consistence, double always remains double} {
+    list [lseq        1e50     [expr {1e50+1}]  ] \
+	 [lseq        1e50           {1e50+1}   ] \
+	 [lseq [expr {1e50+0}] [expr {1e50+1}] 1] \
+	 [lseq       {1e50+0}        {1e50+1}  1] \
+	 [lseq [expr {1e50+0}] count 1 1] \
+	 [lseq       {1e50+0}  count 1 1]
+} [lrepeat 6 [expr {1e50}]]
 
 #
 # Short-hand use cases
@@ -247,6 +263,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] {
@@ -271,15 +291,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]
@@ -291,6 +311,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} }