aboutsummaryrefslogtreecommitdiff
path: root/examples/nonblocking-gets.tcl
blob: a9ac4bd69f82a89016ddde89d761a6e70d0445d2 (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
#!/usr/bin/env jimsh

# Tests that 'gets' on a non-blocking socket
# does not return partial lines

lassign [socket pipe] r w

if {[os.fork] == 0} {
	# The child will be our client
	$r close
	# Output increasingly long lines
	loop i 10000 {
		$w puts [string repeat a $i]
	}
} else {
	# The server reads lines with gets.
	# Each one should be one longer than the last
	$w close

	set exp 0
	$r ndelay 1
	$r readable {
		while {[$r gets buf] >= 0} {
			set len [string length $buf]
			if {$len != $exp} {
				puts "Read line of length $len but expected $exp"
				incr done
				break
			}
			incr exp
		}
		if {[$r eof]} {
			incr done
		}
	}

	vwait done
}