summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclCmdIL.c3
-rw-r--r--generic/tclCmdMZ.c3
-rw-r--r--generic/tclInt.h56
-rw-r--r--generic/tclLink.c11
-rw-r--r--generic/tclOOBasic.c3
-rw-r--r--generic/tclRegexp.c1
-rw-r--r--generic/tclStringObj.c1
-rw-r--r--tests/link.test4
8 files changed, 67 insertions, 15 deletions
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 3e297f6..1ca6c5e 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -20,6 +20,7 @@
#include "tclInt.h"
#include "tclRegexp.h"
#include "tclArithSeries.h"
+#include "tclTomMath.h"
#include <math.h>
#include <assert.h>
@@ -3612,7 +3613,7 @@ Tcl_LsearchObjCmd(
if (allMatches || inlineReturn) {
Tcl_ResetResult(interp);
} else {
- TclNewIndexObj(itemPtr, TCL_INDEX_NONE);
+ TclNewIntObj(itemPtr, -1);
Tcl_SetObjResult(interp, itemPtr);
}
goto done;
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index f94d914..8abf166 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -20,6 +20,7 @@
#include "tclCompile.h"
#include "tclRegexp.h"
#include "tclStringTrim.h"
+#include "tclTomMath.h"
static inline Tcl_Obj * During(Tcl_Interp *interp, int resultCode,
Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
@@ -3748,7 +3749,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];
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1b817e9..b079364 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -4806,15 +4806,46 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
-#define TclNewIndexObj(objPtr, w) \
+#define TclNewUIntObj(objPtr, uw) \
do { \
- size_t _w = (w); \
TclIncrObjsAllocated(); \
TclAllocObjStorage(objPtr); \
(objPtr)->refCount = 0; \
(objPtr)->bytes = NULL; \
- (objPtr)->internalRep.wideValue = ((size_t)(_w) == (size_t)TCL_INDEX_NONE) ? -1 : (Tcl_WideInt)(_w); \
- (objPtr)->typePtr = &tclIntType; \
+ Tcl_WideUInt uw_ = (uw); \
+ if (uw_ > WIDE_MAX) { \
+ mp_int bignumValue_; \
+ if (mp_init_u64(&bignumValue_, uw_) != MP_OKAY) { \
+ Tcl_Panic("%s: memory overflow", "TclNewUIntObj"); \
+ } \
+ TclSetBignumInternalRep((objPtr), &bignumValue_); \
+ } else { \
+ (objPtr)->internalRep.wideValue = (Tcl_WideInt)(uw_); \
+ (objPtr)->typePtr = &tclIntType; \
+ } \
+ TCL_DTRACE_OBJ_CREATE(objPtr); \
+ } while (0)
+
+#define TclNewIndexObj(objPtr, uw) \
+ do { \
+ TclIncrObjsAllocated(); \
+ TclAllocObjStorage(objPtr); \
+ (objPtr)->refCount = 0; \
+ (objPtr)->bytes = NULL; \
+ Tcl_WideUInt uw_ = (uw); \
+ if (uw_ >= TCL_INDEX_NONE) { \
+ (objPtr)->internalRep.wideValue = -1; \
+ (objPtr)->typePtr = &tclIntType; \
+ } else if (uw_ > WIDE_MAX) { \
+ mp_int bignumValue_; \
+ if (mp_init_u64(&bignumValue_, uw_) != MP_OKAY) { \
+ Tcl_Panic("%s: memory overflow", "TclNewUIntObj"); \
+ } \
+ TclSetBignumInternalRep((objPtr), &bignumValue_); \
+ } else { \
+ (objPtr)->internalRep.wideValue = (Tcl_WideInt)(uw_); \
+ (objPtr)->typePtr = &tclIntType; \
+ } \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
@@ -4843,8 +4874,23 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
#define TclNewIntObj(objPtr, w) \
(objPtr) = Tcl_NewWideIntObj(w)
+#define TclNewUIntObj(objPtr, uw) \
+ do { \
+ Tcl_WideUInt uw_ = (uw); \
+ if (uw_ > WIDE_MAX) { \
+ mp_int bignumValue_; \
+ if (mp_init_u64(&bignumValue_, uw_) == MP_OKAY) { \
+ (objPtr) = Tcl_NewBignumObj(&bignumValue_)); \
+ } else { \
+ (objPtr) = NULL; \
+ } \
+ } else { \
+ (objPtr) = Tcl_NewWideIntObj(uw_); \
+ } \
+ } while (0)
+
#define TclNewIndexObj(objPtr, w) \
- (objPtr) = (((size_t)w) == TCL_INDEX_NONE) ? Tcl_NewWideIntObj(-1) : Tcl_NewWideIntObj(w)
+ (objPtr) = (((Tcl_WideUInt)w) >= TCL_INDEX_NONE) ? Tcl_NewWideIntObj(-1) : Tcl_NewWideIntObj(w)
#define TclNewDoubleObj(objPtr, d) \
(objPtr) = Tcl_NewDoubleObj(d)
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 8579f36..e9ad3c6 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -553,7 +553,7 @@ GetUWide(
*/
return 1;
}
-#ifdef WORDS_BIGENDIAN
+#ifndef WORDS_BIGENDIAN
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
}
@@ -1449,12 +1449,12 @@ ObjValue(
}
linkPtr->lastValue.f = LinkedVar(float);
return Tcl_NewDoubleObj(linkPtr->lastValue.f);
- case TCL_LINK_WIDE_UINT:
+ case TCL_LINK_WIDE_UINT: {
if (linkPtr->flags & LINK_ALLOC_LAST) {
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++) {
- TclNewIntObj(objv[i], (Tcl_WideInt)
+ TclNewUIntObj(objv[i],
linkPtr->lastValue.uwPtr[i]);
}
resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
@@ -1462,7 +1462,10 @@ ObjValue(
return resultObj;
}
linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt);
- return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.uw);
+ Tcl_Obj *uwObj;
+ TclNewUIntObj(uwObj, linkPtr->lastValue.uw);
+ return uwObj;
+ }
case TCL_LINK_STRING:
p = LinkedVar(char *);
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index 72dc041..ef554d7 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -15,6 +15,7 @@
#endif
#include "tclInt.h"
#include "tclOOInt.h"
+#include "tclTomMath.h"
static inline Tcl_Object *AddConstructionFinalizer(Tcl_Interp *interp);
static Tcl_NRPostProc AfterNRDestructor;
@@ -1248,7 +1249,7 @@ TclOOSelfObjCmd(
}
case SELF_CALL:
result[0] = TclOORenderCallChain(interp, contextPtr->callPtr);
- TclNewIntObj(result[1], contextPtr->index);
+ TclNewIndexObj(result[1], contextPtr->index);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
return TCL_OK;
}
diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c
index 5fe5412..d8c3b5b 100644
--- a/generic/tclRegexp.c
+++ b/generic/tclRegexp.c
@@ -13,6 +13,7 @@
#include "tclInt.h"
#include "tclRegexp.h"
+#include "tclTomMath.h"
#include <assert.h>
/*
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 7c0d626..5a35f26 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -37,7 +37,6 @@
#include "tclInt.h"
#include "tclTomMath.h"
#include "tclStringRep.h"
-
#include "assert.h"
/*
* Prototypes for functions defined later in this file:
diff --git a/tests/link.test b/tests/link.test
index eba359c..69ebb02 100644
--- a/tests/link.test
+++ b/tests/link.test
@@ -69,9 +69,9 @@ test link-2.1 {writing C variables from Tcl} -constraints {testlink} -setup {
set long 34543
set ulong 567890
set float 1.0987654321
- set uwide 357357357357
+ 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 357357357357 | 0o0721 -10.5 true abcdef 135135 79 161 8000 40000 0xc001babe 34543 567890 1.0987654321 357357357357}
+} -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}
test link-2.2 {writing bad values into variables} -setup {
testlink delete
} -constraints {testlink} -body {
generated by cgit v0.12 at 2025-12-06 20:10:12 (GMT)