giles
a8cfd84f18
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
1049 lines
43 KiB
Plaintext
1049 lines
43 KiB
Plaintext
;; Erlang evaluator tests — sequential expressions.
|
|
|
|
(define er-eval-test-count 0)
|
|
(define er-eval-test-pass 0)
|
|
(define er-eval-test-fails (list))
|
|
|
|
(define
|
|
eev-deep=
|
|
(fn
|
|
(a b)
|
|
(cond
|
|
(and (= (type-of a) "dict") (= (type-of b) "dict"))
|
|
(let
|
|
((ka (sort (keys a))) (kb (sort (keys b))))
|
|
(and (= ka kb) (every? (fn (k) (eev-deep= (get a k) (get b k))) ka)))
|
|
(and (= (type-of a) "list") (= (type-of b) "list"))
|
|
(and
|
|
(= (len a) (len b))
|
|
(every? (fn (i) (eev-deep= (nth a i) (nth b i))) (range 0 (len a))))
|
|
:else (= a b))))
|
|
|
|
(define
|
|
er-eval-test
|
|
(fn
|
|
(name actual expected)
|
|
(set! er-eval-test-count (+ er-eval-test-count 1))
|
|
(if
|
|
(eev-deep= actual expected)
|
|
(set! er-eval-test-pass (+ er-eval-test-pass 1))
|
|
(append! er-eval-test-fails {:actual actual :expected expected :name name}))))
|
|
|
|
(define ev erlang-eval-ast)
|
|
(define nm (fn (v) (get v :name)))
|
|
|
|
;; ── literals ──────────────────────────────────────────────────────
|
|
(er-eval-test "int" (ev "42") 42)
|
|
(er-eval-test "zero" (ev "0") 0)
|
|
(er-eval-test "float" (ev "3.14") 3.14)
|
|
(er-eval-test "string" (ev "\"hi\"") "hi")
|
|
(er-eval-test "atom" (nm (ev "ok")) "ok")
|
|
(er-eval-test "atom true" (nm (ev "true")) "true")
|
|
(er-eval-test "atom false" (nm (ev "false")) "false")
|
|
|
|
;; ── arithmetic ────────────────────────────────────────────────────
|
|
(er-eval-test "add" (ev "1 + 2") 3)
|
|
(er-eval-test "sub" (ev "5 - 3") 2)
|
|
(er-eval-test "mul" (ev "4 * 3") 12)
|
|
(er-eval-test "div-real" (ev "10 / 4") 2.5)
|
|
(er-eval-test "div-int" (ev "10 div 3") 3)
|
|
(er-eval-test "rem" (ev "10 rem 3") 1)
|
|
(er-eval-test "div-neg" (ev "-10 div 3") -3)
|
|
(er-eval-test "precedence" (ev "1 + 2 * 3") 7)
|
|
(er-eval-test "parens" (ev "(1 + 2) * 3") 9)
|
|
(er-eval-test "unary-neg" (ev "-(1 + 2)") -3)
|
|
(er-eval-test "unary-neg int" (ev "-7") -7)
|
|
|
|
;; ── comparison ────────────────────────────────────────────────────
|
|
(er-eval-test "lt true" (nm (ev "1 < 2")) "true")
|
|
(er-eval-test "gt false" (nm (ev "1 > 2")) "false")
|
|
(er-eval-test "le equal" (nm (ev "2 =< 2")) "true")
|
|
(er-eval-test "ge equal" (nm (ev "2 >= 2")) "true")
|
|
(er-eval-test "eq" (nm (ev "2 == 2")) "true")
|
|
(er-eval-test "neq" (nm (ev "1 /= 2")) "true")
|
|
(er-eval-test "exact-eq same" (nm (ev "1 =:= 1")) "true")
|
|
(er-eval-test "exact-neq int" (nm (ev "1 =:= 2")) "false")
|
|
(er-eval-test "=/= true" (nm (ev "1 =/= 2")) "true")
|
|
(er-eval-test "atom-eq" (nm (ev "ok == ok")) "true")
|
|
(er-eval-test "atom-neq" (nm (ev "ok == error")) "false")
|
|
|
|
;; ── logical ───────────────────────────────────────────────────────
|
|
(er-eval-test "and tt" (nm (ev "true and true")) "true")
|
|
(er-eval-test "and tf" (nm (ev "true and false")) "false")
|
|
(er-eval-test "or tf" (nm (ev "true or false")) "true")
|
|
(er-eval-test
|
|
"andalso short"
|
|
(nm (ev "false andalso Neverref"))
|
|
"false")
|
|
(er-eval-test
|
|
"orelse short"
|
|
(nm (ev "true orelse Neverref"))
|
|
"true")
|
|
(er-eval-test "not true" (nm (ev "not true")) "false")
|
|
(er-eval-test "not false" (nm (ev "not false")) "true")
|
|
|
|
;; ── tuples & lists ────────────────────────────────────────────────
|
|
(er-eval-test "tuple tag" (get (ev "{1, 2, 3}") :tag) "tuple")
|
|
(er-eval-test "tuple len" (len (get (ev "{1, 2, 3}") :elements)) 3)
|
|
(er-eval-test "tuple elem" (nth (get (ev "{10, 20}") :elements) 1) 20)
|
|
(er-eval-test "empty tuple" (len (get (ev "{}") :elements)) 0)
|
|
(er-eval-test "nested tuple"
|
|
(nm (nth (get (ev "{ok, error}") :elements) 0)) "ok")
|
|
(er-eval-test "nil list" (get (ev "[]") :tag) "nil")
|
|
(er-eval-test "list head" (get (ev "[1, 2, 3]") :head) 1)
|
|
(er-eval-test
|
|
"list tail tail head"
|
|
(get (get (get (ev "[1, 2, 3]") :tail) :tail) :head)
|
|
3)
|
|
|
|
;; ── list ops ──────────────────────────────────────────────────────
|
|
(er-eval-test "++ head" (get (ev "[1, 2] ++ [3]") :head) 1)
|
|
(er-eval-test "++ last"
|
|
(get (get (get (ev "[1, 2] ++ [3]") :tail) :tail) :head) 3)
|
|
|
|
;; ── block ─────────────────────────────────────────────────────────
|
|
(er-eval-test "block last wins" (ev "begin 1, 2, 3 end") 3)
|
|
(er-eval-test "bare body" (ev "1, 2, 99") 99)
|
|
|
|
;; ── match + var ───────────────────────────────────────────────────
|
|
(er-eval-test "match bind-and-use" (ev "X = 5, X + 1") 6)
|
|
(er-eval-test "match sequential" (ev "X = 1, Y = 2, X + Y") 3)
|
|
(er-eval-test
|
|
"rebind equal ok"
|
|
(ev "X = 5, X = 5, X") 5)
|
|
|
|
;; ── if ────────────────────────────────────────────────────────────
|
|
(er-eval-test "if picks first" (ev "if true -> 1; true -> 2 end") 1)
|
|
(er-eval-test
|
|
"if picks second"
|
|
(nm (ev "if 1 > 2 -> bad; true -> good end"))
|
|
"good")
|
|
(er-eval-test
|
|
"if with guard"
|
|
(ev "X = 5, if X > 0 -> 1; true -> 0 end")
|
|
1)
|
|
|
|
;; ── pattern matching ─────────────────────────────────────────────
|
|
(er-eval-test "match atom literal" (nm (ev "ok = ok, done")) "done")
|
|
(er-eval-test "match int literal" (ev "5 = 5, 42") 42)
|
|
(er-eval-test "match tuple bind"
|
|
(ev "{ok, V} = {ok, 99}, V") 99)
|
|
(er-eval-test "match tuple nested"
|
|
(ev "{A, {B, C}} = {1, {2, 3}}, A + B + C") 6)
|
|
(er-eval-test "match cons head"
|
|
(ev "[H|T] = [1, 2, 3], H") 1)
|
|
(er-eval-test "match cons tail head"
|
|
(ev "[_, H|_] = [1, 2, 3], H") 2)
|
|
(er-eval-test "match nil"
|
|
(ev "[] = [], 7") 7)
|
|
(er-eval-test "match wildcard always"
|
|
(ev "_ = 42, 7") 7)
|
|
(er-eval-test "match var reuse equal"
|
|
(ev "X = 5, X = 5, X") 5)
|
|
|
|
;; ── case ─────────────────────────────────────────────────────────
|
|
(er-eval-test "case bind" (ev "case 5 of N -> N end") 5)
|
|
(er-eval-test "case tuple"
|
|
(ev "case {ok, 42} of {ok, V} -> V end") 42)
|
|
(er-eval-test "case cons"
|
|
(ev "case [1, 2, 3] of [H|_] -> H end") 1)
|
|
(er-eval-test "case fallthrough"
|
|
(ev "case error of ok -> 1; error -> 2 end") 2)
|
|
(er-eval-test "case wildcard"
|
|
(nm (ev "case x of ok -> ok; _ -> err end"))
|
|
"err")
|
|
(er-eval-test "case guard"
|
|
(ev "case 5 of N when N > 0 -> pos; _ -> neg end")
|
|
(er-mk-atom "pos"))
|
|
(er-eval-test "case guard fallthrough"
|
|
(ev "case -3 of N when N > 0 -> pos; _ -> neg end")
|
|
(er-mk-atom "neg"))
|
|
(er-eval-test "case bound re-match"
|
|
(ev "X = 5, case 5 of X -> same; _ -> diff end")
|
|
(er-mk-atom "same"))
|
|
(er-eval-test "case bound re-match fail"
|
|
(ev "X = 5, case 6 of X -> same; _ -> diff end")
|
|
(er-mk-atom "diff"))
|
|
(er-eval-test "case nested tuple"
|
|
(ev "case {ok, {value, 42}} of {ok, {value, V}} -> V end")
|
|
42)
|
|
(er-eval-test "case multi-clause"
|
|
(ev "case 2 of 1 -> one; 2 -> two; _ -> other end")
|
|
(er-mk-atom "two"))
|
|
(er-eval-test "case leak binding"
|
|
(ev "case {ok, 7} of {ok, X} -> X end + 1")
|
|
8)
|
|
|
|
;; ── guard BIFs (is_*) ────────────────────────────────────────────
|
|
(er-eval-test "is_integer 42" (nm (ev "is_integer(42)")) "true")
|
|
(er-eval-test "is_integer ok" (nm (ev "is_integer(ok)")) "false")
|
|
(er-eval-test "is_atom ok" (nm (ev "is_atom(ok)")) "true")
|
|
(er-eval-test "is_atom int" (nm (ev "is_atom(42)")) "false")
|
|
(er-eval-test "is_list cons" (nm (ev "is_list([1,2])")) "true")
|
|
(er-eval-test "is_list nil" (nm (ev "is_list([])")) "true")
|
|
(er-eval-test "is_list tuple" (nm (ev "is_list({1,2})")) "false")
|
|
(er-eval-test "is_tuple tuple" (nm (ev "is_tuple({ok,1})")) "true")
|
|
(er-eval-test "is_tuple list" (nm (ev "is_tuple([1])")) "false")
|
|
(er-eval-test "is_number int" (nm (ev "is_number(42)")) "true")
|
|
(er-eval-test "is_number atom" (nm (ev "is_number(foo)")) "false")
|
|
(er-eval-test "is_boolean true" (nm (ev "is_boolean(true)")) "true")
|
|
(er-eval-test "is_boolean false" (nm (ev "is_boolean(false)")) "true")
|
|
(er-eval-test "is_boolean atom" (nm (ev "is_boolean(foo)")) "false")
|
|
|
|
;; ── guard BIFs wired into case / if ─────────────────────────────
|
|
(er-eval-test "guard is_integer pick"
|
|
(nm (ev "case 5 of N when is_integer(N) -> int; _ -> other end"))
|
|
"int")
|
|
(er-eval-test "guard is_integer reject"
|
|
(nm (ev "case foo of N when is_integer(N) -> int; _ -> other end"))
|
|
"other")
|
|
(er-eval-test "guard is_atom"
|
|
(nm (ev "case foo of X when is_atom(X) -> atom_yes; _ -> no end"))
|
|
"atom_yes")
|
|
(er-eval-test "guard conjunction"
|
|
(nm (ev "case 5 of N when is_integer(N), N > 0 -> pos; _ -> np end"))
|
|
"pos")
|
|
(er-eval-test "guard disjunction (if)"
|
|
(nm (ev "X = foo, if is_integer(X); is_atom(X) -> yes; true -> no end"))
|
|
"yes")
|
|
(er-eval-test "guard arith"
|
|
(nm (ev "case 3 of N when N * 2 > 5 -> big; _ -> small end"))
|
|
"big")
|
|
|
|
;; ── BIFs: list + tuple ──────────────────────────────────────────
|
|
(er-eval-test "length empty" (ev "length([])") 0)
|
|
(er-eval-test "length 3" (ev "length([a, b, c])") 3)
|
|
(er-eval-test "length cons chain" (ev "length([1 | [2 | [3 | []]]])") 3)
|
|
(er-eval-test "hd" (ev "hd([10, 20, 30])") 10)
|
|
(er-eval-test "hd atom"
|
|
(nm (ev "hd([ok, err])")) "ok")
|
|
(er-eval-test "tl head"
|
|
(get (ev "tl([1, 2, 3])") :head) 2)
|
|
(er-eval-test "tl of single" (get (ev "tl([1])") :tag) "nil")
|
|
(er-eval-test "element 1" (nm (ev "element(1, {ok, value})")) "ok")
|
|
(er-eval-test "element 2" (ev "element(2, {ok, 42})") 42)
|
|
(er-eval-test "element 3"
|
|
(nm (ev "element(3, {a, b, c, d})")) "c")
|
|
(er-eval-test "tuple_size 2" (ev "tuple_size({a, b})") 2)
|
|
(er-eval-test "tuple_size 0" (ev "tuple_size({})") 0)
|
|
|
|
;; ── BIFs: atom / list conversions ───────────────────────────────
|
|
(er-eval-test "atom_to_list" (ev "atom_to_list(hello)") "hello")
|
|
(er-eval-test "list_to_atom roundtrip"
|
|
(nm (ev "list_to_atom(atom_to_list(foo))")) "foo")
|
|
(er-eval-test "list_to_atom fresh"
|
|
(nm (ev "list_to_atom(\"bar\")")) "bar")
|
|
|
|
;; ── lists module ────────────────────────────────────────────────
|
|
(er-eval-test "lists:reverse empty"
|
|
(get (ev "lists:reverse([])") :tag) "nil")
|
|
(er-eval-test "lists:reverse 3"
|
|
(ev "hd(lists:reverse([1, 2, 3]))") 3)
|
|
(er-eval-test "lists:reverse full"
|
|
(ev "lists:foldl(fun (X, Acc) -> Acc + X end, 0, lists:reverse([1, 2, 3]))") 6)
|
|
|
|
;; ── funs + lists:map / lists:foldl ──────────────────────────────
|
|
(er-eval-test "fun call" (ev "F = fun (X) -> X + 1 end, F(10)") 11)
|
|
(er-eval-test "fun two-arg"
|
|
(ev "F = fun (X, Y) -> X * Y end, F(3, 4)") 12)
|
|
(er-eval-test "fun closure"
|
|
(ev "N = 100, F = fun (X) -> X + N end, F(5)") 105)
|
|
(er-eval-test "fun clauses"
|
|
(ev "F = fun (0) -> zero; (N) -> N end, element(1, {F(0), F(7)})")
|
|
(er-mk-atom "zero"))
|
|
(er-eval-test "fun multi-clause second"
|
|
(ev "F = fun (0) -> 0; (N) -> N * 2 end, F(5)") 10)
|
|
(er-eval-test "lists:map empty"
|
|
(get (ev "lists:map(fun (X) -> X end, [])") :tag) "nil")
|
|
(er-eval-test "lists:map double"
|
|
(ev "hd(lists:map(fun (X) -> X * 2 end, [1, 2, 3]))") 2)
|
|
(er-eval-test "lists:map sum-length"
|
|
(ev "length(lists:map(fun (X) -> X end, [a, b, c, d]))") 4)
|
|
(er-eval-test "lists:foldl sum"
|
|
(ev "lists:foldl(fun (X, Acc) -> X + Acc end, 0, [1, 2, 3, 4, 5])") 15)
|
|
(er-eval-test "lists:foldl product"
|
|
(ev "lists:foldl(fun (X, Acc) -> X * Acc end, 1, [1, 2, 3, 4])") 24)
|
|
(er-eval-test "lists:foldl as reverse"
|
|
(ev "hd(lists:foldl(fun (X, Acc) -> [X | Acc] end, [], [1, 2, 3]))") 3)
|
|
|
|
;; ── io:format (via capture buffer) ──────────────────────────────
|
|
(er-eval-test "io:format plain"
|
|
(do (er-io-flush!) (ev "io:format(\"hello~n\")") (er-io-buffer-content))
|
|
"hello\n")
|
|
(er-eval-test "io:format args"
|
|
(do (er-io-flush!) (ev "io:format(\"x=~p y=~p~n\", [42, hello])") (er-io-buffer-content))
|
|
"x=42 y=hello\n")
|
|
(er-eval-test "io:format returns ok"
|
|
(nm (do (er-io-flush!) (ev "io:format(\"~n\")"))) "ok")
|
|
(er-eval-test "io:format tuple"
|
|
(do (er-io-flush!) (ev "io:format(\"~p\", [{ok, 1}])") (er-io-buffer-content))
|
|
"{ok,1}")
|
|
(er-eval-test "io:format list"
|
|
(do (er-io-flush!) (ev "io:format(\"~p\", [[1,2,3]])") (er-io-buffer-content))
|
|
"[1,2,3]")
|
|
(er-eval-test "io:format escape"
|
|
(do (er-io-flush!) (ev "io:format(\"50~~\")") (er-io-buffer-content))
|
|
"50~")
|
|
|
|
;; ── processes: self/0, spawn/1, is_pid ──────────────────────────
|
|
(er-eval-test "self tag"
|
|
(get (ev "self()") :tag) "pid")
|
|
(er-eval-test "is_pid self"
|
|
(nm (ev "is_pid(self())")) "true")
|
|
(er-eval-test "is_pid number"
|
|
(nm (ev "is_pid(42)")) "false")
|
|
(er-eval-test "is_pid atom"
|
|
(nm (ev "is_pid(ok)")) "false")
|
|
(er-eval-test "self equals self"
|
|
(nm (ev "Pid = self(), Pid =:= Pid")) "true")
|
|
(er-eval-test "self =:= self expr"
|
|
(nm (ev "self() == self()")) "true")
|
|
(er-eval-test "spawn returns pid"
|
|
(get (ev "spawn(fun () -> ok end)") :tag) "pid")
|
|
(er-eval-test "is_pid spawn"
|
|
(nm (ev "is_pid(spawn(fun () -> ok end))")) "true")
|
|
(er-eval-test "spawn new pid distinct"
|
|
(nm (ev "P1 = self(), P2 = spawn(fun () -> ok end), P1 =:= P2"))
|
|
"false")
|
|
(er-eval-test "two spawns distinct"
|
|
(nm (ev "P1 = spawn(fun () -> ok end), P2 = spawn(fun () -> ok end), P1 =:= P2"))
|
|
"false")
|
|
(er-eval-test "spawn then drain io"
|
|
(do
|
|
(er-io-flush!)
|
|
(ev "spawn(fun () -> io:format(\"child~n\") end), io:format(\"parent~n\")")
|
|
(er-io-buffer-content))
|
|
"parent\nchild\n")
|
|
(er-eval-test "multiple spawn ordering"
|
|
(do
|
|
(er-io-flush!)
|
|
(ev "spawn(fun () -> io:format(\"a~n\") end), spawn(fun () -> io:format(\"b~n\") end), io:format(\"main~n\")")
|
|
(er-io-buffer-content))
|
|
"main\na\nb\n")
|
|
(er-eval-test "child self is its own pid"
|
|
(do
|
|
(er-io-flush!)
|
|
(ev "P = spawn(fun () -> io:format(\"~p\", [is_pid(self())]) end), io:format(\"~p;\", [is_pid(P)])")
|
|
(er-io-buffer-content))
|
|
"true;true")
|
|
|
|
;; ── ! (send) + receive ──────────────────────────────────────────
|
|
(er-eval-test "self-send + receive"
|
|
(nm (ev "Me = self(), Me ! hello, receive Msg -> Msg end")) "hello")
|
|
(er-eval-test "send returns msg"
|
|
(nm (ev "Me = self(), Msg = Me ! ok, Me ! x, receive _ -> Msg end")) "ok")
|
|
(er-eval-test "receive int"
|
|
(ev "Me = self(), Me ! 42, receive N -> N + 1 end") 43)
|
|
(er-eval-test "receive with pattern"
|
|
(ev "Me = self(), Me ! {ok, 7}, receive {ok, V} -> V * 2 end") 14)
|
|
(er-eval-test "receive with guard"
|
|
(ev "Me = self(), Me ! 5, receive N when N > 0 -> positive end")
|
|
(er-mk-atom "positive"))
|
|
(er-eval-test "receive skips non-match"
|
|
(nm (ev "Me = self(), Me ! wrong, Me ! right, receive right -> ok end"))
|
|
"ok")
|
|
(er-eval-test "receive selective leaves others"
|
|
(nm (ev "Me = self(), Me ! a, Me ! b, receive b -> got_b end"))
|
|
"got_b")
|
|
(er-eval-test "two receives consume both"
|
|
(ev "Me = self(), Me ! 1, Me ! 2, X = receive A -> A end, Y = receive B -> B end, X + Y") 3)
|
|
|
|
;; ── spawn + send + receive (real process communication) ─────────
|
|
(er-eval-test "spawn sends back"
|
|
(nm
|
|
(ev "Me = self(), spawn(fun () -> Me ! pong end), receive pong -> got_pong end"))
|
|
"got_pong")
|
|
(er-eval-test "ping-pong"
|
|
(do
|
|
(er-io-flush!)
|
|
(ev "Me = self(), Child = spawn(fun () -> receive {ping, From} -> From ! pong end end), Child ! {ping, Me}, receive pong -> io:format(\"pong~n\") end")
|
|
(er-io-buffer-content))
|
|
"pong\n")
|
|
(er-eval-test "echo server"
|
|
(ev "Me = self(), Echo = spawn(fun () -> receive {From, Msg} -> From ! Msg end end), Echo ! {Me, 99}, receive R -> R end") 99)
|
|
|
|
;; ── receive with multiple clauses ────────────────────────────────
|
|
(er-eval-test "receive multi-clause"
|
|
(nm (ev "Me = self(), Me ! foo, receive ok -> a; foo -> b; bar -> c end"))
|
|
"b")
|
|
(er-eval-test "receive nested tuple"
|
|
(ev "Me = self(), Me ! {result, {ok, 42}}, receive {result, {ok, V}} -> V end") 42)
|
|
|
|
;; ── receive ... after ... ───────────────────────────────────────
|
|
(er-eval-test "after 0 empty mailbox"
|
|
(nm (ev "receive _ -> got after 0 -> timeout end"))
|
|
"timeout")
|
|
(er-eval-test "after 0 match wins"
|
|
(nm (ev "Me = self(), Me ! ok, receive ok -> got after 0 -> timeout end"))
|
|
"got")
|
|
(er-eval-test "after 0 non-match fires timeout"
|
|
(nm (ev "Me = self(), Me ! wrong, receive right -> got after 0 -> timeout end"))
|
|
"timeout")
|
|
(er-eval-test "after 0 leaves non-match"
|
|
(ev "Me = self(), Me ! wrong, receive right -> got after 0 -> to end, receive X -> X end")
|
|
(er-mk-atom "wrong"))
|
|
(er-eval-test "after Ms no sender — timeout fires"
|
|
(nm (ev "receive _ -> got after 100 -> timed_out end"))
|
|
"timed_out")
|
|
(er-eval-test "after Ms with sender — match wins"
|
|
(nm (ev "Me = self(), spawn(fun () -> Me ! hi end), receive hi -> got after 100 -> to end"))
|
|
"got")
|
|
(er-eval-test "after Ms computed"
|
|
(nm (ev "Ms = 50, receive _ -> got after Ms -> done end"))
|
|
"done")
|
|
(er-eval-test "after 0 body side effect"
|
|
(do (er-io-flush!)
|
|
(ev "receive _ -> ok after 0 -> io:format(\"to~n\") end")
|
|
(er-io-buffer-content))
|
|
"to\n")
|
|
(er-eval-test "after zero poll selective"
|
|
(ev "Me = self(), Me ! first, Me ! second, X = receive second -> got_second after 0 -> to end, Y = receive first -> got_first after 0 -> to end, {X, Y}")
|
|
(er-mk-tuple (list (er-mk-atom "got_second") (er-mk-atom "got_first"))))
|
|
|
|
;; ── exit/1 + process termination ─────────────────────────────────
|
|
(er-eval-test "exit normal returns nil" (ev "exit(normal)") nil)
|
|
(er-eval-test "exit normal reason"
|
|
(do (ev "exit(normal)") (nm (er-last-main-exit-reason))) "normal")
|
|
(er-eval-test "exit bye reason"
|
|
(do (ev "exit(bye)") (nm (er-last-main-exit-reason))) "bye")
|
|
(er-eval-test "exit tuple reason"
|
|
(do (ev "exit({shutdown, crash})")
|
|
(get (er-last-main-exit-reason) :tag))
|
|
"tuple")
|
|
(er-eval-test "normal completion reason"
|
|
(do (ev "42") (nm (er-last-main-exit-reason))) "normal")
|
|
(er-eval-test "exit aborts subsequent"
|
|
(do (er-io-flush!) (ev "io:format(\"a~n\"), exit(bye), io:format(\"b~n\")") (er-io-buffer-content))
|
|
"a\n")
|
|
(er-eval-test "child exit doesn't kill parent"
|
|
(do
|
|
(er-io-flush!)
|
|
(ev "spawn(fun () -> io:format(\"before~n\"), exit(quit), io:format(\"after~n\") end), io:format(\"main~n\")")
|
|
(er-io-buffer-content))
|
|
"main\nbefore\n")
|
|
(er-eval-test "child exit reason recorded on child"
|
|
(do
|
|
(er-io-flush!)
|
|
(ev "P = spawn(fun () -> exit(child_bye) end), io:format(\"~p\", [is_pid(P)])")
|
|
(er-io-buffer-content))
|
|
"true")
|
|
(er-eval-test "exit inside fn chain"
|
|
(do (ev "F = fun () -> exit(from_fn) end, F()")
|
|
(nm (er-last-main-exit-reason)))
|
|
"from_fn")
|
|
|
|
;; ── refs / link / monitor ──────────────────────────────────────
|
|
(er-eval-test "make_ref tag"
|
|
(get (ev "make_ref()") :tag) "ref")
|
|
(er-eval-test "is_reference fresh"
|
|
(nm (ev "R = make_ref(), is_reference(R)")) "true")
|
|
(er-eval-test "is_reference pid"
|
|
(nm (ev "is_reference(self())")) "false")
|
|
(er-eval-test "is_reference number"
|
|
(nm (ev "is_reference(42)")) "false")
|
|
(er-eval-test "make_ref distinct"
|
|
(nm (ev "R1 = make_ref(), R2 = make_ref(), R1 =:= R2")) "false")
|
|
(er-eval-test "make_ref same id eq"
|
|
(nm (ev "R = make_ref(), R =:= R")) "true")
|
|
|
|
(er-eval-test "link returns true"
|
|
(nm (ev "P = spawn(fun () -> ok end), link(P)")) "true")
|
|
(er-eval-test "self link returns true"
|
|
(nm (ev "link(self())")) "true")
|
|
(er-eval-test "unlink returns true"
|
|
(nm (ev "P = spawn(fun () -> ok end), link(P), unlink(P)")) "true")
|
|
(er-eval-test "unlink without link"
|
|
(nm (ev "P = spawn(fun () -> ok end), unlink(P)")) "true")
|
|
|
|
(er-eval-test "monitor returns ref"
|
|
(get (ev "P = spawn(fun () -> ok end), monitor(process, P)") :tag)
|
|
"ref")
|
|
(er-eval-test "monitor refs distinct"
|
|
(nm (ev "P = spawn(fun () -> ok end), R1 = monitor(process, P), R2 = monitor(process, P), R1 =:= R2"))
|
|
"false")
|
|
(er-eval-test "demonitor returns true"
|
|
(nm (ev "P = spawn(fun () -> ok end), R = monitor(process, P), demonitor(R)"))
|
|
"true")
|
|
|
|
;; Bidirectional link recorded on both sides.
|
|
(er-eval-test "link bidirectional"
|
|
(do
|
|
(ev "P = spawn(fun () -> receive forever -> ok end end), link(P)")
|
|
;; After eval, check links on main + child via accessors.
|
|
(and
|
|
(= (len (er-proc-field (er-mk-pid 0) :links)) 1)
|
|
(= (len (er-proc-field (er-mk-pid 1) :links)) 1)))
|
|
true)
|
|
|
|
;; unlink clears both sides.
|
|
(er-eval-test "unlink clears both"
|
|
(do
|
|
(ev "P = spawn(fun () -> receive forever -> ok end end), link(P), unlink(P)")
|
|
(and
|
|
(= (len (er-proc-field (er-mk-pid 0) :links)) 0)
|
|
(= (len (er-proc-field (er-mk-pid 1) :links)) 0)))
|
|
true)
|
|
|
|
;; monitor adds entries to both lists.
|
|
(er-eval-test "monitor records both sides"
|
|
(do
|
|
(ev "P = spawn(fun () -> receive forever -> ok end end), monitor(process, P)")
|
|
(and
|
|
(= (len (er-proc-field (er-mk-pid 0) :monitors)) 1)
|
|
(= (len (er-proc-field (er-mk-pid 1) :monitored-by)) 1)))
|
|
true)
|
|
|
|
;; demonitor clears both lists.
|
|
(er-eval-test "demonitor clears both"
|
|
(do
|
|
(ev "P = spawn(fun () -> receive forever -> ok end end), R = monitor(process, P), demonitor(R)")
|
|
(and
|
|
(= (len (er-proc-field (er-mk-pid 0) :monitors)) 0)
|
|
(= (len (er-proc-field (er-mk-pid 1) :monitored-by)) 0)))
|
|
true)
|
|
|
|
;; ── exit-signal propagation + trap_exit ────────────────────────
|
|
(er-eval-test "process_flag default false"
|
|
(nm (ev "process_flag(trap_exit, true)")) "false")
|
|
(er-eval-test "process_flag returns prev"
|
|
(nm (ev "process_flag(trap_exit, true), process_flag(trap_exit, false)"))
|
|
"true")
|
|
|
|
;; Monitor fires on normal exit.
|
|
(er-eval-test "monitor DOWN normal"
|
|
(nm (ev "P = spawn(fun () -> ok end), monitor(process, P), receive {'DOWN', _, process, _, R} -> R end"))
|
|
"normal")
|
|
|
|
;; Monitor fires on abnormal exit.
|
|
(er-eval-test "monitor DOWN abnormal"
|
|
(nm (ev "P = spawn(fun () -> exit(boom) end), monitor(process, P), receive {'DOWN', _, process, _, R} -> R end"))
|
|
"boom")
|
|
|
|
;; Monitor's ref appears in DOWN message.
|
|
(er-eval-test "monitor DOWN ref matches"
|
|
(nm (ev "P = spawn(fun () -> exit(bye) end), Ref = monitor(process, P), receive {'DOWN', Ref, process, _, _} -> ok_match end"))
|
|
"ok_match")
|
|
|
|
;; Two monitors -> both fire.
|
|
(er-eval-test "two monitors both fire"
|
|
(ev "P = spawn(fun () -> exit(crash) end), monitor(process, P), monitor(process, P), receive {'DOWN', _, _, _, _} -> ok end, receive {'DOWN', _, _, _, _} -> 2 end")
|
|
2)
|
|
|
|
;; trap_exit + link + abnormal exit -> {'EXIT', From, Reason} message.
|
|
(er-eval-test "trap_exit catches abnormal"
|
|
(nm (ev "process_flag(trap_exit, true), P = spawn(fun () -> exit(boom) end), link(P), receive {'EXIT', _, R} -> R end"))
|
|
"boom")
|
|
|
|
;; trap_exit + link + normal exit -> {'EXIT', From, normal}.
|
|
(er-eval-test "trap_exit catches normal"
|
|
(nm (ev "process_flag(trap_exit, true), P = spawn(fun () -> ok end), link(P), receive {'EXIT', _, R} -> R end"))
|
|
"normal")
|
|
|
|
;; Cascade exit: A links B, B dies abnormally, A dies with same reason.
|
|
(er-eval-test "cascade reason"
|
|
(do
|
|
(ev "A = spawn(fun () -> B = spawn(fun () -> exit(crash) end), link(B), receive forever -> ok end end), receive after 0 -> ok end")
|
|
(nm (er-proc-field (er-mk-pid 1) :exit-reason)))
|
|
"crash")
|
|
|
|
;; Normal exit doesn't cascade (without trap_exit) — A's body returns
|
|
;; "survived" via the `after` clause and A dies normally.
|
|
(er-eval-test "normal exit no cascade"
|
|
(do
|
|
(ev "A = spawn(fun () -> B = spawn(fun () -> ok end), link(B), receive {'EXIT', _, _} -> got_exit after 50 -> survived end end), receive after 0 -> ok end")
|
|
(list
|
|
(nm (er-proc-field (er-mk-pid 1) :exit-reason))
|
|
(nm (er-proc-field (er-mk-pid 1) :exit-result))))
|
|
(list "normal" "survived"))
|
|
|
|
;; Monitor without trap_exit: monitored proc abnormal doesn't kill the monitor.
|
|
(er-eval-test "monitor doesn't cascade"
|
|
(nm (ev "P = spawn(fun () -> exit(boom) end), monitor(process, P), receive {'DOWN', _, _, _, _} -> alive end"))
|
|
"alive")
|
|
|
|
;; ── try / catch / of / after ─────────────────────────────────
|
|
(er-eval-test "try plain"
|
|
(ev "try 1 + 2 catch _ -> oops end") 3)
|
|
|
|
(er-eval-test "try throw caught"
|
|
(nm (ev "try throw(boom) catch throw:X -> X end")) "boom")
|
|
(er-eval-test "try error caught"
|
|
(nm (ev "try error(crash) catch error:X -> X end")) "crash")
|
|
(er-eval-test "try exit caught"
|
|
(nm (ev "try exit(quit) catch exit:X -> X end")) "quit")
|
|
|
|
(er-eval-test "default class is throw"
|
|
(nm (ev "try throw(bye) catch X -> X end")) "bye")
|
|
(er-eval-test "default class doesn't catch error"
|
|
(do
|
|
(ev "P = spawn(fun () -> try error(crash) catch X -> X end end), receive after 0 -> ok end")
|
|
(nm (er-proc-field (er-mk-pid 1) :exit-reason)))
|
|
"crash")
|
|
|
|
;; of clauses
|
|
(er-eval-test "try of single"
|
|
(ev "try 42 of N -> N * 2 catch _ -> 0 end") 84)
|
|
(er-eval-test "try of multi"
|
|
(nm (ev "try ok of ok -> matched; _ -> nope catch _ -> oops end"))
|
|
"matched")
|
|
(er-eval-test "try of fallthrough"
|
|
(nm (ev "try x of ok -> a; error -> b; _ -> default catch _ -> oops end"))
|
|
"default")
|
|
(er-eval-test "try of with guard"
|
|
(nm (ev "try 5 of N when N > 0 -> pos; _ -> nonneg catch _ -> oops end"))
|
|
"pos")
|
|
|
|
;; after clause
|
|
(er-eval-test "after on success"
|
|
(do (er-io-flush!)
|
|
(ev "try 7 after io:format(\"a\") end")
|
|
(er-io-buffer-content))
|
|
"a")
|
|
(er-eval-test "after on caught"
|
|
(do (er-io-flush!)
|
|
(ev "try throw(b) catch throw:_ -> caught after io:format(\"x\") end")
|
|
(er-io-buffer-content))
|
|
"x")
|
|
(er-eval-test "after returns body value"
|
|
(ev "try 99 after 0 end") 99)
|
|
(er-eval-test "try preserves catch result"
|
|
(nm (ev "try throw(x) catch throw:_ -> recovered after 0 end"))
|
|
"recovered")
|
|
|
|
;; nested try
|
|
(er-eval-test "try nested catch outer"
|
|
(nm (ev "try (try throw(inner) catch error:_ -> bad end) catch throw:X -> X end"))
|
|
"inner")
|
|
(er-eval-test "try nested catch inner"
|
|
(nm (ev "try (try throw(inner) catch throw:X -> X end) catch _ -> outer end"))
|
|
"inner")
|
|
|
|
;; class re-raise on no-match
|
|
(er-eval-test "throw without catch-throw escapes"
|
|
(do
|
|
(ev "P = spawn(fun () -> try throw(bye) catch error:_ -> nope end end), receive after 0 -> ok end")
|
|
(let ((reason (er-proc-field (er-mk-pid 1) :exit-reason)))
|
|
(and (er-tuple? reason) (nm (nth (get reason :elements) 0)))))
|
|
"nocatch")
|
|
|
|
;; multi-clause catch
|
|
(er-eval-test "multi-clause catch picks throw"
|
|
(nm (ev "try throw(a) catch error:X -> e; throw:X -> t; exit:X -> x end"))
|
|
"t")
|
|
(er-eval-test "multi-clause catch picks exit"
|
|
(nm (ev "try exit(a) catch error:X -> e; throw:X -> t; exit:X -> x end"))
|
|
"x")
|
|
|
|
;; ── modules: -module(M)., M:F/N cross-module calls ─────────────
|
|
(er-eval-test "load module returns name"
|
|
(nm (erlang-load-module "-module(m1). foo() -> 42."))
|
|
"m1")
|
|
|
|
(er-eval-test "cross-module zero-arity"
|
|
(do
|
|
(erlang-load-module "-module(m2). val() -> 7.")
|
|
(ev "m2:val()"))
|
|
7)
|
|
|
|
(er-eval-test "cross-module n-ary"
|
|
(do
|
|
(erlang-load-module "-module(m3). add(X, Y) -> X + Y.")
|
|
(ev "m3:add(3, 4)"))
|
|
7)
|
|
|
|
(er-eval-test "module recursive fn"
|
|
(do
|
|
(erlang-load-module "-module(m4). fact(0) -> 1; fact(N) -> N * fact(N-1).")
|
|
(ev "m4:fact(6)"))
|
|
720)
|
|
|
|
(er-eval-test "module sibling calls"
|
|
(do
|
|
(erlang-load-module "-module(m5). a(X) -> b(X) + 1. b(X) -> X * 10.")
|
|
(ev "m5:a(5)"))
|
|
51)
|
|
|
|
(er-eval-test "module multi-arity"
|
|
(do
|
|
(erlang-load-module
|
|
"-module(m6). f(X) -> X. f(X, Y) -> X + Y. f(X, Y, Z) -> X * Y + Z.")
|
|
(ev "{m6:f(1), m6:f(2, 3), m6:f(2, 3, 4)}"))
|
|
(er-mk-tuple (list 1 5 10)))
|
|
|
|
(er-eval-test "module pattern match clauses"
|
|
(do
|
|
(erlang-load-module
|
|
"-module(m7). check(0) -> zero; check(N) when N > 0 -> pos; check(_) -> neg.")
|
|
(nm (ev "m7:check(-3)")))
|
|
"neg")
|
|
|
|
(er-eval-test "cross-module call within module"
|
|
(do
|
|
(erlang-load-module "-module(util1). dbl(X) -> X * 2.")
|
|
(erlang-load-module "-module(util2). quad(X) -> util1:dbl(X) * 2.")
|
|
(ev "util2:quad(5)"))
|
|
20)
|
|
|
|
(er-eval-test "module undefined fn raises"
|
|
(do
|
|
(erlang-load-module "-module(m8). foo() -> 1.")
|
|
(er-io-flush!)
|
|
(ev "P = spawn(fun () -> m8:bar() end), receive after 0 -> ok end")
|
|
(let ((reason (er-proc-field (er-mk-pid 1) :exit-reason)))
|
|
(and (er-tuple? reason) (nm (nth (get reason :elements) 0)))))
|
|
"undef")
|
|
|
|
(er-eval-test "module function used in spawn"
|
|
(do
|
|
(erlang-load-module "-module(m9). work(P) -> P ! done.")
|
|
(ev "Me = self(), spawn(fun () -> m9:work(Me) end), receive done -> ok end"))
|
|
(er-mk-atom "ok"))
|
|
|
|
;; ── gen_server (OTP-lite) ──────────────────────────────────────
|
|
(do
|
|
(er-load-gen-server!)
|
|
(erlang-load-module
|
|
"-module(ctr).
|
|
init(N) -> {ok, N}.
|
|
handle_call(get, _F, S) -> {reply, S, S}.
|
|
handle_call({set, V}, _F, _S) -> {reply, ok, V}.
|
|
handle_call({add, K}, _F, S) -> {reply, S + K, S + K}.
|
|
handle_cast(inc, S) -> {noreply, S + 1}.
|
|
handle_cast(dec, S) -> {noreply, S - 1}.
|
|
handle_cast({add, K}, S) -> {noreply, S + K}.
|
|
handle_info(_M, S) -> {noreply, S}.")
|
|
nil)
|
|
|
|
(er-eval-test "gen_server start + call get"
|
|
(ev "P = gen_server:start_link(ctr, 10), gen_server:call(P, get)")
|
|
10)
|
|
|
|
(er-eval-test "gen_server cast then call"
|
|
(ev "P = gen_server:start_link(ctr, 0), gen_server:cast(P, inc), gen_server:cast(P, inc), gen_server:cast(P, inc), gen_server:call(P, get)")
|
|
3)
|
|
|
|
(er-eval-test "gen_server call returns reply"
|
|
(ev "P = gen_server:start_link(ctr, 5), gen_server:call(P, {add, 7})")
|
|
12)
|
|
|
|
(er-eval-test "gen_server state mutation"
|
|
(ev "P = gen_server:start_link(ctr, 5), gen_server:call(P, {set, 99}), gen_server:call(P, get)")
|
|
99)
|
|
|
|
(er-eval-test "gen_server stop returns ok"
|
|
(nm (ev "P = gen_server:start_link(ctr, 0), gen_server:stop(P)"))
|
|
"ok")
|
|
|
|
(er-eval-test "gen_server cast returns ok immediately"
|
|
(nm (ev "P = gen_server:start_link(ctr, 0), gen_server:cast(P, inc)"))
|
|
"ok")
|
|
|
|
(er-eval-test "gen_server multi-state mutations"
|
|
(ev "P = gen_server:start_link(ctr, 0), gen_server:cast(P, {add, 100}), gen_server:cast(P, dec), gen_server:cast(P, dec), gen_server:call(P, get)")
|
|
98)
|
|
|
|
;; Stack server — exercises a different state shape.
|
|
(do
|
|
(erlang-load-module
|
|
"-module(stk).
|
|
init(_) -> {ok, []}.
|
|
handle_call(pop, _F, []) -> {reply, empty, []};
|
|
handle_call(pop, _F, [H | T]) -> {reply, {ok, H}, T};
|
|
handle_call(peek, _F, []) -> {reply, empty, []};
|
|
handle_call(peek, _F, [H | T]) -> {reply, {ok, H}, [H | T]};
|
|
handle_call(size, _F, S) -> {reply, length(S), S}.
|
|
handle_cast({push, V}, S) -> {noreply, [V | S]}.
|
|
handle_info(_M, S) -> {noreply, S}.")
|
|
nil)
|
|
|
|
(er-eval-test "stack push/pop"
|
|
(ev "P = gen_server:start_link(stk, ignored), gen_server:cast(P, {push, 1}), gen_server:cast(P, {push, 2}), gen_server:cast(P, {push, 3}), gen_server:call(P, size)")
|
|
3)
|
|
|
|
(er-eval-test "stack lifo"
|
|
(ev "P = gen_server:start_link(stk, ignored), gen_server:cast(P, {push, 1}), gen_server:cast(P, {push, 2}), gen_server:cast(P, {push, 3}), {ok, V} = gen_server:call(P, pop), V")
|
|
3)
|
|
|
|
(er-eval-test "stack empty pop"
|
|
(nm (ev "P = gen_server:start_link(stk, ignored), gen_server:call(P, pop)"))
|
|
"empty")
|
|
|
|
;; ── supervisor (one-for-one) ────────────────────────────────────
|
|
(do
|
|
(er-load-supervisor!)
|
|
(erlang-load-module
|
|
"-module(echoer).
|
|
start() -> spawn(fun () -> echoer:loop() end).
|
|
loop() ->
|
|
receive
|
|
{ping, From} -> From ! pong, echoer:loop();
|
|
die -> exit(killed)
|
|
end.")
|
|
nil)
|
|
|
|
(er-eval-test "sup starts children"
|
|
(do
|
|
(erlang-load-module
|
|
"-module(sup1). init(_) -> {ok, [{w1, fun () -> echoer:start() end}]}.")
|
|
(ev "Sup = supervisor:start_link(sup1, []), receive after 5 -> ok end, length(supervisor:which_children(Sup))"))
|
|
1)
|
|
|
|
(er-eval-test "sup multiple children"
|
|
(do
|
|
(erlang-load-module
|
|
"-module(sup2).
|
|
init(_) -> {ok, [
|
|
{w1, fun () -> echoer:start() end},
|
|
{w2, fun () -> echoer:start() end},
|
|
{w3, fun () -> echoer:start() end}
|
|
]}.")
|
|
(ev "Sup = supervisor:start_link(sup2, []), receive after 5 -> ok end, length(supervisor:which_children(Sup))"))
|
|
3)
|
|
|
|
(er-eval-test "sup child responds"
|
|
(do
|
|
(erlang-load-module
|
|
"-module(sup3). init(_) -> {ok, [{w1, fun () -> echoer:start() end}]}.")
|
|
(nm (ev "Sup = supervisor:start_link(sup3, []), receive after 5 -> ok end, [{_, _, P1} | _] = supervisor:which_children(Sup), P1 ! {ping, self()}, receive pong -> ok end")))
|
|
"ok")
|
|
|
|
(er-eval-test "sup restarts on exit"
|
|
(do
|
|
(erlang-load-module
|
|
"-module(sup4). init(_) -> {ok, [{w1, fun () -> echoer:start() end}]}.")
|
|
(nm
|
|
(ev "Sup = supervisor:start_link(sup4, []), receive after 5 -> ok end, [{_, _, P1} | _] = supervisor:which_children(Sup), P1 ! die, receive after 5 -> ok end, [{_, _, P2} | _] = supervisor:which_children(Sup), P1 =/= P2")))
|
|
"true")
|
|
|
|
(er-eval-test "sup restarted child works"
|
|
(do
|
|
(erlang-load-module
|
|
"-module(sup5). init(_) -> {ok, [{w1, fun () -> echoer:start() end}]}.")
|
|
(nm
|
|
(ev "Sup = supervisor:start_link(sup5, []), receive after 5 -> ok end, [{_, _, P1} | _] = supervisor:which_children(Sup), P1 ! die, receive after 5 -> ok end, [{_, _, P2} | _] = supervisor:which_children(Sup), P2 ! {ping, self()}, receive pong -> ok end")))
|
|
"ok")
|
|
|
|
(er-eval-test "sup one-for-one isolates failures"
|
|
(do
|
|
(erlang-load-module
|
|
"-module(sup6).
|
|
init(_) -> {ok, [
|
|
{w1, fun () -> echoer:start() end},
|
|
{w2, fun () -> echoer:start() end}
|
|
]}.")
|
|
(nm
|
|
(ev "Sup = supervisor:start_link(sup6, []), receive after 5 -> ok end, [{_, _, P1}, {_, _, P2}] = supervisor:which_children(Sup), P1 ! die, receive after 5 -> ok end, [{_, _, _NewP1}, {_, _, P2Again}] = supervisor:which_children(Sup), P2 =:= P2Again")))
|
|
"true")
|
|
|
|
(er-eval-test "sup stop"
|
|
(nm
|
|
(do
|
|
(erlang-load-module
|
|
"-module(sup7). init(_) -> {ok, [{w1, fun () -> echoer:start() end}]}.")
|
|
(ev "Sup = supervisor:start_link(sup7, []), receive after 5 -> ok end, supervisor:stop(Sup)")))
|
|
"ok")
|
|
|
|
;; ── register / whereis / registered ─────────────────────────────
|
|
(er-eval-test "register returns true"
|
|
(nm (ev "register(me, self())")) "true")
|
|
|
|
(er-eval-test "whereis registered self"
|
|
(nm (ev "register(me, self()), Pid = whereis(me), if Pid =:= self() -> matched; true -> nope end"))
|
|
"matched")
|
|
|
|
(er-eval-test "whereis undefined"
|
|
(nm (ev "whereis(no_such)")) "undefined")
|
|
|
|
(er-eval-test "send via registered atom"
|
|
(nm (ev "register(srv, self()), srv ! hello, receive M -> M end"))
|
|
"hello")
|
|
|
|
(er-eval-test "send to spawned registered"
|
|
(nm
|
|
(ev "Me = self(), P = spawn(fun () -> receive {From, X} -> From ! {got, X} end end), register(child, P), child ! {Me, payload}, receive {got, V} -> V end"))
|
|
"payload")
|
|
|
|
(er-eval-test "unregister returns true"
|
|
(nm (ev "register(a, self()), unregister(a)")) "true")
|
|
|
|
(er-eval-test "unregister then whereis"
|
|
(nm (ev "register(a, self()), unregister(a), whereis(a)"))
|
|
"undefined")
|
|
|
|
(er-eval-test "registered/0 lists names"
|
|
(ev "register(a, self()), register(b, self()), register(c, self()), length(registered())")
|
|
3)
|
|
|
|
(er-eval-test "register dup raises"
|
|
(do
|
|
(ev "P = spawn(fun () -> register(d, self()), register(d, self()) end), receive after 0 -> ok end")
|
|
(let ((reason (er-proc-field (er-mk-pid 1) :exit-reason)))
|
|
(nm (if (er-atom? reason) reason (nth (get reason :elements) 0)))))
|
|
"badarg")
|
|
|
|
(er-eval-test "unregister missing raises"
|
|
(do
|
|
(ev "P = spawn(fun () -> unregister(no_such) end), receive after 0 -> ok end")
|
|
(let ((reason (er-proc-field (er-mk-pid 1) :exit-reason)))
|
|
(nm (if (er-atom? reason) reason (nth (get reason :elements) 0)))))
|
|
"badarg")
|
|
|
|
(er-eval-test "dead process auto-unregisters"
|
|
;; Register a child while it's alive (still in receive). Send `die` so
|
|
;; it exits. After scheduler drains, whereis should return undefined.
|
|
(nm
|
|
(ev "P = spawn(fun () -> receive die -> exit(killed) end end), register(was_alive, P), P ! die, receive after 5 -> ok end, whereis(was_alive)"))
|
|
"undefined")
|
|
|
|
(er-eval-test "send to unregistered name raises"
|
|
(do
|
|
(ev "P = spawn(fun () -> no_such ! oops end), receive after 0 -> ok end")
|
|
(let ((reason (er-proc-field (er-mk-pid 1) :exit-reason)))
|
|
(nm (if (er-atom? reason) reason (nth (get reason :elements) 0)))))
|
|
"badarg")
|
|
|
|
;; ── list comprehensions ───────────────────────────────────────
|
|
(er-eval-test "lc map double"
|
|
(ev "hd([X * 2 || X <- [1, 2, 3]])") 2)
|
|
(er-eval-test "lc map sum"
|
|
(ev "lists:foldl(fun (X, Acc) -> X + Acc end, 0, [X * 2 || X <- [1, 2, 3]])")
|
|
12)
|
|
(er-eval-test "lc length"
|
|
(ev "length([X || X <- [1, 2, 3, 4, 5]])") 5)
|
|
(er-eval-test "lc filter sum"
|
|
(ev "lists:foldl(fun (X, Acc) -> X + Acc end, 0, [X || X <- [1, 2, 3, 4, 5], X rem 2 =:= 0])")
|
|
6)
|
|
(er-eval-test "lc filter only"
|
|
(ev "length([X || X <- [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], X > 5])")
|
|
5)
|
|
(er-eval-test "lc empty source"
|
|
(get (ev "[X || X <- []]") :tag) "nil")
|
|
(er-eval-test "lc all filtered"
|
|
(get (ev "[X || X <- [1, 2, 3], X > 100]") :tag) "nil")
|
|
(er-eval-test "lc cartesian length"
|
|
(ev "length([{X, Y} || X <- [1, 2, 3], Y <- [a, b]])")
|
|
6)
|
|
(er-eval-test "lc pattern match"
|
|
(ev "lists:foldl(fun (X, Acc) -> X + Acc end, 0, [V || {ok, V} <- [{ok, 1}, {error, x}, {ok, 2}, {ok, 3}]])")
|
|
6)
|
|
(er-eval-test "lc nested generators"
|
|
(ev "length([{X, Y} || X <- [1, 2, 3], Y <- [10, 20, 30], X + Y > 12])")
|
|
7)
|
|
(er-eval-test "lc squares"
|
|
(ev "lists:foldl(fun (X, Acc) -> X + Acc end, 0, [X*X || X <- [1, 2, 3, 4, 5]])")
|
|
55)
|
|
;; First {ok, X} tuple: head of [{ok,a}, {ok,b}] is {ok, a}.
|
|
(er-eval-test "lc tuple capture"
|
|
(nm (nth (get (get (ev "[{ok, X} || X <- [a, b]]") :head) :elements) 0))
|
|
"ok")
|
|
|
|
;; ── binary literals / patterns ────────────────────────────────
|
|
(er-eval-test "binary tag"
|
|
(get (ev "<<>>") :tag) "binary")
|
|
(er-eval-test "is_binary empty" (nm (ev "is_binary(<<>>)")) "true")
|
|
(er-eval-test "is_binary 3 bytes"
|
|
(nm (ev "is_binary(<<1, 2, 3>>)")) "true")
|
|
(er-eval-test "is_binary list" (nm (ev "is_binary([1, 2])")) "false")
|
|
(er-eval-test "byte_size 0" (ev "byte_size(<<>>)") 0)
|
|
(er-eval-test "byte_size 3" (ev "byte_size(<<1, 2, 3>>)") 3)
|
|
(er-eval-test "byte_size 16-bit" (ev "byte_size(<<256:16>>)") 2)
|
|
(er-eval-test "byte_size 32-bit" (ev "byte_size(<<999999:32>>)") 4)
|
|
|
|
;; Match
|
|
(er-eval-test "match single byte"
|
|
(ev "<<X>> = <<7>>, X") 7)
|
|
(er-eval-test "match X:8"
|
|
(ev "<<X:8>> = <<200>>, X") 200)
|
|
(er-eval-test "match 16-bit decode"
|
|
(ev "<<X:16>> = <<1, 0>>, X") 256)
|
|
(er-eval-test "match 16-bit hi byte"
|
|
(ev "<<X:16>> = <<2, 1>>, X") 513)
|
|
(er-eval-test "match A:8 B:16"
|
|
(ev "<<A:8, B:16>> = <<1, 0, 2>>, A + B") 3)
|
|
(er-eval-test "match three 8-bit"
|
|
(ev "<<A, B, C>> = <<1, 2, 3>>, A + B + C") 6)
|
|
|
|
;; Tail binary
|
|
(er-eval-test "tail rest size"
|
|
(ev "<<_:8, Rest/binary>> = <<1, 2, 3, 4>>, byte_size(Rest)") 3)
|
|
(er-eval-test "tail rest content"
|
|
(ev "<<_:8, Rest/binary>> = <<1, 2, 3, 4>>, <<X:8, _/binary>> = Rest, X") 2)
|
|
|
|
;; Match failure
|
|
(er-eval-test "size mismatch fails"
|
|
(do
|
|
(ev "P = spawn(fun () -> <<X:8, Y:8>> = <<1>>, ok end), receive after 0 -> ok end")
|
|
(let ((reason (er-proc-field (er-mk-pid 1) :exit-reason)))
|
|
(cond
|
|
(er-tuple? reason) (nm (nth (get reason :elements) 0))
|
|
(er-atom? reason) (get reason :name)
|
|
:else nil)))
|
|
"badmatch")
|
|
|
|
;; Equality
|
|
(er-eval-test "binary =:= self"
|
|
(nm (ev "B = <<1, 2, 3>>, B =:= B")) "true")
|
|
(er-eval-test "binary =:= same"
|
|
(nm (ev "<<1, 2>> =:= <<1, 2>>")) "true")
|
|
(er-eval-test "binary =/= different"
|
|
(nm (ev "<<1, 2>> =:= <<1, 3>>")) "false")
|
|
|
|
;; Construction with computed value
|
|
(er-eval-test "build with var"
|
|
(ev "X = 42, byte_size(<<X>>)") 1)
|
|
(er-eval-test "build with size var"
|
|
(ev "X = 7, byte_size(<<X:16>>)") 2)
|
|
|
|
;; ── ETS-lite ──────────────────────────────────────────────────
|
|
(er-eval-test "ets:new returns name"
|
|
(nm (ev "ets:new(t1, [set])")) "t1")
|
|
(er-eval-test "ets:insert returns true"
|
|
(nm (ev "T = ets:new(t2, [set]), ets:insert(T, {foo, 1})")) "true")
|
|
(er-eval-test "ets:lookup hit"
|
|
(ev "T = ets:new(t3, [set]), ets:insert(T, {foo, 42}), [{foo, V}] = ets:lookup(T, foo), V")
|
|
42)
|
|
(er-eval-test "ets:lookup miss returns []"
|
|
(get (ev "T = ets:new(t4, [set]), ets:lookup(T, no_such)") :tag) "nil")
|
|
(er-eval-test "ets:insert replaces (set semantics)"
|
|
(ev "T = ets:new(t5, [set]), ets:insert(T, {x, 1}), ets:insert(T, {x, 2}), ets:insert(T, {x, 3}), [{x, V}] = ets:lookup(T, x), V")
|
|
3)
|
|
(er-eval-test "ets:info size grows"
|
|
(ev "T = ets:new(t6, [set]), ets:insert(T, {a, 1}), ets:insert(T, {b, 2}), ets:insert(T, {c, 3}), ets:info(T, size)")
|
|
3)
|
|
(er-eval-test "ets:info size after delete"
|
|
(ev "T = ets:new(t7, [set]), ets:insert(T, {a, 1}), ets:insert(T, {b, 2}), ets:delete(T, a), ets:info(T, size)")
|
|
1)
|
|
(er-eval-test "ets:tab2list length"
|
|
(ev "T = ets:new(t8, [set]), ets:insert(T, {a, 1}), ets:insert(T, {b, 2}), ets:insert(T, {c, 3}), length(ets:tab2list(T))")
|
|
3)
|
|
(er-eval-test "ets:delete table returns true"
|
|
(nm (ev "T = ets:new(t9, [set]), ets:delete(T)")) "true")
|
|
(er-eval-test "ets:lookup after table delete"
|
|
(do
|
|
(ev "P = spawn(fun () -> T = ets:new(t10, [set]), ets:delete(T), ets:lookup(T, x) end), receive after 0 -> ok end")
|
|
(let ((reason (er-proc-field (er-mk-pid 1) :exit-reason)))
|
|
(cond
|
|
(er-atom? reason) (get reason :name)
|
|
:else (nm reason))))
|
|
"badarg")
|
|
|
|
;; Sum a column via lookup chain.
|
|
(er-eval-test "ets aggregate"
|
|
(ev "T = ets:new(t11, [set]), ets:insert(T, {a, 10}), ets:insert(T, {b, 20}), ets:insert(T, {c, 30}), [{a, A}] = ets:lookup(T, a), [{b, B}] = ets:lookup(T, b), [{c, C}] = ets:lookup(T, c), A + B + C")
|
|
60)
|
|
|
|
;; Tuple key (non-atom).
|
|
(er-eval-test "ets tuple key"
|
|
(nm
|
|
(ev "T = ets:new(t12, [set]), ets:insert(T, {{x, 1}, hello}), [{{x, 1}, V}] = ets:lookup(T, {x, 1}), V"))
|
|
"hello")
|
|
|
|
;; Tables are independent.
|
|
(er-eval-test "ets two tables independent"
|
|
(ev "T1 = ets:new(t13, [set]), T2 = ets:new(t14, [set]), ets:insert(T1, {x, 1}), ets:insert(T2, {x, 99}), [{x, A}] = ets:lookup(T1, x), [{x, B}] = ets:lookup(T2, x), A + B")
|
|
100)
|
|
|
|
(define
|
|
er-eval-test-summary
|
|
(str "eval " er-eval-test-pass "/" er-eval-test-count))
|