summaryrefslogtreecommitdiff
path: root/tcltests/test_eventloop.tcl
blob: 13e4ab2737ce0a4dec4b2dacb126b3dd26a43a02 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
if {[info commands vwait] eq ""} {
	return "noimpl"
}

set f [socket stream localhost:80]

set count 0
set done 0

proc onread {f} {
	#puts "[$f gets]"
	incr ::count [string length [$f gets]]
}

proc oneof {f} {
	$f close
	verbose "Read $::count bytes from server"
	incr ::done
}

proc onwrite {f} {
	$f puts -nonewline "GET / HTTP/1.0\r\n\r\n"
	$f flush
	$f writable {}
}

proc bgerror {msg} {
	puts stderr "bgerror: $msg"
	incr ::done
}

$f readable {onread $f} {oneof $f}
$f writable {onwrite $f}

alarm 10
catch -signal {
	vwait done
}
alarm 0
catch {close $f}

rename bgerror ""
rename onread ""
rename oneof ""
rename onwrite ""

return