diff options
author | griffin <briang42@easystreet.net> | 2022-11-01 02:05:11 (GMT) |
---|---|---|
committer | griffin <briang42@easystreet.net> | 2022-11-01 02:05:11 (GMT) |
commit | 026e32d86a8119bac99953394dffdfd5a80665e9 (patch) | |
tree | 21c3e4513d7c91bc847d8f6d9b38283df63fce43 | |
parent | 3516771eb648f78594c2874fb6a681d0afc4ba25 (diff) | |
download | tcl-026e32d86a8119bac99953394dffdfd5a80665e9.zip tcl-026e32d86a8119bac99953394dffdfd5a80665e9.tar.gz tcl-026e32d86a8119bac99953394dffdfd5a80665e9.tar.bz2 |
Fix refCount crash. Improve ArithSeries regression coverage.
-rwxr-xr-x | generic/tclArithSeries.c | 22 | ||||
-rw-r--r-- | generic/tclDecls.h | 4 | ||||
-rw-r--r-- | generic/tclListObj.c | 2 | ||||
-rw-r--r-- | 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 |