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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
#lang zuo
(require "harness.zuo")
(alert "threads")
(check (call-in-main-thread
(lambda ()
(define ch (channel))
(define msgs (channel))
(thread (lambda () (channel-put msgs (list "read" (channel-get ch)))))
(thread (lambda () (channel-put msgs "write") (channel-put ch 'hello)))
(list (channel-get msgs)
(channel-get msgs))))
'("write" ("read" hello)))
(check (call-in-main-thread
(lambda ()
(define ch (channel))
(define go (channel))
(for-each (lambda (i) (channel-put ch i)) '(a b c d))
(thread (lambda ()
(for-each (lambda (v) (channel-put ch (list v (channel-get ch))))
'(1 2 3 4))
(channel-put go 'ok)))
(channel-get go)
(map (lambda (i) (channel-get ch)) '(_ _ _ _))))
'((1 a) (2 b) (3 c) (4 d)))
(check (call-in-main-thread
(lambda ()
(define ch (channel))
(define go (channel))
(define ls '(a b c d))
(for-each (lambda (i) (channel-put ch i)) ls)
(for-each (lambda (v)
(thread (lambda ()
(channel-put ch (list v (channel-get ch)))
(channel-put go 'ok))))
(map symbol->string ls))
(for-each (lambda (i) (channel-get go)) ls)
(map (lambda (i) (channel-get ch)) '(_ _ _ _))))
;; this is the result for now, at least, since everything is deterministic
;; and the scheduler's enquring strategy adds a new thread to the front
'(("d" a) ("c" b) ("b" c) ("a" d)))
;; Each thread starts a process, but the wait might immediately succeed every time
(check (let ([r (call-in-main-thread
(lambda ()
(define ch (channel))
(define ls '(a b c d))
(for-each (lambda (id)
(thread
(lambda ()
(define p (process (hash-ref (runtime-env) 'exe)
""
(~a id)
(hash 'stdin 'pipe 'stdout 'pipe)))
(define to (hash-ref p 'stdin))
(fd-write to (~a "#lang zuo\n"
(~s '(alert (hash-ref (runtime-env) 'args)))))
(fd-close to)
(define from (hash-ref p 'stdout))
(define str (fd-read from eof))
(fd-close from)
(thread-process-wait (hash-ref p 'process))
(channel-put ch str))))
ls)
(map (lambda (i) (channel-get ch)) ls)))])
(and (= (length r) 4)
(andmap (lambda (s) (member s r))
'("(list \"a\")\n" "(list \"b\")\n" "(list \"c\")\n" "(list \"d\")\n"))
#t)))
;; Each thread starts a process, relies on the main thread to finish it
(check (let ([r (call-in-main-thread
(lambda ()
(define ch (channel))
(define done (channel))
(define ls '(a b c d))
(for-each (lambda (id)
(thread
(lambda ()
(define p (process (hash-ref (runtime-env) 'exe)
""
(~a id)
(hash 'stdin 'pipe 'stdout 'pipe)))
(channel-put ch p)
(thread-process-wait (hash-ref p 'process))
(channel-put done 'ok))))
ls)
(define results
(map (lambda (i)
(define p (channel-get ch))
(define to (hash-ref p 'stdin))
(define from (hash-ref p 'stdout))
(fd-write to (~a "#lang zuo\n"
(~s '(alert (hash-ref (runtime-env) 'args)))))
(fd-close to)
(define str (fd-read from eof))
(fd-close from)
str)
ls))
(for-each (lambda (id) (channel-get done)) ls)
results))])
(and (= (length r) 4)
(andmap (lambda (s) (member s r))
'("(list \"a\")\n" "(list \"b\")\n" "(list \"c\")\n" "(list \"d\")\n"))
#t)))
;; Each thread starts a process, main thread waits on all
(check (let ([r (call-in-main-thread
(lambda ()
(define ch (channel))
(define go (channel))
(define ls '(a b c d))
(for-each (lambda (id)
(thread
(lambda ()
(define p (process (hash-ref (runtime-env) 'exe)
""
(~a id)
(hash 'stdin 'pipe 'stdout 'pipe)))
(channel-put ch (hash-ref p 'process))
(channel-get go)
(define to (hash-ref p 'stdin))
(fd-write to (~a "#lang zuo\n"
(~s '(alert (hash-ref (runtime-env) 'args)))))
(fd-close to)
(define from (hash-ref p 'stdout))
(define str (fd-read from eof))
(fd-close from)
(channel-put ch str))))
ls)
(define ps (map (lambda (i) (channel-get ch)) ls))
(for-each (lambda (i) (channel-put go i)) ls)
(let loop ([ps ps])
(unless (null? ps)
(define p (apply thread-process-wait ps))
(loop (remove p ps))))
(map (lambda (i) (channel-get ch)) ls)))])
(and (= (length r) 4)
(andmap (lambda (s) (member s r))
'("(list \"a\")\n" "(list \"b\")\n" "(list \"c\")\n" "(list \"d\")\n"))
#t)))
(check-fail (begin
(require zuo/thread)
(call-in-main-thread
(lambda () (channel-get (channel)))))
"main thread is stuck")
(check-fail (begin
(require zuo/thread)
(call-in-main-thread
(lambda ()
((call/prompt (lambda () (call/cc (lambda (k) k)))) 0))))
"main thread is stuck")
(check (channel-try-get (channel)) #f)
(check (let ([ch (channel)])
(channel-put ch "x")
(channel-try-get ch))
"x")
|
