summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2019-04-12 19:44:34 (GMT)
committerdgp <dgp@users.sourceforge.net>2019-04-12 19:44:34 (GMT)
commit6ae823b6b7894f244a874659bfd93fb4914c6a3a (patch)
treebb59dd0853a15bd8f1fbdb66bb75064f30fd94e0
parent325bbf57920315a1457d500d5fec8867c0e0744b (diff)
parent71ae5810dc6d2d626841ee68af71d69df5fd7bd3 (diff)
downloadtcl-6ae823b6b7894f244a874659bfd93fb4914c6a3a.zip
tcl-6ae823b6b7894f244a874659bfd93fb4914c6a3a.tar.gz
tcl-6ae823b6b7894f244a874659bfd93fb4914c6a3a.tar.bz2
merge 8.7
-rw-r--r--.travis.yml31
-rw-r--r--doc/define.n18
-rw-r--r--doc/info.n4
-rw-r--r--doc/interp.n2
-rw-r--r--generic/tclCmdAH.c6
-rw-r--r--generic/tclCmdMZ.c12
-rw-r--r--generic/tclExecute.c16
-rw-r--r--generic/tclProcess.c4
-rw-r--r--generic/tclTest.c21
-rw-r--r--generic/tclTestObj.c26
-rw-r--r--generic/tclTestProcBodyObj.c2
-rw-r--r--generic/tclTomMath.h28
-rw-r--r--generic/tclTomMathDecls.h17
-rw-r--r--generic/tclTomMathInterface.c4
-rw-r--r--generic/tclUtil.c6
-rw-r--r--generic/tclVar.c11
-rw-r--r--generic/tclZlib.c6
-rw-r--r--libtommath/bn_mp_clear.c2
-rw-r--r--libtommath/bn_mp_fwrite.c8
-rw-r--r--libtommath/bn_mp_get_double.c6
-rw-r--r--libtommath/bn_mp_get_long.c10
-rw-r--r--libtommath/bn_mp_get_long_long.c8
-rw-r--r--libtommath/bn_mp_grow.c4
-rw-r--r--libtommath/bn_mp_init.c2
-rw-r--r--libtommath/bn_mp_init_size.c2
-rw-r--r--libtommath/bn_mp_is_square.c5
-rw-r--r--libtommath/bn_mp_prime_random_ex.c10
-rw-r--r--libtommath/bn_mp_read_radix.c4
-rw-r--r--libtommath/bn_mp_set_double.c8
-rw-r--r--libtommath/bn_mp_shrink.c4
-rw-r--r--libtommath/bn_mp_sqrt.c22
-rw-r--r--libtommath/tommath_private.h65
-rw-r--r--macosx/tclMacOSXFCmd.c10
-rw-r--r--tests/cmdMZ.test54
-rw-r--r--tests/obj.test28
-rw-r--r--tests/oo.test24
-rw-r--r--tests/socket.test6
-rw-r--r--tests/utf.test4
-rw-r--r--unix/tclUnixFCmd.c20
-rw-r--r--win/tclWinFCmd.c2
40 files changed, 325 insertions, 197 deletions
diff --git a/.travis.yml b/.travis.yml
index 3770e07..59b52eb 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -160,6 +160,22 @@ matrix:
- wine
env:
- BUILD_DIR=win
+ - CFGOPT="--host=i686-w64-mingw32 --disable-shared"
+ - NO_DIRECT_TEST=1
+ - os: linux
+ dist: xenial
+ compiler: i686-w64-mingw32-gcc
+ addons:
+ apt:
+ packages:
+ - gcc-mingw-w64-base
+ - binutils-mingw-w64-i686
+ - gcc-mingw-w64-i686
+ - gcc-mingw-w64
+ - gcc-multilib
+ - wine
+ env:
+ - BUILD_DIR=win
- CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=6"
- NO_DIRECT_TEST=1
- os: linux
@@ -223,6 +239,21 @@ matrix:
- wine
env:
- BUILD_DIR=win
+ - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --disable-shared"
+ - NO_DIRECT_TEST=1
+ - os: linux
+ dist: xenial
+ compiler: x86_64-w64-mingw32-gcc
+ addons:
+ apt:
+ packages:
+ - gcc-mingw-w64-base
+ - binutils-mingw-w64-x86-64
+ - gcc-mingw-w64-x86-64
+ - gcc-mingw-w64
+ - wine
+ env:
+ - BUILD_DIR=win
- CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_UTF_MAX=6"
- NO_DIRECT_TEST=1
- os: linux
diff --git a/doc/define.n b/doc/define.n
index a2b0813..9046203 100644
--- a/doc/define.n
+++ b/doc/define.n
@@ -284,7 +284,8 @@ this feature for classes requires the definition of a metaclass.
This deletes each of the methods called \fIname\fR from a class. The methods
must have previously existed in that class. Does not affect the superclasses
of the class, nor does it affect the subclasses or instances of the class
-(except when they have a call chain through the class being modified).
+(except when they have a call chain through the class being modified) or the
+class object itself.
.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.
@@ -310,7 +311,8 @@ This renames the method called \fIfromName\fR in a class to \fItoName\fR. The
method must have previously existed in the class, and \fItoName\fR must not
previously refer to a method in that class. Does not affect the superclasses
of the class, nor does it affect the subclasses or instances of the class
-(except when they have a call chain through the class being modified). Does
+(except when they have a call chain through the class being modified), or the
+class object itself. Does
not change the export status of the method; if it was exported before, it will
be afterwards.
.SH "CONFIGURING OBJECTS"
@@ -436,8 +438,10 @@ well be in an inconsistent state unless additional configuration work is done.
\fBdeletemethod\fI name\fR ?\fIname ...\fR
.
This deletes each of the methods called \fIname\fR from an object. The methods
-must have previously existed in that object. Does not affect the classes that
-the object is an instance of.
+must have previously existed in that object (e.g., because it was created
+through \fBoo::objdefine method\fR). Does not affect the classes that the
+object is an instance of, or remove the exposure of those class-provided
+methods in the instance of that class.
.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.
@@ -455,8 +459,10 @@ By default, this slot works by appending.
This renames the method called \fIfromName\fR in an object to \fItoName\fR.
The method must have previously existed in the object, and \fItoName\fR must
not previously refer to a method in that object. Does not affect the classes
-that the object is an instance of. Does not change the export status of the
-method; if it was exported before, it will be afterwards.
+that the object is an instance of and cannot rename in an instance object the
+methods provided by those classes (though a \fBoo::objdefine forward\fRed
+method may provide an equivalent capability). Does not change the export
+status of the method; if it was exported before, it will be afterwards.
.TP
\fBself \fR
.VS TIP470
diff --git a/doc/info.n b/doc/info.n
index ac89bdb..dc21ac1 100644
--- a/doc/info.n
+++ b/doc/info.n
@@ -212,7 +212,7 @@ procedures nested in statically defined procedures, and literal eval scripts in
files or statically defined procedures, its type is \fBsource\fR and its
location is the absolute line number in the script. Otherwise, its type is
\fBproc\fR and its location is its line number within the body of the
-procedure.
+procedure.
.PP
In contrast, procedure definitions and \fBeval\fR within a dynamically
\fBeval\fRuated environment count line numbers relative to the start of
@@ -300,7 +300,7 @@ described \fBOBJECT INTROSPECTION\fR below.
.TP
\fBinfo patchlevel\fR
.
-Returns the value of the global variable \fBtcl_patchLevel\fR, in which the
+Returns the value of the global variable \fBtcl_patchLevel\fR, in which the
exact version of the Tcl library initially stored.
.TP
\fBinfo procs \fR?\fIpattern\fR?
diff --git a/doc/interp.n b/doc/interp.n
index e91e403..40ab9f9 100644
--- a/doc/interp.n
+++ b/doc/interp.n
@@ -201,7 +201,7 @@ slave interpreter identified by \fIpath\fR. If no arguments are
given, option and current setting are returned. If \fB\-frame\fR
is given, the debug setting is set to the given boolean if provided
and the current setting is returned.
-This only effects the output of \fBinfo frame\fR, in that exact
+This only affects the output of \fBinfo frame\fR, in that exact
frame-level information for command invocation at the bytecode level
is only captured with this setting on.
.RS
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 331f791..1811c5c 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -932,7 +932,7 @@ Tcl_ExitObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- int value;
+ Tcl_WideInt value;
if ((objc != 1) && (objc != 2)) {
Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?");
@@ -941,10 +941,10 @@ Tcl_ExitObjCmd(
if (objc == 1) {
value = 0;
- } else if (Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_OK) {
+ } else if (TclGetWideBitsFromObj(interp, objv[1], &value) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_Exit(value);
+ Tcl_Exit((int)value);
/*NOTREACHED*/
return TCL_OK; /* Better not ever reach this! */
}
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 8767ca6..2671d49 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -4373,6 +4373,11 @@ usage:
middle *= TclpWideClickInMicrosec();
#endif
+ if (!count) { /* no iterations - avoid divide by zero */
+ objs[0] = objs[2] = objs[4] = Tcl_NewWideIntObj(0);
+ goto retRes;
+ }
+
/* if not calibrate */
if (!calibrate) {
/* minimize influence of measurement overhead */
@@ -4425,9 +4430,14 @@ usage:
objs[4] = Tcl_NewWideIntObj((count / middle) * 1000000);
}
+ retRes:
/* estimated net execution time (in millisecs) */
if (!calibrate) {
- objs[6] = Tcl_ObjPrintf("%.3f", (double)middle / 1000);
+ if (middle >= 1) {
+ objs[6] = Tcl_ObjPrintf("%.3f", (double)middle / 1000);
+ } else {
+ objs[6] = Tcl_NewWideIntObj(0);
+ }
TclNewLiteralStringObj(objs[7], "nett-ms");
}
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 680bdd0..d5dc9e1 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5631,7 +5631,7 @@ TEBCresume(
/* [string is wideinteger] is WIDE_MIN to WIDE_MAX range */
Tcl_WideInt w;
- if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
+ if (TclGetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
type1 = TCL_NUMBER_INT;
}
}
@@ -8399,22 +8399,18 @@ ExecuteExtendedBinaryMathOp(
}
overflowExpon:
- Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
- if ((big2.used > 1)
-#if DIGIT_BIT > 28
- || ((big2.used == 1) && (big2.dp[0] >= (1<<28)))
-#endif
- ) {
- mp_clear(&big2);
+
+ if ((TclGetWideIntFromObj(NULL, value2Ptr, &w2) != TCL_OK)
+ || (value2Ptr->typePtr != &tclIntType)
+ || (Tcl_WideUInt)w2 >= (1<<28)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"exponent too large", -1));
return GENERAL_ARITHMETIC_ERROR;
}
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
mp_init(&bigResult);
- mp_expt_d_ex(&big1, big2.dp[0], &bigResult, 1);
+ mp_expt_d_ex(&big1, w2, &bigResult, 1);
mp_clear(&big1);
- mp_clear(&big2);
BIG_RESULT(&bigResult);
}
diff --git a/generic/tclProcess.c b/generic/tclProcess.c
index a781386..2f3f4ba 100644
--- a/generic/tclProcess.c
+++ b/generic/tclProcess.c
@@ -540,7 +540,7 @@ ProcessStatusObjCmd(
dict = Tcl_NewDictObj();
Tcl_MutexLock(&infoTablesMutex);
for (i = 0; i < numPids; i++) {
- result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid);
+ result = Tcl_GetIntFromObj(interp, pidObjs[i], &pid);
if (result != TCL_OK) {
Tcl_MutexUnlock(&infoTablesMutex);
Tcl_DecrRefCount(dict);
@@ -654,7 +654,7 @@ ProcessPurgeObjCmd(
}
Tcl_MutexLock(&infoTablesMutex);
for (i = 0; i < numPids; i++) {
- result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid);
+ result = Tcl_GetIntFromObj(interp, pidObjs[i], &pid);
if (result != TCL_OK) {
Tcl_MutexUnlock(&infoTablesMutex);
return result;
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 172b56e..349d935 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -52,6 +52,7 @@ DLLEXPORT int Tcltest_SafeInit(Tcl_Interp *interp);
static Tcl_DString delString;
static Tcl_Interp *delInterp;
+static const Tcl_ObjType *properByteArrayType;
/*
* One of the following structures exists for each asynchronous handler
@@ -552,8 +553,7 @@ int
Tcltest_Init(
Tcl_Interp *interp) /* Interpreter for application. */
{
- Tcl_Obj *listPtr;
- Tcl_Obj **objv;
+ Tcl_Obj **objv, *objPtr;
int objc, index;
static const char *const specialOptions[] = {
"-appinitprocerror", "-appinitprocdeleteinterp",
@@ -575,6 +575,11 @@ Tcltest_Init(
return TCL_ERROR;
}
+ objPtr = Tcl_NewStringObj("abc", 3);
+ (void)Tcl_GetByteArrayFromObj(objPtr, &index);
+ properByteArrayType = objPtr->typePtr;
+ Tcl_DecrRefCount(objPtr);
+
/*
* Create additional commands and math functions for testing Tcl.
*/
@@ -740,9 +745,9 @@ Tcltest_Init(
* Check for special options used in ../tests/main.test
*/
- listPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY);
- if (listPtr != NULL) {
- if (Tcl_ListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
+ objPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY);
+ if (objPtr != NULL) {
+ if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
return TCL_ERROR;
}
if (objc && (Tcl_GetIndexFromObj(NULL, objv[0], specialOptions, NULL,
@@ -5011,7 +5016,7 @@ TestbytestringObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
- int n;
+ int n = 0;
const char *p;
if (objc != 2) {
@@ -5019,6 +5024,10 @@ TestbytestringObjCmd(
return TCL_ERROR;
}
p = (const char *)Tcl_GetByteArrayFromObj(objv[1], &n);
+ if ((p == NULL) || !Tcl_FetchIntRep(objv[1], properByteArrayType)) {
+ Tcl_AppendResult(interp, "testbytestring expects bytes", NULL);
+ return TCL_ERROR;
+ }
Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n));
return TCL_OK;
}
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index 8f12fd6..a289e32 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -385,9 +385,9 @@ TestbooleanobjCmd(
*/
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetBooleanObj(varPtr[varIndex], boolValue);
+ Tcl_SetWideIntObj(varPtr[varIndex], boolValue != 0);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(boolValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(boolValue != 0));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "get") == 0) {
@@ -410,9 +410,9 @@ TestbooleanobjCmd(
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetBooleanObj(varPtr[varIndex], !boolValue);
+ Tcl_SetWideIntObj(varPtr[varIndex], boolValue == 0);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(!boolValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(boolValue == 0));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else {
@@ -658,7 +658,7 @@ TestintobjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
int intValue, varIndex, i;
- long longValue;
+ Tcl_WideInt wideValue;
const char *index, *subCmd, *string;
Tcl_Obj **varPtr;
@@ -713,7 +713,7 @@ TestintobjCmd(
} else {
SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue));
}
- } else if (strcmp(subCmd, "setlong") == 0) {
+ } else if (strcmp(subCmd, "setint") == 0) {
if (objc != 4) {
goto wrongNumArgs;
}
@@ -728,28 +728,28 @@ TestintobjCmd(
SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(intValue));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
- } else if (strcmp(subCmd, "setmaxlong") == 0) {
- long maxLong = LONG_MAX;
+ } else if (strcmp(subCmd, "setmax") == 0) {
+ Tcl_WideInt maxWide = WIDE_MAX;
if (objc != 3) {
goto wrongNumArgs;
}
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetWideIntObj(varPtr[varIndex], maxLong);
+ Tcl_SetWideIntObj(varPtr[varIndex], maxWide);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(maxLong));
+ SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(maxWide));
}
- } else if (strcmp(subCmd, "ismaxlong") == 0) {
+ } else if (strcmp(subCmd, "ismax") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
- if (Tcl_GetLongFromObj(interp, varPtr[varIndex], &longValue) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(interp, varPtr[varIndex], &wideValue) != TCL_OK) {
return TCL_ERROR;
}
Tcl_AppendToObj(Tcl_GetObjResult(interp),
- ((longValue == LONG_MAX)? "1" : "0"), -1);
+ ((wideValue == WIDE_MAX)? "1" : "0"), -1);
} else if (strcmp(subCmd, "get") == 0) {
if (objc != 3) {
goto wrongNumArgs;
diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c
index fba2844..913b253 100644
--- a/generic/tclTestProcBodyObj.c
+++ b/generic/tclTestProcBodyObj.c
@@ -340,7 +340,7 @@ ProcBodyTestCheckObjCmd(
}
version = Tcl_PkgPresent(interp, packageName, packageVersion, 1);
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
strcmp(version, packageVersion) == 0));
return TCL_OK;
}
diff --git a/generic/tclTomMath.h b/generic/tclTomMath.h
index 3f23fd6..26eef26 100644
--- a/generic/tclTomMath.h
+++ b/generic/tclTomMath.h
@@ -7,8 +7,7 @@
* Michael Fromberger but has been written from scratch with
* additional optimizations in place.
*
- * The library is free for all purposes without any express
- * guarantee it works.
+ * SPDX-License-Identifier: Unlicense
*/
#ifndef BN_H_
#define BN_H_
@@ -128,6 +127,7 @@ typedef unsigned long long mp_word;
#define MP_MEM -2 /* out of mem */
#define MP_VAL -3 /* invalid input */
#define MP_RANGE MP_VAL
+#define MP_ITER -4 /* Max. iterations reached */
#define MP_YES 1 /* yes response */
#define MP_NO 0 /* no response */
@@ -346,15 +346,20 @@ int mp_cnt_lsb(const mp_int *a);
/* I Love Earth! */
-/* makes a pseudo-random int of a given size */
+/* makes a pseudo-random mp_int of a given size */
/*
int mp_rand(mp_int *a, int digits);
*/
+/* makes a pseudo-random small int of a given size */
+/*
+int mp_rand_digit(mp_digit *r);
+*/
#ifdef MP_PRNG_ENABLE_LTM_RNG
-/* as last resort we will fall back to libtomcrypt's rng_get_bytes()
- * in case you don't use libtomcrypt or use it w/o rng_get_bytes()
- * you have to implement it somewhere else, as it's required */
+/* A last resort to provide random data on systems without any of the other
+ * implemented ways to gather entropy.
+ * It is compatible with `rng_get_bytes()` from libtomcrypt so you could
+ * provide that one and then set `ltm_rng = rng_get_bytes;` */
extern unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen, void (*callback)(void));
extern void (*ltm_rng_callback)(void);
#endif
@@ -691,10 +696,17 @@ int mp_prime_miller_rabin(const mp_int *a, const mp_int *b, int *result);
int mp_prime_rabin_miller_trials(int size);
*/
-/* performs t rounds of Miller-Rabin on "a" using the first
- * t prime bases. Also performs an initial sieve of trial
+/* performs t random rounds of Miller-Rabin on "a" additional to
+ * bases 2 and 3. Also performs an initial sieve of trial
* division. Determines if "a" is prime with probability
* of error no more than (1/4)**t.
+ * Both a strong Lucas-Selfridge to complete the BPSW test
+ * and a separate Frobenius test are available at compile time.
+ * With t<0 a deterministic test is run for primes up to
+ * 318665857834031151167461. With t<13 (abs(t)-13) additional
+ * tests with sequential small primes are run starting at 43.
+ * Is Fips 186.4 compliant if called with t as computed by
+ * mp_prime_rabin_miller_trials();
*
* Sets result to 1 if probably prime, 0 otherwise
*/
diff --git a/generic/tclTomMathDecls.h b/generic/tclTomMathDecls.h
index 52ab26f..165e3b7 100644
--- a/generic/tclTomMathDecls.h
+++ b/generic/tclTomMathDecls.h
@@ -30,12 +30,17 @@
/* Define custom memory allocation for libtommath */
-/* MODULE_SCOPE void* XMALLOC( size_t ); */
-#define XMALLOC(s) ((void*)ckalloc((size_t)(s)))
-/* MODULE_SCOPE void* XREALLOC( void*, size_t ); */
-#define XREALLOC(x,s) ((void*)ckrealloc((char*)(x),(size_t)(s)))
-/* MODULE_SCOPE void XFREE( void* ); */
-#define XFREE(x) (ckfree((char*)(x)))
+/* MODULE_SCOPE void* TclBNAlloc( size_t ); */
+#define TclBNAlloc(s) ((void*)ckalloc((size_t)(s)))
+/* MODULE_SCOPE void* TclBNRealloc( void*, size_t ); */
+#define TclBNRealloc(x,s) ((void*)ckrealloc((char*)(x),(size_t)(s)))
+/* MODULE_SCOPE void TclBNFree( void* ); */
+#define TclBNFree(x) (ckfree((char*)(x)))
+
+#define XMALLOC(size) TclBNAlloc(size)
+#define XFREE(mem, size) TclBNFree(mem)
+#define XREALLOC(mem, oldsize, newsize) TclBNRealloc(mem, newsize)
+
/* Rename the global symbols in libtommath to avoid linkage conflicts */
diff --git a/generic/tclTomMathInterface.c b/generic/tclTomMathInterface.c
index 236a8cf..ae1eb7e 100644
--- a/generic/tclTomMathInterface.c
+++ b/generic/tclTomMathInterface.c
@@ -111,7 +111,7 @@ TclInitBignumFromWideInt(
mp_int *a, /* Bignum to initialize */
Tcl_WideInt v) /* Initial value */
{
- if (mp_init_size(a, (CHAR_BIT * sizeof(Tcl_WideUInt) + DIGIT_BIT - 1) / DIGIT_BIT) != MP_OKAY) {
+ if (mp_init(a) != MP_OKAY) {
Tcl_Panic("initialization failure in TclInitBignumFromWideInt");
}
if (v < 0) {
@@ -143,7 +143,7 @@ TclInitBignumFromWideUInt(
mp_int *a, /* Bignum to initialize */
Tcl_WideUInt v) /* Initial value */
{
- if (mp_init_size(a, (CHAR_BIT * sizeof(Tcl_WideUInt) + DIGIT_BIT - 1) / DIGIT_BIT) != MP_OKAY) {
+ if (mp_init(a) != MP_OKAY) {
Tcl_Panic("initialization failure in TclInitBignumFromWideUInt");
}
mp_set_long_long(a, v);
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 250a393..2889852 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -3448,7 +3448,7 @@ TclPrecTraceProc(
int flags) /* Information about what happened. */
{
Tcl_Obj *value;
- int prec;
+ Tcl_WideInt prec;
int *precisionPtr = Tcl_GetThreadData(&precisionKey, sizeof(int));
/*
@@ -3488,11 +3488,11 @@ TclPrecTraceProc(
}
value = Tcl_GetVar2Ex(interp, name1, name2, flags & TCL_GLOBAL_ONLY);
if (value == NULL
- || Tcl_GetIntFromObj(NULL, value, &prec) != TCL_OK
+ || Tcl_GetWideIntFromObj(NULL, value, &prec) != TCL_OK
|| prec < 0 || prec > TCL_MAX_PREC) {
return (char *) "improper value for precision";
}
- *precisionPtr = prec;
+ *precisionPtr = (int)prec;
return NULL;
}
#endif /* !TCL_NO_DEPRECATED)*/
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 3271935..e400369 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -722,7 +722,7 @@ TclObjLookupVarEx(
Tcl_Obj *cachedNamePtr = localName(varFramePtr, index);
if (part1Ptr == cachedNamePtr) {
- cachedNamePtr = NULL;
+ LocalSetIntRep(part1Ptr, index, NULL);
} else {
/*
* [80304238ac] Trickiness here. We will store and incr the
@@ -735,6 +735,14 @@ TclObjLookupVarEx(
* cachedNamePtr and leave it as string only. This is
* radical and destructive, so a better idea would be welcome.
*/
+
+ /*
+ * Firstly set cached local var reference (avoid free before set,
+ * see [45b9faf103f2])
+ */
+ LocalSetIntRep(part1Ptr, index, cachedNamePtr);
+
+ /* Then wipe it */
TclFreeIntRep(cachedNamePtr);
/*
@@ -744,7 +752,6 @@ TclObjLookupVarEx(
*/
LocalSetIntRep(cachedNamePtr, index, NULL);
}
- LocalSetIntRep(part1Ptr, index, cachedNamePtr);
} else {
/*
* At least mark part1Ptr as already parsed.
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 32268af..8dbe807 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -422,6 +422,7 @@ GenerateHeader(
{
Tcl_Obj *value;
int len, result = TCL_ERROR;
+ Tcl_WideInt wideValue = 0;
const char *valueStr;
Tcl_Encoding latin1enc;
static const char *const types[] = {
@@ -485,10 +486,11 @@ GenerateHeader(
if (GetValue(interp, dictObj, "time", &value) != TCL_OK) {
goto error;
- } else if (value != NULL && Tcl_GetLongFromObj(interp, value,
- (long *) &headerPtr->header.time) != TCL_OK) {
+ } else if (value != NULL && Tcl_GetWideIntFromObj(interp, value,
+ &wideValue) != TCL_OK) {
goto error;
}
+ headerPtr->header.time = wideValue;
if (GetValue(interp, dictObj, "type", &value) != TCL_OK) {
goto error;
diff --git a/libtommath/bn_mp_clear.c b/libtommath/bn_mp_clear.c
index 1f360b2..b8e724c 100644
--- a/libtommath/bn_mp_clear.c
+++ b/libtommath/bn_mp_clear.c
@@ -25,7 +25,7 @@ void mp_clear(mp_int *a)
}
/* free ram */
- XFREE(a->dp);
+ XFREE(a->dp, sizeof (mp_digit) * (size_t)a->alloc);
/* reset members to make debugging easier */
a->dp = NULL;
diff --git a/libtommath/bn_mp_fwrite.c b/libtommath/bn_mp_fwrite.c
index 9f0c3df..85a942f 100644
--- a/libtommath/bn_mp_fwrite.c
+++ b/libtommath/bn_mp_fwrite.c
@@ -22,24 +22,24 @@ int mp_fwrite(const mp_int *a, int radix, FILE *stream)
return err;
}
- buf = OPT_CAST(char) XMALLOC((size_t)len);
+ buf = (char *) XMALLOC((size_t)len);
if (buf == NULL) {
return MP_MEM;
}
if ((err = mp_toradix(a, buf, radix)) != MP_OKAY) {
- XFREE(buf);
+ XFREE(buf, len);
return err;
}
for (x = 0; x < len; x++) {
if (fputc((int)buf[x], stream) == EOF) {
- XFREE(buf);
+ XFREE(buf, len);
return MP_VAL;
}
}
- XFREE(buf);
+ XFREE(buf, len);
return MP_OKAY;
}
#endif
diff --git a/libtommath/bn_mp_get_double.c b/libtommath/bn_mp_get_double.c
index 3ed5a71..629eae3 100644
--- a/libtommath/bn_mp_get_double.c
+++ b/libtommath/bn_mp_get_double.c
@@ -19,10 +19,10 @@ double mp_get_double(const mp_int *a)
for (i = 0; i < DIGIT_BIT; ++i) {
fac *= 2.0;
}
- for (i = USED(a); i --> 0;) {
- d = (d * fac) + (double)DIGIT(a, i);
+ for (i = a->used; i --> 0;) {
+ d = (d * fac) + (double)a->dp[i];
}
- return (mp_isneg(a) != MP_NO) ? -d : d;
+ return (a->sign == MP_NEG) ? -d : d;
}
#endif
diff --git a/libtommath/bn_mp_get_long.c b/libtommath/bn_mp_get_long.c
index a4d05d6..b95bb8a 100644
--- a/libtommath/bn_mp_get_long.c
+++ b/libtommath/bn_mp_get_long.c
@@ -18,19 +18,19 @@ unsigned long mp_get_long(const mp_int *a)
int i;
unsigned long res;
- if (a->used == 0) {
+ if (IS_ZERO(a)) {
return 0;
}
/* get number of digits of the lsb we have to read */
- i = MIN(a->used, ((((int)sizeof(unsigned long) * CHAR_BIT) + DIGIT_BIT - 1) / DIGIT_BIT)) - 1;
+ i = MIN(a->used, (((CHAR_BIT * (int)sizeof(unsigned long)) + DIGIT_BIT - 1) / DIGIT_BIT)) - 1;
/* get most significant digit of result */
- res = DIGIT(a, i);
+ res = (unsigned long)a->dp[i];
-#if (ULONG_MAX != 0xffffffffuL) || (DIGIT_BIT < 32)
+#if (ULONG_MAX != 0xFFFFFFFFUL) || (DIGIT_BIT < 32)
while (--i >= 0) {
- res = (res << DIGIT_BIT) | DIGIT(a, i);
+ res = (res << DIGIT_BIT) | (unsigned long)a->dp[i];
}
#endif
return res;
diff --git a/libtommath/bn_mp_get_long_long.c b/libtommath/bn_mp_get_long_long.c
index 61d16ea..49a0208 100644
--- a/libtommath/bn_mp_get_long_long.c
+++ b/libtommath/bn_mp_get_long_long.c
@@ -18,19 +18,19 @@ Tcl_WideUInt mp_get_long_long(const mp_int *a)
int i;
Tcl_WideUInt res;
- if (a->used == 0) {
+ if (IS_ZERO(a)) {
return 0;
}
/* get number of digits of the lsb we have to read */
- i = MIN(a->used, ((((int)sizeof(Tcl_WideUInt) * CHAR_BIT) + DIGIT_BIT - 1) / DIGIT_BIT)) - 1;
+ i = MIN(a->used, (((CHAR_BIT * (int)sizeof(Tcl_WideUInt)) + DIGIT_BIT - 1) / DIGIT_BIT)) - 1;
/* get most significant digit of result */
- res = DIGIT(a, i);
+ res = (unsigned long long)a->dp[i];
#if DIGIT_BIT < 64
while (--i >= 0) {
- res = (res << DIGIT_BIT) | DIGIT(a, i);
+ res = (res << DIGIT_BIT) | (unsigned long long)a->dp[i];
}
#endif
return res;
diff --git a/libtommath/bn_mp_grow.c b/libtommath/bn_mp_grow.c
index 1d92b29..b120194 100644
--- a/libtommath/bn_mp_grow.c
+++ b/libtommath/bn_mp_grow.c
@@ -29,7 +29,9 @@ int mp_grow(mp_int *a, int size)
* in case the operation failed we don't want
* to overwrite the dp member of a.
*/
- tmp = OPT_CAST(mp_digit) XREALLOC(a->dp, sizeof(mp_digit) * (size_t)size);
+ tmp = (mp_digit *) XREALLOC(a->dp,
+ (size_t)a->alloc * sizeof (mp_digit),
+ (size_t)size * sizeof(mp_digit));
if (tmp == NULL) {
/* reallocation failed but "a" is still valid [can be freed] */
return MP_MEM;
diff --git a/libtommath/bn_mp_init.c b/libtommath/bn_mp_init.c
index 7520089..3c0c489 100644
--- a/libtommath/bn_mp_init.c
+++ b/libtommath/bn_mp_init.c
@@ -18,7 +18,7 @@ int mp_init(mp_int *a)
int i;
/* allocate memory required and clear it */
- a->dp = OPT_CAST(mp_digit) XMALLOC(sizeof(mp_digit) * (size_t)MP_PREC);
+ a->dp = (mp_digit *) XMALLOC(MP_PREC * sizeof(mp_digit));
if (a->dp == NULL) {
return MP_MEM;
}
diff --git a/libtommath/bn_mp_init_size.c b/libtommath/bn_mp_init_size.c
index 9b933fb..1becb23 100644
--- a/libtommath/bn_mp_init_size.c
+++ b/libtommath/bn_mp_init_size.c
@@ -21,7 +21,7 @@ int mp_init_size(mp_int *a, int size)
size += (MP_PREC * 2) - (size % MP_PREC);
/* alloc mem */
- a->dp = OPT_CAST(mp_digit) XMALLOC(sizeof(mp_digit) * (size_t)size);
+ a->dp = (mp_digit *) XMALLOC((size_t)size * sizeof(mp_digit));
if (a->dp == NULL) {
return MP_MEM;
}
diff --git a/libtommath/bn_mp_is_square.c b/libtommath/bn_mp_is_square.c
index 5363a47..1dd1d6c 100644
--- a/libtommath/bn_mp_is_square.c
+++ b/libtommath/bn_mp_is_square.c
@@ -49,13 +49,12 @@ int mp_is_square(const mp_int *arg, int *ret)
return MP_VAL;
}
- /* digits used? (TSD) */
- if (arg->used == 0) {
+ if (IS_ZERO(arg)) {
return MP_OKAY;
}
/* First check mod 128 (suppose that DIGIT_BIT is at least 7) */
- if (rem_128[127u & DIGIT(arg, 0)] == (char)1) {
+ if (rem_128[127u & arg->dp[0]] == (char)1) {
return MP_OKAY;
}
diff --git a/libtommath/bn_mp_prime_random_ex.c b/libtommath/bn_mp_prime_random_ex.c
index b0b4632..0ca29ec 100644
--- a/libtommath/bn_mp_prime_random_ex.c
+++ b/libtommath/bn_mp_prime_random_ex.c
@@ -46,19 +46,19 @@ int mp_prime_random_ex(mp_int *a, int t, int size, int flags, ltm_prime_callback
bsize = (size>>3) + ((size&7)?1:0);
/* we need a buffer of bsize bytes */
- tmp = OPT_CAST(unsigned char) XMALLOC((size_t)bsize);
+ tmp = (unsigned char *) XMALLOC((size_t)bsize);
if (tmp == NULL) {
return MP_MEM;
}
/* calc the maskAND value for the MSbyte*/
- maskAND = ((size&7) == 0) ? 0xFF : (0xFF >> (8 - (size & 7)));
+ maskAND = ((size&7) == 0) ? 0xFF : (unsigned char)(0xFF >> (8 - (size & 7)));
/* calc the maskOR_msb */
maskOR_msb = 0;
maskOR_msb_offset = ((size & 7) == 1) ? 1 : 0;
if ((flags & LTM_PRIME_2MSB_ON) != 0) {
- maskOR_msb |= 0x80 >> ((9 - size) & 7);
+ maskOR_msb |= (unsigned char)(0x80 >> ((9 - size) & 7));
}
/* get the maskOR_lsb */
@@ -76,7 +76,7 @@ int mp_prime_random_ex(mp_int *a, int t, int size, int flags, ltm_prime_callback
/* work over the MSbyte */
tmp[0] &= maskAND;
- tmp[0] |= 1 << ((size - 1) & 7);
+ tmp[0] |= (unsigned char)(1 << ((size - 1) & 7));
/* mix in the maskORs */
tmp[maskOR_msb_offset] |= maskOR_msb;
@@ -123,7 +123,7 @@ int mp_prime_random_ex(mp_int *a, int t, int size, int flags, ltm_prime_callback
err = MP_OKAY;
error:
- XFREE(tmp);
+ XFREE(tmp, bsize);
return err;
}
diff --git a/libtommath/bn_mp_read_radix.c b/libtommath/bn_mp_read_radix.c
index 200601e..a8723b7 100644
--- a/libtommath/bn_mp_read_radix.c
+++ b/libtommath/bn_mp_read_radix.c
@@ -12,6 +12,8 @@
* SPDX-License-Identifier: Unlicense
*/
+#define MP_TOUPPER(c) ((((c) >= 'a') && ((c) <= 'z')) ? (((c) + 'A') - 'a') : (c))
+
/* read a string [ASCII] in a given radix */
int mp_read_radix(mp_int *a, const char *str, int radix)
{
@@ -46,7 +48,7 @@ int mp_read_radix(mp_int *a, const char *str, int radix)
* this allows numbers like 1AB and 1ab to represent the same value
* [e.g. in hex]
*/
- ch = (radix <= 36) ? (char)toupper((int)*str) : *str;
+ ch = (radix <= 36) ? (char)MP_TOUPPER((int)*str) : *str;
pos = (unsigned)(ch - '(');
if (mp_s_rmap_reverse_sz < pos) {
break;
diff --git a/libtommath/bn_mp_set_double.c b/libtommath/bn_mp_set_double.c
index 76f6293..12f8dad 100644
--- a/libtommath/bn_mp_set_double.c
+++ b/libtommath/bn_mp_set_double.c
@@ -15,11 +15,11 @@
#if defined(__STDC_IEC_559__) || defined(__GCC_IEC_559)
int mp_set_double(mp_int *a, double b)
{
- uint64_t frac;
+ unsigned long long frac;
int exp, res;
union {
double dbl;
- uint64_t bits;
+ unsigned long long bits;
} cast;
cast.dbl = b;
@@ -41,8 +41,8 @@ int mp_set_double(mp_int *a, double b)
return res;
}
- if (((cast.bits >> 63) != 0ULL) && (mp_iszero(a) == MP_NO)) {
- SIGN(a) = MP_NEG;
+ if (((cast.bits >> 63) != 0ULL) && !IS_ZERO(a)) {
+ a->sign = MP_NEG;
}
return MP_OKAY;
diff --git a/libtommath/bn_mp_shrink.c b/libtommath/bn_mp_shrink.c
index ff7905f..fa30184 100644
--- a/libtommath/bn_mp_shrink.c
+++ b/libtommath/bn_mp_shrink.c
@@ -23,7 +23,9 @@ int mp_shrink(mp_int *a)
}
if (a->alloc != used) {
- if ((tmp = OPT_CAST(mp_digit) XREALLOC(a->dp, sizeof(mp_digit) * (size_t)used)) == NULL) {
+ if ((tmp = (mp_digit *) XREALLOC(a->dp,
+ (size_t)a->alloc * sizeof (mp_digit),
+ (size_t)used * sizeof(mp_digit))) == NULL) {
return MP_MEM;
}
a->dp = tmp;
diff --git a/libtommath/bn_mp_sqrt.c b/libtommath/bn_mp_sqrt.c
index bbca158..116fb14 100644
--- a/libtommath/bn_mp_sqrt.c
+++ b/libtommath/bn_mp_sqrt.c
@@ -14,6 +14,9 @@
#ifndef NO_FLOATING_POINT
#include <math.h>
+#if (DIGIT_BIT != 28) || (FLT_RADIX != 2) || (DBL_MANT_DIG != 53) || (DBL_MAX_EXP != 1024)
+#define NO_FLOATING_POINT
+#endif
#endif
/* this function is less generic than mp_n_root, simpler and faster */
@@ -21,8 +24,8 @@ int mp_sqrt(const mp_int *arg, mp_int *ret)
{
int res;
mp_int t1, t2;
- int i, j, k;
#ifndef NO_FLOATING_POINT
+ int i, j, k;
volatile double d;
mp_digit dig;
#endif
@@ -38,6 +41,8 @@ int mp_sqrt(const mp_int *arg, mp_int *ret)
return MP_OKAY;
}
+#ifndef NO_FLOATING_POINT
+
i = (arg->used / 2) - 1;
j = 2 * i;
if ((res = mp_init_size(&t1, i+2)) != MP_OKAY) {
@@ -52,8 +57,6 @@ int mp_sqrt(const mp_int *arg, mp_int *ret)
t1.dp[k] = (mp_digit) 0;
}
-#ifndef NO_FLOATING_POINT
-
/* Estimate the square root using the hardware floating point unit. */
d = 0.0;
@@ -96,11 +99,16 @@ int mp_sqrt(const mp_int *arg, mp_int *ret)
#else
- /* Estimate the square root as having 1 in the most significant place. */
+ if ((res = mp_init_copy(&t1, arg)) != MP_OKAY) {
+ return res;
+ }
+
+ if ((res = mp_init(&t2)) != MP_OKAY) {
+ goto E2;
+ }
- t1.used = i + 2;
- t1.dp[i+1] = (mp_digit) 1;
- t1.dp[i] = (mp_digit) 0;
+ /* First approx. (not very bad for large arg) */
+ mp_rshd(&t1, t1.used/2);
#endif
diff --git a/libtommath/tommath_private.h b/libtommath/tommath_private.h
index 2096f77..b3600a0 100644
--- a/libtommath/tommath_private.h
+++ b/libtommath/tommath_private.h
@@ -13,7 +13,6 @@
#define TOMMATH_PRIV_H_
#include <tommath.h>
-#include <ctype.h>
#ifndef MIN
#define MIN(x, y) (((x) < (y)) ? (x) : (y))
@@ -25,28 +24,19 @@
#ifdef __cplusplus
extern "C" {
-
-/* C++ compilers don't like assigning void * to mp_digit * */
-#define OPT_CAST(x) (x *)
-
-#else
-
-/* C on the other hand doesn't care */
-#define OPT_CAST(x)
-
#endif
/* define heap macros */
#ifndef XMALLOC
/* default to libc stuff */
-# define XMALLOC malloc
-# define XFREE free
-# define XREALLOC realloc
+# define XMALLOC(size) malloc(size)
+# define XFREE(mem, size) free(mem)
+# define XREALLOC(mem, oldsize, newsize) realloc(mem, newsize)
#elif 0
/* prototypes for our heap functions */
-extern void *XMALLOC(size_t n);
-extern void *XREALLOC(void *p, size_t n);
-extern void XFREE(void *p);
+extern void *XMALLOC(size_t size);
+extern void *XREALLOC(void *mem, size_t oldsize, size_t newsize);
+extern void XFREE(void *mem, size_t size);
#endif
/* you'll have to tune these... */
@@ -58,6 +48,11 @@ extern void XFREE(void *p);
/* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */
#define MP_WARRAY (1u << (((sizeof(mp_word) * CHAR_BIT) - (2 * DIGIT_BIT)) + 1))
+/* ---> Basic Manipulations <--- */
+#define IS_ZERO(a) ((a)->used == 0)
+#define IS_EVEN(a) (((a)->used == 0) || (((a)->dp[0] & 1u) == 0u))
+#define IS_ODD(a) (((a)->used > 0) && (((a)->dp[0] & 1u) == 1u))
+
/* lowlevel functions, do not call! */
int s_mp_add(const mp_int *a, const mp_int *b, mp_int *c);
int s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c);
@@ -85,36 +80,26 @@ extern const size_t mp_s_rmap_reverse_sz;
/* Fancy macro to set an MPI from another type.
* There are several things assumed:
- * x is the counter and unsigned
+ * x is the counter
* a is the pointer to the MPI
* b is the original value that should be set in the MPI.
*/
#define MP_SET_XLONG(func_name, type) \
int func_name (mp_int * a, type b) \
{ \
- unsigned int x; \
- int res; \
- \
- mp_zero (a); \
- \
- /* set four bits at a time */ \
- for (x = 0; x < (sizeof(type) * 2u); x++) { \
- /* shift the number up four bits */ \
- if ((res = mp_mul_2d (a, 4, a)) != MP_OKAY) { \
- return res; \
- } \
- \
- /* OR in the top four bits of the source */ \
- a->dp[0] |= (mp_digit)(b >> ((sizeof(type) * 8u) - 4u)) & 15uL;\
- \
- /* shift the source up to the next four bits */ \
- b <<= 4; \
- \
- /* ensure that digits are not clamped off */ \
- a->used += 1; \
- } \
- mp_clamp (a); \
- return MP_OKAY; \
+ int x = 0; \
+ int new_size = (((CHAR_BIT * sizeof(type)) + DIGIT_BIT) - 1) / DIGIT_BIT; \
+ int res = mp_grow(a, new_size); \
+ if (res == MP_OKAY) { \
+ mp_zero(a); \
+ while (b != 0u) { \
+ a->dp[x++] = ((mp_digit)b & MP_MASK); \
+ if ((CHAR_BIT * sizeof (b)) <= DIGIT_BIT) { break; } \
+ b >>= ((CHAR_BIT * sizeof (b)) <= DIGIT_BIT ? 0 : DIGIT_BIT); \
+ } \
+ a->used = x; \
+ } \
+ return res; \
}
#ifdef __cplusplus
diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c
index 1f7dcd8..7c65088 100644
--- a/macosx/tclMacOSXFCmd.c
+++ b/macosx/tclMacOSXFCmd.c
@@ -192,7 +192,7 @@ TclMacOSXGetFileAttribute(
OSSwapBigToHostInt32(finder->type));
break;
case MACOSX_HIDDEN_ATTRIBUTE:
- *attributePtrPtr = Tcl_NewBooleanObj(
+ *attributePtrPtr = Tcl_NewWideIntObj(
(finder->fdFlags & kFinfoIsInvisible) != 0);
break;
case MACOSX_RSRCLENGTH_ATTRIBUTE:
@@ -580,7 +580,7 @@ GetOSTypeFromObj(
if (!TclHasIntRep(objPtr, &tclOSTypeType)) {
result = SetOSTypeFromAny(interp, objPtr);
}
- *osTypePtr = (OSType) objPtr->internalRep.longValue;
+ *osTypePtr = (OSType) objPtr->internalRep.wideValue;
return result;
}
@@ -609,7 +609,7 @@ NewOSTypeObj(
TclNewObj(objPtr);
TclInvalidateStringRep(objPtr);
- objPtr->internalRep.longValue = (long) osType;
+ objPtr->internalRep.wideValue = (Tcl_WideInt) osType;
objPtr->typePtr = &tclOSTypeType;
return objPtr;
}
@@ -660,7 +660,7 @@ SetOSTypeFromAny(
(OSType) bytes[2] << 8 |
(OSType) bytes[3];
TclFreeIntRep(objPtr);
- objPtr->internalRep.longValue = (long) osType;
+ objPtr->internalRep.wideValue = (Tcl_WideInt) osType;
objPtr->typePtr = &tclOSTypeType;
}
Tcl_DStringFree(&ds);
@@ -694,7 +694,7 @@ UpdateStringOfOSType(
{
const int size = TCL_UTF_MAX * 4;
char *dst = Tcl_InitStringRep(objPtr, NULL, size);
- OSType osType = (OSType) objPtr->internalRep.longValue;
+ OSType osType = (OSType) objPtr->internalRep.wideValue;
int written = 0;
Tcl_Encoding encoding;
char src[5];
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test
index 45231c8..1ad45e7 100644
--- a/tests/cmdMZ.test
+++ b/tests/cmdMZ.test
@@ -316,6 +316,14 @@ test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} {
# The tests for Tcl_SubstObjCmd are in subst.test
# The tests for Tcl_SwitchObjCmd are in switch.test
+# todo: rewrite this if monotonic clock is provided resp. command "after"
+# gets microsecond accuracy (RFE [fdfbd5e10] gets merged):
+proc _nrt_sleep {msec} {
+ set usec [expr {$msec * 1000}]
+ set stime [clock microseconds]
+ while {abs([clock microseconds] - $stime) < $usec} {after 0}
+}
+
test cmdMZ-5.1 {Tcl_TimeObjCmd: basic format of command} -body {
time
} -returnCodes error -result {wrong # args: should be "time command ?count?"}
@@ -332,7 +340,7 @@ test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} -body {
time {format 1}
} -match regexp -result {^\d+ microseconds per iteration}
test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} {
- expr {[lindex [time {after 2}] 0] < [lindex [time {after 1000}] 0]}
+ expr {[lindex [time {_nrt_sleep 1}] 0] < [lindex [time {_nrt_sleep 20}] 0]}
} 1
test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} {
list [catch {time {error foo}} msg] $msg $::errorInfo
@@ -360,22 +368,25 @@ test cmdMZ-6.3 {Tcl_TimeRateObjCmd: basic format of command} {
test cmdMZ-6.4 {Tcl_TimeRateObjCmd: compile of script happens even with negative iteration counts} {
list [catch {timerate "foreach a {c d e} \{" -12456} msg] $msg
} {1 {missing close-brace}}
-test cmdMZ-6.5 {Tcl_TimeRateObjCmd: result format and one iteration} {
- regexp {^\d+.\d+ \ws/# 1 # \d+ #/sec \d+.\d+ nett-ms$} [timerate {} 0]
+test cmdMZ-6.5a {Tcl_TimeRateObjCmd: result format and one iteration} {
+ regexp {^\d+(?:\.\d+)? \ws/# 1 # \d+(?:\.\d+)? #/sec \d+(?:\.\d+)? nett-ms$} [timerate {} 0]
+} 1
+test cmdMZ-6.5b {Tcl_TimeRateObjCmd: result format without iterations} {
+ regexp {^0 \ws/# 0 # 0 #/sec 0 nett-ms$} [timerate {} 0 0]
} 1
test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} {
- set m1 [timerate {after 0} 20]
- set m2 [timerate {after 1} 20]
+ set m1 [timerate {_nrt_sleep 0} 20]
+ set m2 [timerate {_nrt_sleep 0.2} 20]
list \
[expr {[lindex $m1 0] < [lindex $m2 0]}] \
[expr {[lindex $m1 0] < 100}] \
- [expr {[lindex $m2 0] >= 500}] \
+ [expr {[lindex $m2 0] > 100}] \
[expr {[lindex $m1 2] > 1000}] \
- [expr {[lindex $m2 2] <= 50}] \
- [expr {[lindex $m1 4] > 10000}] \
- [expr {[lindex $m2 4] < 10000}] \
- [expr {[lindex $m1 6] > 10 && [lindex $m1 6] < 50}] \
- [expr {[lindex $m2 6] > 10 && [lindex $m2 6] < 50}]
+ [expr {[lindex $m2 2] < 1000}] \
+ [expr {[lindex $m1 4] > 50000}] \
+ [expr {[lindex $m2 4] < 50000}] \
+ [expr {[lindex $m1 6] > 10 && [lindex $m1 6] < 100}] \
+ [expr {[lindex $m2 6] > 10 && [lindex $m2 6] < 100}]
} [lrepeat 9 1]
test cmdMZ-6.7 {Tcl_TimeRateObjCmd: errors generate right trace} {
list [catch {timerate {error foo} 1} msg] $msg $::errorInfo
@@ -394,11 +405,11 @@ test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} {
} {1 1 1 1}
test cmdMZ-6.9 {Tcl_TimeRateObjCmd: max count of iterations} {
set m1 [timerate {} 1000 5]; # max-count wins
- set m2 [timerate {after 20} 1 5]; # max-time wins
+ set m2 [timerate {_nrt_sleep 20} 1 5]; # max-time wins
list [lindex $m1 2] [lindex $m2 2]
} {5 1}
test cmdMZ-6.10 {Tcl_TimeRateObjCmd: huge overhead cause 0us result} {
- set m1 [timerate -overhead 1e6 {after 10} 100 1]
+ set m1 [timerate -overhead 1e6 {_nrt_sleep 10} 100 1]
list \
[expr {[lindex $m1 0] == 0.0}] \
[expr {[lindex $m1 2] == 1}] \
@@ -406,6 +417,23 @@ test cmdMZ-6.10 {Tcl_TimeRateObjCmd: huge overhead cause 0us result} {
[expr {[lindex $m1 6] <= 0.001}]
} {1 1 1 1}
+test cmdMZ-try-1.0 {
+
+ fix for issue 45b9faf103f2
+
+ [try] interaction with local variable names produces segmentation violation
+
+} -body {
+ ::apply {{} {
+ set cmd try
+ $cmd {
+ lindex 5
+ } on ok res {}
+ set res
+ }}
+} -result 5
+
+
# The tests for Tcl_WhileObjCmd are in while.test
# cleanup
diff --git a/tests/obj.test b/tests/obj.test
index 87c8d08..5bcffa3 100644
--- a/tests/obj.test
+++ b/tests/obj.test
@@ -476,11 +476,11 @@ test obj-26.1 {UpdateStringOfInt} testobj {
lappend result [testintobj get 1] ;# must update string rep
} {512 5120 5120}
-test obj-27.1 {Tcl_NewLongObj} testobj {
+test obj-27.1 {Tcl_NewWideObj} testobj {
set result ""
lappend result [testobj freeallvars]
- testintobj setmaxlong 1
- lappend result [testintobj ismaxlong 1]
+ testintobj setmax 1
+ lappend result [testintobj ismax 1]
lappend result [testobj type 1]
lappend result [testobj refcount 1]
} {{} 1 int 1}
@@ -489,7 +489,7 @@ test obj-28.1 {Tcl_SetLongObj, existing "empty string" object} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testobj newobj 1]
- lappend result [testintobj setlong 1 77] ;# makes existing obj long int
+ lappend result [testintobj setint 1 77] ;# makes existing obj int
lappend result [testobj type 1]
lappend result [testobj refcount 1]
} {{} {} 77 int 2}
@@ -497,32 +497,32 @@ test obj-28.2 {Tcl_SetLongObj, existing non-"empty string" object} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testdoubleobj set 1 12.34]
- lappend result [testintobj setlong 1 77] ;# makes existing obj long int
+ lappend result [testintobj setint 1 77] ;# makes existing obj int
lappend result [testobj type 1]
lappend result [testobj refcount 1]
} {{} 12.34 77 int 2}
-test obj-29.1 {Tcl_GetLongFromObj, existing long integer object} testobj {
+test obj-29.1 {Tcl_GetWideIntFromObj, existing int object} testobj {
set result ""
- lappend result [testintobj setlong 1 22]
- lappend result [testintobj mult10 1] ;# gets existing long int rep
+ lappend result [testintobj setint 1 22]
+ lappend result [testintobj mult10 1] ;# gets existingint rep
} {22 220}
-test obj-29.2 {Tcl_GetLongFromObj, convert to long} testobj {
+test obj-29.2 {Tcl_GetWideIntFromObj, convert to int} testobj {
set result ""
- lappend result [testintobj setlong 1 477]
+ lappend result [testintobj setint 1 477]
lappend result [testintobj div10 1] ;# must convert to bool
lappend result [testobj type 1]
} {477 47 int}
-test obj-29.3 {Tcl_GetLongFromObj, error converting to long integer} testobj {
+test obj-29.3 {Tcl_GetWideIntFromObj, error converting to int} testobj {
set result ""
lappend result [teststringobj set 1 abc]
- lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
+ lappend result [catch {testintobj ismax 1} msg] ;# cvts to long int
lappend result $msg
} {abc 1 {expected integer but got "abc"}}
-test obj-29.4 {Tcl_GetLongFromObj, error converting from "empty string"} testobj {
+test obj-29.4 {Tcl_GetWideIntFromObj, error converting from "empty string"} testobj {
set result ""
lappend result [testobj newobj 1]
- lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
+ lappend result [catch {testintobj ismax 1} msg] ;# cvts to long int
lappend result $msg
} {{} 1 {expected integer but got ""}}
diff --git a/tests/oo.test b/tests/oo.test
index 0f8cd47..b0c5570 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -1549,6 +1549,30 @@ test oo-10.3 {OO: invoke and modify} -setup {
oo::define B deletemethod b c
lappend result [C a] [C b] [C c]
} -result {A.a,B.a A.b,B.b A.c,B.c - A.a,B.a A.b A.c,B.c - A.a A.b,B.a A.c,B.c - A.a A.b A.c}
+test oo-10.4 {OO: invoke and modify} -setup {
+ oo::class create A {
+ method a {} {return A.a}
+ method b {} {return A.b}
+ method c {} {return A.c}
+ }
+ A create B
+ oo::objdefine B {
+ method a {} {return [next],B.a}
+ method b {} {return [next],B.b}
+ method c {} {return [next],B.c}
+ }
+ set result {}
+} -cleanup {
+ A destroy
+} -body {
+ lappend result [B a] [B b] [B c] -
+ oo::objdefine B deletemethod b
+ lappend result [B a] [B b] [B c] -
+ oo::objdefine B renamemethod a b
+ lappend result [B a] [B b] [B c] -
+ oo::objdefine B deletemethod b c
+ lappend result [B a] [B b] [B c]
+} -result {A.a,B.a A.b,B.b A.c,B.c - A.a,B.a A.b A.c,B.c - A.a A.b,B.a A.c,B.c - A.a A.b A.c}
test oo-11.1 {OO: cleanup} {
oo::object create foo
diff --git a/tests/socket.test b/tests/socket.test
index 1d202f3..b91668e 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -129,9 +129,9 @@ catch {socket 127.0.0.1 [randport]}
set t2 [clock milliseconds]
set lat2 [expr {($t2-$t1)*3}]
-# Use the maximum of the two latency calculations, but at least 100ms
+# Use the maximum of the two latency calculations, but at least 200ms
set latency [expr {$lat1 > $lat2 ? $lat1 : $lat2}]
-set latency [expr {$latency > 100 ? $latency : 1000}]
+set latency [expr {$latency > 200 ? $latency : 200}]
unset t1 t2 s1 s2 lat1 lat2 server
# If remoteServerIP or remoteServerPort are not set, check in the environment
@@ -672,7 +672,7 @@ test socket_$af-2.11 {detecting new data} -constraints [list socket supported_$a
vwait sock
puts $s2 one
flush $s2
- after idle {set x 1}
+ after $latency {set x 1}; # Spurious failures in Travis CI, if we do [after idle]
vwait x
fconfigure $sock -blocking 0
set result a:[gets $sock]
diff --git a/tests/utf.test b/tests/utf.test
index f4926af..72b8d97 100644
--- a/tests/utf.test
+++ b/tests/utf.test
@@ -108,7 +108,7 @@ test utf-4.2 {Tcl_NumUtfChars: length 1} {testnumutfchars testbytestring} {
testnumutfchars [testbytestring "\xC2\xA2"]
} {1}
test utf-4.3 {Tcl_NumUtfChars: long string} {testnumutfchars testbytestring} {
- testnumutfchars [testbytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e4e"]
+ testnumutfchars [testbytestring "abc\xC2\xA2\xE4\xB9\x8E\uA2\x4E"]
} {7}
test utf-4.4 {Tcl_NumUtfChars: #u0000} {testnumutfchars testbytestring} {
testnumutfchars [testbytestring "\xC0\x80"]
@@ -120,7 +120,7 @@ test utf-4.6 {Tcl_NumUtfChars: length 1, calc len} {testnumutfchars testbytestri
testnumutfchars [testbytestring "\xC2\xA2"] 2
} {1}
test utf-4.7 {Tcl_NumUtfChars: long string, calc len} {testnumutfchars testbytestring} {
- testnumutfchars [testbytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e4e"] 10
+ testnumutfchars [testbytestring "abc\xC2\xA2\xE4\xB9\x8E\uA2\x4E"] 10
} {7}
test utf-4.8 {Tcl_NumUtfChars: #u0000, calc len} {testnumutfchars testbytestring} {
testnumutfchars [testbytestring "\xC0\x80"] 2
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index 7205085..e963589 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.c
@@ -1499,11 +1499,11 @@ SetGroupAttribute(
Tcl_Obj *fileName, /* The name of the file (UTF-8). */
Tcl_Obj *attributePtr) /* New group for file. */
{
- long gid;
+ Tcl_WideInt gid;
int result;
const char *native;
- if (Tcl_GetLongFromObj(NULL, attributePtr, &gid) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(NULL, attributePtr, &gid) != TCL_OK) {
Tcl_DString ds;
struct group *groupPtr = NULL;
const char *string;
@@ -1565,11 +1565,11 @@ SetOwnerAttribute(
Tcl_Obj *fileName, /* The name of the file (UTF-8). */
Tcl_Obj *attributePtr) /* New owner for file. */
{
- long uid;
+ Tcl_WideInt uid;
int result;
const char *native;
- if (Tcl_GetLongFromObj(NULL, attributePtr, &uid) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(NULL, attributePtr, &uid) != TCL_OK) {
Tcl_DString ds;
struct passwd *pwPtr = NULL;
const char *string;
@@ -1631,7 +1631,7 @@ SetPermissionsAttribute(
Tcl_Obj *fileName, /* The name of the file (UTF-8). */
Tcl_Obj *attributePtr) /* The attribute to set. */
{
- long mode;
+ Tcl_WideInt mode;
mode_t newMode;
int result = TCL_ERROR;
const char *native;
@@ -1650,11 +1650,11 @@ SetPermissionsAttribute(
TclNewLiteralStringObj(modeObj, "0o");
Tcl_AppendToObj(modeObj, modeStringPtr+scanned+1, -1);
- result = Tcl_GetLongFromObj(NULL, modeObj, &mode);
+ result = Tcl_GetWideIntFromObj(NULL, modeObj, &mode);
Tcl_DecrRefCount(modeObj);
}
if (result == TCL_OK
- || Tcl_GetLongFromObj(NULL, attributePtr, &mode) == TCL_OK) {
+ || Tcl_GetWideIntFromObj(NULL, attributePtr, &mode) == TCL_OK) {
newMode = (mode_t) (mode & 0x00007FFF);
} else {
Tcl_StatBuf buf;
@@ -2340,8 +2340,8 @@ GetUnixFileAttributes(
return TCL_ERROR;
}
- *attributePtrPtr = Tcl_NewBooleanObj(
- fileAttributes & attributeArray[objIndex]);
+ *attributePtrPtr = Tcl_NewWideIntObj(
+ (fileAttributes & attributeArray[objIndex]) != 0);
return TCL_OK;
}
@@ -2440,7 +2440,7 @@ GetUnixFileAttributes(
return TCL_ERROR;
}
- *attributePtrPtr = Tcl_NewBooleanObj(statBuf.st_flags & UF_IMMUTABLE);
+ *attributePtrPtr = Tcl_NewWideIntObj((statBuf.st_flags & UF_IMMUTABLE) != 0);
return TCL_OK;
}
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index a950714..14bb252 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -1549,7 +1549,7 @@ GetWinFileAttributes(
}
}
- *attributePtrPtr = Tcl_NewBooleanObj(attr);
+ *attributePtrPtr = Tcl_NewWideIntObj(attr != 0);
return TCL_OK;
}