* tests/socket.test:

	* tests/winPipe.test:
	* tests/pid.test: Fixed SF Bug #575848. See below for a
	  description the general problem.

1 files changed, 53 insertions, 48 deletions

diff --git a/tests/socket.test b/tests/socket.test
index f5c75b1..172a46b 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: socket.test,v 1.23 2002/04/15 23:09:12 dgp Exp $
+# RCS: @(#) $Id: socket.test,v 1.24 2002/07/04 20:06:13 andreas_kupries Exp $
 
 # Running socket tests with a remote server:
 # ------------------------------------------
@@ -248,9 +248,11 @@ test socket-1.12 {arg parsing for socket command} {socket} {
     list [catch {socket foo badport} msg] $msg
 } {1 {expected integer but got "badport"}}
 
+set path(script) [makeFile {} script]
+
 test socket-2.1 {tcp connection} {socket stdio} {
     removeFile script
-    set f [open script w]
+    set f [open $path(script) w]
     puts $f {
 	set timer [after 10000 "set x timed_out"]
 	set f [socket -server accept 0]
@@ -267,7 +269,7 @@ test socket-2.1 {tcp connection} {socket stdio} {
 	puts $x
     }
     close $f
-    set f [open "|[list $::tcltest::tcltest script]" r]
+    set f [open "|[list $::tcltest::tcltest $path(script)]" r]
     gets $f x
     gets $f listen
     if {[catch {socket 127.0.0.1 $listen} msg]} {
@@ -288,7 +290,7 @@ if [info exists port] {
 }
 test socket-2.2 {tcp connection with client port specified} {socket stdio} {
     removeFile script
-    set f [open script w]
+    set f [open $path(script) w]
     puts $f {
 	set timer [after 10000 "set x timeout"]
         set f [socket -server accept 0]
@@ -305,7 +307,7 @@ test socket-2.2 {tcp connection with client port specified} {socket stdio} {
 	close $f
     }
     close $f
-    set f [open "|[list $::tcltest::tcltest script]" r]
+    set f [open "|[list $::tcltest::tcltest $path(script)]" r]
     gets $f x
     gets $f listen
     global port
@@ -324,7 +326,7 @@ test socket-2.2 {tcp connection with client port specified} {socket stdio} {
 } [list ready "hello $port"]
 test socket-2.3 {tcp connection with client interface specified} {socket stdio} {
     removeFile script
-    set f [open script w]
+    set f [open $path(script) w]
     puts $f {
 	set timer [after 2000 "set x done"]
         set f [socket  -server accept 2830]
@@ -340,7 +342,7 @@ test socket-2.3 {tcp connection with client interface specified} {socket stdio}
 	close $f
     }
     close $f
-    set f [open "|[list $::tcltest::tcltest script]" r]
+    set f [open "|[list $::tcltest::tcltest $path(script)]" r]
     gets $f x
     if {[catch {socket -myaddr 127.0.0.1 127.0.0.1 2830} sock]} {
         set x $sock
@@ -355,7 +357,7 @@ test socket-2.3 {tcp connection with client interface specified} {socket stdio}
 } {ready {hello 127.0.0.1}}
 test socket-2.4 {tcp connection with server interface specified} {socket stdio} {
     removeFile script
-    set f [open script w]
+    set f [open $path(script) w]
     puts $f {
 	set timer [after 2000 "set x done"]
         set f [socket -server accept -myaddr [info hostname] 0]
@@ -372,7 +374,7 @@ test socket-2.4 {tcp connection with server interface specified} {socket stdio}
 	close $f
     }
     close $f
-    set f [open "|[list $::tcltest::tcltest script]" r]
+    set f [open "|[list $::tcltest::tcltest $path(script)]" r]
     gets $f x
     gets $f listen
     if {[catch {socket [info hostname] $listen} sock]} {
@@ -388,7 +390,7 @@ test socket-2.4 {tcp connection with server interface specified} {socket stdio}
 } {ready hello}
 test socket-2.5 {tcp connection with redundant server port} {socket stdio} {
     removeFile script
-    set f [open script w]
+    set f [open $path(script) w]
     puts $f {
 	set timer [after 10000 "set x timeout"]
         set f [socket -server accept 0]
@@ -405,7 +407,7 @@ test socket-2.5 {tcp connection with redundant server port} {socket stdio} {
 	close $f
     }
     close $f
-    set f [open "|[list $::tcltest::tcltest script]" r]
+    set f [open "|[list $::tcltest::tcltest $path(script)]" r]
     gets $f x
     gets $f listen
     if {[catch {socket 127.0.0.1 $listen} sock]} {
@@ -431,7 +433,7 @@ test socket-2.6 {tcp connection} {socket} {
 } ok
 test socket-2.7 {echo server, one line} {socket stdio} {
     removeFile script
-    set f [open script w]
+    set f [open $path(script) w]
     puts $f {
 	set timer [after 10000 "set x timeout"]
 	set f [socket -server accept 0]
@@ -457,7 +459,7 @@ test socket-2.7 {echo server, one line} {socket stdio} {
 	puts $x
     }
     close $f
-    set f [open "|[list $::tcltest::tcltest script]" r]
+    set f [open "|[list $::tcltest::tcltest $path(script)]" r]
     gets $f
     gets $f listen
     set s [socket 127.0.0.1 $listen]
@@ -498,7 +500,7 @@ test socket-2.8 {echo server, loop 50 times, single connection} {socket stdio} {
 	close $f
 	puts "done $i"
     } script
-    set f [open "|[list $::tcltest::tcltest script]" r]
+    set f [open "|[list $::tcltest::tcltest $path(script)]" r]
     gets $f
     gets $f listen
     set s [socket 127.0.0.1 $listen]
@@ -517,10 +519,10 @@ test socket-2.8 {echo server, loop 50 times, single connection} {socket stdio} {
 test socket-2.9 {socket conflict} {socket stdio} {
     set s [socket -server accept 0]
     removeFile script
-    set f [open script w]
+    set f [open $path(script) w]
     puts -nonewline $f "socket -server accept [lindex [fconfigure $s -sockname] 2]"
     close $f
-    set f [open "|[list $::tcltest::tcltest script]" r]
+    set f [open "|[list $::tcltest::tcltest $path(script)]" r]
     gets $f
     after 100
     set x [list [catch {close $f} msg]]
@@ -583,7 +585,7 @@ test socket-2.11 {detecting new data} {socket} {
 
 test socket-3.1 {socket conflict} {socket stdio} {
     removeFile script
-    set f [open script w]
+    set f [open $path(script) w]
     puts $f {
 	set f [socket -server accept 0]
 	puts ready
@@ -592,7 +594,7 @@ test socket-3.1 {socket conflict} {socket stdio} {
 	close $f
     }
     close $f
-    set f [open "|[list $::tcltest::tcltest script]" r+]
+    set f [open "|[list $::tcltest::tcltest $path(script)]" r+]
     gets $f
     gets $f listen
     set x [list [catch {socket -server accept $listen} msg] \
@@ -603,7 +605,7 @@ test socket-3.1 {socket conflict} {socket stdio} {
 } {1 {couldn't open socket: address already in use}}
 test socket-3.2 {server with several clients} {socket stdio} {
     removeFile script
-    set f [open script w]
+    set f [open $path(script) w]
     puts $f {
 	set t1 [after 30000 "set x timed_out"]
 	set t2 [after 31000 "set x timed_out"]
@@ -636,7 +638,7 @@ test socket-3.2 {server with several clients} {socket stdio} {
 	puts $x
     }
     close $f
-    set f [open "|[list $::tcltest::tcltest script]" r+]
+    set f [open "|[list $::tcltest::tcltest $path(script)]" r+]
     set x [gets $f]
     gets $f listen
     set s1 [socket 127.0.0.1 $listen]
@@ -663,7 +665,7 @@ test socket-3.2 {server with several clients} {socket stdio} {
 
 test socket-4.1 {server with several clients} {socket stdio} {
     removeFile script
-    set f [open script w]
+    set f [open $path(script) w]
     puts $f {
 	set port [gets stdin]
 	set s [socket 127.0.0.1 $port]
@@ -677,11 +679,11 @@ test socket-4.1 {server with several clients} {socket stdio} {
 	gets stdin
     }
     close $f
-    set p1 [open "|[list $::tcltest::tcltest script]" r+]
+    set p1 [open "|[list $::tcltest::tcltest $path(script)]" r+]
     fconfigure $p1 -buffering line
-    set p2 [open "|[list $::tcltest::tcltest script]" r+]
+    set p2 [open "|[list $::tcltest::tcltest $path(script)]" r+]
     fconfigure $p2 -buffering line
-    set p3 [open "|[list $::tcltest::tcltest script]" r+]
+    set p3 [open "|[list $::tcltest::tcltest $path(script)]" r+]
     fconfigure $p3 -buffering line
     proc accept {s a p} {
 	fconfigure $s -buffering line
@@ -763,13 +765,13 @@ test socket-5.3 {byte order problems, socket numbers, htons} \
 
 test socket-6.1 {accept callback error} {socket stdio} {
     removeFile script
-    set f [open script w]
+    set f [open $path(script) w]
     puts $f {
 	gets stdin port
 	socket 127.0.0.1 $port
     }
     close $f
-    set f [open "|[list $::tcltest::tcltest script]" r+]
+    set f [open "|[list $::tcltest::tcltest $path(script)]" r+]
     proc bgerror args {
 	global x
 	set x $args
@@ -788,7 +790,7 @@ test socket-6.1 {accept callback error} {socket stdio} {
 
 test socket-7.1 {testing socket specific options} {socket stdio} {
     removeFile script
-    set f [open script w]
+    set f [open $path(script) w]
     puts $f {
 	set ss [socket -server accept 0]
 	proc accept args {
@@ -802,7 +804,7 @@ test socket-7.1 {testing socket specific options} {socket stdio} {
 	after cancel $timer
     }
     close $f
-    set f [open "|[list $::tcltest::tcltest script]" r]
+    set f [open "|[list $::tcltest::tcltest $path(script)]" r]
     gets $f
     gets $f listen
     set s [socket 127.0.0.1 $listen]
@@ -816,7 +818,7 @@ test socket-7.1 {testing socket specific options} {socket stdio} {
 } {0 0 3}
 test socket-7.2 {testing socket specific options} {socket stdio} {
     removeFile script
-    set f [open script w]
+    set f [open $path(script) w]
     puts $f {
 	set ss [socket -server accept 2821]
 	proc accept args {
@@ -830,7 +832,7 @@ test socket-7.2 {testing socket specific options} {socket stdio} {
 	after cancel $timer
     }
     close $f
-    set f [open "|[list $::tcltest::tcltest script]" r]
+    set f [open "|[list $::tcltest::tcltest $path(script)]" r]
     gets $f
     gets $f listen
     set s [socket 127.0.0.1 $listen]
@@ -1390,6 +1392,9 @@ test socket-11.13 {testing async write, async flush, async close} \
     set count
 } 65566
 
+set path(script1) [makeFile {} script1]
+set path(script2) [makeFile {} script2]
+
 test socket-12.1 {testing inheritance of server sockets} {socket exec} {
     removeFile script1
     removeFile script2
@@ -1397,7 +1402,7 @@ test socket-12.1 {testing inheritance of server sockets} {socket exec} {
     # Script1 is just a 10 second delay.  If the server socket
     # is inherited, it will be held open for 10 seconds
 
-    set f [open script1 w]
+    set f [open $path(script1) w]
     puts $f {
 	after 10000 exit
 	vwait forever
@@ -1408,25 +1413,25 @@ test socket-12.1 {testing inheritance of server sockets} {socket exec} {
     # waits a second, and exits.  The server socket will now
     # be closed unless script1 inherited it.
 
-    set f [open script2 w]
+    set f [open $path(script2) w]
     puts $f [list set tcltest $::tcltest::tcltest]
-    puts $f {
+    puts $f [format {
 	set f [socket -server accept 0]
 	puts [lindex [fconfigure $f -sockname] 2]
 	proc accept { file addr port } {
 	    close $file
 	}
-	exec $tcltest script1 &
+	exec $tcltest "%s" &
 	close $f
 	after 1000 exit
 	vwait forever
-    }
+    } $path(script1)]
     close $f
 	
     # Launch script2 and wait 5 seconds
 
     ### exec $::tcltest::tcltest script2 &
-    set p [open "|[list $::tcltest::tcltest script2]" r]
+    set p [open "|[list $::tcltest::tcltest $path(script2)]" r]
     gets $p listen
 
     after 5000 { set ok_to_proceed 1 }
@@ -1453,7 +1458,7 @@ test socket-12.2 {testing inheritance of client sockets} {socket exec} {
     # Script1 is just a 20 second delay.  If the server socket
     # is inherited, it will be held open for 10 seconds
 
-    set f [open script1 w]
+    set f [open $path(script1) w]
     puts $f {
 	after 20000 exit
 	vwait forever
@@ -1464,17 +1469,17 @@ test socket-12.2 {testing inheritance of client sockets} {socket exec} {
     # launches script1 and exits.  If the child process inherited the
     # client socket, the socket will still be open.
 
-    set f [open script2 w]
+    set f [open $path(script2) w]
     puts $f [list set tcltest $::tcltest::tcltest]
-    puts $f {
+    puts $f [format {
         gets stdin port
 	set f [socket 127.0.0.1 $port]
-	exec $tcltest script1 &
+	exec $tcltest "%s" &
 	puts $f testing
 	flush $f
 	after 1000 exit
 	vwait forever
-    }
+    } $path(script1)]
     close $f
 
     # Create the server socket
@@ -1521,7 +1526,7 @@ test socket-12.2 {testing inheritance of client sockets} {socket exec} {
     # Launch the script2 process
     ### exec $::tcltest::tcltest script2 &
 
-    set p [open "|[list $::tcltest::tcltest script2]" w]
+    set p [open "|[list $::tcltest::tcltest $path(script2)]" w]
     puts $p [lindex [fconfigure $server -sockname] 2] ; flush $p
 
     vwait x
@@ -1537,33 +1542,33 @@ test socket-12.3 {testing inheritance of accepted sockets} {socket exec} {
     removeFile script1
     removeFile script2
 
-    set f [open script1 w]
+    set f [open $path(script1) w]
     puts $f {
 	after 10000 exit
 	vwait forever
     }
     close $f
 
-    set f [open script2 w]
+    set f [open $path(script2) w]
     puts $f [list set tcltest $::tcltest::tcltest]
-    puts $f {
+    puts $f [format {
 	set server [socket -server accept 0]
 	puts stdout [lindex [fconfigure $server -sockname] 2]
 	proc accept { file host port } {
 	    global tcltest
 	    puts $file {test data on socket}
-	    exec $tcltest script1 &
+	    exec $tcltest "%s" &
 	    after 1000 exit
 	}
 	vwait forever
-    }
+    } $path(script1)]
     close $f
 
     # Launch the script2 process and connect to it.  See how long
     # the socket stays open
 
     ## exec $::tcltest::tcltest script2 &
-    set p [open "|[list $::tcltest::tcltest script2]" r]
+    set p [open "|[list $::tcltest::tcltest $path(script2)]" r]
     gets $p listen
 
     after 1000 set ok_to_proceed 1