summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorgriffin <briang42@easystreet.net>2022-08-24 23:22:21 (GMT)
committergriffin <briang42@easystreet.net>2022-08-24 23:22:21 (GMT)
commit85da0b0875d23f8af54cef159f7878f8bc3d30f3 (patch)
tree291fd2fd9d4fc5a8892e62b9d625590de115eca6
parent9a179b641897fc4e631dfe3dbd737d864f5df96d (diff)
downloadtcl-85da0b0875d23f8af54cef159f7878f8bc3d30f3.zip
tcl-85da0b0875d23f8af54cef159f7878f8bc3d30f3.tar.gz
tcl-85da0b0875d23f8af54cef159f7878f8bc3d30f3.tar.bz2
Implement support for float (double) values. Add more test coverage.
-rw-r--r--generic/tclCmdAH.c4
-rw-r--r--generic/tclCmdIL.c312
-rw-r--r--generic/tclInt.h45
-rw-r--r--generic/tclListObj.c416
-rw-r--r--tests/lseq.test75
5 files changed, 619 insertions, 233 deletions
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index f31eabc..adb4044 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -2968,15 +2968,13 @@ ForeachAssignments(
k = statePtr->index[i]++;
if (k < statePtr->argcList[i]) {
if (isarithseries) {
- Tcl_WideInt value;
- if (TclArithSeriesObjIndex(statePtr->vCopyList[i], k, &value) != TCL_OK) {
+ if (TclArithSeriesObjIndex(statePtr->vCopyList[i], k, &valuePtr) != TCL_OK) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (setting %s loop variable \"%s\")",
(statePtr->resultList != NULL ? "lmap" : "foreach"),
TclGetString(statePtr->varvList[i][v])));
return TCL_ERROR;
}
- valuePtr = Tcl_NewWideIntObj(value);
} else {
valuePtr = statePtr->argvList[i][k];
}
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 332c77b..77a8ffc 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2229,11 +2229,11 @@ Tcl_JoinObjCmd(
if (listLen == 1) {
/* One element; return it */
if (isArithSeries) {
- Tcl_WideInt value;
- if (TclArithSeriesObjIndex(objv[1], 0, &value) != TCL_OK) {
+ Tcl_Obj *valueObj;
+ if (TclArithSeriesObjIndex(objv[1], 0, &valueObj) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj(value));
+ Tcl_SetObjResult(interp, valueObj);
} else {
Tcl_SetObjResult(interp, elemPtrs[0]);
}
@@ -2251,7 +2251,7 @@ Tcl_JoinObjCmd(
TclNewObj(resObjPtr);
if (isArithSeries) {
- Tcl_WideInt value;
+ Tcl_Obj *valueObj;
for (i = 0; i < listLen; i++) {
if (i > 0) {
@@ -2264,10 +2264,11 @@ Tcl_JoinObjCmd(
Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
}
- if (TclArithSeriesObjIndex(objv[1], i, &value) != TCL_OK) {
+ if (TclArithSeriesObjIndex(objv[1], i, &valueObj) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_AppendObjToObj(resObjPtr, Tcl_NewWideIntObj(value));
+ Tcl_AppendObjToObj(resObjPtr, valueObj);
+ Tcl_DecrRefCount(valueObj);
}
} else {
for (i = 0; i < listLen; i++) {
@@ -4046,34 +4047,57 @@ static SequenceDecoded
SequenceIdentifyArgument(
Tcl_Interp *interp, /* for error reporting */
Tcl_Obj *argPtr, /* Argument to decode */
- Tcl_WideInt *intValuePtr, /* Return numeric value */
+ Tcl_Obj **numValuePtr, /* Return numeric value */
int *keywordIndexPtr) /* Return keyword enum */
{
int status;
- Tcl_WideInt number;
SequenceOperators opmode;
SequenceByMode bymode;
+ union {
+ Tcl_WideInt i;
+ double d;
+ } nvalue;
- status = Tcl_GetWideIntFromObj(NULL, argPtr, &number);
- if (status != TCL_OK) {
+ status = TclGetNumberFromObj(NULL, argPtr, (ClientData*)&nvalue, keywordIndexPtr);
+ if (status == TCL_OK) {
+ if (numValuePtr) {
+ *numValuePtr = argPtr;
+ }
+ return NumericArg;
+ } else {
/* Check for an index expression */
long value;
+ double dvalue;
+ Tcl_Obj *exprValueObj;
+ int keyword;
Tcl_InterpState savedstate;
savedstate = Tcl_SaveInterpState(interp, status);
if (Tcl_ExprLongObj(interp, argPtr, &value) != TCL_OK) {
status = Tcl_RestoreInterpState(interp, savedstate);
+ exprValueObj = argPtr;
} else {
+ // Determine if expression is double or int
+ if (Tcl_ExprDoubleObj(interp, argPtr, &dvalue) != TCL_OK) {
+ keyword = TCL_NUMBER_INT;
+ exprValueObj = argPtr;
+ } else {
+ if (floor(dvalue) == dvalue) {
+ exprValueObj = Tcl_NewWideIntObj(value);
+ keyword = TCL_NUMBER_INT;
+ } else {
+ exprValueObj = Tcl_NewDoubleObj(dvalue);
+ keyword = TCL_NUMBER_DOUBLE;
+ }
+ }
status = Tcl_RestoreInterpState(interp, savedstate);
- if (intValuePtr) {
- *intValuePtr = value;
+ if (numValuePtr) {
+ *numValuePtr = exprValueObj;
+ }
+ if (keywordIndexPtr) {
+ *keywordIndexPtr = keyword ;// type of expression result
}
return NumericArg;
}
- } else {
- if (intValuePtr) {
- *intValuePtr = number;
- }
- return NumericArg;
}
status = Tcl_GetIndexFromObj(NULL, argPtr, seq_operations,
@@ -4139,14 +4163,19 @@ Tcl_LseqObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
- Tcl_WideInt elementCount = -1;
- Tcl_WideInt start = 0, end = 0, step = 0, number = 0;
+ Tcl_Obj *elementCount = NULL;
+ Tcl_Obj *start = NULL, *end = NULL, *step = NULL;
Tcl_WideInt values[5];
- int status, keyword;
+ Tcl_Obj *numValues[5];
+ Tcl_Obj *numberObj;
+ int status, keyword, useDoubles = 0;
Tcl_Obj *arithSeriesPtr;
SequenceOperators opmode;
SequenceDecoded decoded;
int i, arg_key = 0, value_i = 0;
+ // Default constants
+ Tcl_Obj *zero = Tcl_NewIntObj(0);
+ Tcl_Obj *one = Tcl_NewIntObj(1);
/*
* Create a decoding key by looping through the arguments and identify
@@ -4158,7 +4187,8 @@ Tcl_LseqObjCmd(
arg_key=0;
} else for (i=1; i<objc; i++) {
arg_key = (arg_key * 10);
- decoded = SequenceIdentifyArgument(interp, objv[i], &number, &keyword);
+ numValues[value_i] = NULL;
+ decoded = SequenceIdentifyArgument(interp, objv[i], &numberObj, &keyword);
switch (decoded) {
case NoneArg:
@@ -4172,7 +4202,10 @@ Tcl_LseqObjCmd(
case NumericArg:
arg_key += NumericArg;
- values[value_i] = number;
+ numValues[value_i] = numberObj;
+ Tcl_IncrRefCount(numValues[value_i]);
+ values[value_i] = keyword; // This is the TCL_NUMBER_* value
+ useDoubles = useDoubles ? useDoubles : keyword == TCL_NUMBER_DOUBLE;
value_i++;
break;
@@ -4211,149 +4244,130 @@ Tcl_LseqObjCmd(
/* range n */
case 1:
- start = 0;
- elementCount = (values[0] <= 0 ? 0 : values[0]);
- end = values[0]-1;
- step = 1;
- break;
+ start = zero;
+ elementCount = numValues[0];
+ end = NULL;
+ step = one;
+ break;
/* range n n */
case 11:
- start = values[0];
- end = values[1];
- step = (start <= end) ? 1 : -1;
- elementCount = step ? (end-start+step)/step : 0; // 0 step -> empty list
- if (elementCount < 0) elementCount = 0;
- break;
+ start = numValues[0];
+ end = numValues[1];
+ break;
/* range n n n */
case 111:
- start = values[0];
- end = values[1];
- step = values[2];
- elementCount = step ? (end-start+step)/step : 0; // 0 step -> empty list
- if (elementCount < 0) elementCount = 0;
- break;
+ start = numValues[0];
+ end = numValues[1];
+ step = numValues[2];
+ break;
/* range n 'to' n */
/* range n 'count' n */
/* range n 'by' n */
case 121:
- opmode = (SequenceOperators)values[1];
- switch (opmode) {
- case RANGE_DOTS:
- case RANGE_TO:
- start = values[0];
- end = values[2];
- step = (start <= end) ? 1 : -1;
- elementCount = step ? (start-end+step)/step : 0; // 0 step -> empty list
- break;
- case RANGE_BY:
- start = 0;
- elementCount = values[0];
- step = values[2];
- end = start + (step * elementCount);
- break;
- case RANGE_COUNT:
- start = values[0];
- elementCount = (values[2] >= 0 ? values[2] : 0);
- step = 1;
- end = start + (step * elementCount);
- break;
- default:
- status = TCL_ERROR;
- goto done;
- }
- break;
+ opmode = (SequenceOperators)values[1];
+ switch (opmode) {
+ case RANGE_DOTS:
+ case RANGE_TO:
+ start = numValues[0];
+ end = numValues[2];
+ break;
+ case RANGE_BY:
+ start = zero;
+ elementCount = numValues[0];
+ step = numValues[2];
+ break;
+ case RANGE_COUNT:
+ start = numValues[0];
+ elementCount = numValues[2];
+ step = one;
+ break;
+ default:
+ status = TCL_ERROR;
+ goto done;
+ }
+ break;
/* range n 'to' n n */
/* range n 'count' n n */
case 1211:
- opmode = (SequenceOperators)values[1];
- switch (opmode) {
- case RANGE_DOTS:
- case RANGE_TO:
- start = values[0];
- end = values[2];
- step = values[3];
- elementCount = step ? (end-start+step)/step : 0; // 0 step -> empty list
- break;
- case RANGE_COUNT:
- start = values[0];
- elementCount = (values[2] >= 0 ? values[2] : 0);
- step = values[3];
- end = start + (step * elementCount);
- break;
- case RANGE_BY:
- /* Error case */
- status = TCL_ERROR;
- goto done;
- break;
- default:
- status = TCL_ERROR;
- goto done;
- break;
- }
- break;
+ opmode = (SequenceOperators)values[1];
+ switch (opmode) {
+ case RANGE_DOTS:
+ case RANGE_TO:
+ start = numValues[0];
+ end = numValues[2];
+ step = numValues[3];
+ break;
+ case RANGE_COUNT:
+ start = numValues[0];
+ elementCount = numValues[2];
+ step = numValues[3];
+ break;
+ case RANGE_BY:
+ /* Error case */
+ status = TCL_ERROR;
+ goto done;
+ break;
+ default:
+ status = TCL_ERROR;
+ goto done;
+ break;
+ }
+ break;
/* range n n 'by' n */
case 1121:
- start = values[0];
- end = values[1];
- opmode = (SequenceOperators)values[2];
- switch (opmode) {
- case RANGE_BY:
- step = values[3];
- break;
- case RANGE_DOTS:
- case RANGE_TO:
- case RANGE_COUNT:
- default:
- status = TCL_ERROR;
- goto done;
- break;
- }
- elementCount = step ? (end-start+step)/step : 0; // 0 step -> empty list
- break;
+ start = numValues[0];
+ end = numValues[1];
+ opmode = (SequenceOperators)values[2];
+ switch (opmode) {
+ case RANGE_BY:
+ step = numValues[3];
+ break;
+ case RANGE_DOTS:
+ case RANGE_TO:
+ case RANGE_COUNT:
+ default:
+ status = TCL_ERROR;
+ goto done;
+ break;
+ }
+ break;
/* range n 'to' n 'by' n */
/* range n 'count' n 'by' n */
case 12121:
- start = values[0];
- opmode = (SequenceOperators)values[3];
- switch (opmode) {
- case RANGE_BY:
- step = values[4];
- break;
- default:
- status = TCL_ERROR;
- goto done;
- break;
- }
- opmode = (SequenceOperators)values[1];
- switch (opmode) {
- case RANGE_DOTS:
- case RANGE_TO:
- start = values[0];
- end = values[2];
- elementCount = step ? (end-start+step)/step : 0; // 0 step -> empty list
- break;
- case RANGE_COUNT:
- start = values[0];
- elementCount = values[2] >= 0 ? values[2] : 0;
- if (step != 0) {
- end = start + (step * elementCount);
- } else {
- end = start;
- elementCount = 0; /* empty list when step is 0 */
- }
- break;
- default:
- status = TCL_ERROR;
- goto done;
- break;
- }
- break;
+ start = numValues[0];
+ opmode = (SequenceOperators)values[3];
+ switch (opmode) {
+ case RANGE_BY:
+ step = numValues[4];
+ break;
+ default:
+ status = TCL_ERROR;
+ goto done;
+ break;
+ }
+ opmode = (SequenceOperators)values[1];
+ switch (opmode) {
+ case RANGE_DOTS:
+ case RANGE_TO:
+ start = numValues[0];
+ end = numValues[2];
+ break;
+ case RANGE_COUNT:
+ start = numValues[0];
+ elementCount = numValues[2];
+ break;
+ default:
+ status = TCL_ERROR;
+ goto done;
+ break;
+ }
+ break;
/* Error cases: incomplete arguments */
case 12:
@@ -4393,11 +4407,21 @@ Tcl_LseqObjCmd(
/*
* Success! Now lets create the series object.
*/
- arithSeriesPtr = TclNewArithSeriesObj(start, end, step, elementCount);
+ arithSeriesPtr = TclNewArithSeriesObj(useDoubles, start, end, step, elementCount);
+
Tcl_SetObjResult(interp, arithSeriesPtr);
status = TCL_OK;
done:
+ // Free number arguments.
+ while (--value_i>=0) {
+ if (numValues[value_i]) Tcl_DecrRefCount(numValues[value_i]);
+ }
+
+ // Free constants
+ Tcl_DecrRefCount(zero);
+ Tcl_DecrRefCount(one);
+
return status;
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index f66814e..95abe4c 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2490,14 +2490,31 @@ typedef struct ArithSeries {
Tcl_WideInt step;
Tcl_WideInt len;
Tcl_Obj **elements;
- Tcl_Obj *wideObjPtr; /* Used to speedup [foreach] reusing the same obj. */
+ int isDouble;
} ArithSeries;
+typedef struct ArithSeriesDbl {
+ double start;
+ double end;
+ double step;
+ Tcl_WideInt len;
+ Tcl_Obj **elements;
+ int isDouble;
+} ArithSeriesDbl;
#define ArithSeriesRepPtr(arithSeriesObjPtr) \
(ArithSeries *) ((arithSeriesObjPtr)->internalRep.twoPtrValue.ptr1)
#define ArithSeriesIndexM(arithSeriesRepPtr, index) \
- (arithSeriesRepPtr)->start+((index) * arithSeriesRepPtr->step)
+ ((arithSeriesRepPtr)->isDouble ? \
+ (((ArithSeriesDbl*)(arithSeriesRepPtr))->start+((index) * ((ArithSeriesDbl*)(arithSeriesRepPtr))->step)) \
+ : \
+ ((arithSeriesRepPtr)->start+((index) * arithSeriesRepPtr->step)))
+
+#define ArithSeriesStepM(arithSeriesRepPtr) \
+ ((arithSeriesRepPtr)->isDouble ? \
+ ((ArithSeriesDbl*)(arithSeriesRepPtr))->step \
+ : \
+ (arithSeriesRepPtr)->step)
/*
@@ -2942,19 +2959,25 @@ MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp,
CmdFrame *cfPtr);
MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
CmdFrame **cfPtrPtr, int *wordPtr);
-MODULE_SCOPE Tcl_Obj * TclArithSeriesObjCopy(Tcl_Interp *interp,
+MODULE_SCOPE Tcl_Obj * TclArithSeriesObjCopy(Tcl_Interp *interp,
Tcl_Obj *arithSeriesPtr);
-MODULE_SCOPE int TclArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr,
- Tcl_WideInt index, Tcl_WideInt *element);
+MODULE_SCOPE int TclArithSeriesObjStep(Tcl_Obj *arithSeriesPtr,
+ Tcl_Obj **stepObj);
+MODULE_SCOPE int TclArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr,
+ Tcl_WideInt index, Tcl_Obj **elementObj);
MODULE_SCOPE Tcl_WideInt TclArithSeriesObjLength(Tcl_Obj *arithSeriesPtr);
-MODULE_SCOPE Tcl_Obj * TclArithSeriesObjRange(Tcl_Obj *arithSeriesPtr,
+MODULE_SCOPE Tcl_Obj * TclArithSeriesObjRange(Tcl_Obj *arithSeriesPtr,
int fromIdx, int toIdx);
-MODULE_SCOPE Tcl_Obj * TclArithSeriesObjReverse(Tcl_Obj *arithSeriesPtr);
-MODULE_SCOPE int TclArithSeriesGetElements(Tcl_Interp *interp,
+MODULE_SCOPE Tcl_Obj * TclArithSeriesObjReverse(Tcl_Obj *arithSeriesPtr);
+MODULE_SCOPE int TclArithSeriesGetElements(Tcl_Interp *interp,
Tcl_Obj *objPtr, int *objcPtr, Tcl_Obj ***objvPtr);
-MODULE_SCOPE Tcl_Obj * TclNewArithSeriesObj(Tcl_WideInt start,
- Tcl_WideInt end, Tcl_WideInt step,
- Tcl_WideInt len);
+MODULE_SCOPE Tcl_Obj * TclNewArithSeriesInt(Tcl_WideInt start,
+ Tcl_WideInt end, Tcl_WideInt step,
+ Tcl_WideInt len);
+MODULE_SCOPE Tcl_Obj * TclNewArithSeriesDbl(double start, double end,
+ double step, Tcl_WideInt len);
+MODULE_SCOPE Tcl_Obj * TclNewArithSeriesObj(int useDoubles, Tcl_Obj *startObj,
+ Tcl_Obj *endObj, Tcl_Obj *stepObj, Tcl_Obj *lenObj);
MODULE_SCOPE int TclAsyncNotifier(int sigNumber, Tcl_ThreadId threadId,
ClientData clientData, int *flagPtr, int value);
MODULE_SCOPE void TclAsyncMarkFromNotifier(void);
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 6b5ab7e..4366782 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -847,11 +847,7 @@ Tcl_ListObjIndex(
ListGetInternalRep(listPtr, listRepPtr);
if (listRepPtr == NULL && TclHasInternalRep(listPtr,&tclArithSeriesType)) {
- Tcl_WideInt widint;
- if (TclArithSeriesObjIndex(listPtr, index, &widint) == TCL_OK) {
- *objPtrPtr = Tcl_NewWideIntObj(widint);
- return TCL_OK;
- }
+ return TclArithSeriesObjIndex(listPtr, index, objPtrPtr);
}
if (listRepPtr == NULL) {
@@ -2325,7 +2321,7 @@ ArithSeriesLen(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step)
/*
*----------------------------------------------------------------------
*
- * TclNewArithSeriesObj --
+ * TclNewArithSeriesInt --
*
* Creates a new ArithSeries object. The returned object has
* refcount = 0.
@@ -2341,7 +2337,7 @@ ArithSeriesLen(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step)
*----------------------------------------------------------------------
*/
Tcl_Obj *
-TclNewArithSeriesObj(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_WideInt len)
+TclNewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_WideInt len)
{
Tcl_WideInt length = (len>=0 ? len : ArithSeriesLen(start, end, step));
Tcl_Obj *arithSeriesPtr;
@@ -2354,13 +2350,12 @@ TclNewArithSeriesObj(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_W
}
arithSeriesRepPtr = (ArithSeries*) ckalloc(sizeof (ArithSeries));
+ arithSeriesRepPtr->isDouble = 0;
arithSeriesRepPtr->start = start;
arithSeriesRepPtr->end = end;
arithSeriesRepPtr->step = step;
arithSeriesRepPtr->len = length;
arithSeriesRepPtr->elements = NULL;
- arithSeriesRepPtr->wideObjPtr = Tcl_NewWideIntObj(0);
- Tcl_IncrRefCount(arithSeriesRepPtr->wideObjPtr);
arithSeriesPtr->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
arithSeriesPtr->internalRep.twoPtrValue.ptr2 = NULL;
arithSeriesPtr->typePtr = &tclArithSeriesType;
@@ -2369,8 +2364,227 @@ TclNewArithSeriesObj(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_W
return arithSeriesPtr;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNewArithSeriesDbl --
+ *
+ * Creates a new ArithSeries object with doubles. The returned object has
+ * refcount = 0.
+ *
+ * Results:
+ *
+ * A Tcl_Obj pointer to the created ArithSeries object.
+ * A NULL pointer of the range is invalid.
+ *
+ * Side Effects:
+ *
+ * None.
+ *----------------------------------------------------------------------
+ */
+Tcl_Obj *
+TclNewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len)
+{
+ Tcl_WideInt length = (len>=0 ? len : ArithSeriesLen(start, end, step));
+ Tcl_Obj *arithSeriesPtr;
+ ArithSeriesDbl *arithSeriesRepPtr;
+ TclNewObj(arithSeriesPtr);
+
+ if (length <= 0) {
+ return arithSeriesPtr;
+ }
+
+ arithSeriesRepPtr = (ArithSeriesDbl*) ckalloc(sizeof (ArithSeriesDbl));
+ arithSeriesRepPtr->isDouble = 1;
+ arithSeriesRepPtr->start = start;
+ arithSeriesRepPtr->end = end;
+ arithSeriesRepPtr->step = step;
+ arithSeriesRepPtr->len = length;
+ arithSeriesRepPtr->elements = NULL;
+ arithSeriesPtr->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
+ arithSeriesPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ arithSeriesPtr->typePtr = &tclArithSeriesType;
+ if (length > 0)
+ Tcl_InvalidateStringRep(arithSeriesPtr);
+
+ return arithSeriesPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * assignNumber --
+ *
+ * Create the approprite Tcl_Obj value for the given numeric values.
+ * Used locally only for decoding [lseq] numeric arguments.
+ * refcount = 0.
+ *
+ * Results:
+ *
+ * A Tcl_Obj pointer.
+ * No assignment on error.
+ *
+ * Side Effects:
+ *
+ * None.
+ *----------------------------------------------------------------------
+ */
+static void
+assignNumber(int useDoubles, Tcl_WideInt *intNumberPtr, double *dblNumberPtr, Tcl_Obj *numberObj)
+{
+ union {
+ double d;
+ Tcl_WideInt i;
+ } *number;
+ int tcl_number_type;
+ if (TclGetNumberFromObj(NULL, numberObj, (ClientData*)&number, &tcl_number_type) != TCL_OK) {
+ return;
+ }
+ if (useDoubles) {
+ if (tcl_number_type == TCL_NUMBER_DOUBLE) {
+ *dblNumberPtr = number->d;
+ } else {
+ *dblNumberPtr = (double)number->i;
+ }
+ } else {
+ if (tcl_number_type == TCL_NUMBER_INT) {
+ *intNumberPtr = number->i;
+ } else {
+ *intNumberPtr = (Tcl_WideInt)number->d;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNewArithSeriesObj --
+ *
+ * Creates a new ArithSeries object. Some arguments may be NULL and will
+ * be computed based on the other given arguments.
+ * refcount = 0.
+ *
+ * Results:
+ *
+ * A Tcl_Obj pointer to the created ArithSeries object.
+ * An empty Tcl_Obj if the range is invalid.
+ *
+ * Side Effects:
+ *
+ * None.
+ *----------------------------------------------------------------------
+ */
+Tcl_Obj *
+TclNewArithSeriesObj(int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj, Tcl_Obj *stepObj, Tcl_Obj *lenObj)
+{
+ double dstart, dend, dstep;
+ Tcl_WideInt start, end, step, len;
+
+ if (startObj) {
+ assignNumber(useDoubles, &start, &dstart, startObj);
+ } else {
+ start = 0;
+ dstart = start;
+ }
+ if (stepObj) {
+ assignNumber(useDoubles, &step, &dstep, stepObj);
+ if (useDoubles) {
+ step = dstep;
+ } else {
+ dstep = step;
+ }
+ if (dstep == 0) {
+ return Tcl_NewObj();
+ }
+ }
+ if (endObj) {
+ assignNumber(useDoubles, &end, &dend, endObj);
+ }
+ if (lenObj) {
+ Tcl_GetWideIntFromObj(NULL, lenObj, &len);
+ }
+
+ if (startObj && endObj) {
+ if (!stepObj) {
+ if (useDoubles) {
+ dstep = (dstart < dend) ? 1.0 : -1.0;
+ step = dstep;
+ } else {
+ step = (start < end) ? 1 : -1;
+ dstep = step;
+ }
+ }
+ assert(dstep!=0);
+ if (!lenObj) {
+ if (useDoubles) {
+ len = (dend - dstart + dstep)/dstep;
+ } else {
+ len = (end - start + step)/step;
+ }
+ }
+ }
+
+ if (!endObj) {
+ if (useDoubles) {
+ dend = dstart + (dstep * (len-1));
+ end = dend;
+ } else {
+ end = start + (step * (len-1));
+ dend = end;
+ }
+ }
+
+ if (useDoubles) {
+ return TclNewArithSeriesDbl(dstart, dend, dstep, len);
+ } else {
+ return TclNewArithSeriesInt(start, end, step, len);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclArithSeriesObjStep --
+ *
+ * Return a Tcl_Obj with the step value from the give ArithSeries Obj.
+ * refcount = 0.
+ *
+ * Results:
+ *
+ * A Tcl_Obj pointer to the created ArithSeries object.
+ * A NULL pointer of the range is invalid.
+ *
+ * Side Effects:
+ *
+ * None.
+ *----------------------------------------------------------------------
+ */
+/*
+ * TclArithSeriesObjStep --
+ */
+int
+TclArithSeriesObjStep(
+ Tcl_Obj *arithSeriesPtr,
+ Tcl_Obj **stepObj)
+{
+ ArithSeries *arithSeriesRepPtr;
+
+ if (arithSeriesPtr->typePtr != &tclArithSeriesType) {
+ Tcl_Panic("TclArithSeriesObjIndex called with a not ArithSeries Obj.");
+ }
+ arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesPtr);
+ if (arithSeriesRepPtr->isDouble) {
+ *stepObj = Tcl_NewDoubleObj(((ArithSeriesDbl*)(arithSeriesRepPtr))->step);
+ } else {
+ *stepObj = Tcl_NewWideIntObj(arithSeriesRepPtr->step);
+ }
+ return TCL_OK;
+}
+
+
/*
*----------------------------------------------------------------------
*
@@ -2394,19 +2608,23 @@ TclNewArithSeriesObj(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_W
*/
int
-TclArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr, Tcl_WideInt index, Tcl_WideInt *element)
+TclArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr, Tcl_WideInt index, Tcl_Obj **elementObj)
{
ArithSeries *arithSeriesRepPtr;
if (arithSeriesPtr->typePtr != &tclArithSeriesType) {
- Tcl_Panic("TclArithSeriesObjIndex called with a not ArithSeries Obj.");
+ Tcl_Panic("TclArithSeriesObjIndex called with a not ArithSeries Obj.");
+ }
+ arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesPtr);
+ if (index < 0 || index >= arithSeriesRepPtr->len) {
+ return TCL_ERROR;
+ }
+ /* List[i] = Start + (Step * index) */
+ if (arithSeriesRepPtr->isDouble) {
+ *elementObj = Tcl_NewDoubleObj(ArithSeriesIndexM(arithSeriesRepPtr, index));
+ } else {
+ *elementObj = Tcl_NewWideIntObj(ArithSeriesIndexM(arithSeriesRepPtr, index));
}
- arithSeriesRepPtr = (ArithSeries*)
- arithSeriesPtr->internalRep.twoPtrValue.ptr1;
- if (index < 0 || index >= arithSeriesRepPtr->len)
- return TCL_ERROR;
- /* List[i] = Start + (Step * i) */
- *element = ArithSeriesIndexM(arithSeriesRepPtr, index);//->start+(index*arithSeriesRepPtr->step);
return TCL_OK;
}
@@ -2467,7 +2685,6 @@ FreeArithSeriesInternalRep(Tcl_Obj *arithSeriesPtr)
}
ckfree((char *) arithSeriesRepPtr->elements);
}
- Tcl_DecrRefCount(arithSeriesRepPtr->wideObjPtr);
ckfree((char *) arithSeriesRepPtr);
arithSeriesPtr->internalRep.twoPtrValue.ptr1 = NULL;
}
@@ -2502,14 +2719,8 @@ DupArithSeriesInternalRep(srcPtr, copyPtr)
* Allocate a new ArithSeries structure. */
copyArithSeriesRepPtr = (ArithSeries*) ckalloc(sizeof(ArithSeries));
- copyArithSeriesRepPtr->start = srcArithSeriesRepPtr->start;
- copyArithSeriesRepPtr->end = srcArithSeriesRepPtr->end;
- copyArithSeriesRepPtr->step = srcArithSeriesRepPtr->step;
- copyArithSeriesRepPtr->len = srcArithSeriesRepPtr->len;
+ *copyArithSeriesRepPtr = *srcArithSeriesRepPtr;
copyArithSeriesRepPtr->elements = NULL;
- copyArithSeriesRepPtr->wideObjPtr = Tcl_NewWideIntObj(0);
- Tcl_IncrRefCount(copyArithSeriesRepPtr->wideObjPtr);
-
copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesRepPtr;
copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
copyPtr->typePtr = &tclArithSeriesType;
@@ -2548,24 +2759,20 @@ UpdateStringOfArithSeries(Tcl_Obj *arithSeriesPtr)
{
ArithSeries *arithSeriesRepPtr =
(ArithSeries*) arithSeriesPtr->internalRep.twoPtrValue.ptr1;
- char buffer[TCL_INTEGER_SPACE+2], *p;
+ char *elem, *p;
+ Tcl_Obj *elemObj;
Tcl_WideInt i;
- Tcl_WideInt length = 0, ele;
+ Tcl_WideInt length = 0;
int slen;
/*
* Pass 1: estimate space.
*/
for (i = 0; i < arithSeriesRepPtr->len; i++) {
- ele = ArithSeriesIndexM(arithSeriesRepPtr, i);
- /*
- * Note that sprintf will generate a compiler warning under
- * Mingw claiming %I64 is an unknown format specifier.
- * Just ignore this warning. We can't use %L as the format
- * specifier since that gets printed as a 32 bit value.
- */
- sprintf(buffer, "%" TCL_LL_MODIFIER "d", ele);
- slen = strlen(buffer) + 1; /* + 1 is for the space or the nul-term */
+ TclArithSeriesObjIndex(arithSeriesPtr, i, &elemObj);
+ elem = TclGetStringFromObj(elemObj, &slen);
+ Tcl_DecrRefCount(elemObj);
+ slen += 1; /* + 1 is for the space or the nul-term */
length += slen;
}
@@ -2575,12 +2782,12 @@ UpdateStringOfArithSeries(Tcl_Obj *arithSeriesPtr)
p = Tcl_InitStringRep(arithSeriesPtr, NULL, length);
for (i = 0; i < arithSeriesRepPtr->len; i++) {
- ele = ArithSeriesIndexM(arithSeriesRepPtr, i);
- sprintf(buffer, "%" TCL_LL_MODIFIER "d", ele);
- slen = strlen(buffer);
- strcpy(p, buffer);
+ TclArithSeriesObjIndex(arithSeriesPtr, i, &elemObj);
+ elem = TclGetStringFromObj(elemObj, &slen);
+ strcpy(p, elem);
p[slen] = ' ';
p += slen+1;
+ Tcl_DecrRefCount(elemObj);
}
if (length > 0) arithSeriesPtr->bytes[length-1] = '\0';
arithSeriesPtr->length = length-1;
@@ -2691,7 +2898,7 @@ TclArithSeriesObjRange(
int toIdx) /* Index of last element to include. */
{
ArithSeries *arithSeriesRepPtr;
- Tcl_WideInt start = -1, end = -1, step, len;
+ Tcl_Obj *startObj, *endObj, *stepObj;
ArithSeriesGetInternalRep(arithSeriesPtr, arithSeriesRepPtr);
@@ -2704,14 +2911,21 @@ TclArithSeriesObjRange(
return obj;
}
- TclArithSeriesObjIndex(arithSeriesPtr, fromIdx, &start);
- TclArithSeriesObjIndex(arithSeriesPtr, toIdx, &end);
- step = arithSeriesRepPtr->step;
- len = ArithSeriesLen(start, end, step);
+ TclArithSeriesObjIndex(arithSeriesPtr, fromIdx, &startObj);
+ Tcl_IncrRefCount(startObj);
+ TclArithSeriesObjIndex(arithSeriesPtr, toIdx, &endObj);
+ Tcl_IncrRefCount(endObj);
+ TclArithSeriesObjStep(arithSeriesPtr, &stepObj);
+ Tcl_IncrRefCount(stepObj);
if (Tcl_IsShared(arithSeriesPtr) ||
((arithSeriesPtr->refCount > 1))) {
- return TclNewArithSeriesObj(start, end, step, len);
+ Tcl_Obj *newSlicePtr = TclNewArithSeriesObj(arithSeriesRepPtr->isDouble,
+ startObj, endObj, stepObj, NULL);
+ Tcl_DecrRefCount(startObj);
+ Tcl_DecrRefCount(endObj);
+ Tcl_DecrRefCount(stepObj);
+ return newSlicePtr;
}
/*
@@ -2725,11 +2939,33 @@ TclArithSeriesObjRange(
TclInvalidateStringRep(arithSeriesPtr);
- arithSeriesRepPtr->start = start;
- arithSeriesRepPtr->end = end;
- arithSeriesRepPtr->step = step;
- arithSeriesRepPtr->len = len;
- arithSeriesRepPtr->elements = NULL;
+ if (arithSeriesRepPtr->isDouble) {
+ ArithSeriesDbl *arithSeriesDblRepPtr = (ArithSeriesDbl*)arithSeriesPtr;
+ double start, end, step;
+ Tcl_GetDoubleFromObj(NULL, startObj, &start);
+ Tcl_GetDoubleFromObj(NULL, endObj, &end);
+ Tcl_GetDoubleFromObj(NULL, stepObj, &step);
+ arithSeriesDblRepPtr->start = start;
+ arithSeriesDblRepPtr->end = end;
+ arithSeriesDblRepPtr->step = step;
+ arithSeriesDblRepPtr->len = (end-start+step)/step;
+ arithSeriesDblRepPtr->elements = NULL;
+
+ } else {
+ Tcl_WideInt start, end, step;
+ Tcl_GetWideIntFromObj(NULL, startObj, &start);
+ Tcl_GetWideIntFromObj(NULL, endObj, &end);
+ Tcl_GetWideIntFromObj(NULL, stepObj, &step);
+ arithSeriesRepPtr->start = start;
+ arithSeriesRepPtr->end = end;
+ arithSeriesRepPtr->step = step;
+ arithSeriesRepPtr->len = (end-start+step)/step;
+ arithSeriesRepPtr->elements = NULL;
+ }
+
+ Tcl_DecrRefCount(startObj);
+ Tcl_DecrRefCount(endObj);
+ Tcl_DecrRefCount(stepObj);
return arithSeriesPtr;
}
@@ -2844,39 +3080,77 @@ TclArithSeriesObjReverse(
Tcl_Obj *arithSeriesPtr) /* List object to reverse. */
{
ArithSeries *arithSeriesRepPtr;
- Tcl_WideInt start = -1, end = -1, step, len;
+ Tcl_Obj *startObj, *endObj, *stepObj;
+ Tcl_Obj *resultObj;
+ Tcl_WideInt start, end, step, len;
+ double dstart, dend, dstep;
+ int isDouble;
ArithSeriesGetInternalRep(arithSeriesPtr, arithSeriesRepPtr);
+ isDouble = arithSeriesRepPtr->isDouble;
len = arithSeriesRepPtr->len;
- TclArithSeriesObjIndex(arithSeriesPtr, (len-1), &start);
- TclArithSeriesObjIndex(arithSeriesPtr, 0, &end);
- step = -arithSeriesRepPtr->step;
+
+ TclArithSeriesObjIndex(arithSeriesPtr, (len-1), &startObj);
+ TclArithSeriesObjIndex(arithSeriesPtr, 0, &endObj);
+ TclArithSeriesObjStep(arithSeriesPtr, &stepObj);
+
+ if (isDouble) {
+ Tcl_GetDoubleFromObj(NULL, startObj, &dstart);
+ Tcl_GetDoubleFromObj(NULL, endObj, &dend);
+ Tcl_GetDoubleFromObj(NULL, stepObj, &dstep);
+ dstep = -dstep;
+ TclSetDoubleObj(stepObj, dstep);
+ } else {
+ Tcl_GetWideIntFromObj(NULL, startObj, &start);
+ Tcl_GetWideIntFromObj(NULL, endObj, &end);
+ Tcl_GetWideIntFromObj(NULL, stepObj, &step);
+ step = -step;
+ TclSetIntObj(stepObj, step);
+ }
if (Tcl_IsShared(arithSeriesPtr) ||
((arithSeriesPtr->refCount > 1))) {
- return TclNewArithSeriesObj(start, end, step, len);
- }
+ Tcl_Obj *lenObj = Tcl_NewWideIntObj(len);
+ resultObj = TclNewArithSeriesObj(isDouble,
+ startObj, endObj, stepObj, lenObj);
+ Tcl_DecrRefCount(lenObj);
+ } else {
- /*
- * In-place is possible.
- */
+ /*
+ * In-place is possible.
+ */
- TclInvalidateStringRep(arithSeriesPtr);
+ TclInvalidateStringRep(arithSeriesPtr);
- arithSeriesRepPtr->start = start;
- arithSeriesRepPtr->end = end;
- arithSeriesRepPtr->step = step;
- if (arithSeriesRepPtr->elements) {
- Tcl_WideInt i;
- for (i=0; i<len; i++) {
- Tcl_DecrRefCount(arithSeriesRepPtr->elements[i]);
+ if (isDouble) {
+ ArithSeriesDbl *arithSeriesDblRepPtr =
+ (ArithSeriesDbl*)arithSeriesRepPtr;
+ arithSeriesDblRepPtr->start = dstart;
+ arithSeriesDblRepPtr->end = dend;
+ arithSeriesDblRepPtr->step = dstep;
+ } else {
+ arithSeriesRepPtr->start = start;
+ arithSeriesRepPtr->end = end;
+ arithSeriesRepPtr->step = step;
}
- ckfree((char*)arithSeriesRepPtr->elements);
+ if (arithSeriesRepPtr->elements) {
+ Tcl_WideInt i;
+ for (i=0; i<len; i++) {
+ Tcl_DecrRefCount(arithSeriesRepPtr->elements[i]);
+ }
+ ckfree((char*)arithSeriesRepPtr->elements);
+ }
+ arithSeriesRepPtr->elements = NULL;
+
+ resultObj = arithSeriesPtr;
}
- arithSeriesRepPtr->elements = NULL;
- return arithSeriesPtr;
+ Tcl_DecrRefCount(startObj);
+ Tcl_DecrRefCount(endObj);
+ Tcl_DecrRefCount(stepObj);
+
+ return resultObj;
}
diff --git a/tests/lseq.test b/tests/lseq.test
index 04f9c77..4c837ba 100644
--- a/tests/lseq.test
+++ b/tests/lseq.test
@@ -14,7 +14,7 @@ if {"::tcltest" ni [namespace children]} {
namespace import -force ::tcltest::*
}
-testConstraint arithSeriesDouble 0
+testConstraint arithSeriesDouble 1
testConstraint arithSeriesShimmer 1
testConstraint arithSeriesShimmerOk 0
@@ -71,7 +71,7 @@ test lseq-1.11 {error case: increasing wrong step direction} {
test lseq-1.12 {decreasing lseq with step} arithSeriesDouble {
lseq 25. to -25. by -5
-} { 25.0 20.0 15.0 10.0 5.0 0.0 -5.0 -10.0 -15.0 -20.0 -25.0}
+} {25.0 20.0 15.0 10.0 5.0 0.0 -5.0 -10.0 -15.0 -20.0 -25.0}
test lseq-1.13 {count operation} {
-body {
@@ -172,7 +172,7 @@ test lseq-2.11 {error case: increasing wrong step direction} {
test lseq-2.12 {decreasing lseq with step} arithSeriesDouble {
lseq 25. -25. -5
-} { 25.0 20.0 15.0 10.0 5.0 0.0 -5.0 -10.0 -15.0 -20.0 -25.0}
+} {25.0 20.0 15.0 10.0 5.0 0.0 -5.0 -10.0 -15.0 -20.0 -25.0}
test lseq-2.13 {count only operation} {
lseq 5
@@ -188,7 +188,7 @@ test lseq-2.15 {count with decreasing step} {
test lseq-2.16 {large numbers} {
lseq 1e6 2e6 1e5
-} {1000000 1100000 1200000 1300000 1400000 1500000 1600000 1700000 1800000 1900000 2000000}
+} {1000000.0 1100000.0 1200000.0 1300000.0 1400000.0 1500000.0 1600000.0 1700000.0 1800000.0 1900000.0 2000000.0}
test lseq-2.17 {large numbers} arithSeriesDouble {
lseq 1e6 2e6 1e5
@@ -394,6 +394,23 @@ test lseq-3.29 {edge case: negative count} {
lseq -15
} {}
+test lseq-3.30 {lreverse with double values} arithSeriesDouble {
+ set r [lseq 3.5 18.5 1.5]
+ set a [lreverse $r]
+ join [list \
+ [lindex [tcl::unsupported::representation $r] 3] \
+ $r \
+ [lindex [tcl::unsupported::representation $a] 3] \
+ $a] \n
+} {arithseries
+3.5 5.0 6.5 8.0 9.5 11.0 12.5 14.0 15.5 17.0 18.5
+arithseries
+18.5 17.0 15.5 14.0 12.5 11.0 9.5 8.0 6.5 5.0 3.5}
+
+test lseq-3.31 {lreverse inplace with doubles} arithSeriesDouble {
+ lreverse [lseq 1.1 29.9 0.3]
+} {29.9 29.599999999999998 29.299999999999997 29.0 28.7 28.4 28.099999999999998 27.799999999999997 27.5 27.2 26.9 26.599999999999998 26.299999999999997 26.0 25.7 25.4 25.099999999999998 24.799999999999997 24.5 24.2 23.9 23.599999999999998 23.299999999999997 23.0 22.7 22.4 22.099999999999998 21.799999999999997 21.5 21.2 20.9 20.6 20.299999999999997 20.0 19.7 19.4 19.1 18.799999999999997 18.5 18.2 17.9 17.6 17.299999999999997 17.0 16.7 16.4 16.1 15.799999999999999 15.5 15.2 14.899999999999999 14.6 14.299999999999999 14.0 13.7 13.399999999999999 13.099999999999998 12.8 12.5 12.2 11.899999999999999 11.599999999999998 11.3 11.0 10.7 10.399999999999999 10.099999999999998 9.8 9.5 9.2 8.899999999999999 8.599999999999998 8.3 8.0 7.699999999999999 7.399999999999999 7.099999999999998 6.800000000000001 6.5 6.199999999999999 5.899999999999999 5.599999999999998 5.300000000000001 5.0 4.699999999999999 4.399999999999999 4.099999999999998 3.8000000000000007 3.5 3.1999999999999993 2.8999999999999986 2.599999999999998 2.3000000000000007 2.0 1.6999999999999993 1.3999999999999986 1.1000000000000014}
+
test lseq-4.1 {end expressions} {
set start 7
lseq $start $start+11
@@ -405,6 +422,56 @@ test lseq-4.2 {start expressions} {
lmap t $tl {expr {$t - $base + 60}}
} {0 10 20 30 40 50 60}
+## lseq 1 to 10 by -2
+## # -> lseq: invalid step = -2 with a = 1 and b = 10
+
+test lseq-4.3 {TIP examples} {
+ set examples {# Examples from TIP-629
+ # --- Begin ---
+ lseq 10 .. 1
+ # -> 10 9 8 7 6 5 4 3 2 1
+ lseq 1 .. 10
+ # -> 1 2 3 4 5 6 7 8 9 10
+ lseq 10 .. 1 by 2
+ # ->
+ lseq 10 .. 1 by -2
+ # -> 10 8 6 4 2
+ lseq 5.0 to 15.
+ # -> 5.0 6.0 7.0 8.0 9.0 10.0 11.0 12.0 13.0 14.0 15.0
+ lseq 5.0 to 25. by 5
+ # -> 5.0 10.0 15.0 20.0 25.0
+ lseq 25. to 5. by 5
+ # ->
+ lseq 25. to 5. by -5
+ # -> 25.0 20.0 15.0 10.0 5.0
+ lseq 1 to 10 by 2
+ # -> 1 3 5 7 9
+ lseq 25. to -25. by -5
+ # -> 25.0 20.0 15.0 10.0 5.0 0.0 -5.0 -10.0 -15.0 -20.0 -25.0
+ lseq 5 5
+ # -> 5
+ lseq 5 5 2
+ # -> 5
+ lseq 5 5 -2
+ # -> 5
+ }
+
+ foreach {cmd expect} [split $examples \n] {
+ if {[string trim $cmd] ne ""} {
+ set cmd [string trimleft $cmd]
+ if {[string match {\#*} $cmd]} continue
+ set status [catch $cmd ans]
+ lappend res $ans
+ if {[regexp {\# -> (.*)$} $expect -> expected]} {
+ if {$expected ne $ans} {
+ lappend res [list Mismatch: $cmd -> $ans ne $expected]
+ }
+ }
+ }
+ }
+ set res
+} {{10 9 8 7 6 5 4 3 2 1} {1 2 3 4 5 6 7 8 9 10} {} {10 8 6 4 2} {5.0 6.0 7.0 8.0 9.0 10.0 11.0 12.0 13.0 14.0 15.0} {5.0 10.0 15.0 20.0 25.0} {} {25.0 20.0 15.0 10.0 5.0} {1 3 5 7 9} {25.0 20.0 15.0 10.0 5.0 0.0 -5.0 -10.0 -15.0 -20.0 -25.0} 5 5 5}
+
# cleanup
::tcltest::cleanupTests