Fix bug [57945b574a6df0332efc4ac96b066f7c347b28f7|57945b574a]: lock in forking process under heavy multithreading. Thanks to Joe Mistachkin for the implementation of the fix, and Gustaf Neumann for the original report and testing the fix.

1 files changed, 26 insertions, 0 deletions

diff --git a/tests/thread.test b/tests/thread.test
index bfef91c..3c0a1e1 100644
--- a/tests/thread.test
+++ b/tests/thread.test
@@ -254,6 +254,32 @@ test thread-6.1 {freeing very large object trees in a thread} testthread {
     set res
 } {0}
 
+test thread-8.1 {threaded fork stress} -constraints {thread} -setup {
+    unset -nocomplain ::threadCount ::execCount ::threads ::thread
+    set ::threadCount 10
+    set ::execCount 10
+} -body {
+    set ::threads [list]
+    for {set i 0} {$i < $::threadCount} {incr i} {
+	lappend ::threads [thread::create -joinable [string map \
+		[list %execCount% $::execCount] {
+	    proc execLs {} {
+		if {$::tcl_platform(platform) eq "windows"} then {
+		    return [exec $::env(COMSPEC) /c DIR]
+		} else {
+		    return [exec /bin/ls]
+		}
+	    }
+	    set j {%execCount%}; while {[incr j -1]} {execLs}
+	}]]
+    }
+    foreach ::thread $::threads {
+	thread::join $::thread
+    }
+} -cleanup {
+    unset -nocomplain ::threadCount ::execCount ::threads ::thread
+} -result {}
+
 # cleanup
 ::tcltest::cleanupTests
 return