Tcl Source Code

Artifact 58b19027d30843ab9f0a71eb3608141c5a246714:

Attachment "crash.tcl" to ticket [2818131fff] added by flatworm 2009-07-08 22:58:13.

---

proc Accept {sock addr port} {
	chan configure $sock -translation binary -buffering none
	zlib push inflate $sock
	chan event $sock readable [list Read $sock]
	puts "Accepted $sock"
}

proc Read sock {
	puts "Data on $sock"
	if {[gets $sock line] < 0} {
		puts "EOF on $sock"
		chan close $sock
	} else {
		puts "Rcvd: [regsub -all {[^[:print:]]} $line .]"
	}
}

proc MakeServerCrash sock {
	puts $sock test
	chan close $sock
	puts "Client closed $sock"
}

set serv [socket -server Accept -myaddr localhost 0]
set port [lindex [chan configure $serv -sockname] 2]
puts "Server listens on $serv"

set client [socket localhost $port]
chan configure $client -translation binary -buffering none
zlib push deflate $client
chan event $client readable [list Read $client]
puts "Client is $client"

after idle [list MakeServerCrash $client]

vwait forever