summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2022-11-25 23:38:50 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2022-11-25 23:38:50 (GMT)
commitbfe8928bed8d82210b9a892f1ea0add32ac7ad59 (patch)
treeb035e4acd3ecf6630f6203802365f1a86c3a6839 /generic
parent7bf0253a4354d176c6582cd6f4ed02434e6c4797 (diff)
parentba490472b58358406e7f04356e4e8a076644d9c6 (diff)
downloadtcl-bfe8928bed8d82210b9a892f1ea0add32ac7ad59.zip
tcl-bfe8928bed8d82210b9a892f1ea0add32ac7ad59.tar.gz
tcl-bfe8928bed8d82210b9a892f1ea0add32ac7ad59.tar.bz2
Merge 9.0
Diffstat (limited to 'generic')
-rwxr-xr-xgeneric/tclArithSeries.c7
-rw-r--r--generic/tclClock.c12
-rw-r--r--generic/tclCmdIL.c4
-rw-r--r--generic/tclCmdMZ.c6
-rw-r--r--generic/tclCompExpr.c2
-rw-r--r--generic/tclIO.c32
-rw-r--r--generic/tclInt.decls2
-rw-r--r--generic/tclIntDecls.h6
-rw-r--r--generic/tclLink.c7
-rw-r--r--generic/tclListObj.c14
-rw-r--r--generic/tclScan.c4
-rw-r--r--generic/tclTest.c12
12 files changed, 64 insertions, 44 deletions
diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c
index 8155126..34c0dd1 100755
--- a/generic/tclArithSeries.c
+++ b/generic/tclArithSeries.c
@@ -393,9 +393,9 @@ TclArithSeriesObjStep(
}
arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesPtr);
if (arithSeriesRepPtr->isDouble) {
- *stepObj = Tcl_NewDoubleObj(((ArithSeriesDbl*)(arithSeriesRepPtr))->step);
+ TclNewDoubleObj(*stepObj, ((ArithSeriesDbl*)(arithSeriesRepPtr))->step);
} else {
- *stepObj = Tcl_NewWideIntObj(arithSeriesRepPtr->step);
+ TclNewIntObj(*stepObj, arithSeriesRepPtr->step);
}
return TCL_OK;
}
@@ -959,7 +959,8 @@ TclArithSeriesObjReverse(
if (Tcl_IsShared(arithSeriesPtr) ||
((arithSeriesPtr->refCount > 1))) {
- Tcl_Obj *lenObj = Tcl_NewWideIntObj(len);
+ Tcl_Obj *lenObj;
+ TclNewIntObj(lenObj, len);
if (TclNewArithSeriesObj(interp, &resultObj,
isDouble, startObj, endObj, stepObj, lenObj) != TCL_OK) {
resultObj = NULL;
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 36f82e6..1d33886 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -14,6 +14,7 @@
*/
#include "tclInt.h"
+#include "tclTomMath.h"
/*
* Windows has mktime. The configurators do not check.
@@ -1804,14 +1805,16 @@ ClockMillisecondsObjCmd(
Tcl_Obj *const *objv) /* Parameter values */
{
Tcl_Time now;
+ Tcl_Obj *timeObj;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
Tcl_GetTime(&now);
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
- now.sec * 1000 + now.usec / 1000));
+ TclNewUIntObj(timeObj, (Tcl_WideUInt)
+ now.sec * 1000 + now.usec / 1000);
+ Tcl_SetObjResult(interp, timeObj);
return TCL_OK;
}
@@ -1992,13 +1995,16 @@ ClockSecondsObjCmd(
Tcl_Obj *const *objv) /* Parameter values */
{
Tcl_Time now;
+ Tcl_Obj *timeObj;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
Tcl_GetTime(&now);
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) now.sec));
+ TclNewUIntObj(timeObj, (Tcl_WideUInt)now.sec);
+
+ Tcl_SetObjResult(interp, timeObj);
return TCL_OK;
}
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index befcb9a..612764d 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -4111,10 +4111,10 @@ SequenceIdentifyArgument(
exprValueObj = argPtr;
} else {
if (floor(dvalue) == dvalue) {
- exprValueObj = Tcl_NewWideIntObj(value);
+ TclNewIntObj(exprValueObj, value);
keyword = TCL_NUMBER_INT;
} else {
- exprValueObj = Tcl_NewDoubleObj(dvalue);
+ TclNewDoubleObj(exprValueObj, dvalue);
keyword = TCL_NUMBER_DOUBLE;
}
}
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 7506e66..8e77862 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -4073,9 +4073,9 @@ Tcl_TimeObjCmd(
* Use int obj since we know time is not fractional. [Bug 1202178]
*/
- objs[0] = Tcl_NewWideIntObj((count <= 0) ? 0 : (Tcl_WideInt)totalMicroSec);
+ TclNewIntObj(objs[0], (count <= 0) ? 0 : (Tcl_WideInt)totalMicroSec);
} else {
- objs[0] = Tcl_NewDoubleObj(totalMicroSec/count);
+ TclNewDoubleObj(objs[0], totalMicroSec/count);
}
/*
@@ -4560,7 +4560,7 @@ Tcl_TimeRateObjCmd(
if (measureOverhead > ((double) usec) / count) {
measureOverhead = ((double) usec) / count;
}
- objs[0] = Tcl_NewDoubleObj(measureOverhead);
+ TclNewDoubleObj(objs[0], measureOverhead);
TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#-overhead"); /* mics */
objs += 2;
}
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 5e7806d..b7bcf7c 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -2790,7 +2790,7 @@ TclVariadicOpCmd(
nodes[1].p.parent = 0;
} else {
if (lexeme == DIVIDE) {
- litObjv[0] = Tcl_NewDoubleObj(1.0);
+ TclNewDoubleObj(litObjv[0], 1.0);
} else {
TclNewIntObj(litObjv[0], occdPtr->i.identity);
}
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 1541390..64b309d 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -393,9 +393,9 @@ ChanClose(
* calling Tcl_GetErrno().
*
* Side effects:
- * The CHANNEL_BLOCKED and CHANNEL_EOF flags of the channel state are set
- * as appropriate. On EOF, the inputEncodingFlags are set to perform
- * ending operations on decoding.
+ * The CHANNEL_ENCODING_ERROR, CHANNEL_BLOCKED and CHANNEL_EOF flags
+ * of the channel state are set as appropriate. On EOF, the
+ * inputEncodingFlags are set to perform ending operations on decoding.
*
* TODO - Is this really the right place for that?
*
@@ -4610,6 +4610,12 @@ Tcl_GetsObj(
char *dst, *dstEnd, *eol, *eof;
Tcl_EncodingState oldState;
+ if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) {
+ UpdateInterest(chanPtr);
+ Tcl_SetErrno(EILSEQ);
+ return TCL_INDEX_NONE;
+ }
+
if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
return TCL_INDEX_NONE;
}
@@ -4981,6 +4987,7 @@ Tcl_GetsObj(
done:
assert(!GotFlag(statePtr, CHANNEL_EOF)
|| GotFlag(statePtr, CHANNEL_STICKY_EOF)
+ || GotFlag(statePtr, CHANNEL_ENCODING_ERROR)
|| Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
== (CHANNEL_EOF|CHANNEL_BLOCKED)));
@@ -5970,6 +5977,12 @@ DoReadChars(
}
}
+ if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) {
+ /* TODO: We don't need this call? */
+ UpdateInterest(chanPtr);
+ Tcl_SetErrno(EILSEQ);
+ return -1;
+ }
/*
* Early out when next read will see eofchar.
*
@@ -9983,6 +9996,11 @@ DoRead(
* too. Keep on keeping on for now.
*/
+ if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) {
+ UpdateInterest(chanPtr);
+ Tcl_SetErrno(EILSEQ);
+ return -1;
+ }
if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
SetFlag(statePtr, CHANNEL_EOF);
assert(statePtr->inputEncodingFlags & TCL_ENCODING_END);
@@ -10080,10 +10098,10 @@ DoRead(
}
/*
- * 1) We're @EOF because we saw eof char.
+ * 1) We're @EOF because we saw eof char, or there was an encoding error.
*/
- if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
+ if (GotFlag(statePtr, CHANNEL_STICKY_EOF|CHANNEL_ENCODING_ERROR)) {
break;
}
@@ -10168,6 +10186,7 @@ DoRead(
assert(!GotFlag(statePtr, CHANNEL_EOF)
|| GotFlag(statePtr, CHANNEL_STICKY_EOF)
+ || GotFlag(statePtr, CHANNEL_ENCODING_ERROR)
|| Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
== (CHANNEL_EOF|CHANNEL_BLOCKED)));
@@ -11348,8 +11367,8 @@ DumpFlags(
char *str,
int flags)
{
- char buf[20];
int i = 0;
+ char buf[24];
#define ChanFlag(chr, bit) (buf[i++] = ((flags & (bit)) ? (chr) : '_'))
@@ -11362,6 +11381,7 @@ DumpFlags(
ChanFlag('c', CHANNEL_CLOSED);
ChanFlag('E', CHANNEL_EOF);
ChanFlag('S', CHANNEL_STICKY_EOF);
+ ChanFlag('U', CHANNEL_ENCODING_ERROR);
ChanFlag('B', CHANNEL_BLOCKED);
ChanFlag('/', INPUT_SAW_CR);
ChanFlag('D', CHANNEL_DEAD);
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index d9bd5c5..0c88b87 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -706,7 +706,7 @@ declare 258 {
# TIP 625: for unit testing - create list objects with span
declare 260 {
- Tcl_Obj *TclListTestObj(int length, int leadingSpace, int endSpace)
+ Tcl_Obj *TclListTestObj(Tcl_Size length, Tcl_Size leadingSpace, Tcl_Size endSpace)
}
# TIP 625: for unit testing - check list invariants
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index eaa7d95..128e3c9 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -578,8 +578,8 @@ EXTERN Tcl_Obj * TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj);
/* Slot 259 is reserved */
/* 260 */
-EXTERN Tcl_Obj * TclListTestObj(int length, int leadingSpace,
- int endSpace);
+EXTERN Tcl_Obj * TclListTestObj(Tcl_Size length,
+ Tcl_Size leadingSpace, Tcl_Size endSpace);
/* 261 */
EXTERN void TclListObjValidate(Tcl_Interp *interp,
Tcl_Obj *listObj);
@@ -848,7 +848,7 @@ typedef struct TclIntStubs {
void (*tclStaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 257 */
Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */
void (*reserved259)(void);
- Tcl_Obj * (*tclListTestObj) (int length, int leadingSpace, int endSpace); /* 260 */
+ Tcl_Obj * (*tclListTestObj) (Tcl_Size length, Tcl_Size leadingSpace, Tcl_Size endSpace); /* 260 */
void (*tclListObjValidate) (Tcl_Interp *interp, Tcl_Obj *listObj); /* 261 */
} TclIntStubs;
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 5b473d1..37c104b 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -1283,7 +1283,7 @@ ObjValue(
memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
for (i=0; i < linkPtr->numElems; i++) {
- objv[i] = Tcl_NewDoubleObj(linkPtr->lastValue.dPtr[i]);
+ TclNewDoubleObj(objv[i], linkPtr->lastValue.dPtr[i]);
}
resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
Tcl_Free(objv);
@@ -1402,7 +1402,7 @@ ObjValue(
memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
for (i=0; i < linkPtr->numElems; i++) {
- objv[i] = Tcl_NewDoubleObj(linkPtr->lastValue.fPtr[i]);
+ TclNewDoubleObj(objv[i], linkPtr->lastValue.fPtr[i]);
}
resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
Tcl_Free(objv);
@@ -1415,8 +1415,7 @@ ObjValue(
memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
for (i=0; i < linkPtr->numElems; i++) {
- TclNewUIntObj(objv[i],
- linkPtr->lastValue.uwPtr[i]);
+ TclNewUIntObj(objv[i], linkPtr->lastValue.uwPtr[i]);
}
resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
Tcl_Free(objv);
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index d9fcada..4a5b3ae 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -11,6 +11,7 @@
#include <assert.h>
#include "tclInt.h"
+#include "tclTomMath.h"
#include "tclArithSeries.h"
/*
@@ -3528,15 +3529,8 @@ UpdateStringOfList(
*------------------------------------------------------------------------
*/
Tcl_Obj *
-TclListTestObj (int length, int leadingSpace, int endSpace)
+TclListTestObj(Tcl_Size length, Tcl_Size leadingSpace, Tcl_Size endSpace)
{
- if (length < 0)
- length = 0;
- if (leadingSpace < 0)
- leadingSpace = 0;
- if (endSpace < 0)
- endSpace = 0;
-
ListRep listRep;
Tcl_Size capacity;
Tcl_Obj *listObj;
@@ -3552,9 +3546,9 @@ TclListTestObj (int length, int leadingSpace, int endSpace)
ListRepInit(capacity, NULL, 0, &listRep);
ListStore *storePtr = listRep.storePtr;
- int i;
+ Tcl_Size i;
for (i = 0; i < length; ++i) {
- storePtr->slots[i + leadingSpace] = Tcl_NewIntObj(i);
+ TclNewUIntObj(storePtr->slots[i + leadingSpace], i);
Tcl_IncrRefCount(storePtr->slots[i + leadingSpace]);
}
storePtr->firstUsed = leadingSpace;
diff --git a/generic/tclScan.c b/generic/tclScan.c
index 3e9cfae..ee18174 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -993,7 +993,7 @@ Tcl_ScanObjCmd(
* Scan a floating point number
*/
- objPtr = Tcl_NewDoubleObj(0.0);
+ TclNewDoubleObj(objPtr, 0.0);
Tcl_IncrRefCount(objPtr);
if (width == 0) {
width = ~0;
@@ -1090,7 +1090,7 @@ Tcl_ScanObjCmd(
if (code == TCL_OK) {
if (underflow && (nconversions == 0)) {
if (numVars) {
- TclNewIndexObj(objPtr, TCL_INDEX_NONE);
+ TclNewIntObj(objPtr, -1);
} else {
if (objPtr) {
Tcl_SetListObj(objPtr, 0, NULL);
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 869ab1d..f175c01 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -3500,18 +3500,18 @@ TestlistrepCmd(
Tcl_WrongNumArgs(interp, 2, objv, "length ?leadSpace endSpace?");
return TCL_ERROR;
} else {
- int length;
- int leadSpace = 0;
- int endSpace = 0;
- if (Tcl_GetIntFromObj(interp, objv[2], &length) != TCL_OK) {
+ Tcl_WideInt length;
+ Tcl_WideInt leadSpace = 0;
+ Tcl_WideInt endSpace = 0;
+ if (Tcl_GetWideIntFromObj(interp, objv[2], &length) != TCL_OK) {
return TCL_ERROR;
}
if (objc > 3) {
- if (Tcl_GetIntFromObj(interp, objv[3], &leadSpace) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(interp, objv[3], &leadSpace) != TCL_OK) {
return TCL_ERROR;
}
if (objc > 4) {
- if (Tcl_GetIntFromObj(interp, objv[4], &endSpace)
+ if (Tcl_GetWideIntFromObj(interp, objv[4], &endSpace)
!= TCL_OK) {
return TCL_ERROR;
}