diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2022-11-13 17:11:37 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2022-11-13 17:11:37 (GMT) |
commit | c7ea989512ae5da9dbbad648d0c0b39158b97404 (patch) | |
tree | cac830050ce86767f41a78331be36b9eaff62631 /generic | |
parent | 46a5d4b5fa40f76f18980d1995c96698335ad4b2 (diff) | |
parent | 3c61afae6735dd0fd14a8ec428464827a8cc68cd (diff) | |
download | tcl-c7ea989512ae5da9dbbad648d0c0b39158b97404.zip tcl-c7ea989512ae5da9dbbad648d0c0b39158b97404.tar.gz tcl-c7ea989512ae5da9dbbad648d0c0b39158b97404.tar.bz2 |
Merge 8.7
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tcl.decls | 8 | ||||
-rw-r--r-- | generic/tclClock.c | 4 | ||||
-rw-r--r-- | generic/tclCmdMZ.c | 4 | ||||
-rw-r--r-- | generic/tclDecls.h | 19 | ||||
-rw-r--r-- | generic/tclInt.decls | 2 | ||||
-rw-r--r-- | generic/tclIntDecls.h | 6 | ||||
-rw-r--r-- | generic/tclListObj.c | 13 | ||||
-rw-r--r-- | generic/tclObj.c | 67 | ||||
-rw-r--r-- | generic/tclScan.c | 2 | ||||
-rw-r--r-- | generic/tclStubInit.c | 2 | ||||
-rw-r--r-- | generic/tclTest.c | 4 |
11 files changed, 110 insertions, 21 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls index 6d9fbbd..85fe54f 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2552,6 +2552,14 @@ declare 683 { int Tcl_GetEncodingNulLength(Tcl_Encoding encoding) } +# TIP #648 +declare 684 { + Tcl_Obj *Tcl_NewWideUIntObj(Tcl_WideUInt wideValue) +} +declare 685 { + void Tcl_SetWideUIntObj(Tcl_Obj *objPtr, Tcl_WideUInt uwideValue) +} + # ----- BASELINE -- FOR -- 8.7.0 ----- # ############################################################################## diff --git a/generic/tclClock.c b/generic/tclClock.c index a9ba70c..d64348e 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -1810,7 +1810,7 @@ ClockMillisecondsObjCmd( return TCL_ERROR; } Tcl_GetTime(&now); - Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) + Tcl_SetObjResult(interp, Tcl_NewWideUIntObj((Tcl_WideUInt) now.sec * 1000 + now.usec / 1000)); return TCL_OK; } @@ -1998,7 +1998,7 @@ ClockSecondsObjCmd( return TCL_ERROR; } Tcl_GetTime(&now); - Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) now.sec)); + Tcl_SetObjResult(interp, Tcl_NewWideUIntObj(now.sec)); return TCL_OK; } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index b063689..ff466d9 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -3775,7 +3775,7 @@ TclNRSwitchObjCmd( TclNewIndexObj(rangeObjAry[0], info.matches[j].start); TclNewIndexObj(rangeObjAry[1], info.matches[j].end-1); } else { - TclNewIndexObj(rangeObjAry[1], TCL_INDEX_NONE); + TclNewIntObj(rangeObjAry[1], -1); rangeObjAry[0] = rangeObjAry[1]; } @@ -4099,7 +4099,7 @@ Tcl_TimeObjCmd( * Use int obj since we know time is not fractional. [Bug 1202178] */ - objs[0] = Tcl_NewWideIntObj((count <= 0) ? 0 : (Tcl_WideInt)totalMicroSec); + objs[0] = Tcl_NewWideUIntObj((count <= 0) ? 0 : (Tcl_WideUInt)totalMicroSec); } else { objs[0] = Tcl_NewDoubleObj(totalMicroSec/count); } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 0888ecf..6fcd08d 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -2040,6 +2040,11 @@ EXTERN int Tcl_RemoveChannelMode(Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 683 */ EXTERN int Tcl_GetEncodingNulLength(Tcl_Encoding encoding); +/* 684 */ +EXTERN Tcl_Obj * Tcl_NewWideUIntObj(Tcl_WideUInt wideValue); +/* 685 */ +EXTERN void Tcl_SetWideUIntObj(Tcl_Obj *objPtr, + Tcl_WideUInt uwideValue); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2759,6 +2764,8 @@ typedef struct TclStubs { int (*tcl_GetNumber) (Tcl_Interp *interp, const char *bytes, size_t numBytes, void **clientDataPtr, int *typePtr); /* 681 */ int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */ int (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */ + Tcl_Obj * (*tcl_NewWideUIntObj) (Tcl_WideUInt wideValue); /* 684 */ + void (*tcl_SetWideUIntObj) (Tcl_Obj *objPtr, Tcl_WideUInt uwideValue); /* 685 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -4157,6 +4164,10 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_RemoveChannelMode) /* 682 */ #define Tcl_GetEncodingNulLength \ (tclStubsPtr->tcl_GetEncodingNulLength) /* 683 */ +#define Tcl_NewWideUIntObj \ + (tclStubsPtr->tcl_NewWideUIntObj) /* 684 */ +#define Tcl_SetWideUIntObj \ + (tclStubsPtr->tcl_SetWideUIntObj) /* 685 */ #endif /* defined(USE_TCL_STUBS) */ @@ -4420,6 +4431,14 @@ extern const TclStubs *tclStubsPtr; #undef Tcl_StringMatch #define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0) +#if TCL_MAJOR_VERSION > 8 +# define Tcl_NewIndexObj(value) (((value) >= TCL_INDEX_NONE) ? Tcl_NewWideIntObj(-1) : Tcl_NewWideUIntObj(value)) +# define Tcl_SetIndexObj(objPtr, value) (((value) >= TCL_INDEX_NONE) ? Tcl_SetWideIntObj(objPtr, -1) : Tcl_SetWideUIntObj(objPtr, value)) +#else +# define Tcl_NewIndexObj Tcl_NewIntObj +# define Tcl_SetIndexObj Tcl_SetIntObj +#endif + #if TCL_UTF_MAX < 4 # undef Tcl_UniCharToUtfDString # define Tcl_UniCharToUtfDString Tcl_Char16ToUtfDString diff --git a/generic/tclInt.decls b/generic/tclInt.decls index c0e0e06..b3e352a 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -701,7 +701,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 3da8567..4c8d897 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -660,8 +660,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); @@ -930,7 +930,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/tclListObj.c b/generic/tclListObj.c index 8ee0f48..f016224 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -3514,15 +3514,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; @@ -3538,9 +3531,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); + storePtr->slots[i + leadingSpace] = Tcl_NewIndexObj(i); Tcl_IncrRefCount(storePtr->slots[i + leadingSpace]); } storePtr->firstUsed = leadingSpace; diff --git a/generic/tclObj.c b/generic/tclObj.c index ce8e610..4639731 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -3219,6 +3219,33 @@ Tcl_NewWideIntObj( /* *---------------------------------------------------------------------- * + * Tcl_NewWideUIntObj -- + * + * Results: + * The newly created object is returned. This object will have an invalid + * string representation. The returned object has ref count 0. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +Tcl_NewWideUIntObj( + Tcl_WideUInt uwideValue) + /* Wide integer used to initialize the new + * object. */ +{ + Tcl_Obj *objPtr; + + TclNewUIntObj(objPtr, uwideValue); + return objPtr; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_DbNewWideIntObj -- * * If a client is compiled with TCL_MEM_DEBUG defined, calls to @@ -3312,6 +3339,46 @@ Tcl_SetWideIntObj( TclSetIntObj(objPtr, wideValue); } + +/* + *---------------------------------------------------------------------- + * + * Tcl_SetWideUIntObj -- + * + * Modify an object to be a wide integer object or a bignum object + * and to have the specified unsigned wide integer value. + * + * Results: + * None. + * + * Side effects: + * The object's old string rep, if any, is freed. Also, any old internal + * rep is freed. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_SetWideUIntObj( + Tcl_Obj *objPtr, /* Object w. internal rep to init. */ + Tcl_WideUInt uwideValue) + /* Wide integer used to initialize the + * object's value. */ +{ + if (Tcl_IsShared(objPtr)) { + Tcl_Panic("%s called with shared object", "Tcl_SetWideUIntObj"); + } + + if (uwideValue > WIDE_MAX) { + mp_int bignumValue; + if (mp_init_u64(&bignumValue, uwideValue) != MP_OKAY) { + Tcl_Panic("%s: memory overflow", "Tcl_SetWideUIntObj"); + } + TclSetBignumInternalRep(objPtr, &bignumValue); + } { + TclSetIntObj(objPtr, (Tcl_WideInt)uwideValue); + } +} /* *---------------------------------------------------------------------- diff --git a/generic/tclScan.c b/generic/tclScan.c index 6bc914d..c0cf49f 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -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/tclStubInit.c b/generic/tclStubInit.c index 7af42d3..12e5e38 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -2053,6 +2053,8 @@ const TclStubs tclStubs = { Tcl_GetNumber, /* 681 */ Tcl_RemoveChannelMode, /* 682 */ Tcl_GetEncodingNulLength, /* 683 */ + Tcl_NewWideUIntObj, /* 684 */ + Tcl_SetWideUIntObj, /* 685 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclTest.c b/generic/tclTest.c index c9bad56..ba4dfc4 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -3114,12 +3114,12 @@ TestlinkCmd( tmp = Tcl_NewWideIntObj(longVar); Tcl_AppendElement(interp, Tcl_GetString(tmp)); Tcl_DecrRefCount(tmp); - tmp = Tcl_NewWideIntObj((long)ulongVar); + tmp = Tcl_NewWideUIntObj(ulongVar); Tcl_AppendElement(interp, Tcl_GetString(tmp)); Tcl_DecrRefCount(tmp); Tcl_PrintDouble(NULL, (double)floatVar, buffer); Tcl_AppendElement(interp, buffer); - tmp = Tcl_NewWideIntObj((Tcl_WideInt)uwideVar); + tmp = Tcl_NewWideUIntObj(uwideVar); Tcl_AppendElement(interp, Tcl_GetString(tmp)); Tcl_DecrRefCount(tmp); } else if (strcmp(argv[1], "set") == 0) { |