86 lines
2.2 KiB
Plaintext
86 lines
2.2 KiB
Plaintext
## the child supervision layer in src/proc.hak
|
|
|
|
$include "../src/proc.hak"
|
|
|
|
fun chk(ok msg) {
|
|
if ok { printf "OK: %s\n" msg } \
|
|
else { printf "ERROR: %s\n" msg }
|
|
}
|
|
|
|
## --- children are collected in completion order, whichever finishes first ---
|
|
g := (ChildGroup:new)
|
|
chk (= (g:count) 0) "a new group watches nothing"
|
|
a := (g:spawn "sleep 3; exit 11" "r")
|
|
b := (g:spawn "sleep 1; exit 22" "r")
|
|
c := (g:spawn "sleep 2; exit 33" "r")
|
|
chk (= (g:count) 3) "spawn adds to the group"
|
|
chk (integer? (g:proc-of a)) "the record carries a process handle"
|
|
chk (integer? (g:out-of a)) "...and the requested stream"
|
|
chk (nil? (g:in-of a)) "...and nil for one not requested"
|
|
|
|
ticks := 0
|
|
fun ticker() {
|
|
while (< ticks 5) {
|
|
ticks := (+ ticks 1)
|
|
core.yield
|
|
}
|
|
}
|
|
core.fork ticker
|
|
|
|
order := (core.basicNew Array 3)
|
|
n := 0
|
|
while (< n 3) {
|
|
kid := (g:wait 25)
|
|
if (nil? kid) {
|
|
printf "ERROR: g:wait timed out\n"
|
|
n := 3
|
|
} \
|
|
else {
|
|
core.basicAtPut order n (g:status kid)
|
|
g:close kid
|
|
n := (+ n 1)
|
|
}
|
|
}
|
|
|
|
chk (= (core.basicAt order 0) 22) "the first to finish was reported first"
|
|
chk (= (core.basicAt order 1) 33) "then the second"
|
|
chk (= (core.basicAt order 2) 11) "then the third"
|
|
chk (= ticks 5) "coprocesses ran while the group waited"
|
|
chk (= (g:count) 0) "close removes a child from the group"
|
|
g:done
|
|
|
|
## --- simultaneous exits ---
|
|
## standard signals do not queue, so on the SIGCHLD path one signal can stand
|
|
## for every one of these; the group must still account for all of them.
|
|
g2 := (ChildGroup:new)
|
|
i := 0
|
|
while (< i 6) {
|
|
g2:spawn "sleep 1; exit 7" "r"
|
|
i := (+ i 1)
|
|
}
|
|
seen := 0
|
|
bad := 0
|
|
while (< seen 6) {
|
|
kid := (g2:wait 25)
|
|
if (nil? kid) {
|
|
printf "ERROR: timed out with children unaccounted for\n"
|
|
seen := 6
|
|
bad := 1
|
|
} \
|
|
else {
|
|
if (not (= (g2:status kid) 7)) { bad := 1 }
|
|
g2:close kid
|
|
seen := (+ seen 1)
|
|
}
|
|
}
|
|
chk (= bad 0) "six children exiting together were all collected"
|
|
g2:done
|
|
|
|
## --- a timeout is reported as nil, not as a hang ---
|
|
g3 := (ChildGroup:new)
|
|
g3:spawn "sleep 30" "r"
|
|
chk (= (g3:count) 1) "the group is watching the long-running child"
|
|
chk (nil? (g3:wait 1)) "g:wait returns nil when nothing finishes in time"
|
|
g3:done
|
|
chk (= (g3:count) 0) "g:done emptied a group that still held a running child"
|