erlang: bank.erl account server (+8 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:
159
lib/erlang/tests/programs/bank.sx
Normal file
159
lib/erlang/tests/programs/bank.sx
Normal file
@@ -0,0 +1,159 @@
|
||||
;; Bank account server — stateful process, balance threaded through
|
||||
;; recursive loop. Handles {deposit, Amt, From}, {withdraw, Amt, From},
|
||||
;; {balance, From}, stop. Tests stateful process patterns.
|
||||
|
||||
(define er-bank-test-count 0)
|
||||
(define er-bank-test-pass 0)
|
||||
(define er-bank-test-fails (list))
|
||||
|
||||
(define
|
||||
er-bank-test
|
||||
(fn
|
||||
(name actual expected)
|
||||
(set! er-bank-test-count (+ er-bank-test-count 1))
|
||||
(if
|
||||
(= actual expected)
|
||||
(set! er-bank-test-pass (+ er-bank-test-pass 1))
|
||||
(append! er-bank-test-fails {:actual actual :expected expected :name name}))))
|
||||
|
||||
(define bank-ev erlang-eval-ast)
|
||||
|
||||
;; Server fun shared by all tests — threaded via the program string.
|
||||
(define
|
||||
er-bank-server-src
|
||||
"Server = fun (Balance) ->
|
||||
receive
|
||||
{deposit, Amt, From} -> From ! ok, Server(Balance + Amt);
|
||||
{withdraw, Amt, From} ->
|
||||
if Amt > Balance -> From ! insufficient, Server(Balance);
|
||||
true -> From ! ok, Server(Balance - Amt)
|
||||
end;
|
||||
{balance, From} -> From ! Balance, Server(Balance);
|
||||
stop -> ok
|
||||
end
|
||||
end")
|
||||
|
||||
;; Open account, deposit, check balance.
|
||||
(er-bank-test
|
||||
"deposit 100 -> balance 100"
|
||||
(bank-ev
|
||||
(str
|
||||
er-bank-server-src
|
||||
", Me = self(),
|
||||
Bank = spawn(fun () -> Server(0) end),
|
||||
Bank ! {deposit, 100, Me},
|
||||
receive ok -> ok end,
|
||||
Bank ! {balance, Me},
|
||||
receive B -> Bank ! stop, B end"))
|
||||
100)
|
||||
|
||||
;; Multiple deposits accumulate.
|
||||
(er-bank-test
|
||||
"deposits accumulate"
|
||||
(bank-ev
|
||||
(str
|
||||
er-bank-server-src
|
||||
", Me = self(),
|
||||
Bank = spawn(fun () -> Server(0) end),
|
||||
Bank ! {deposit, 50, Me}, receive ok -> ok end,
|
||||
Bank ! {deposit, 25, Me}, receive ok -> ok end,
|
||||
Bank ! {deposit, 10, Me}, receive ok -> ok end,
|
||||
Bank ! {balance, Me},
|
||||
receive B -> Bank ! stop, B end"))
|
||||
85)
|
||||
|
||||
;; Withdraw within balance succeeds; insufficient gets rejected.
|
||||
(er-bank-test
|
||||
"withdraw within balance"
|
||||
(bank-ev
|
||||
(str
|
||||
er-bank-server-src
|
||||
", Me = self(),
|
||||
Bank = spawn(fun () -> Server(100) end),
|
||||
Bank ! {withdraw, 30, Me}, receive ok -> ok end,
|
||||
Bank ! {balance, Me},
|
||||
receive B -> Bank ! stop, B end"))
|
||||
70)
|
||||
|
||||
(er-bank-test
|
||||
"withdraw insufficient"
|
||||
(get
|
||||
(bank-ev
|
||||
(str
|
||||
er-bank-server-src
|
||||
", Me = self(),
|
||||
Bank = spawn(fun () -> Server(20) end),
|
||||
Bank ! {withdraw, 100, Me},
|
||||
receive R -> Bank ! stop, R end"))
|
||||
:name)
|
||||
"insufficient")
|
||||
|
||||
;; State preserved across an insufficient withdrawal.
|
||||
(er-bank-test
|
||||
"state preserved on rejection"
|
||||
(bank-ev
|
||||
(str
|
||||
er-bank-server-src
|
||||
", Me = self(),
|
||||
Bank = spawn(fun () -> Server(50) end),
|
||||
Bank ! {withdraw, 1000, Me}, receive _ -> ok end,
|
||||
Bank ! {balance, Me},
|
||||
receive B -> Bank ! stop, B end"))
|
||||
50)
|
||||
|
||||
;; Mixed deposits and withdrawals.
|
||||
(er-bank-test
|
||||
"mixed transactions"
|
||||
(bank-ev
|
||||
(str
|
||||
er-bank-server-src
|
||||
", Me = self(),
|
||||
Bank = spawn(fun () -> Server(100) end),
|
||||
Bank ! {deposit, 50, Me}, receive ok -> ok end,
|
||||
Bank ! {withdraw, 30, Me}, receive ok -> ok end,
|
||||
Bank ! {deposit, 10, Me}, receive ok -> ok end,
|
||||
Bank ! {withdraw, 5, Me}, receive ok -> ok end,
|
||||
Bank ! {balance, Me},
|
||||
receive B -> Bank ! stop, B end"))
|
||||
125)
|
||||
|
||||
;; Server.stop terminates the bank cleanly — main can verify by
|
||||
;; sending stop and then exiting normally.
|
||||
(er-bank-test
|
||||
"server stops cleanly"
|
||||
(get
|
||||
(bank-ev
|
||||
(str
|
||||
er-bank-server-src
|
||||
", Me = self(),
|
||||
Bank = spawn(fun () -> Server(0) end),
|
||||
Bank ! stop,
|
||||
done"))
|
||||
:name)
|
||||
"done")
|
||||
|
||||
;; Two clients sharing one bank — interleaved transactions.
|
||||
(er-bank-test
|
||||
"two clients share bank"
|
||||
(bank-ev
|
||||
(str
|
||||
er-bank-server-src
|
||||
", Me = self(),
|
||||
Bank = spawn(fun () -> Server(0) end),
|
||||
Client = fun (Amt) ->
|
||||
spawn(fun () ->
|
||||
Bank ! {deposit, Amt, self()},
|
||||
receive ok -> Me ! deposited end
|
||||
end)
|
||||
end,
|
||||
Client(40),
|
||||
Client(60),
|
||||
receive deposited -> ok end,
|
||||
receive deposited -> ok end,
|
||||
Bank ! {balance, Me},
|
||||
receive B -> Bank ! stop, B end"))
|
||||
100)
|
||||
|
||||
(define
|
||||
er-bank-test-summary
|
||||
(str "bank " er-bank-test-pass "/" er-bank-test-count))
|
||||
@@ -72,7 +72,7 @@ Core mapping:
|
||||
- [ ] Classic programs in `lib/erlang/tests/programs/`:
|
||||
- [x] `ring.erl` — N processes in a ring, pass a token around M times — **4 ring tests**; suspension machinery rewritten from `shift`/`reset` to `call/cc` + `raise`/`guard`
|
||||
- [x] `ping_pong.erl` — two processes exchanging messages — **4 ping-pong tests**
|
||||
- [ ] `bank.erl` — account server (deposit/withdraw/balance)
|
||||
- [x] `bank.erl` — account server (deposit/withdraw/balance) — **8 bank tests**
|
||||
- [ ] `echo.erl` — minimal server
|
||||
- [ ] `fib_server.erl` — compute fib on request
|
||||
- [ ] `lib/erlang/conformance.sh` + runner, `scoreboard.json` + `scoreboard.md`
|
||||
@@ -99,6 +99,7 @@ Core mapping:
|
||||
|
||||
_Newest first._
|
||||
|
||||
- **2026-04-24 bank.erl green** — `lib/erlang/tests/programs/bank.sx` with 8 tests. Stateful server pattern: `Server = fun (Balance) -> receive ... Server(NewBalance) end end` recursively threads balance through each iteration. Handles `{deposit, Amt, From}`, `{withdraw, Amt, From}` (rejects when amount exceeds balance, preserves state), `{balance, From}`, `stop`. Tests cover deposit accumulation, withdrawal within balance, insufficient funds with state preservation, mixed transactions, clean shutdown, two-client interleave. Total suite 343/343.
|
||||
- **2026-04-24 ping_pong.erl green** — `lib/erlang/tests/programs/ping_pong.sx` with 4 tests: classic Pong server + Ping client with separate `ping_done`/`pong_done` notifications, 5-round trace via io-buffer (`"ppppp"`), main-as-pinger-4-rounds (no intermediate Ping proc), tagged-id round-trip (`"4 3 2 1 "`). All driven by `Ping = fun (Target, K) -> ... Ping(Target, K-1) ... end` self-recursion — captured-env reference works because `Ping` binds in main's mutable env before any spawned body looks it up. Total suite 335/335.
|
||||
- **2026-04-24 ring.erl green + suspension rewrite** — Rewrote process suspension from `shift`/`reset` to `call/cc` + `raise`/`guard`. **Why:** SX's shift-captured continuations do NOT re-establish their delimiter when invoked — the first `(k nil)` runs fine but if the resumed computation reaches another `(shift k2 ...)` it raises "shift without enclosing reset". Ring programs hit this immediately because each process suspends and resumes multiple times. `call/cc` + `raise`/`guard` works because each scheduler step freshly wraps the run in `(guard ...)`, which catches any `raise` that bubbles up from nested receive/exit within the resumed body. Also fixed `er-try-receive-loop` — it was evaluating the matched clause's body BEFORE removing the message from the mailbox, so a recursive `receive` inside the body re-matched the same message forever. Added `lib/erlang/tests/programs/ring.sx` with 4 tests (N=3 M=6, N=2 M=4, N=1 M=5 self-loop, N=3 M=9 hop-count via io-buffer). All process-communication eval tests still pass. Total suite 331/331.
|
||||
- **2026-04-24 exit/1 + termination green** — `exit/1` BIF uses `(shift k ...)` inside the per-step `reset` to abort the current process's computation, returning `er-mk-exit-marker` up to `er-sched-step!`. Step handler records `:exit-reason`, clears `:exit-result`, marks dead. Normal fall-off-end still records reason `normal`. `exit/2` errors with "deferred to Phase 4 (links)". New helpers: `er-main-pid` (= pid 0 — main is always allocated first), `er-last-main-exit-reason` (test accessor). 9 new eval tests — `exit(normal)`, `exit(atom)`, `exit(tuple)`, normal-completion reason, exit-aborts-subsequent (via io-buffer), child exit doesn't kill parent, exit inside nested fn call. Total eval 174/174; suite 327/327.
|
||||
|
||||
Reference in New Issue
Block a user