From 82fb7b1d551b7e74efa4ee9cc814ef74fab5332c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 27 Nov 2022 23:37:32 +0000 Subject: size_t result for lengthProc. More usage of Tcl_GetWideUIntFromObj --- generic/tclArithSeries.c | 2 +- generic/tclArithSeries.h | 2 +- generic/tclCmdIL.c | 4 +++- generic/tclExecute.c | 2 +- generic/tclInt.h | 2 +- generic/tclListObj.c | 6 +++--- generic/tclObj.c | 2 +- generic/tclTest.c | 32 ++++++++++++++++++++++++-------- generic/tclUtil.c | 2 +- tests/link.test | 2 +- 10 files changed, 37 insertions(+), 19 deletions(-) diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index 70bbb1b..1d6291d 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -462,7 +462,7 @@ TclArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr, Tcl_WideInt index, Tcl_Obj **ele * *---------------------------------------------------------------------- */ -unsigned long long TclArithSeriesObjLength(Tcl_Obj *arithSeriesPtr) +size_t TclArithSeriesObjLength(Tcl_Obj *arithSeriesPtr) { ArithSeries *arithSeriesRepPtr = (ArithSeries*) arithSeriesPtr->internalRep.twoPtrValue.ptr1; diff --git a/generic/tclArithSeries.h b/generic/tclArithSeries.h index 8392a57..ccd050f 100644 --- a/generic/tclArithSeries.h +++ b/generic/tclArithSeries.h @@ -39,7 +39,7 @@ 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 unsigned long long TclArithSeriesObjLength(Tcl_Obj *arithSeriesPtr); +MODULE_SCOPE size_t TclArithSeriesObjLength(Tcl_Obj *arithSeriesPtr); MODULE_SCOPE Tcl_Obj * TclArithSeriesObjRange(Tcl_Interp *interp, Tcl_Obj *arithSeriesPtr, Tcl_Size fromIdx, Tcl_Size toIdx); MODULE_SCOPE Tcl_Obj * TclArithSeriesObjReverse(Tcl_Interp *interp, diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 612764d..d5c7fc8 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -2575,6 +2575,7 @@ Tcl_LlengthObjCmd( { size_t listLen; int result; + Tcl_Obj *objPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "list"); @@ -2591,7 +2592,8 @@ Tcl_LlengthObjCmd( * length. */ - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(listLen)); + TclNewUIntObj(objPtr, listLen); + Tcl_SetObjResult(interp, objPtr); return TCL_OK; } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 9049c0a..c1a2bfd 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -4649,7 +4649,7 @@ TEBCresume( TRACE_ERROR(interp); goto gotError; } - TclNewIntObj(objResultPtr, length); + TclNewUIntObj(objResultPtr, length); TRACE_APPEND(("%" TCL_Z_MODIFIER "u\n", length)); NEXT_INST_F(1, 1, 1); diff --git a/generic/tclInt.h b/generic/tclInt.h index 0ff0d8e..b5fc48e 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1093,7 +1093,7 @@ typedef struct ActiveInterpTrace { typedef struct { /* For internal core use only */ Tcl_ObjType objType; - unsigned long long (*lengthProc)(Tcl_Obj *obj); + size_t (*lengthProc)(Tcl_Obj *obj); } TclObjTypeWithAbstractList; #define TCL_OBJTYPE_V0_1(lengthProc) (sizeof(TclObjTypeWithAbstractList)) \ }, lengthProc /* For internal core use only */ diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 565872e..58322c5 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -143,7 +143,7 @@ static void DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static void FreeListInternalRep(Tcl_Obj *listPtr); static int SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfList(Tcl_Obj *listPtr); -static unsigned long long ListLength(Tcl_Obj *listPtr); +static size_t ListLength(Tcl_Obj *listPtr); /* * The structure below defines the list Tcl object type by means of functions @@ -2024,7 +2024,7 @@ Tcl_ListObjLength( return TCL_OK; } -unsigned long long ListLength( +size_t ListLength( Tcl_Obj *listPtr) { ListRep listRep; @@ -2648,7 +2648,7 @@ TclLindexFlat( /* Handle ArithSeries as special case */ if (TclHasInternalRep(listObj,&tclArithSeriesType.objType)) { - Tcl_WideInt listLen = TclArithSeriesObjLength(listObj); + size_t listLen = TclArithSeriesObjLength(listObj); Tcl_Size index; Tcl_Obj *elemObj = NULL; for (i=0 ; i WIDE_MAX) { + mp_int bignumValue; + if (mp_init_u64(&bignumValue, ulongVar) != MP_OKAY) { + Tcl_Panic("%s: memory overflow", "Tcl_SetWideUIntObj"); + } + tmp = Tcl_NewBignumObj(&bignumValue); + } else { + tmp = Tcl_NewWideIntObj((Tcl_WideInt)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); + if (uwideVar > WIDE_MAX) { + mp_int bignumValue; + if (mp_init_u64(&bignumValue, uwideVar) != MP_OKAY) { + Tcl_Panic("%s: memory overflow", "Tcl_SetWideUIntObj"); + } + tmp = Tcl_NewBignumObj(&bignumValue); + } else { + tmp = Tcl_NewWideIntObj((Tcl_WideInt)uwideVar); + } Tcl_AppendElement(interp, Tcl_GetString(tmp)); Tcl_DecrRefCount(tmp); } else if (strcmp(argv[1], "set") == 0) { @@ -3500,18 +3516,18 @@ TestlistrepCmd( Tcl_WrongNumArgs(interp, 2, objv, "length ?leadSpace endSpace?"); return TCL_ERROR; } else { - Tcl_WideInt length; - Tcl_WideInt leadSpace = 0; - Tcl_WideInt endSpace = 0; - if (Tcl_GetWideIntFromObj(interp, objv[2], &length) != TCL_OK) { + Tcl_WideUInt length; + Tcl_WideUInt leadSpace = 0; + Tcl_WideUInt endSpace = 0; + if (Tcl_GetWideUIntFromObj(interp, objv[2], &length) != TCL_OK) { return TCL_ERROR; } if (objc > 3) { - if (Tcl_GetWideIntFromObj(interp, objv[3], &leadSpace) != TCL_OK) { + if (Tcl_GetWideUIntFromObj(interp, objv[3], &leadSpace) != TCL_OK) { return TCL_ERROR; } if (objc > 4) { - if (Tcl_GetWideIntFromObj(interp, objv[4], &endSpace) + if (Tcl_GetWideUIntFromObj(interp, objv[4], &endSpace) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 58fb1e4..a0a866b 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -122,7 +122,7 @@ static int FindElement(Tcl_Interp *interp, const char *string, * is unregistered, so has no need of a setFromAnyProc either. */ -static unsigned long long LengthOne(TCL_UNUSED(Tcl_Obj *)) {return 1;} +static size_t LengthOne(TCL_UNUSED(Tcl_Obj *)) {return 1;} static const TclObjTypeWithAbstractList endOffsetType = { {"end-offset", /* name */ diff --git a/tests/link.test b/tests/link.test index 69ebb02..43a85fb 100644 --- a/tests/link.test +++ b/tests/link.test @@ -71,7 +71,7 @@ test link-2.1 {writing C variables from Tcl} -constraints {testlink} -setup { set float 1.0987654321 set uwide 12345678901234567890 concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide -} -result {465 -10.5 1 abcdef 135135 79 161 8000 40000 -1073628482 34543 567890 1.0987653732299805 -6101065172474983726 | 0o0721 -10.5 true abcdef 135135 79 161 8000 40000 0xc001babe 34543 567890 1.0987654321 12345678901234567890} +} -result {465 -10.5 1 abcdef 135135 79 161 8000 40000 -1073628482 34543 567890 1.0987653732299805 12345678901234567890 | 0o0721 -10.5 true abcdef 135135 79 161 8000 40000 0xc001babe 34543 567890 1.0987654321 12345678901234567890} test link-2.2 {writing bad values into variables} -setup { testlink delete } -constraints {testlink} -body { -- cgit v0.12