summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2022-11-01 17:06:52 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2022-11-01 17:06:52 (GMT)
commit4b553938e32696507d51aa515625b520d8db230c (patch)
tree83bef770bb6af7f1c7beb816a636f4984a5d4011
parent4d9dcbbcbc557a5b15e79a8b05e5b0b92230adcb (diff)
parent67319477f132908fc3f5241bece926457d7d4a5e (diff)
downloadtcl-4b553938e32696507d51aa515625b520d8db230c.zip
tcl-4b553938e32696507d51aa515625b520d8db230c.tar.gz
tcl-4b553938e32696507d51aa515625b520d8db230c.tar.bz2
Merge 8.7
-rwxr-xr-xgeneric/tclArithSeries.c22
-rw-r--r--generic/tclDecls.h4
-rw-r--r--generic/tclListObj.c2
-rw-r--r--tests/lseq.test39
4 files changed, 59 insertions, 8 deletions
diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c
index 55e5a81..7292109 100755
--- a/generic/tclArithSeries.c
+++ b/generic/tclArithSeries.c
@@ -724,9 +724,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 7f29ecb..56cd7e8 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -557,7 +557,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,
@@ -2060,7 +2060,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 c025dda..ccd23a1 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -2639,10 +2639,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 19ae348..3f68da4 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]
@@ -509,12 +510,44 @@ 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}
+
# Panic when using variable value?
-test lseq-4.6 {panic using variable index} {
+test lseq-4.10 {panic using variable index} {
set i 0
lindex [lseq 10] $i
} {0}
+
# cleanup
::tcltest::cleanupTests