diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2022-11-25 23:38:50 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2022-11-25 23:38:50 (GMT) |
commit | bfe8928bed8d82210b9a892f1ea0add32ac7ad59 (patch) | |
tree | b035e4acd3ecf6630f6203802365f1a86c3a6839 /generic | |
parent | 7bf0253a4354d176c6582cd6f4ed02434e6c4797 (diff) | |
parent | ba490472b58358406e7f04356e4e8a076644d9c6 (diff) | |
download | tcl-bfe8928bed8d82210b9a892f1ea0add32ac7ad59.zip tcl-bfe8928bed8d82210b9a892f1ea0add32ac7ad59.tar.gz tcl-bfe8928bed8d82210b9a892f1ea0add32ac7ad59.tar.bz2 |
Merge 9.0
Diffstat (limited to 'generic')
-rwxr-xr-x | generic/tclArithSeries.c | 7 | ||||
-rw-r--r-- | generic/tclClock.c | 12 | ||||
-rw-r--r-- | generic/tclCmdIL.c | 4 | ||||
-rw-r--r-- | generic/tclCmdMZ.c | 6 | ||||
-rw-r--r-- | generic/tclCompExpr.c | 2 | ||||
-rw-r--r-- | generic/tclIO.c | 32 | ||||
-rw-r--r-- | generic/tclInt.decls | 2 | ||||
-rw-r--r-- | generic/tclIntDecls.h | 6 | ||||
-rw-r--r-- | generic/tclLink.c | 7 | ||||
-rw-r--r-- | generic/tclListObj.c | 14 | ||||
-rw-r--r-- | generic/tclScan.c | 4 | ||||
-rw-r--r-- | generic/tclTest.c | 12 |
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; } |