1 files changed, 36 insertions, 26 deletions

diff --git a/tests/socket.test b/tests/socket.test
index b2719de..30a3746 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -59,7 +59,7 @@
 # listening at port 2048. If all fails, a message is printed and the tests
 # using the remote server are not performed.
 #
-# SCCS: @(#) socket.test 1.83 97/09/15 16:29:47
+# SCCS: @(#) socket.test 1.86 98/01/02 17:33:48
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -221,7 +221,7 @@ socket ?-myaddr addr? ?-myport myport? ?-async? host port
 socket -server command ?-myaddr addr? port}}
 test socket-1.8 {arg parsing for socket command} {
     list [catch {socket -froboz} msg] $msg
-} {1 {bad option "-froboz", must be -async, -myaddr, -myport, or -server}}
+} {1 {bad option "-froboz": must be -async, -myaddr, -myport, or -server}}
 test socket-1.9 {arg parsing for socket command} {
     list [catch {socket -server foo -myport 2521 3333} msg] $msg
 } {1 {Option -myport is not valid for servers}}
@@ -484,12 +484,14 @@ test socket-2.8 {echo server, loop 50 times, single connection} {stdio} {
     gets $f
     set s [socket localhost 2828]
     fconfigure $s -buffering line
-    for {set x 0} {$x < 50} {incr x} {
-        puts $s "hello abcdefghijklmnop"
-        gets $s
+    catch {
+	for {set x 0} {$x < 50} {incr x} {
+	    puts $s "hello abcdefghijklmnop"
+	    gets $s
+	}
     }
     close $s
-    set x [gets $f]
+    catch {set x [gets $f]}
     close $f
     set x
 } {done 50}
@@ -497,7 +499,7 @@ test socket-2.9 {socket conflict} {stdio} {
     set s [socket -server accept 2828]
     removeFile script
     set f [open script w]
-    puts $f {set f [socket -server accept 2828]}
+    puts -nonewline $f {socket -server accept 2828}
     close $f
     set f [open "|[list $tcltest script]" r]
     gets $f
@@ -795,7 +797,7 @@ test socket-7.3 {testing socket specific options} {
     close $s
     update
     llength $l
-} 10
+} 12
 test socket-7.4 {testing socket specific options} {
     set s [socket -server accept 2823]
     proc accept {s a p} {
@@ -981,6 +983,18 @@ test socket-9.3 {testing EOF stickyness} {
 
 removeFile script
 
+test socket-10.1 {testing socket accept callback error handling} {
+    set goterror 0
+    proc bgerror args {global goterror; set goterror 1}
+    set s [socket -server accept 2898]
+    proc accept {s a p} {close $s; error}
+    set c [socket localhost 2898]
+    vwait goterror
+    close $s
+    close $c
+    set goterror
+} 1
+
 #
 # The rest of the tests are run only if we are doing testing against
 # a remote server.
@@ -990,7 +1004,7 @@ if {$doTestsWithRemoteServer == 0} {
     return
 }
 
-test socket-10.1 {tcp connection} {
+test socket-11.1 {tcp connection} {
     sendCommand {
 	set socket9_1_test_server [socket -server accept 2834]
 	proc accept {s a p} {
@@ -1004,7 +1018,7 @@ test socket-10.1 {tcp connection} {
     sendCommand {close $socket9_1_test_server}
     set r
 } done
-test socket-10.2 {client specifies its port} {
+test socket-11.2 {client specifies its port} {
     if {[info exists port]} {
 	incr port
     } else {
@@ -1028,10 +1042,7 @@ test socket-10.2 {client specifies its port} {
     }
     set result
 } ok
-#
-# Tests io-10.3, io-10.4 have been removed.
-#
-test socket-10.3 {trying to connect, no server} {
+test socket-11.3 {trying to connect, no server} {
     set status ok
     if {![catch {set s [socket $remoteServerIp 2836]}]} {
 	if {![catch {gets $s}]} {
@@ -1041,7 +1052,7 @@ test socket-10.3 {trying to connect, no server} {
     }
     set status
 } ok
-test socket-10.4 {remote echo, one line} {
+test socket-11.4 {remote echo, one line} {
     sendCommand {
 	set socket10_6_test_server [socket -server accept 2836]
 	proc accept {s a p} {
@@ -1065,7 +1076,7 @@ test socket-10.4 {remote echo, one line} {
     sendCommand {close $socket10_6_test_server}
     set r
 } hello
-test socket-10.5 {remote echo, 50 lines} {
+test socket-11.5 {remote echo, 50 lines} {
     sendCommand {
 	set socket10_7_test_server [socket -server accept 2836]
 	proc accept {s a p} {
@@ -1099,7 +1110,7 @@ if {$tcl_platform(platform) == "macintosh"} {
 } else {
     set conflictResult {1 {couldn't open socket: address already in use}}
 }
-test socket-10.6 {socket conflict} {
+test socket-11.6 {socket conflict} {
     set s1 [socket -server accept 2836]
     if {[catch {set s2 [socket -server accept 2836]} msg]} {
 	set result [list 1 $msg]
@@ -1110,7 +1121,7 @@ test socket-10.6 {socket conflict} {
     close $s1
     set result
 } $conflictResult
-test socket-10.7 {server with several clients} {
+test socket-11.7 {server with several clients} {
     sendCommand {
 	set socket10_9_test_server [socket -server accept 2836]
 	proc accept {s a p} {
@@ -1146,7 +1157,7 @@ test socket-10.7 {server with several clients} {
     sendCommand {close $socket10_9_test_server}
     set i
 } 100    
-test socket-10.8 {client with several servers} {
+test socket-11.8 {client with several servers} {
     sendCommand {
 	set s1 [socket -server "accept 4003" 4003]
 	set s2 [socket -server "accept 4004" 4004]
@@ -1172,7 +1183,7 @@ test socket-10.8 {client with several servers} {
     }
     set l
 } {4003 {} 1 4004 {} 1 4005 {} 1}
-test socket-10.9 {accept callback error} {
+test socket-11.9 {accept callback error} {
     set s [socket -server accept 2836]
     proc accept {s a p} {expr 10 / 0}
     proc bgerror args {
@@ -1194,7 +1205,7 @@ test socket-10.9 {accept callback error} {
     rename bgerror {}
     set x
 } {{divide by zero}}
-test socket-10.10 {testing socket specific options} {
+test socket-11.10 {testing socket specific options} {
     sendCommand {
 	set socket10_12_test_server [socket -server accept 2836]
 	proc accept {s a p} {close $s}
@@ -1208,7 +1219,7 @@ test socket-10.10 {testing socket specific options} {
     sendCommand {close $socket10_12_test_server}
     set l
 } {2836 3 3}
-test socket-10.11 {testing spurious events} {
+test socket-11.11 {testing spurious events} {
     sendCommand {
 	set socket10_13_test_server [socket -server accept 2836]
 	proc accept {s a p} {
@@ -1247,7 +1258,7 @@ test socket-10.11 {testing spurious events} {
     sendCommand {close $socket10_13_test_server}
     list $spurious $len
 } {0 2690}
-test socket-10.12 {testing EOF stickyness} {
+test socket-11.12 {testing EOF stickyness} {
     set counter 0
     set done 0
     proc count_up {s} {
@@ -1280,7 +1291,7 @@ test socket-10.12 {testing EOF stickyness} {
     sendCommand {close $socket10_14_test_server}
     set done
 } {EOF is sticky}
-test socket-10.13 {testing async write, async flush, async close} {
+test socket-11.13 {testing async write, async flush, async close} {
     proc readit {s} {
 	global count done
 	set l [read $s]
@@ -1340,5 +1351,4 @@ if {[string match sock* $commandSocket] == 1} {
 catch {close $commandSocket}
 catch {close $remoteProcChan}
 
-set x ""
-unset x
+return