Merge loops/erlang into architecture — 530/530 tests, all phases complete
This commit is contained in:
86
lib/erlang/bench_ring.sh
Executable file
86
lib/erlang/bench_ring.sh
Executable file
@@ -0,0 +1,86 @@
|
||||
#!/usr/bin/env bash
|
||||
# Erlang-on-SX ring benchmark.
|
||||
#
|
||||
# Spawns N processes in a ring, passes a token N hops (one full round),
|
||||
# and reports wall-clock time + throughput. Aspirational target from
|
||||
# the plan is 1M processes; current sync-scheduler architecture caps out
|
||||
# orders of magnitude lower — this script measures honestly across a
|
||||
# range of N so the result/scaling is recorded.
|
||||
#
|
||||
# Usage:
|
||||
# bash lib/erlang/bench_ring.sh # default ladder
|
||||
# bash lib/erlang/bench_ring.sh 100 1000 5000 # custom Ns
|
||||
|
||||
set -uo pipefail
|
||||
cd "$(git rev-parse --show-toplevel)"
|
||||
|
||||
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
|
||||
if [ ! -x "$SX_SERVER" ]; then
|
||||
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
|
||||
fi
|
||||
if [ ! -x "$SX_SERVER" ]; then
|
||||
echo "ERROR: sx_server.exe not found." >&2
|
||||
exit 1
|
||||
fi
|
||||
|
||||
if [ "$#" -gt 0 ]; then
|
||||
NS=("$@")
|
||||
else
|
||||
NS=(10 100 500 1000)
|
||||
fi
|
||||
|
||||
TMPFILE=$(mktemp)
|
||||
trap "rm -f $TMPFILE" EXIT
|
||||
|
||||
# One-line Erlang program. Replaces __N__ with the size for each run.
|
||||
PROGRAM='Me = self(), N = __N__, 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, BuildRing = fun (K, Acc) -> if K =:= 0 -> Acc; true -> BuildRing(K-1, [spawn(Spawner) | Acc]) end end, Pids = BuildRing(N, []), Wire = fun (Ps) -> case Ps of [P, Q | _] -> P ! {setup, Q}, Wire(tl(Ps)); [Last] -> Last ! {setup, hd(Pids)} end end, Wire(Pids), hd(Pids) ! {token, N, Me}, receive done -> done end'
|
||||
|
||||
run_n() {
|
||||
local n="$1"
|
||||
local prog="${PROGRAM//__N__/$n}"
|
||||
cat > "$TMPFILE" <<EPOCHS
|
||||
(epoch 1)
|
||||
(load "lib/erlang/tokenizer.sx")
|
||||
(load "lib/erlang/parser.sx")
|
||||
(load "lib/erlang/parser-core.sx")
|
||||
(load "lib/erlang/parser-expr.sx")
|
||||
(load "lib/erlang/parser-module.sx")
|
||||
(load "lib/erlang/transpile.sx")
|
||||
(load "lib/erlang/runtime.sx")
|
||||
(epoch 2)
|
||||
(eval "(erlang-eval-ast \"${prog//\"/\\\"}\")")
|
||||
EPOCHS
|
||||
|
||||
local start_s start_ns end_s end_ns elapsed_ms
|
||||
start_s=$(date +%s)
|
||||
start_ns=$(date +%N)
|
||||
out=$(timeout 300 "$SX_SERVER" < "$TMPFILE" 2>&1)
|
||||
end_s=$(date +%s)
|
||||
end_ns=$(date +%N)
|
||||
|
||||
local ok="false"
|
||||
if echo "$out" | grep -q ':name "done"'; then ok="true"; fi
|
||||
|
||||
# ms = (end_s - start_s)*1000 + (end_ns - start_ns)/1e6
|
||||
elapsed_ms=$(awk -v s1="$start_s" -v n1="$start_ns" -v s2="$end_s" -v n2="$end_ns" \
|
||||
'BEGIN { printf "%d", (s2 - s1) * 1000 + (n2 - n1) / 1000000 }')
|
||||
|
||||
if [ "$ok" = "true" ]; then
|
||||
local hops_per_s
|
||||
hops_per_s=$(awk -v n="$n" -v ms="$elapsed_ms" \
|
||||
'BEGIN { if (ms == 0) ms = 1; printf "%.0f", n * 1000 / ms }')
|
||||
printf " N=%-8s hops=%-8s %sms (%s hops/s)\n" "$n" "$n" "$elapsed_ms" "$hops_per_s"
|
||||
else
|
||||
printf " N=%-8s FAILED %sms\n" "$n" "$elapsed_ms"
|
||||
fi
|
||||
}
|
||||
|
||||
echo "Ring benchmark — sx_server.exe (synchronous scheduler)"
|
||||
echo
|
||||
for n in "${NS[@]}"; do
|
||||
run_n "$n"
|
||||
done
|
||||
echo
|
||||
echo "Note: 1M-process target from the plan is aspirational; the synchronous"
|
||||
echo "scheduler with shift-based suspension and dict-based env copies is not"
|
||||
echo "engineered for that scale. Numbers above are honest baselines."
|
||||
35
lib/erlang/bench_ring_results.md
Normal file
35
lib/erlang/bench_ring_results.md
Normal file
@@ -0,0 +1,35 @@
|
||||
# Ring Benchmark Results
|
||||
|
||||
Generated by `lib/erlang/bench_ring.sh` against `sx_server.exe` on the
|
||||
synchronous Erlang-on-SX scheduler.
|
||||
|
||||
| N (processes) | Hops | Wall-clock | Throughput |
|
||||
|---|---|---|---|
|
||||
| 10 | 10 | 907ms | 11 hops/s |
|
||||
| 50 | 50 | 2107ms | 24 hops/s |
|
||||
| 100 | 100 | 3827ms | 26 hops/s |
|
||||
| 500 | 500 | 17004ms | 29 hops/s |
|
||||
| 1000 | 1000 | 29832ms | 34 hops/s |
|
||||
|
||||
(Each `Nm` row spawns N processes connected in a ring and passes a
|
||||
single token N hops total — i.e. the token completes one full lap.)
|
||||
|
||||
## Status of the 1M-process target
|
||||
|
||||
Phase 3's stretch goal in `plans/erlang-on-sx.md` is a million-process
|
||||
ring benchmark. **That target is not met** in the current synchronous
|
||||
scheduler; extrapolating from the table above, 1M hops would take
|
||||
~30 000 s. Correctness is fine — the program runs at every measured
|
||||
size — but throughput is bound by per-hop overhead.
|
||||
|
||||
Per-hop cost is dominated by:
|
||||
- `er-env-copy` per fun clause attempt (whole-dict copy each time)
|
||||
- `call/cc` capture + `raise`/`guard` unwind on every `receive`
|
||||
- `er-q-delete-at!` rebuilds the mailbox backing list on every match
|
||||
- `dict-set!`/`dict-has?` lookups in the global processes table
|
||||
|
||||
To reach 1M-process throughput in this architecture would need at
|
||||
least: persistent (path-copying) envs, an inline scheduler that
|
||||
doesn't call/cc on the common path (msg-already-in-mailbox), and a
|
||||
linked-list mailbox. None of those are in scope for the Phase 3
|
||||
checkbox — captured here as the floor we're starting from.
|
||||
153
lib/erlang/conformance.sh
Executable file
153
lib/erlang/conformance.sh
Executable file
@@ -0,0 +1,153 @@
|
||||
#!/usr/bin/env bash
|
||||
# Erlang-on-SX conformance runner.
|
||||
#
|
||||
# Loads every erlang test suite via the epoch protocol, collects
|
||||
# pass/fail counts, and writes lib/erlang/scoreboard.json + .md.
|
||||
#
|
||||
# Usage:
|
||||
# bash lib/erlang/conformance.sh # run all suites
|
||||
# bash lib/erlang/conformance.sh -v # verbose per-suite
|
||||
|
||||
set -uo pipefail
|
||||
cd "$(git rev-parse --show-toplevel)"
|
||||
|
||||
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
|
||||
if [ ! -x "$SX_SERVER" ]; then
|
||||
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
|
||||
fi
|
||||
if [ ! -x "$SX_SERVER" ]; then
|
||||
echo "ERROR: sx_server.exe not found." >&2
|
||||
exit 1
|
||||
fi
|
||||
|
||||
VERBOSE="${1:-}"
|
||||
TMPFILE=$(mktemp)
|
||||
OUTFILE=$(mktemp)
|
||||
trap "rm -f $TMPFILE $OUTFILE" EXIT
|
||||
|
||||
# Each suite: name | counter pass | counter total
|
||||
SUITES=(
|
||||
"tokenize|er-test-pass|er-test-count"
|
||||
"parse|er-parse-test-pass|er-parse-test-count"
|
||||
"eval|er-eval-test-pass|er-eval-test-count"
|
||||
"runtime|er-rt-test-pass|er-rt-test-count"
|
||||
"ring|er-ring-test-pass|er-ring-test-count"
|
||||
"ping-pong|er-pp-test-pass|er-pp-test-count"
|
||||
"bank|er-bank-test-pass|er-bank-test-count"
|
||||
"echo|er-echo-test-pass|er-echo-test-count"
|
||||
"fib|er-fib-test-pass|er-fib-test-count"
|
||||
)
|
||||
|
||||
cat > "$TMPFILE" << 'EPOCHS'
|
||||
(epoch 1)
|
||||
(load "lib/erlang/tokenizer.sx")
|
||||
(load "lib/erlang/parser.sx")
|
||||
(load "lib/erlang/parser-core.sx")
|
||||
(load "lib/erlang/parser-expr.sx")
|
||||
(load "lib/erlang/parser-module.sx")
|
||||
(load "lib/erlang/transpile.sx")
|
||||
(load "lib/erlang/runtime.sx")
|
||||
(load "lib/erlang/tests/tokenize.sx")
|
||||
(load "lib/erlang/tests/parse.sx")
|
||||
(load "lib/erlang/tests/eval.sx")
|
||||
(load "lib/erlang/tests/runtime.sx")
|
||||
(load "lib/erlang/tests/programs/ring.sx")
|
||||
(load "lib/erlang/tests/programs/ping_pong.sx")
|
||||
(load "lib/erlang/tests/programs/bank.sx")
|
||||
(load "lib/erlang/tests/programs/echo.sx")
|
||||
(load "lib/erlang/tests/programs/fib_server.sx")
|
||||
(epoch 100)
|
||||
(eval "(list er-test-pass er-test-count)")
|
||||
(epoch 101)
|
||||
(eval "(list er-parse-test-pass er-parse-test-count)")
|
||||
(epoch 102)
|
||||
(eval "(list er-eval-test-pass er-eval-test-count)")
|
||||
(epoch 103)
|
||||
(eval "(list er-rt-test-pass er-rt-test-count)")
|
||||
(epoch 104)
|
||||
(eval "(list er-ring-test-pass er-ring-test-count)")
|
||||
(epoch 105)
|
||||
(eval "(list er-pp-test-pass er-pp-test-count)")
|
||||
(epoch 106)
|
||||
(eval "(list er-bank-test-pass er-bank-test-count)")
|
||||
(epoch 107)
|
||||
(eval "(list er-echo-test-pass er-echo-test-count)")
|
||||
(epoch 108)
|
||||
(eval "(list er-fib-test-pass er-fib-test-count)")
|
||||
EPOCHS
|
||||
|
||||
timeout 120 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1
|
||||
|
||||
# Parse "(N M)" from the line after each "(ok-len <epoch> ...)" marker.
|
||||
parse_pair() {
|
||||
local epoch="$1"
|
||||
local line
|
||||
line=$(grep -A1 "^(ok-len $epoch " "$OUTFILE" | tail -1)
|
||||
echo "$line" | sed -E 's/[()]//g'
|
||||
}
|
||||
|
||||
TOTAL_PASS=0
|
||||
TOTAL_COUNT=0
|
||||
JSON_SUITES=""
|
||||
MD_ROWS=""
|
||||
|
||||
idx=0
|
||||
for entry in "${SUITES[@]}"; do
|
||||
name="${entry%%|*}"
|
||||
epoch=$((100 + idx))
|
||||
pair=$(parse_pair "$epoch")
|
||||
pass=$(echo "$pair" | awk '{print $1}')
|
||||
count=$(echo "$pair" | awk '{print $2}')
|
||||
if [ -z "$pass" ] || [ -z "$count" ]; then
|
||||
pass=0
|
||||
count=0
|
||||
fi
|
||||
TOTAL_PASS=$((TOTAL_PASS + pass))
|
||||
TOTAL_COUNT=$((TOTAL_COUNT + count))
|
||||
status="ok"
|
||||
marker="✅"
|
||||
if [ "$pass" != "$count" ]; then
|
||||
status="fail"
|
||||
marker="❌"
|
||||
fi
|
||||
if [ "$VERBOSE" = "-v" ]; then
|
||||
printf " %-12s %s/%s\n" "$name" "$pass" "$count"
|
||||
fi
|
||||
if [ -n "$JSON_SUITES" ]; then JSON_SUITES+=","; fi
|
||||
JSON_SUITES+=$'\n '
|
||||
JSON_SUITES+="{\"name\":\"$name\",\"pass\":$pass,\"total\":$count,\"status\":\"$status\"}"
|
||||
MD_ROWS+="| $marker | $name | $pass | $count |"$'\n'
|
||||
idx=$((idx + 1))
|
||||
done
|
||||
|
||||
printf '\nErlang-on-SX conformance: %d / %d\n' "$TOTAL_PASS" "$TOTAL_COUNT"
|
||||
|
||||
# scoreboard.json
|
||||
cat > lib/erlang/scoreboard.json <<JSON
|
||||
{
|
||||
"language": "erlang",
|
||||
"total_pass": $TOTAL_PASS,
|
||||
"total": $TOTAL_COUNT,
|
||||
"suites": [$JSON_SUITES
|
||||
]
|
||||
}
|
||||
JSON
|
||||
|
||||
# scoreboard.md
|
||||
cat > lib/erlang/scoreboard.md <<MD
|
||||
# Erlang-on-SX Scoreboard
|
||||
|
||||
**Total: ${TOTAL_PASS} / ${TOTAL_COUNT} tests passing**
|
||||
|
||||
| | Suite | Pass | Total |
|
||||
|---|---|---|---|
|
||||
$MD_ROWS
|
||||
|
||||
Generated by \`lib/erlang/conformance.sh\`.
|
||||
MD
|
||||
|
||||
if [ "$TOTAL_PASS" -eq "$TOTAL_COUNT" ]; then
|
||||
exit 0
|
||||
else
|
||||
exit 1
|
||||
fi
|
||||
@@ -237,6 +237,8 @@
|
||||
(er-parse-fun-expr st)
|
||||
(er-is? st "keyword" "try")
|
||||
(er-parse-try st)
|
||||
(er-is? st "punct" "<<")
|
||||
(er-parse-binary st)
|
||||
:else (error
|
||||
(str
|
||||
"Erlang parse: unexpected "
|
||||
@@ -281,12 +283,56 @@
|
||||
(fn
|
||||
(st)
|
||||
(er-expect! st "punct" "[")
|
||||
(if
|
||||
(cond
|
||||
(er-is? st "punct" "]")
|
||||
(do (er-advance! st) {:type "nil"})
|
||||
(let
|
||||
((elems (list (er-parse-expr-prec st 0))))
|
||||
(er-parse-list-tail st elems)))))
|
||||
:else (let
|
||||
((first (er-parse-expr-prec st 0)))
|
||||
(cond
|
||||
(er-is? st "punct" "||") (er-parse-list-comp st first)
|
||||
:else (er-parse-list-tail st (list first)))))))
|
||||
|
||||
(define
|
||||
er-parse-list-comp
|
||||
(fn
|
||||
(st head)
|
||||
(er-advance! st)
|
||||
(let
|
||||
((quals (list (er-parse-lc-qualifier st))))
|
||||
(er-parse-list-comp-tail st head quals))))
|
||||
|
||||
(define
|
||||
er-parse-list-comp-tail
|
||||
(fn
|
||||
(st head quals)
|
||||
(cond
|
||||
(er-is? st "punct" ",")
|
||||
(do
|
||||
(er-advance! st)
|
||||
(append! quals (er-parse-lc-qualifier st))
|
||||
(er-parse-list-comp-tail st head quals))
|
||||
(er-is? st "punct" "]")
|
||||
(do (er-advance! st) {:head head :qualifiers quals :type "lc"})
|
||||
:else (error
|
||||
(str
|
||||
"Erlang parse: expected ',' or ']' in list comprehension, got '"
|
||||
(er-cur-value st)
|
||||
"'")))))
|
||||
|
||||
(define
|
||||
er-parse-lc-qualifier
|
||||
(fn
|
||||
(st)
|
||||
(let
|
||||
((e (er-parse-expr-prec st 0)))
|
||||
(cond
|
||||
(er-is? st "punct" "<-")
|
||||
(do
|
||||
(er-advance! st)
|
||||
(let
|
||||
((source (er-parse-expr-prec st 0)))
|
||||
{:kind "gen" :pattern e :source source}))
|
||||
:else {:kind "filter" :expr e}))))
|
||||
|
||||
(define
|
||||
er-parse-list-tail
|
||||
@@ -532,3 +578,63 @@
|
||||
((guards (if (er-is? st "keyword" "when") (do (er-advance! st) (er-parse-guards st)) (list))))
|
||||
(er-expect! st "punct" "->")
|
||||
(let ((body (er-parse-body st))) {:pattern pat :body body :class klass :guards guards}))))))
|
||||
|
||||
;; ── binary literals / patterns ────────────────────────────────
|
||||
;; `<< [Seg {, Seg}] >>` where Seg = Value [: Size] [/ Spec]. Size is
|
||||
;; a literal integer (multiple of 8 supported); Spec is `integer`
|
||||
;; (default) or `binary` (rest-of-binary tail). Sufficient for the
|
||||
;; common `<<A:8, B:16, Rest/binary>>` patterns.
|
||||
(define
|
||||
er-parse-binary
|
||||
(fn
|
||||
(st)
|
||||
(er-expect! st "punct" "<<")
|
||||
(cond
|
||||
(er-is? st "punct" ">>")
|
||||
(do (er-advance! st) {:segments (list) :type "binary"})
|
||||
:else (let
|
||||
((segs (list (er-parse-binary-segment st))))
|
||||
(er-parse-binary-tail st segs)))))
|
||||
|
||||
(define
|
||||
er-parse-binary-tail
|
||||
(fn
|
||||
(st segs)
|
||||
(cond
|
||||
(er-is? st "punct" ",")
|
||||
(do
|
||||
(er-advance! st)
|
||||
(append! segs (er-parse-binary-segment st))
|
||||
(er-parse-binary-tail st segs))
|
||||
(er-is? st "punct" ">>")
|
||||
(do (er-advance! st) {:segments segs :type "binary"})
|
||||
:else (error
|
||||
(str
|
||||
"Erlang parse: expected ',' or '>>' in binary, got '"
|
||||
(er-cur-value st)
|
||||
"'")))))
|
||||
|
||||
(define
|
||||
er-parse-binary-segment
|
||||
(fn
|
||||
(st)
|
||||
;; Use `er-parse-primary` for the value so a leading `:` falls
|
||||
;; through to the segment's size suffix instead of being eaten
|
||||
;; by `er-parse-postfix-loop` as a `Mod:Fun` remote call.
|
||||
(let
|
||||
((v (er-parse-primary st)))
|
||||
(let
|
||||
((size (cond
|
||||
(er-is? st "punct" ":")
|
||||
(do (er-advance! st) (er-parse-primary st))
|
||||
:else nil))
|
||||
(spec (cond
|
||||
(er-is? st "op" "/")
|
||||
(do
|
||||
(er-advance! st)
|
||||
(let
|
||||
((tok (er-cur st)))
|
||||
(er-advance! st)
|
||||
(get tok :value)))
|
||||
:else "integer")))
|
||||
{:size size :spec spec :value v}))))
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
16
lib/erlang/scoreboard.json
Normal file
16
lib/erlang/scoreboard.json
Normal file
@@ -0,0 +1,16 @@
|
||||
{
|
||||
"language": "erlang",
|
||||
"total_pass": 530,
|
||||
"total": 530,
|
||||
"suites": [
|
||||
{"name":"tokenize","pass":62,"total":62,"status":"ok"},
|
||||
{"name":"parse","pass":52,"total":52,"status":"ok"},
|
||||
{"name":"eval","pass":346,"total":346,"status":"ok"},
|
||||
{"name":"runtime","pass":39,"total":39,"status":"ok"},
|
||||
{"name":"ring","pass":4,"total":4,"status":"ok"},
|
||||
{"name":"ping-pong","pass":4,"total":4,"status":"ok"},
|
||||
{"name":"bank","pass":8,"total":8,"status":"ok"},
|
||||
{"name":"echo","pass":7,"total":7,"status":"ok"},
|
||||
{"name":"fib","pass":8,"total":8,"status":"ok"}
|
||||
]
|
||||
}
|
||||
18
lib/erlang/scoreboard.md
Normal file
18
lib/erlang/scoreboard.md
Normal file
@@ -0,0 +1,18 @@
|
||||
# Erlang-on-SX Scoreboard
|
||||
|
||||
**Total: 530 / 530 tests passing**
|
||||
|
||||
| | Suite | Pass | Total |
|
||||
|---|---|---|---|
|
||||
| ✅ | tokenize | 62 | 62 |
|
||||
| ✅ | parse | 52 | 52 |
|
||||
| ✅ | eval | 346 | 346 |
|
||||
| ✅ | runtime | 39 | 39 |
|
||||
| ✅ | ring | 4 | 4 |
|
||||
| ✅ | ping-pong | 4 | 4 |
|
||||
| ✅ | bank | 8 | 8 |
|
||||
| ✅ | echo | 7 | 7 |
|
||||
| ✅ | fib | 8 | 8 |
|
||||
|
||||
|
||||
Generated by `lib/erlang/conformance.sh`.
|
||||
1130
lib/erlang/tests/eval.sx
Normal file
1130
lib/erlang/tests/eval.sx
Normal file
File diff suppressed because it is too large
Load Diff
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))
|
||||
140
lib/erlang/tests/programs/echo.sx
Normal file
140
lib/erlang/tests/programs/echo.sx
Normal file
@@ -0,0 +1,140 @@
|
||||
;; Echo server — minimal classic Erlang server. Receives {From, Msg}
|
||||
;; and sends Msg back to From, then loops. `stop` ends the server.
|
||||
|
||||
(define er-echo-test-count 0)
|
||||
(define er-echo-test-pass 0)
|
||||
(define er-echo-test-fails (list))
|
||||
|
||||
(define
|
||||
er-echo-test
|
||||
(fn
|
||||
(name actual expected)
|
||||
(set! er-echo-test-count (+ er-echo-test-count 1))
|
||||
(if
|
||||
(= actual expected)
|
||||
(set! er-echo-test-pass (+ er-echo-test-pass 1))
|
||||
(append! er-echo-test-fails {:actual actual :expected expected :name name}))))
|
||||
|
||||
(define echo-ev erlang-eval-ast)
|
||||
|
||||
(define
|
||||
er-echo-server-src
|
||||
"EchoSrv = fun () ->
|
||||
Loop = fun () ->
|
||||
receive
|
||||
{From, Msg} -> From ! Msg, Loop();
|
||||
stop -> ok
|
||||
end
|
||||
end,
|
||||
Loop()
|
||||
end")
|
||||
|
||||
;; Single round-trip with an atom.
|
||||
(er-echo-test
|
||||
"atom round-trip"
|
||||
(get
|
||||
(echo-ev
|
||||
(str
|
||||
er-echo-server-src
|
||||
", Me = self(),
|
||||
Echo = spawn(EchoSrv),
|
||||
Echo ! {Me, hello},
|
||||
receive R -> Echo ! stop, R end"))
|
||||
:name)
|
||||
"hello")
|
||||
|
||||
;; Number round-trip.
|
||||
(er-echo-test
|
||||
"number round-trip"
|
||||
(echo-ev
|
||||
(str
|
||||
er-echo-server-src
|
||||
", Me = self(),
|
||||
Echo = spawn(EchoSrv),
|
||||
Echo ! {Me, 42},
|
||||
receive R -> Echo ! stop, R end"))
|
||||
42)
|
||||
|
||||
;; Tuple round-trip — pattern-match the reply to extract V.
|
||||
(er-echo-test
|
||||
"tuple round-trip"
|
||||
(echo-ev
|
||||
(str
|
||||
er-echo-server-src
|
||||
", Me = self(),
|
||||
Echo = spawn(EchoSrv),
|
||||
Echo ! {Me, {ok, 7}},
|
||||
receive {ok, V} -> Echo ! stop, V end"))
|
||||
7)
|
||||
|
||||
;; List round-trip.
|
||||
(er-echo-test
|
||||
"list round-trip"
|
||||
(echo-ev
|
||||
(str
|
||||
er-echo-server-src
|
||||
", Me = self(),
|
||||
Echo = spawn(EchoSrv),
|
||||
Echo ! {Me, [1, 2, 3]},
|
||||
receive [H | _] -> Echo ! stop, H end"))
|
||||
1)
|
||||
|
||||
;; Multiple sequential round-trips.
|
||||
(er-echo-test
|
||||
"three round-trips"
|
||||
(echo-ev
|
||||
(str
|
||||
er-echo-server-src
|
||||
", Me = self(),
|
||||
Echo = spawn(EchoSrv),
|
||||
Echo ! {Me, 10}, A = receive Ra -> Ra end,
|
||||
Echo ! {Me, 20}, B = receive Rb -> Rb end,
|
||||
Echo ! {Me, 30}, C = receive Rc -> Rc end,
|
||||
Echo ! stop,
|
||||
A + B + C"))
|
||||
60)
|
||||
|
||||
;; Two clients sharing one echo server. Each gets its own reply.
|
||||
(er-echo-test
|
||||
"two clients"
|
||||
(get
|
||||
(echo-ev
|
||||
(str
|
||||
er-echo-server-src
|
||||
", Me = self(),
|
||||
Echo = spawn(EchoSrv),
|
||||
Client = fun (Tag) ->
|
||||
spawn(fun () ->
|
||||
Echo ! {self(), Tag},
|
||||
receive R -> Me ! {got, R} end
|
||||
end)
|
||||
end,
|
||||
Client(a),
|
||||
Client(b),
|
||||
receive {got, _} -> ok end,
|
||||
receive {got, _} -> ok end,
|
||||
Echo ! stop,
|
||||
finished"))
|
||||
:name)
|
||||
"finished")
|
||||
|
||||
;; Echo via io trace — verify each message round-trips through.
|
||||
(er-echo-test
|
||||
"trace 4 messages"
|
||||
(do
|
||||
(er-io-flush!)
|
||||
(echo-ev
|
||||
(str
|
||||
er-echo-server-src
|
||||
", Me = self(),
|
||||
Echo = spawn(EchoSrv),
|
||||
Send = fun (V) -> Echo ! {Me, V}, receive R -> io:format(\"~p \", [R]) end end,
|
||||
Send(1), Send(2), Send(3), Send(4),
|
||||
Echo ! stop,
|
||||
done"))
|
||||
(er-io-buffer-content))
|
||||
"1 2 3 4 ")
|
||||
|
||||
(define
|
||||
er-echo-test-summary
|
||||
(str "echo " er-echo-test-pass "/" er-echo-test-count))
|
||||
152
lib/erlang/tests/programs/fib_server.sx
Normal file
152
lib/erlang/tests/programs/fib_server.sx
Normal file
@@ -0,0 +1,152 @@
|
||||
;; Fib server — long-lived process that computes fibonacci numbers on
|
||||
;; request. Tests recursive function evaluation inside a server loop.
|
||||
|
||||
(define er-fib-test-count 0)
|
||||
(define er-fib-test-pass 0)
|
||||
(define er-fib-test-fails (list))
|
||||
|
||||
(define
|
||||
er-fib-test
|
||||
(fn
|
||||
(name actual expected)
|
||||
(set! er-fib-test-count (+ er-fib-test-count 1))
|
||||
(if
|
||||
(= actual expected)
|
||||
(set! er-fib-test-pass (+ er-fib-test-pass 1))
|
||||
(append! er-fib-test-fails {:actual actual :expected expected :name name}))))
|
||||
|
||||
(define fib-ev erlang-eval-ast)
|
||||
|
||||
;; Fib + server-loop source. Standalone so each test can chain queries.
|
||||
(define
|
||||
er-fib-server-src
|
||||
"Fib = fun (0) -> 0; (1) -> 1; (N) -> Fib(N-1) + Fib(N-2) end,
|
||||
FibSrv = fun () ->
|
||||
Loop = fun () ->
|
||||
receive
|
||||
{fib, N, From} -> From ! Fib(N), Loop();
|
||||
stop -> ok
|
||||
end
|
||||
end,
|
||||
Loop()
|
||||
end")
|
||||
|
||||
;; Base cases.
|
||||
(er-fib-test
|
||||
"fib(0)"
|
||||
(fib-ev
|
||||
(str
|
||||
er-fib-server-src
|
||||
", Me = self(),
|
||||
Srv = spawn(FibSrv),
|
||||
Srv ! {fib, 0, Me},
|
||||
receive R -> Srv ! stop, R end"))
|
||||
0)
|
||||
|
||||
(er-fib-test
|
||||
"fib(1)"
|
||||
(fib-ev
|
||||
(str
|
||||
er-fib-server-src
|
||||
", Me = self(),
|
||||
Srv = spawn(FibSrv),
|
||||
Srv ! {fib, 1, Me},
|
||||
receive R -> Srv ! stop, R end"))
|
||||
1)
|
||||
|
||||
;; Larger values.
|
||||
(er-fib-test
|
||||
"fib(10) = 55"
|
||||
(fib-ev
|
||||
(str
|
||||
er-fib-server-src
|
||||
", Me = self(),
|
||||
Srv = spawn(FibSrv),
|
||||
Srv ! {fib, 10, Me},
|
||||
receive R -> Srv ! stop, R end"))
|
||||
55)
|
||||
|
||||
(er-fib-test
|
||||
"fib(15) = 610"
|
||||
(fib-ev
|
||||
(str
|
||||
er-fib-server-src
|
||||
", Me = self(),
|
||||
Srv = spawn(FibSrv),
|
||||
Srv ! {fib, 15, Me},
|
||||
receive R -> Srv ! stop, R end"))
|
||||
610)
|
||||
|
||||
;; Multiple sequential queries to one server. Sum to avoid dict-equality.
|
||||
(er-fib-test
|
||||
"sequential fib(5..8) sum"
|
||||
(fib-ev
|
||||
(str
|
||||
er-fib-server-src
|
||||
", Me = self(),
|
||||
Srv = spawn(FibSrv),
|
||||
Srv ! {fib, 5, Me}, A = receive Ra -> Ra end,
|
||||
Srv ! {fib, 6, Me}, B = receive Rb -> Rb end,
|
||||
Srv ! {fib, 7, Me}, C = receive Rc -> Rc end,
|
||||
Srv ! {fib, 8, Me}, D = receive Rd -> Rd end,
|
||||
Srv ! stop,
|
||||
A + B + C + D"))
|
||||
47)
|
||||
|
||||
;; Verify Fib obeys the recurrence — fib(n) = fib(n-1) + fib(n-2).
|
||||
(er-fib-test
|
||||
"fib recurrence at n=12"
|
||||
(fib-ev
|
||||
(str
|
||||
er-fib-server-src
|
||||
", Me = self(),
|
||||
Srv = spawn(FibSrv),
|
||||
Srv ! {fib, 10, Me}, A = receive Ra -> Ra end,
|
||||
Srv ! {fib, 11, Me}, B = receive Rb -> Rb end,
|
||||
Srv ! {fib, 12, Me}, C = receive Rc -> Rc end,
|
||||
Srv ! stop,
|
||||
C - (A + B)"))
|
||||
0)
|
||||
|
||||
;; Two clients each get their own answer; main sums the results.
|
||||
(er-fib-test
|
||||
"two clients sum"
|
||||
(fib-ev
|
||||
(str
|
||||
er-fib-server-src
|
||||
", Me = self(),
|
||||
Srv = spawn(FibSrv),
|
||||
Client = fun (N) ->
|
||||
spawn(fun () ->
|
||||
Srv ! {fib, N, self()},
|
||||
receive R -> Me ! {result, R} end
|
||||
end)
|
||||
end,
|
||||
Client(7),
|
||||
Client(9),
|
||||
{result, A} = receive M1 -> M1 end,
|
||||
{result, B} = receive M2 -> M2 end,
|
||||
Srv ! stop,
|
||||
A + B"))
|
||||
47)
|
||||
|
||||
;; Trace queries via io-buffer.
|
||||
(er-fib-test
|
||||
"trace fib 0..6"
|
||||
(do
|
||||
(er-io-flush!)
|
||||
(fib-ev
|
||||
(str
|
||||
er-fib-server-src
|
||||
", Me = self(),
|
||||
Srv = spawn(FibSrv),
|
||||
Ask = fun (N) -> Srv ! {fib, N, Me}, receive R -> io:format(\"~p \", [R]) end end,
|
||||
Ask(0), Ask(1), Ask(2), Ask(3), Ask(4), Ask(5), Ask(6),
|
||||
Srv ! stop,
|
||||
done"))
|
||||
(er-io-buffer-content))
|
||||
"0 1 1 2 3 5 8 ")
|
||||
|
||||
(define
|
||||
er-fib-test-summary
|
||||
(str "fib " er-fib-test-pass "/" er-fib-test-count))
|
||||
127
lib/erlang/tests/programs/ping_pong.sx
Normal file
127
lib/erlang/tests/programs/ping_pong.sx
Normal file
@@ -0,0 +1,127 @@
|
||||
;; Ping-pong program — two processes exchange N messages, then signal
|
||||
;; main via separate `ping_done` / `pong_done` notifications.
|
||||
|
||||
(define er-pp-test-count 0)
|
||||
(define er-pp-test-pass 0)
|
||||
(define er-pp-test-fails (list))
|
||||
|
||||
(define
|
||||
er-pp-test
|
||||
(fn
|
||||
(name actual expected)
|
||||
(set! er-pp-test-count (+ er-pp-test-count 1))
|
||||
(if
|
||||
(= actual expected)
|
||||
(set! er-pp-test-pass (+ er-pp-test-pass 1))
|
||||
(append! er-pp-test-fails {:actual actual :expected expected :name name}))))
|
||||
|
||||
(define pp-ev erlang-eval-ast)
|
||||
|
||||
;; Three rounds of ping-pong, then stop. Main receives ping_done and
|
||||
;; pong_done in arrival order (Ping finishes first because Pong exits
|
||||
;; only after receiving stop).
|
||||
(define
|
||||
er-pp-program
|
||||
"Me = self(),
|
||||
Pong = spawn(fun () ->
|
||||
Loop = fun () ->
|
||||
receive
|
||||
{ping, From} -> From ! pong, Loop();
|
||||
stop -> Me ! pong_done
|
||||
end
|
||||
end,
|
||||
Loop()
|
||||
end),
|
||||
Ping = fun (Target, K) ->
|
||||
if K =:= 0 -> Target ! stop, Me ! ping_done;
|
||||
true -> Target ! {ping, self()}, receive pong -> Ping(Target, K - 1) end
|
||||
end
|
||||
end,
|
||||
spawn(fun () -> Ping(Pong, 3) end),
|
||||
receive ping_done -> ok end,
|
||||
receive pong_done -> both_done end")
|
||||
|
||||
(er-pp-test
|
||||
"ping-pong 3 rounds"
|
||||
(get (pp-ev er-pp-program) :name)
|
||||
"both_done")
|
||||
|
||||
;; Count exchanges via io-buffer — each pong trip prints "p".
|
||||
(er-pp-test
|
||||
"ping-pong 5 rounds trace"
|
||||
(do
|
||||
(er-io-flush!)
|
||||
(pp-ev
|
||||
"Me = self(),
|
||||
Pong = spawn(fun () ->
|
||||
Loop = fun () ->
|
||||
receive
|
||||
{ping, From} -> io:format(\"p\"), From ! pong, Loop();
|
||||
stop -> Me ! pong_done
|
||||
end
|
||||
end,
|
||||
Loop()
|
||||
end),
|
||||
Ping = fun (Target, K) ->
|
||||
if K =:= 0 -> Target ! stop, Me ! ping_done;
|
||||
true -> Target ! {ping, self()}, receive pong -> Ping(Target, K - 1) end
|
||||
end
|
||||
end,
|
||||
spawn(fun () -> Ping(Pong, 5) end),
|
||||
receive ping_done -> ok end,
|
||||
receive pong_done -> ok end")
|
||||
(er-io-buffer-content))
|
||||
"ppppp")
|
||||
|
||||
;; Main → Pong directly (no Ping process). Main plays the ping role.
|
||||
(er-pp-test
|
||||
"main-as-pinger 4 rounds"
|
||||
(pp-ev
|
||||
"Me = self(),
|
||||
Pong = spawn(fun () ->
|
||||
Loop = fun () ->
|
||||
receive
|
||||
{ping, From} -> From ! pong, Loop();
|
||||
stop -> ok
|
||||
end
|
||||
end,
|
||||
Loop()
|
||||
end),
|
||||
Go = fun (K) ->
|
||||
if K =:= 0 -> Pong ! stop, K;
|
||||
true -> Pong ! {ping, Me}, receive pong -> Go(K - 1) end
|
||||
end
|
||||
end,
|
||||
Go(4)")
|
||||
0)
|
||||
|
||||
;; Ensure the processes really interleave — inject an id into each
|
||||
;; ping and check we get them all back via trace (the order is
|
||||
;; deterministic under our sync scheduler).
|
||||
(er-pp-test
|
||||
"ids round-trip"
|
||||
(do
|
||||
(er-io-flush!)
|
||||
(pp-ev
|
||||
"Me = self(),
|
||||
Pong = spawn(fun () ->
|
||||
Loop = fun () ->
|
||||
receive
|
||||
{ping, From, Id} -> From ! {pong, Id}, Loop();
|
||||
stop -> ok
|
||||
end
|
||||
end,
|
||||
Loop()
|
||||
end),
|
||||
Go = fun (K) ->
|
||||
if K =:= 0 -> Pong ! stop, done;
|
||||
true -> Pong ! {ping, Me, K}, receive {pong, RId} -> io:format(\"~p \", [RId]), Go(K - 1) end
|
||||
end
|
||||
end,
|
||||
Go(4)")
|
||||
(er-io-buffer-content))
|
||||
"4 3 2 1 ")
|
||||
|
||||
(define
|
||||
er-pp-test-summary
|
||||
(str "ping-pong " er-pp-test-pass "/" er-pp-test-count))
|
||||
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))
|
||||
139
lib/erlang/tests/runtime.sx
Normal file
139
lib/erlang/tests/runtime.sx
Normal file
@@ -0,0 +1,139 @@
|
||||
;; Erlang runtime tests — scheduler + process-record primitives.
|
||||
|
||||
(define er-rt-test-count 0)
|
||||
(define er-rt-test-pass 0)
|
||||
(define er-rt-test-fails (list))
|
||||
|
||||
(define
|
||||
er-rt-test
|
||||
(fn
|
||||
(name actual expected)
|
||||
(set! er-rt-test-count (+ er-rt-test-count 1))
|
||||
(if
|
||||
(= actual expected)
|
||||
(set! er-rt-test-pass (+ er-rt-test-pass 1))
|
||||
(append! er-rt-test-fails {:actual actual :expected expected :name name}))))
|
||||
|
||||
;; ── queue ─────────────────────────────────────────────────────────
|
||||
(er-rt-test "queue empty len" (er-q-len (er-q-new)) 0)
|
||||
(er-rt-test "queue empty?" (er-q-empty? (er-q-new)) true)
|
||||
|
||||
(define q1 (er-q-new))
|
||||
(er-q-push! q1 "a")
|
||||
(er-q-push! q1 "b")
|
||||
(er-q-push! q1 "c")
|
||||
(er-rt-test "queue push len" (er-q-len q1) 3)
|
||||
(er-rt-test "queue empty? after push" (er-q-empty? q1) false)
|
||||
(er-rt-test "queue peek" (er-q-peek q1) "a")
|
||||
(er-rt-test "queue pop 1" (er-q-pop! q1) "a")
|
||||
(er-rt-test "queue pop 2" (er-q-pop! q1) "b")
|
||||
(er-rt-test "queue len after pops" (er-q-len q1) 1)
|
||||
(er-rt-test "queue pop 3" (er-q-pop! q1) "c")
|
||||
(er-rt-test "queue empty again" (er-q-empty? q1) true)
|
||||
(er-rt-test "queue pop empty" (er-q-pop! q1) nil)
|
||||
|
||||
;; Queue FIFO under interleaved push/pop
|
||||
(define q2 (er-q-new))
|
||||
(er-q-push! q2 1)
|
||||
(er-q-push! q2 2)
|
||||
(er-q-pop! q2)
|
||||
(er-q-push! q2 3)
|
||||
(er-rt-test "queue interleave peek" (er-q-peek q2) 2)
|
||||
(er-rt-test "queue to-list" (er-q-to-list q2) (list 2 3))
|
||||
|
||||
;; ── scheduler init ─────────────────────────────────────────────
|
||||
(er-sched-init!)
|
||||
(er-rt-test "sched process count 0" (er-sched-process-count) 0)
|
||||
(er-rt-test "sched runnable count 0" (er-sched-runnable-count) 0)
|
||||
(er-rt-test "sched current nil" (er-sched-current-pid) nil)
|
||||
|
||||
;; ── pid allocation ─────────────────────────────────────────────
|
||||
(define pa (er-pid-new!))
|
||||
(define pb (er-pid-new!))
|
||||
(er-rt-test "pid tag" (get pa :tag) "pid")
|
||||
(er-rt-test "pid ids distinct" (= (er-pid-id pa) (er-pid-id pb)) false)
|
||||
(er-rt-test "pid? true" (er-pid? pa) true)
|
||||
(er-rt-test "pid? false" (er-pid? 42) false)
|
||||
(er-rt-test
|
||||
"pid-equal same"
|
||||
(er-pid-equal? pa (er-mk-pid (er-pid-id pa)))
|
||||
true)
|
||||
(er-rt-test "pid-equal diff" (er-pid-equal? pa pb) false)
|
||||
|
||||
;; ── process lifecycle ──────────────────────────────────────────
|
||||
(er-sched-init!)
|
||||
(define p1 (er-proc-new! {}))
|
||||
(define p2 (er-proc-new! {}))
|
||||
(er-rt-test "proc count 2" (er-sched-process-count) 2)
|
||||
(er-rt-test "runnable count 2" (er-sched-runnable-count) 2)
|
||||
(er-rt-test
|
||||
"proc state runnable"
|
||||
(er-proc-field (get p1 :pid) :state)
|
||||
"runnable")
|
||||
(er-rt-test
|
||||
"proc mailbox empty"
|
||||
(er-proc-mailbox-size (get p1 :pid))
|
||||
0)
|
||||
(er-rt-test
|
||||
"proc lookup"
|
||||
(er-pid-equal? (get (er-proc-get (get p1 :pid)) :pid) (get p1 :pid))
|
||||
true)
|
||||
(er-rt-test "proc exists" (er-proc-exists? (get p1 :pid)) true)
|
||||
(er-rt-test
|
||||
"proc no-such-pid"
|
||||
(er-proc-exists? (er-mk-pid 9999))
|
||||
false)
|
||||
|
||||
;; runnable queue dequeue order
|
||||
(er-rt-test
|
||||
"dequeue first"
|
||||
(er-pid-equal? (er-sched-next-runnable!) (get p1 :pid))
|
||||
true)
|
||||
(er-rt-test
|
||||
"dequeue second"
|
||||
(er-pid-equal? (er-sched-next-runnable!) (get p2 :pid))
|
||||
true)
|
||||
(er-rt-test "dequeue empty" (er-sched-next-runnable!) nil)
|
||||
|
||||
;; current-pid get/set
|
||||
(er-sched-set-current! (get p1 :pid))
|
||||
(er-rt-test
|
||||
"current pid set"
|
||||
(er-pid-equal? (er-sched-current-pid) (get p1 :pid))
|
||||
true)
|
||||
|
||||
;; ── mailbox push ──────────────────────────────────────────────
|
||||
(er-proc-mailbox-push! (get p1 :pid) {:tag "atom" :name "ping"})
|
||||
(er-proc-mailbox-push! (get p1 :pid) 42)
|
||||
(er-rt-test "mailbox size 2" (er-proc-mailbox-size (get p1 :pid)) 2)
|
||||
|
||||
;; ── field update ──────────────────────────────────────────────
|
||||
(er-proc-set! (get p1 :pid) :state "waiting")
|
||||
(er-rt-test
|
||||
"proc state waiting"
|
||||
(er-proc-field (get p1 :pid) :state)
|
||||
"waiting")
|
||||
(er-proc-set! (get p1 :pid) :trap-exit true)
|
||||
(er-rt-test
|
||||
"proc trap-exit"
|
||||
(er-proc-field (get p1 :pid) :trap-exit)
|
||||
true)
|
||||
|
||||
;; ── fresh scheduler ends in clean state ───────────────────────
|
||||
(er-sched-init!)
|
||||
(er-rt-test
|
||||
"sched init resets count"
|
||||
(er-sched-process-count)
|
||||
0)
|
||||
(er-rt-test
|
||||
"sched init resets queue"
|
||||
(er-sched-runnable-count)
|
||||
0)
|
||||
(er-rt-test
|
||||
"sched init resets current"
|
||||
(er-sched-current-pid)
|
||||
nil)
|
||||
|
||||
(define
|
||||
er-rt-test-summary
|
||||
(str "runtime " er-rt-test-pass "/" er-rt-test-count))
|
||||
1913
lib/erlang/transpile.sx
Normal file
1913
lib/erlang/transpile.sx
Normal file
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user