Merge 8.6

7 files changed, 129 insertions, 85 deletions

diff --git a/doc/CrtAlias.3 b/doc/CrtAlias.3
index f9c912d..2c49583 100644
--- a/doc/CrtAlias.3
+++ b/doc/CrtAlias.3
@@ -185,12 +185,12 @@ top-level interpreter) then \fBNULL\fR is returned.
 \fBTcl_GetParent\fR is a synonym for \fBTcl_GetMaster\fR.
 .VE "TIP 581"
 .PP
-\fBTcl_GetInterpPath\fR stores in the result of \fIaskingInterp\fR
-the relative path between \fIaskingInterp\fR and \fIslaveInterp\fR;
-\fIslaveInterp\fR must be a slave of \fIaskingInterp\fR. If the computation
+\fBTcl_GetInterpPath\fR stores in the result of \fIinterp\fR
+the relative path between \fIinterp\fR and \fIslaveInterp\fR;
+\fIslaveInterp\fR must be a slave of \fIinterp\fR. If the computation
 of the relative path succeeds, \fBTCL_OK\fR is returned, else
 \fBTCL_ERROR\fR is returned and an error message is stored as the
-result of \fIaskingInterp\fR.
+result of \fIinterp\fR.
 .PP
 \fBTcl_CreateAlias\fR creates a command named \fIslaveCmd\fR in
 \fIslaveInterp\fR that when invoked, will cause the command \fItargetCmd\fR
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 6e99913..cebb31e 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -2170,23 +2170,23 @@ TclSetSlaveCancelFlags(
 
 int
 Tcl_GetInterpPath(
-    Tcl_Interp *askingInterp,	/* Interpreter to start search from. */
+    Tcl_Interp *interp,	/* Interpreter to start search from. */
     Tcl_Interp *targetInterp)	/* Interpreter to find. */
 {
     InterpInfo *iiPtr;
 
-    if (targetInterp == askingInterp) {
-	Tcl_SetObjResult(askingInterp, Tcl_NewObj());
+    if (targetInterp == interp) {
+	Tcl_SetObjResult(interp, Tcl_NewObj());
 	return TCL_OK;
     }
     if (targetInterp == NULL) {
 	return TCL_ERROR;
     }
     iiPtr = (InterpInfo *) ((Interp *) targetInterp)->interpInfo;
-    if (Tcl_GetInterpPath(askingInterp, iiPtr->slave.masterInterp) != TCL_OK){
+    if (Tcl_GetInterpPath(interp, iiPtr->slave.masterInterp) != TCL_OK){
 	return TCL_ERROR;
     }
-    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(askingInterp),
+    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
 	    Tcl_NewStringObj(Tcl_GetHashKey(&iiPtr->master.slaveTable,
 		    iiPtr->slave.slaveEntryPtr), -1));
     return TCL_OK;
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index e4edfda..c894ff1 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -811,14 +811,14 @@ namespace eval tcltest {
     trace add variable Option(-errfile) write \
 	    [namespace code {errorChannel $Option(-errfile) ;#}]
 
-    proc loadIntoSlaveInterpreter {slave args} {
+    proc loadIntoChildInterpreter {child args} {
 	variable Version
-	interp eval $slave [package ifneeded tcltest $Version]
-	interp eval $slave "tcltest::configure {*}{$args}"
-	interp alias $slave ::tcltest::ReportToMaster \
-	    {} ::tcltest::ReportedFromSlave
+	interp eval $child [package ifneeded tcltest $Version]
+	interp eval $child "tcltest::configure {*}{$args}"
+	interp alias $child ::tcltest::ReportToParent \
+	    {} ::tcltest::ReportedFromChild
     }
-    proc ReportedFromSlave {total passed skipped failed because newfiles} {
+    proc ReportedFromChild {total passed skipped failed because newfiles} {
 	variable numTests
 	variable skippedBecause
 	variable createdNewFiles
@@ -2462,8 +2462,8 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} {
     set testFileName [file tail [info script]]
 
     # Hook to handle reporting to a parent interpreter
-    if {[llength [info commands [namespace current]::ReportToMaster]]} {
-	ReportToMaster $numTests(Total) $numTests(Passed) $numTests(Skipped) \
+    if {[llength [info commands [namespace current]::ReportToParent]]} {
+	ReportToParent $numTests(Total) $numTests(Passed) $numTests(Skipped) \
 	    $numTests(Failed) [array get skippedBecause] \
 	    [array get createdNewFiles]
 	set testSingleFile false
diff --git a/macosx/tclMacOSXNotify.c b/macosx/tclMacOSXNotify.c
index 01581cf..bbbac65 100644
--- a/macosx/tclMacOSXNotify.c
+++ b/macosx/tclMacOSXNotify.c
@@ -14,6 +14,18 @@
  */
 
 #include "tclInt.h"
+
+/*
+ * In macOS 10.12 the os_unfair_lock was introduced as a replacement for the
+ * OSSpinLock, and the OSSpinLock was deprecated.
+ */
+
+#if MAC_OS_X_VERSION_MIN_REQUIRED >= 101200
+#define USE_OS_UNFAIR_LOCK
+#include <os/lock.h>
+#undef TCL_MAC_DEBUG_NOTIFIER
+#endif
+
 #ifdef HAVE_COREFOUNDATION	/* Traditional unix select-based notifier is
 				 * in tclUnixNotfy.c */
 #include <CoreFoundation/CoreFoundation.h>
@@ -21,6 +33,8 @@
 
 /* #define TCL_MAC_DEBUG_NOTIFIER 1 */
 
+#if  !defined(USE_OS_UNFAIR_LOCK)
+
 /*
  * We use the Darwin-native spinlock API rather than pthread mutexes for
  * notifier locking: this radically simplifies the implementation and lowers
@@ -109,26 +123,45 @@ extern int		_spin_lock_try(OSSpinLock *lock);
 
 #pragma GCC diagnostic pop
 #endif /* HAVE_LIBKERN_OSATOMIC_H && HAVE_OSSPINLOCKLOCK */
+#endif /* not using os_unfair_lock */
 
 /*
- * These spinlocks lock access to the global notifier state.
+ * These locks control access to the global notifier state.
  */
 
+#if defined(USE_OS_UNFAIR_LOCK)
+static os_unfair_lock notifierInitLock = OS_UNFAIR_LOCK_INIT;
+static os_unfair_lock notifierLock     = OS_UNFAIR_LOCK_INIT;
+#else
 static OSSpinLock notifierInitLock = SPINLOCK_INIT;
 static OSSpinLock notifierLock     = SPINLOCK_INIT;
+#endif
 
 /*
- * Macros abstracting notifier locking/unlocking
+ * Macros that abstract notifier locking/unlocking
  */
 
+#if defined(USE_OS_UNFAIR_LOCK)
+#define LOCK_NOTIFIER_INIT	os_unfair_lock_lock(&notifierInitLock)
+#define UNLOCK_NOTIFIER_INIT	os_unfair_lock_unlock(&notifierInitLock)
+#define LOCK_NOTIFIER		os_unfair_lock_lock(&notifierLock)
+#define UNLOCK_NOTIFIER		os_unfair_lock_unlock(&notifierLock)
+#define LOCK_NOTIFIER_TSD	os_unfair_lock_lock(&tsdPtr->tsdLock)
+#define UNLOCK_NOTIFIER_TSD	os_unfair_lock_unlock(&tsdPtr->tsdLock)
+#else
 #define LOCK_NOTIFIER_INIT	SpinLockLock(&notifierInitLock)
 #define UNLOCK_NOTIFIER_INIT	SpinLockUnlock(&notifierInitLock)
 #define LOCK_NOTIFIER		SpinLockLock(&notifierLock)
 #define UNLOCK_NOTIFIER		SpinLockUnlock(&notifierLock)
 #define LOCK_NOTIFIER_TSD	SpinLockLock(&tsdPtr->tsdLock)
 #define UNLOCK_NOTIFIER_TSD	SpinLockUnlock(&tsdPtr->tsdLock)
+#endif
 
-#ifdef TCL_MAC_DEBUG_NOTIFIER
+/*
+ * The debug version of the Notifier only works if using OSSpinLock.
+ */
+
+#if defined(TCL_MAC_DEBUG_NOTIFIER) && !defined(USE_OS_UNFAIR_LOCK)
 #define TclMacOSXNotifierDbgMsg(m, ...) \
     do {								\
 	fprintf(notifierLog?notifierLog:stderr, "tclMacOSXNotify.c:%d: " \
@@ -155,7 +188,7 @@ static OSSpinLock notifierLock     = SPINLOCK_INIT;
 #undef LOCK_NOTIFIER
 #define LOCK_NOTIFIER		SpinLockLockDbg(&notifierLock)
 #undef LOCK_NOTIFIER_TSD
-#define LOCK_NOTIFIER_TSD	SpinLockLockDbg(&tsdPtr->tsdLock)
+#define LOCK_NOTIFIER_TSD	SpinLockLockDbg(tsdPtr->tsdLock)
 #include <asl.h>
 static FILE *notifierLog = NULL;
 #ifndef NOTIFIER_LOG
@@ -262,8 +295,6 @@ typedef struct ThreadSpecificData {
     int runLoopRunning;		/* True if this thread's Tcl runLoop is
 				 * running. */
     int runLoopNestingLevel;	/* Level of nested runLoop invocations. */
-    int runLoopServicingEvents;	/* True if this thread's runLoop is servicing
-				 * Tcl events. */
 
     /* Must hold the notifierLock before accessing the following fields: */
     /* Start notifierLock section */
@@ -276,9 +307,14 @@ typedef struct ThreadSpecificData {
 				 * from these pointers. */
     /* End notifierLock section */
 
+#if defined(USE_OS_UNFAIR_LOCK)
+    os_unfair_lock tsdLock;
+#else
     OSSpinLock tsdLock;		/* Must hold this lock before acessing the
 				 * following fields from more than one
 				 * thread. */
+#endif
+
     /* Start tsdLock section */
     SelectMasks checkMasks;	/* This structure is used to build up the
 				 * masks to be used in the next call to
@@ -464,7 +500,6 @@ Tcl_InitNotifier(void)
     /*
      * Initialize support for weakly imported spinlock API.
      */
-
     if (pthread_once(&spinLockLockInitControl, SpinLockLockInit)) {
 	Tcl_Panic("Tcl_InitNotifier: pthread_once failed");
     }
@@ -501,7 +536,7 @@ Tcl_InitNotifier(void)
 	bzero(&runLoopObserverContext, sizeof(CFRunLoopObserverContext));
 	runLoopObserverContext.info = tsdPtr;
 	runLoopObserver = CFRunLoopObserverCreate(NULL,
-		kCFRunLoopEntry|kCFRunLoopExit|kCFRunLoopBeforeWaiting, TRUE,
+		kCFRunLoopEntry|kCFRunLoopExit, TRUE,
 		LONG_MIN, UpdateWaitingListAndServiceEvents,
 		&runLoopObserverContext);
 	if (!runLoopObserver) {
@@ -519,7 +554,7 @@ Tcl_InitNotifier(void)
 	 */
 
 	runLoopObserverTcl = CFRunLoopObserverCreate(NULL,
-		kCFRunLoopEntry|kCFRunLoopExit|kCFRunLoopBeforeWaiting, TRUE,
+		kCFRunLoopEntry|kCFRunLoopExit, TRUE,
 		LONG_MIN, UpdateWaitingListAndServiceEvents,
 		&runLoopObserverContext);
 	if (!runLoopObserverTcl) {
@@ -535,7 +570,11 @@ Tcl_InitNotifier(void)
 	tsdPtr->runLoopObserverTcl = runLoopObserverTcl;
 	tsdPtr->runLoopTimer = NULL;
 	tsdPtr->waitTime = CF_TIMEINTERVAL_FOREVER;
+#if defined(USE_OS_UNFAIR_LOCK)
+	tsdPtr->tsdLock = OS_UNFAIR_LOCK_INIT;
+#else
 	tsdPtr->tsdLock = SPINLOCK_INIT;
+#endif
     }
 
     LOCK_NOTIFIER_INIT;
@@ -593,7 +632,6 @@ Tcl_InitNotifier(void)
     ENABLE_ASL;
     notifierCount++;
     UNLOCK_NOTIFIER_INIT;
-
     return tsdPtr;
 }
 
@@ -1229,6 +1267,10 @@ Tcl_WaitForEvent(
 	Tcl_Panic("Tcl_WaitForEvent: Notifier not initialized");
     }
 
+    /*
+     * A NULL timePtr means wait forever.
+     */
+
     if (timePtr) {
 	Tcl_Time vTime = *timePtr;
 
@@ -1242,14 +1284,23 @@ Tcl_WaitForEvent(
 	    tclScaleTimeProcPtr(&vTime, tclTimeClientData);
 	    waitTime = vTime.sec + 1.0e-6 * vTime.usec;
 	} else {
+
 	    /*
-	     * Polling: pretend to wait for files and tell the notifier thread
-	     * what we are doing. The notifier thread makes sure it goes
-	     * through select with its select mask in the same state as ours
-	     * currently is. We block until that happens.
+	     * The max block time was set to 0.
+	     *
+	     * If we set the waitTime to 0, then the call to CFRunLoopInMode
+	     * may return without processing all of its sources.  The Apple
+	     * documentation says that if the waitTime is 0 "only one pass is
+	     * made through the run loop before returning; if multiple sources
+	     * or timers are ready to fire immediately, only one (possibly two
+	     * if one is a version 0 source) will be fired, regardless of the
+	     * value of returnAfterSourceHandled."  This can cause some chanio
+	     * tests to fail.  So we use a small positive waitTime unless there
+	     * is another RunLoop running.
 	     */
 
 	    polling = 1;
+	    waitTime = tsdPtr->runLoopRunning ? 0 : 0.0001;
 	}
     }
 
@@ -1262,18 +1313,18 @@ Tcl_WaitForEvent(
 
     /*
      * If the Tcl runloop is already running (e.g. if Tcl_WaitForEvent was
-     * called recursively) or is servicing events via the runloop observer,
-     * re-run it in a custom runloop mode containing only the source for the
-     * notifier thread, otherwise wakeups from other sources added to the
-     * common runloop modes might get lost or 3rd party event handlers might
-     * get called when they do not expect to be.
+     * called recursively) start a new runloop in a custom runloop mode
+     * containing only the source for the notifier thread.  Otherwise wakeups
+     * from other sources added to the common runloop mode might get lost or
+     * 3rd party event handlers might get called when they do not expect to
+     * be.
      */
 
     runLoopRunning = tsdPtr->runLoopRunning;
     tsdPtr->runLoopRunning = 1;
-    runLoopStatus = CFRunLoopRunInMode(tsdPtr->runLoopServicingEvents ||
-	    runLoopRunning ? tclEventsOnlyRunLoopMode : kCFRunLoopDefaultMode,
-	    waitTime, TRUE);
+    runLoopStatus = CFRunLoopRunInMode(
+	runLoopRunning ? tclEventsOnlyRunLoopMode : kCFRunLoopDefaultMode,
+	waitTime, TRUE);
     tsdPtr->runLoopRunning = runLoopRunning;
 
     LOCK_NOTIFIER_TSD;
@@ -1391,7 +1442,6 @@ UpdateWaitingListAndServiceEvents(
     void *info)
 {
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)info;
-
     if (tsdPtr->sleeping) {
 	return;
     }
@@ -1414,19 +1464,6 @@ UpdateWaitingListAndServiceEvents(
 	}
 	tsdPtr->runLoopNestingLevel--;
 	break;
-    case kCFRunLoopBeforeWaiting:
-	if (tsdPtr->runLoopTimer && !tsdPtr->runLoopServicingEvents &&
-		(tsdPtr->runLoopNestingLevel > 1
-			|| !tsdPtr->runLoopRunning)) {
-	    tsdPtr->runLoopServicingEvents = 1;
-            /*
-	     * This call seems to simply force event processing through and
-	     * prevents hangups that have long been observed with Tk-Cocoa.
-	     */
-	    Tcl_ServiceAll();
-	    tsdPtr->runLoopServicingEvents = 0;
-	}
-	break;
     default:
 	break;
     }
@@ -1459,7 +1496,7 @@ OnOffWaitingList(
 {
     int changeWaitingList;
 
-#ifdef TCL_MAC_DEBUG_NOTIFIER
+#if defined(TCL_MAC_DEBUG_NOTIFIER) && !defined(USE_OS_UNFAIR_LOCK)
     if (SpinLockTry(&notifierLock)) {
 	Tcl_Panic("OnOffWaitingList: notifierLock unlocked");
     }
@@ -1990,9 +2027,19 @@ AtForkChild(void)
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
-    UNLOCK_NOTIFIER_TSD;
-    UNLOCK_NOTIFIER;
-    UNLOCK_NOTIFIER_INIT;
+    /*
+     * If a child process unlocks an os_unfair_lock that was created in its parent
+     * the child will exit with an illegal instruction error.  So we reinitialize
+     * the lock in the child rather than attempt to unlock it.
+     */
+
+#if defined(USE_OS_UNFAIR_LOCK)
+    tsdPtr->tsdLock = OS_UNFAIR_LOCK_INIT;
+#else
+       UNLOCK_NOTIFIER_TSD;
+       UNLOCK_NOTIFIER;
+       UNLOCK_NOTIFIER_INIT;
+#endif
     if (tsdPtr->runLoop) {
 	tsdPtr->runLoop = NULL;
 	if (!noCFafterFork) {
diff --git a/tests/init.test b/tests/init.test
index 1d838ef..e8d484b 100644
--- a/tests/init.test
+++ b/tests/init.test
@@ -19,16 +19,16 @@ if {"::tcltest" ni [namespace children]} {
 catch {namespace delete {*}[namespace children :: test_ns_*]}
 
 test init-0.1 {no error on initialization phase (init.tcl)} -setup {
-    interp create slave
+    interp create child
 } -body {
-    slave eval {
+    child eval {
 	list [set v [info exists ::errorInfo]] \
 		[if {$v} {set ::errorInfo}] \
 	     [set v [info exists ::errorCode]] \
 		[if {$v} {set ::errorCode}]
     }
 } -cleanup {
-    interp delete slave
+    interp delete child
 } -result {0 {} 0 {}}
 
 # Six cases - white box testing
@@ -59,11 +59,11 @@ test init-1.8 {auto_qualify - multiple colons 2} {
     auto_qualify :::foo ::bar
 } foo
 
-# We use a sub-interp and auto_reset and double the tests because there is 2
+# We use a child interp and auto_reset and double the tests because there is 2
 # places where auto_loading occur (before loading the indexes files and after)
 
 set testInterp [interp create]
-tcltest::loadIntoSlaveInterpreter $testInterp {*}$argv
+tcltest::loadIntoChildInterpreter $testInterp {*}$argv
 interp eval $testInterp {
     namespace import -force ::tcltest::*
     customMatch pairwise {apply {{mode pair} {
diff --git a/tests/io.test b/tests/io.test
index 458cc5d..7072b63 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -6719,7 +6719,7 @@ test io-49.5 {testing crlf reading, leftover cr disgorgment} {
     set l
 } [list 7 a\rb\rc 7 {} 7 1]
 
-test io-50.1 {testing handler deletion} {testchannelevent} {
+test io-50.1 {testing handler deletion} {testchannelevent nonPortable} {
     file delete $path(test1)
     set f [open $path(test1) w]
     close $f
@@ -6735,7 +6735,7 @@ test io-50.1 {testing handler deletion} {testchannelevent} {
     close $f
     set z
 } called
-test io-50.2 {testing handler deletion with multiple handlers} {testchannelevent} {
+test io-50.2 {testing handler deletion with multiple handlers} {testchannelevent nonPortable} {
     file delete $path(test1)
     set f [open $path(test1) w]
     close $f
@@ -6753,7 +6753,7 @@ test io-50.2 {testing handler deletion with multiple handlers} {testchannelevent
     string compare [string tolower $z] \
 	[list [list called delhandler $f 0] [list called delhandler $f 1]]
 } 0
-test io-50.3 {testing handler deletion with multiple handlers} {testchannelevent} {
+test io-50.3 {testing handler deletion with multiple handlers} {testchannelevent nonPortable} {
     file delete $path(test1)
     set f [open $path(test1) w]
     close $f
@@ -6779,7 +6779,7 @@ test io-50.3 {testing handler deletion with multiple handlers} {testchannelevent
 	[list [list delhandler $f 0 called] \
 	      [list delhandler $f 0 deleted myself]]
 } 0
-test io-50.4 {testing handler deletion vs reentrant calls} {testchannelevent} {
+test io-50.4 {testing handler deletion vs reentrant calls} {testchannelevent nonPortable} {
     file delete $path(test1)
     set f [open $path(test1) w]
     close $f
@@ -6801,10 +6801,9 @@ test io-50.4 {testing handler deletion vs reentrant calls} {testchannelevent} {
     variable z ""
     update
     close $f
-    string compare [string tolower $z] \
-	{{delrecursive calling recursive} {delrecursive deleting recursive}}
-} 0
-test io-50.5 {testing handler deletion vs reentrant calls} {testchannelevent} {
+    set z
+} {{delrecursive calling recursive} {delrecursive deleting recursive}}
+test io-50.5 {testing handler deletion vs reentrant calls} {testchannelevent nonPortable} {
     file delete $path(test1)
     set f [open $path(test1) w]
     close $f
@@ -6834,11 +6833,10 @@ test io-50.5 {testing handler deletion vs reentrant calls} {testchannelevent} {
     set u toplevel
     update
     close $f
-    string compare [string tolower $z] \
-	[list {del calling recursive} {del deleted notcalled} \
-	      {del deleted myself} {del after update}]
-} 0
-test io-50.6 {testing handler deletion vs reentrant calls} {testchannelevent} {
+    set z	
+} [list {del calling recursive} {del deleted notcalled} \
+	{del deleted myself} {del after update}]
+test io-50.6 {testing handler deletion vs reentrant calls} {testchannelevent nonPortable} {
     file delete $path(test1)
     set f [open $path(test1) w]
     close $f
@@ -6876,11 +6874,10 @@ test io-50.6 {testing handler deletion vs reentrant calls} {testchannelevent} {
     set u toplevel
     update
     close $f
-    string compare [string tolower $z] \
-	[list {first called} {first called not toplevel} \
-	      {second called, first time} {second called, second time} \
-	      {first after update}]
-} 0
+    set z
+} [list {first called} {first called not toplevel} \
+	{second called, first time} {second called, second time} \
+	{first after update}]
 
 test io-51.1 {Test old socket deletion on Macintosh} {socket} {
     set x 0
diff --git a/tests/package.test b/tests/package.test
index bc73003..a147457 100644
--- a/tests/package.test
+++ b/tests/package.test
@@ -17,9 +17,9 @@ if {"::tcltest" ni [namespace children]} {
     namespace import -force ::tcltest::*
 }
 
-# Do all this in a slave interp to avoid garbaging the package list
+# Do all this in a child interp to avoid garbaging the package list
 set i [interp create]
-tcltest::loadIntoSlaveInterpreter $i {*}$argv
+tcltest::loadIntoChildInterpreter $i {*}$argv
 interp eval $i {
 namespace import -force ::tcltest::*
 package forget {*}[package names]
@@ -862,15 +862,15 @@ test package-4.56 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
 # No tests for FindPackage; can't think up anything detectable errors.
 
 test package-5.1 {TclFreePackageInfo procedure} {
-    interp create slave
-    slave eval {
+    interp create child
+    child eval {
 	package ifneeded t 2.3 x
 	package ifneeded t 2.4 y
 	package ifneeded x 3.1 z
 	package provide q 4.3
 	package unknown "will this get freed?"
     }
-    interp delete slave
+    interp delete child
 } {}
 test package-5.2 {TclFreePackageInfo procedure} -body {
     interp create foo