merge 8.7

12 files changed, 124 insertions, 50 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/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/tclCmdMZ.c b/generic/tclCmdMZ.c
index 3bf485b..7532de9 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -4870,24 +4870,18 @@ TryPostBody(
 		Tcl_Obj *varName;
 
 		Tcl_ListObjIndex(NULL, info[3], 0, &varName);
-		Tcl_IncrRefCount(varName);
 		if (Tcl_ObjSetVar2(interp, varName, NULL, resultObj,
 			TCL_LEAVE_ERR_MSG) == NULL) {
-		    Tcl_DecrRefCount(varName);
 		    Tcl_DecrRefCount(resultObj);
 		    goto handlerFailed;
 		}
-		Tcl_DecrRefCount(varName);
 		Tcl_DecrRefCount(resultObj);
 		if (dummy > 1) {
 		    Tcl_ListObjIndex(NULL, info[3], 1, &varName);
-		    Tcl_IncrRefCount(varName);
 		    if (Tcl_ObjSetVar2(interp, varName, NULL, options,
 			    TCL_LEAVE_ERR_MSG) == NULL) {
-			Tcl_DecrRefCount(varName);
 			goto handlerFailed;
 		    }
-		    Tcl_DecrRefCount(varName);
 		}
 	    } else {
 		/*
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/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/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 5a7abec..8dbe807 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -422,7 +422,7 @@ GenerateHeader(
 {
     Tcl_Obj *value;
     int len, result = TCL_ERROR;
-    Tcl_WideInt wideValue;
+    Tcl_WideInt wideValue = 0;
     const char *valueStr;
     Tcl_Encoding latin1enc;
     static const char *const types[] = {
diff --git a/libtommath/bn_mp_set_double.c b/libtommath/bn_mp_set_double.c
index c96a3b3..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;
 
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/tests/cmdMZ.test b/tests/cmdMZ.test
index 80258dc..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
@@ -367,18 +375,18 @@ 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
@@ -397,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}] \
@@ -420,9 +428,9 @@ test cmdMZ-try-1.0 {
 	set cmd try
 	$cmd {
 	    lindex 5
-	} on ok res {} 
+	} on ok res {}
 	set res
-    }} 
+    }}
 } -result 5
 
 
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