Merge old 8.7 674a6ad0472c7

1 files changed, 33 insertions, 28 deletions

diff --git a/tests/socket.test b/tests/socket.test
index 66a1bf1..3372ffa 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -4,8 +4,8 @@
 # commands. Sourcing this file into Tcl runs the tests and generates output
 # for errors. No output means no errors were found.
 #
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-2000 Ajuba Solutions.
+# Copyright © 1994-1996 Sun Microsystems, Inc.
+# Copyright © 1998-2000 Ajuba Solutions.
 #
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -61,7 +61,7 @@
 # using the remote server are not performed.
 
 if {"::tcltest" ni [namespace children]} {
-    package require tcltest
+    package require tcltest 2.5
     namespace import -force ::tcltest::*
 }
 
@@ -69,14 +69,19 @@ if {"::tcltest" ni [namespace children]} {
 catch [list package require -exact Tcltest [info patchlevel]]
 ::tcltest::loadTestedCommands
 
-if {[expr {[info exists ::env(TRAVIS_OSX_IMAGE)] && [string match xcode* $::env(TRAVIS_OSX_IMAGE)]}]} {
+# A bad interaction between socket creation, macOS, and unattended CI
+# environments make this whole file impractical to run; too many weird hangs.
+if {[info exists ::env(MAC_CI)]} {
     return
 }
+testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]
 
 # Some tests require the Thread package or exec command
 testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
 testConstraint exec [llength [info commands exec]]
-testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
+testConstraint knownMsvcBug [expr {![info exists ::env(CI_BUILD_WITH_MSVC)]}]
+testConstraint notWinCI [expr {
+     $tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}]
 
 # Produce a random port number in the Dynamic/Private range
 # from 49152 through 65535.
@@ -248,7 +253,7 @@ if {$doTestsWithRemoteServer} {
 # Some tests are run only if we are doing testing against a remote server.
 testConstraint doTestsWithRemoteServer $doTestsWithRemoteServer
 if {!$doTestsWithRemoteServer} {
-    if {[string first s $::tcltest::verbose] != -1} {
+    if {[string first s $::tcltest::verbose] >= 0} {
     	puts "Skipping tests with remote server. See tests/socket.test for"
 	puts "information on how to run remote server."
 	puts "Reason for not doing remote tests: $noRemoteTestReason"
@@ -734,7 +739,7 @@ test socket_$af-2.12 {} [list socket stdio supported_$af] {
     close $f
     set ::done
 } 0
-test socket_$af-2.13 {Bug 1758a0b603} {socket stdio} {
+test socket_$af-2.13 {Bug 1758a0b603} {socket stdio notWine} {
     file delete $path(script)
     set f [open $path(script) w]
     puts $f {
@@ -968,7 +973,7 @@ test socket_$af-6.1 {accept callback error} -constraints [list socket supported_
     }
     close $f
     set f [open "|[list [interpreter] $path(script)]" r+]
-    proc accept {s a p} {expr 10 / 0}
+    proc accept {s a p} {expr {10 / 0}}
     set s [socket -server accept -myaddr $localhost 0]
     puts $f [lindex [fconfigure $s -sockname] 2]
     close $f
@@ -1543,7 +1548,7 @@ test socket_$af-11.11 {testing spurious events} -setup {
     after cancel $timer
     sendCommand {close $server}
 } -result {0 2690 1}
-test socket_$af-11.12 {testing EOF stickyness} -constraints [list socket supported_$af doTestsWithRemoteServer] -setup {
+test socket_$af-11.12 {testing EOF stickyness} -constraints [list socket supported_$af doTestsWithRemoteServer notWine] -setup {
     set counter 0
     set done 0
     set port [sendCommand {
@@ -1867,12 +1872,12 @@ proc transf_test {{testmode transfer} {maxIter 1000} {maxTime 10000}} {
       }
     }
     tcltest::DebugPuts 1 "== test \[$::localhost\]:$port $testmode =="
-    set ::master [thread::id]
-    # helper thread creating async connection and initiating transfer (detach) to master:
+    set ::parent [thread::id]
+    # helper thread creating async connection and initiating transfer (detach) to parent:
     set ::helper [thread::create]
     thread::send -async $::helper [list \
-      lassign [list $::master $::localhost $port $testmode] \
-                     ::master ::localhost ::port ::testmode
+      lassign [list $::parent $::localhost $port $testmode] \
+                     ::parent ::localhost ::port ::testmode
     ]
     thread::send -async $::helper {
       set ::helper [thread::id]
@@ -1881,29 +1886,29 @@ proc transf_test {{testmode transfer} {maxIter 1000} {maxTime 10000}} {
         if {"helper-writable" in $::testmode} {;# to test both sides during connect
           fileevent $fd writable [list apply {{fd} {
             if {[thread::id] ne $::helper} {
-              thread::send -async $::master {set ::count "ERROR: invalid thread, $::helper is expecting"}
+              thread::send -async $::parent {set ::count "ERROR: invalid thread, $::helper is expecting"}
               close $fd
               return
             }
           }} $fd]
         };#
         thread::detach $fd
-        thread::send -async $::master [list transf_master $fd {*}$args]
+        thread::send -async $::parent [list transf_parent $fd {*}$args]
       }
       iteration first
     }
-    # master proc commiting transfer attempt (attach) and checking acquire was successful:
-    proc transf_master {fd args} {
+    # parent proc commiting transfer attempt (attach) and checking acquire was successful:
+    proc transf_parent {fd args} {
       tcltest::DebugPuts 1 "** trma / $::count ** $args **"
       thread::attach $fd
-      if {"master-close" in $::testmode} {;# to test close during connect
+      if {"parent-close" in $::testmode} {;# to test close during connect
         set ::count $::count
         close $fd
         return
       };#
       fileevent $fd writable [list apply {{fd} {
-        if {[thread::id] ne $::master} {
-          thread::send -async $::master {set ::count "ERROR: invalid thread, $::master is expecting"}
+        if {[thread::id] ne $::parent} {
+          thread::send -async $::parent {set ::count "ERROR: invalid thread, $::parent is expecting"}
           close $fd
           return
         }
@@ -1931,7 +1936,7 @@ proc transf_test {{testmode transfer} {maxIter 1000} {maxTime 10000}} {
     if {$srvsock ne {}} {close $srvsock}
     if {[info exists ::helper]} {thread::release -wait $::helper}
     tcltest::DebugPuts 1 "== stop / $::count =="
-    unset -nocomplain ::count ::testmode ::master ::helper
+    unset -nocomplain ::count ::testmode ::parent ::helper
   }
 }
 test socket_$af-13.2.tr1 {Testing socket transfer between threads during async connect} -body {
@@ -1941,12 +1946,12 @@ test socket_$af-13.2.tr2 {Testing socket transfer between threads during async c
     transf_test {transfer helper-writable} 100
 } -result 100 -constraints [list socket supported_$af thread]
 test socket_$af-13.2.cl1 {Testing socket transfer between threads during async connect} -body {
-    transf_test {master-close} 100
+    transf_test {parent-close} 100
 } -result 100 -constraints [list socket supported_$af thread]
 test socket_$af-13.2.cl2 {Testing socket transfer between threads during async connect} -body {
-    transf_test {master-close helper-writable} 100
+    transf_test {parent-close helper-writable} 100
 } -result 100 -constraints [list socket supported_$af thread]
-catch {rename transf_master {}}
+catch {rename transf_parent {}}
 rename transf_test {}
 
 # ----------------------------------------------------------------------
@@ -2101,7 +2106,7 @@ test socket-14.4 {[socket -async] and both, readdable and writable fileevents} \
     } -result {{} bye}
 # FIXME: we should also have an IPv6 counterpart of this
 test socket-14.5 {[socket -async] which fails before any connect() can be made} \
-    -constraints {socket supported_inet} \
+    -constraints {socket supported_inet notWine} \
     -body {
         # address from rfc5737
         socket -async -myaddr 192.0.2.42 127.0.0.1 [randport]
@@ -2389,7 +2394,7 @@ test socket-14.10.1 {pending [socket -async] and nonblocking [puts], server is I
 	removeFile script
     } -result {{} ok}
 test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener, no flush} \
-    -constraints {socket knownMsvcBug} \
+    -constraints {socket notWinCI} \
     -body {
         set sock [socket -async localhost [randport]]
         fconfigure $sock -blocking 0
@@ -2436,7 +2441,7 @@ test socket-14.12 {[socket -async] background progress triggered by [fconfigure
     } -result {connection refused}
 
 test socket-14.13 {testing writable event when quick failure} \
-    -constraints {socket win supported_inet} \
+    -constraints {socket win supported_inet notWine} \
     -body {
     # Test for bug 336441ed59 where a quick background fail was ignored
 
@@ -2520,7 +2525,7 @@ test socket-14.18 {bug c6ed4acfd8: running async socket connect made other conne
     } -result {}
 
 test socket-14.19 {tip 456 -- introduce the -reuseport option} \
-    -constraints {socket} \
+    -constraints {socket notWine} \
     -body {
         proc accept {channel address port} {}
         set port [randport]