merge trunk

sebres · Sep 29, 2022 · 129b286 · 129b286
2 parents 5875c86 + c909454
commit 129b286
Show file tree

Hide file tree

Showing 3 changed files with 31 additions and 14 deletions.
diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c
@@ -282,7 +282,8 @@ TclNewArithSeriesObj(
     Tcl_Obj *lenObj)          /* Number of elements */
 {
     double dstart, dend, dstep;
-    Tcl_WideInt start, end, step, len;
+    Tcl_WideInt start, end, step;
+    Tcl_WideInt len;
 
     if (startObj) {
 	assignNumber(useDoubles, &start, &dstart, startObj);
@@ -306,7 +307,12 @@ TclNewArithSeriesObj(
 	assignNumber(useDoubles, &end, &dend, endObj);
     }
     if (lenObj) {
-	Tcl_GetWideIntFromObj(NULL, lenObj, &len);
+	int tcl_number_type;
+	Tcl_WideInt *valuePtr;
+	if (TclGetNumberFromObj(interp, lenObj, (ClientData*)&valuePtr, &tcl_number_type) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	len = *valuePtr;
     }
 
     if (startObj && endObj) {
@@ -339,7 +345,7 @@ TclNewArithSeriesObj(
 	}
     }
 
-    if (len < 0 || (Tcl_WideUInt)len > ListSizeT_MAX) {
+    if (TCL_MAJOR_VERSION < 9 && len > ListSizeT_MAX) {
 	Tcl_SetObjResult(
 	    interp,
 	    Tcl_NewStringObj("max length of a Tcl list exceeded", -1));

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
@@ -4728,7 +4728,7 @@ TEBCresume(
 
 	    /* Decode end-offset index values. */
 
-	    index = TclIndexDecode(opnd, length);
+	    index = TclIndexDecode(opnd, length-1);
 
 	    /* Compute value @ index */
 	    if (index < length) {

diff --git a/tests/lseq.test b/tests/lseq.test
@@ -65,7 +65,7 @@ test lseq-1.10 {integer lseq with step} {
     lseq 1 to 10 by 2
 } {1 3 5 7 9}
 
-test lseq-1.11 {error case: increasing wrong step direction} knownBug {
+test lseq-1.11 {error case: increasing wrong step direction} {
     lseq 1 to 10 by -2
 } {}
 
@@ -113,7 +113,7 @@ test lseq-1.19 {too many arguments extra numeric value} -body {
     lseq 12 to 24 by 2 7
 } -returnCodes 1 -result {wrong # args: should be "lseq n ??op? n ??by? n??"}
 
-test lseq-1.20 {bug: wrong length computed} knownBug {
+test lseq-1.20 {bug: wrong length computed} {
     lseq 1 to 10 -1
 } {}
 
@@ -128,11 +128,11 @@ test lseq-1.22 {n n by -n} {
 #
 # Short-hand use cases
 #
-test lseq-2.2 {step magnitude} knownBug {
+test lseq-2.2 {step magnitude} {
     lseq 10 1 2 ;# this is an empty case since step has wrong sign
 } {}
 
-test lseq-2.3 {step wrong sign} {arithSeriesDouble knownBug} {
+test lseq-2.3 {step wrong sign} arithSeriesDouble {
     lseq 25. 5. 5 ;# ditto - empty list
 } {}
 
@@ -166,7 +166,7 @@ test lseq-2.10 {integer lseq with step} {
     lseq 1 10 2
 } {1 3 5 7 9}
 
-test lseq-2.11 {error case: increasing wrong step direction} knownBug {
+test lseq-2.11 {error case: increasing wrong step direction} {
     lseq 1 10 -2
 } {}
 
@@ -196,7 +196,7 @@ test lseq-2.17 {large numbers} arithSeriesDouble {
 
 # Covered: {10 1 2 } {1 10 2} {1 10 -2} {1 1 1} {1 1 1} {-5 17 3}
 # Missing: {- - +} {- - -} {- + -} {+ - -} {- - +} {+ + -}
-test lseq-2.18 {signs} knownBug {
+test lseq-2.18 {signs} {
     list [lseq -10 -1 2] \
 	[lseq -10 -1 -1] \
 	[lseq -10 1 -3] \
@@ -390,7 +390,7 @@ test lseq-3.28 {lreverse bug in ArithSeries} {} {
     list $r $rr [string equal $r [lreverse $rr]]
 } {{-5 -2 1 4 7 10 13 16} {16 13 10 7 4 1 -2 -5} 1}
 
-test lseq-3.29 {edge case: negative count} knownBug {
+test lseq-3.29 {edge case: negative count} {
     lseq -15
 } {}
 
@@ -425,7 +425,7 @@ test lseq-4.2 {start expressions} {
 ##	lseq 1 to 10 by -2
 ##	# -> lseq: invalid step = -2 with a = 1 and b = 10
 
-test lseq-4.3 {TIP examples} knownBug {
+test lseq-4.3 {TIP examples} {
     set examples {# Examples from TIP-629
 	# --- Begin ---
 	lseq 10 .. 1
@@ -474,7 +474,7 @@ test lseq-4.3 {TIP examples} knownBug {
 
 #
 # Ticket 9933cc4d88697f05976accebd31c1e3ba6efe9c6 - lseq corner case
-test lseq-4.4 {lseq corner case} -constraints knownBug -body {
+test lseq-4.4 {lseq corner case} -body {
     set tcmd {
 	set res {}
 	set s [catch {lindex [lseq 10 100] 0} e]
@@ -489,7 +489,18 @@ test lseq-4.4 {lseq corner case} -constraints knownBug -body {
 	lappend res $s $e
     }
     eval $tcmd
-} -result {0 10 1 {max length of a Tcl list exceeded} 1 {max length of a Tcl list exceeded} 0 10 0 2147483638}
+} -cleanup {
+    unset res
+} -result {0 10 0 10 0 9223372036854774991 0 10 0 2147483638}
+
+# Ticket 99e834bf33 - lseq, lindex end off by one
+
+test lseq-4.5 {lindex off by one} -body {
+    lappend res [eval {lindex [lseq 1 4] end}]
+    lappend res [eval {lindex [lseq 1 4] end-1}]
+} -cleanup {
+    unset res
+} -result {4 3}
 
 
 # cleanup