From 026e32d86a8119bac99953394dffdfd5a80665e9 Mon Sep 17 00:00:00 2001
From: griffin <briang42@easystreet.net>
Date: Tue, 1 Nov 2022 02:05:11 +0000
Subject: Fix refCount crash. Improve ArithSeries regression coverage.

---
 generic/tclArithSeries.c | 22 ++++++++++++++++++++--
 generic/tclDecls.h       |  4 ++--
 generic/tclListObj.c     |  2 +-
 tests/lseq.test          | 35 +++++++++++++++++++++++++++++++++--
 4 files changed, 56 insertions(+), 7 deletions(-)

diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c
index c3c44f3..5c4e5a5 100755
--- a/generic/tclArithSeries.c
+++ b/generic/tclArithSeries.c
@@ -723,9 +723,27 @@ TclArithSeriesObjRange(
 	return obj;
     }
 
-    TclArithSeriesObjIndex(arithSeriesPtr, fromIdx, &startObj);
+    if (TclArithSeriesObjIndex(arithSeriesPtr, fromIdx, &startObj) != TCL_OK) {
+	if (interp) {
+	    Tcl_SetObjResult(
+		interp,
+		Tcl_ObjPrintf("index %d is out of bounds 0 to %"
+			      TCL_LL_MODIFIER "d", fromIdx, (arithSeriesRepPtr->len-1)));
+	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+	}
+	return NULL;
+    }
     Tcl_IncrRefCount(startObj);
-    TclArithSeriesObjIndex(arithSeriesPtr, toIdx, &endObj);
+    if (TclArithSeriesObjIndex(arithSeriesPtr, toIdx, &endObj) != TCL_OK) {
+	if (interp) {
+	    Tcl_SetObjResult(
+		interp,
+		Tcl_ObjPrintf("index %d is out of bounds 0 to %"
+			      TCL_LL_MODIFIER "d", fromIdx, (arithSeriesRepPtr->len-1)));
+	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+	}
+	return NULL;
+    }
     Tcl_IncrRefCount(endObj);
     TclArithSeriesObjStep(arithSeriesPtr, &stepObj);
     Tcl_IncrRefCount(stepObj);
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index a7d3023..8cb77b8 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -636,7 +636,7 @@ EXTERN Tcl_Channel	Tcl_OpenFileChannel(Tcl_Interp *interp,
 /* 199 */
 EXTERN Tcl_Channel	Tcl_OpenTcpClient(Tcl_Interp *interp, int port,
 				const char *address, const char *myaddr,
-				int myport, int async);
+				int myport, int flags);
 /* 200 */
 EXTERN Tcl_Channel	Tcl_OpenTcpServer(Tcl_Interp *interp, int port,
 				const char *host,
@@ -2272,7 +2272,7 @@ typedef struct TclStubs {
     Tcl_Obj * (*tcl_ObjSetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 196 */
     Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, Tcl_Size argc, const char **argv, int flags); /* 197 */
     Tcl_Channel (*tcl_OpenFileChannel) (Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* 198 */
-    Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int async); /* 199 */
+    Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int flags); /* 199 */
     Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, void *callbackData); /* 200 */
     void (*tcl_Preserve) (void *data); /* 201 */
     void (*tcl_PrintDouble) (Tcl_Interp *interp, double value, char *dst); /* 202 */
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index a1d080c..8ee0f48 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -2644,10 +2644,10 @@ TclLindexFlat(
 		/* ArithSeries cannot be a list of lists */
 		Tcl_DecrRefCount(elemObj);
 		TclNewObj(elemObj);
-		Tcl_IncrRefCount(elemObj);
 		break;
 	    }
 	}
+	Tcl_IncrRefCount(elemObj);
 	return elemObj;
     }
 
diff --git a/tests/lseq.test b/tests/lseq.test
index 2e5d7e1..b8ae2e9 100644
--- a/tests/lseq.test
+++ b/tests/lseq.test
@@ -255,8 +255,9 @@ test lseq-3.7 {lmap lseq} {
 
 test lseq-3.8 {lrange lseq} {
     set r [lrange [lseq 1 100] 10 20]
-    lindex [tcl::unsupported::representation $r] 3
-} {arithseries}
+    set empty [lrange [lseq 1 100] 20 10]
+    list $r $empty [lindex [tcl::unsupported::representation $r] 3]
+} {{11 12 13 14 15 16 17 18 19 20 21} {} arithseries}
 
 test lseq-3.9 {lassign lseq} arithSeriesShimmer {
     set r [lseq 15]
@@ -510,6 +511,36 @@ test lseq-4.5 {lindex off by one} -body {
     unset res
 } -result {4 3}
 
+# Bad refcount on ResultObj
+test lseq-4.6 {lindex flat} -body {
+    set l [lseq 2 10]
+    set cmd lindex
+    set i 4
+    set c [lindex $l $i]
+    set d [$cmd $l $i]
+    set e [lindex [lseq 2 10] $i]
+    set f [$cmd [lseq 2 10] $i]
+    list $c $d $e $f
+} -cleanup {
+    unset l
+    unset e
+} -result [lrepeat 4 6]
+
+test lseq-4.7 {empty list} {
+    list [lseq 0] [join [lseq 0] {}] [join [lseq 1] {}]
+} {{} {} 0}
+
+test lseq-4.8 {error case lrange} -body {
+    lrange [lseq 1 5] fred ginger
+} -returnCodes 1 \
+    -result {bad index "fred": must be integer?[+-]integer? or end?[+-]integer?}
+
+test lseq-4.9 {error case lrange} -body {
+    set fred 7
+    set ginger 8
+    lrange [lseq 1 5] $fred $ginger
+} -returnCodes 1 \
+    -result {index 7 is out of bounds 0 to 4}
 
 # cleanup
 ::tcltest::cleanupTests
-- 
cgit v0.12