;; 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") (define er-eval-test-summary (str "eval " er-eval-test-pass "/" er-eval-test-count))