erlang: ring.erl + call/cc suspension rewrite (+4 ring tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
This commit is contained in:
132
lib/erlang/tests/programs/ring.sx
Normal file
132
lib/erlang/tests/programs/ring.sx
Normal file
@@ -0,0 +1,132 @@
|
||||
;; Ring program — N processes in a ring, token passes M times.
|
||||
;;
|
||||
;; Each process waits for {setup, Next} so main can tie the knot
|
||||
;; (can't reference a pid before spawning it). Once wired, main
|
||||
;; injects the first token; each process forwards decrementing K
|
||||
;; until it hits 0, at which point it signals `done` to main.
|
||||
|
||||
(define er-ring-test-count 0)
|
||||
(define er-ring-test-pass 0)
|
||||
(define er-ring-test-fails (list))
|
||||
|
||||
(define
|
||||
er-ring-test
|
||||
(fn
|
||||
(name actual expected)
|
||||
(set! er-ring-test-count (+ er-ring-test-count 1))
|
||||
(if
|
||||
(= actual expected)
|
||||
(set! er-ring-test-pass (+ er-ring-test-pass 1))
|
||||
(append! er-ring-test-fails {:actual actual :expected expected :name name}))))
|
||||
|
||||
(define ring-ev erlang-eval-ast)
|
||||
|
||||
(define
|
||||
er-ring-program-3-6
|
||||
"Me = self(),
|
||||
Spawner = fun () ->
|
||||
receive {setup, Next} ->
|
||||
Loop = fun () ->
|
||||
receive
|
||||
{token, 0, Parent} -> Parent ! done;
|
||||
{token, K, Parent} -> Next ! {token, K-1, Parent}, Loop()
|
||||
end
|
||||
end,
|
||||
Loop()
|
||||
end
|
||||
end,
|
||||
P1 = spawn(Spawner),
|
||||
P2 = spawn(Spawner),
|
||||
P3 = spawn(Spawner),
|
||||
P1 ! {setup, P2},
|
||||
P2 ! {setup, P3},
|
||||
P3 ! {setup, P1},
|
||||
P1 ! {token, 5, Me},
|
||||
receive done -> finished end")
|
||||
|
||||
(er-ring-test
|
||||
"ring N=3 M=6"
|
||||
(get (ring-ev er-ring-program-3-6) :name)
|
||||
"finished")
|
||||
|
||||
;; Two-node ring — token bounces twice between P1 and P2.
|
||||
(er-ring-test
|
||||
"ring N=2 M=4"
|
||||
(get (ring-ev
|
||||
"Me = self(),
|
||||
Spawner = fun () ->
|
||||
receive {setup, Next} ->
|
||||
Loop = fun () ->
|
||||
receive
|
||||
{token, 0, Parent} -> Parent ! done;
|
||||
{token, K, Parent} -> Next ! {token, K-1, Parent}, Loop()
|
||||
end
|
||||
end,
|
||||
Loop()
|
||||
end
|
||||
end,
|
||||
P1 = spawn(Spawner),
|
||||
P2 = spawn(Spawner),
|
||||
P1 ! {setup, P2},
|
||||
P2 ! {setup, P1},
|
||||
P1 ! {token, 3, Me},
|
||||
receive done -> done end") :name)
|
||||
"done")
|
||||
|
||||
;; Single-node "ring" — P sends to itself M times.
|
||||
(er-ring-test
|
||||
"ring N=1 M=5"
|
||||
(get (ring-ev
|
||||
"Me = self(),
|
||||
Spawner = fun () ->
|
||||
receive {setup, Next} ->
|
||||
Loop = fun () ->
|
||||
receive
|
||||
{token, 0, Parent} -> Parent ! finished_loop;
|
||||
{token, K, Parent} -> Next ! {token, K-1, Parent}, Loop()
|
||||
end
|
||||
end,
|
||||
Loop()
|
||||
end
|
||||
end,
|
||||
P = spawn(Spawner),
|
||||
P ! {setup, P},
|
||||
P ! {token, 4, Me},
|
||||
receive finished_loop -> ok end") :name)
|
||||
"ok")
|
||||
|
||||
;; Confirm the token really went around — count hops via io-buffer.
|
||||
(er-ring-test
|
||||
"ring N=3 M=9 hop count"
|
||||
(do
|
||||
(er-io-flush!)
|
||||
(ring-ev
|
||||
"Me = self(),
|
||||
Spawner = fun () ->
|
||||
receive {setup, Next} ->
|
||||
Loop = fun () ->
|
||||
receive
|
||||
{token, 0, Parent} -> Parent ! done;
|
||||
{token, K, Parent} ->
|
||||
io:format(\"~p \", [K]),
|
||||
Next ! {token, K-1, Parent},
|
||||
Loop()
|
||||
end
|
||||
end,
|
||||
Loop()
|
||||
end
|
||||
end,
|
||||
P1 = spawn(Spawner),
|
||||
P2 = spawn(Spawner),
|
||||
P3 = spawn(Spawner),
|
||||
P1 ! {setup, P2},
|
||||
P2 ! {setup, P3},
|
||||
P3 ! {setup, P1},
|
||||
P1 ! {token, 8, Me},
|
||||
receive done -> done end")
|
||||
(er-io-buffer-content))
|
||||
"8 7 6 5 4 3 2 1 ")
|
||||
|
||||
(define
|
||||
er-ring-test-summary
|
||||
(str "ring " er-ring-test-pass "/" er-ring-test-count))
|
||||
Reference in New Issue
Block a user