erlang: try/catch/of/after, Phase 4 complete (+19 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
This commit is contained in:
@@ -531,6 +531,30 @@
|
||||
er-mk-exit-marker
|
||||
(fn (reason) {:tag "er-exit-marker" :reason reason}))
|
||||
|
||||
(define
|
||||
er-mk-throw-marker
|
||||
(fn (reason) {:tag "er-throw-marker" :reason reason}))
|
||||
|
||||
(define
|
||||
er-mk-error-marker
|
||||
(fn (reason) {:tag "er-error-marker" :reason reason}))
|
||||
|
||||
(define
|
||||
er-thrown?
|
||||
(fn
|
||||
(v)
|
||||
(and
|
||||
(= (type-of v) "dict")
|
||||
(= (get v :tag) "er-throw-marker"))))
|
||||
|
||||
(define
|
||||
er-errored?
|
||||
(fn
|
||||
(v)
|
||||
(and
|
||||
(= (type-of v) "dict")
|
||||
(= (get v :tag) "er-error-marker"))))
|
||||
|
||||
(define
|
||||
er-sched-run-all!
|
||||
(fn
|
||||
@@ -592,7 +616,16 @@
|
||||
(guard
|
||||
(c
|
||||
((er-suspended? c) (set-nth! result-ref 0 c))
|
||||
((er-exited? c) (set-nth! result-ref 0 c)))
|
||||
((er-exited? c) (set-nth! result-ref 0 c))
|
||||
((er-thrown? c)
|
||||
(set-nth!
|
||||
result-ref
|
||||
0
|
||||
(er-mk-exit-marker
|
||||
(er-mk-tuple
|
||||
(list (er-mk-atom "nocatch") (get c :reason))))))
|
||||
((er-errored? c)
|
||||
(set-nth! result-ref 0 (er-mk-exit-marker (get c :reason)))))
|
||||
(set-nth!
|
||||
result-ref
|
||||
0
|
||||
|
||||
@@ -1,11 +1,11 @@
|
||||
{
|
||||
"language": "erlang",
|
||||
"total_pass": 386,
|
||||
"total": 386,
|
||||
"total_pass": 405,
|
||||
"total": 405,
|
||||
"suites": [
|
||||
{"name":"tokenize","pass":62,"total":62,"status":"ok"},
|
||||
{"name":"parse","pass":52,"total":52,"status":"ok"},
|
||||
{"name":"eval","pass":202,"total":202,"status":"ok"},
|
||||
{"name":"eval","pass":221,"total":221,"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"},
|
||||
|
||||
@@ -1,12 +1,12 @@
|
||||
# Erlang-on-SX Scoreboard
|
||||
|
||||
**Total: 386 / 386 tests passing**
|
||||
**Total: 405 / 405 tests passing**
|
||||
|
||||
| | Suite | Pass | Total |
|
||||
|---|---|---|---|
|
||||
| ✅ | tokenize | 62 | 62 |
|
||||
| ✅ | parse | 52 | 52 |
|
||||
| ✅ | eval | 202 | 202 |
|
||||
| ✅ | eval | 221 | 221 |
|
||||
| ✅ | runtime | 39 | 39 |
|
||||
| ✅ | ring | 4 | 4 |
|
||||
| ✅ | ping-pong | 4 | 4 |
|
||||
|
||||
@@ -561,6 +561,79 @@
|
||||
(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")
|
||||
|
||||
(define
|
||||
er-eval-test-summary
|
||||
(str "eval " er-eval-test-pass "/" er-eval-test-count))
|
||||
|
||||
@@ -122,6 +122,7 @@
|
||||
(= ty "fun") (er-eval-fun node env)
|
||||
(= ty "send") (er-eval-send node env)
|
||||
(= ty "receive") (er-eval-receive node env)
|
||||
(= ty "try") (er-eval-try node env)
|
||||
(= ty "match") (er-eval-match node env)
|
||||
:else (error (str "Erlang eval: unsupported node type '" ty "'"))))))
|
||||
|
||||
@@ -573,6 +574,8 @@
|
||||
(= name "monitor") (er-bif-monitor vs)
|
||||
(= name "demonitor") (er-bif-demonitor vs)
|
||||
(= name "process_flag") (er-bif-process-flag vs)
|
||||
(= name "throw") (raise (er-mk-throw-marker (er-bif-arg1 vs "throw")))
|
||||
(= name "error") (raise (er-mk-error-marker (er-bif-arg1 vs "error")))
|
||||
:else (error
|
||||
(str "Erlang: undefined function '" name "/" (len vs) "'")))))
|
||||
|
||||
@@ -1089,3 +1092,143 @@
|
||||
(do
|
||||
(er-env-restore! env snap)
|
||||
(er-try-receive-clauses clauses msg env (+ i 1))))))))
|
||||
|
||||
;; ── try/of/catch/after ────────────────────────────────────────────
|
||||
;; The outer guard captures any exception so the `after` body is
|
||||
;; guaranteed to run, then re-raises. The inner guard runs the
|
||||
;; expression body, optional `of` clauses on success, and `catch`
|
||||
;; clauses on a thrown/erred/exited condition. If no catch clause
|
||||
;; matches the raised class+pattern, the inner guard's clause
|
||||
;; re-raises by returning nothing (handled via re-raise marker).
|
||||
(define
|
||||
er-eval-try
|
||||
(fn
|
||||
(node env)
|
||||
(let
|
||||
((after-body (get node :after))
|
||||
(saved-exc (list nil))
|
||||
(result-ref (list nil)))
|
||||
(guard
|
||||
(c (:else (do (set-nth! saved-exc 0 c) nil)))
|
||||
(set-nth! result-ref 0 (er-eval-try-inner node env)))
|
||||
(when
|
||||
(> (len after-body) 0)
|
||||
(er-eval-body after-body env))
|
||||
(if
|
||||
(= (nth saved-exc 0) nil)
|
||||
(nth result-ref 0)
|
||||
(raise (nth saved-exc 0))))))
|
||||
|
||||
(define
|
||||
er-eval-try-inner
|
||||
(fn
|
||||
(node env)
|
||||
(let
|
||||
((catch-clauses (get node :catch-clauses))
|
||||
(of-clauses (get node :of-clauses))
|
||||
(caught-ref (list false))
|
||||
(result-ref (list nil))
|
||||
(re-raise-ref (list nil)))
|
||||
(guard
|
||||
(c
|
||||
((er-thrown? c)
|
||||
(er-eval-try-catch
|
||||
catch-clauses "throw" (get c :reason) env
|
||||
caught-ref result-ref re-raise-ref))
|
||||
((er-errored? c)
|
||||
(er-eval-try-catch
|
||||
catch-clauses "error" (get c :reason) env
|
||||
caught-ref result-ref re-raise-ref))
|
||||
((er-exited? c)
|
||||
(er-eval-try-catch
|
||||
catch-clauses "exit" (get c :reason) env
|
||||
caught-ref result-ref re-raise-ref)))
|
||||
(let
|
||||
((r (er-eval-body (get node :exprs) env)))
|
||||
(if
|
||||
(= (len of-clauses) 0)
|
||||
(set-nth! result-ref 0 r)
|
||||
(set-nth!
|
||||
result-ref
|
||||
0
|
||||
(er-eval-of-clauses of-clauses r env 0)))))
|
||||
(when (not (= (nth re-raise-ref 0) nil))
|
||||
(raise (nth re-raise-ref 0)))
|
||||
(nth result-ref 0))))
|
||||
|
||||
;; Try catch-clauses against (Class, Reason). If a clause matches,
|
||||
;; runs its body and writes to result-ref. If none match, queues a
|
||||
;; re-raise marker.
|
||||
(define
|
||||
er-eval-try-catch
|
||||
(fn
|
||||
(clauses class-name reason env caught-ref result-ref re-raise-ref)
|
||||
(er-eval-try-catch-iter
|
||||
clauses class-name reason env 0 caught-ref result-ref re-raise-ref)))
|
||||
|
||||
(define
|
||||
er-eval-try-catch-iter
|
||||
(fn
|
||||
(clauses class-name reason env i caught-ref result-ref re-raise-ref)
|
||||
(if
|
||||
(>= i (len clauses))
|
||||
(set-nth!
|
||||
re-raise-ref
|
||||
0
|
||||
(er-mk-class-marker class-name reason))
|
||||
(let
|
||||
((c (nth clauses i))
|
||||
(snap (er-env-copy env))
|
||||
(clause-class (get (get c :class) :value)))
|
||||
(cond
|
||||
(not (= clause-class class-name))
|
||||
(er-eval-try-catch-iter
|
||||
clauses class-name reason env (+ i 1)
|
||||
caught-ref result-ref re-raise-ref)
|
||||
:else
|
||||
(if
|
||||
(and
|
||||
(er-match! (get c :pattern) reason env)
|
||||
(er-eval-guards (get c :guards) env))
|
||||
(do
|
||||
(set-nth! caught-ref 0 true)
|
||||
(set-nth!
|
||||
result-ref
|
||||
0
|
||||
(er-eval-body (get c :body) env)))
|
||||
(do
|
||||
(er-env-restore! env snap)
|
||||
(er-eval-try-catch-iter
|
||||
clauses class-name reason env (+ i 1)
|
||||
caught-ref result-ref re-raise-ref))))))))
|
||||
|
||||
(define
|
||||
er-mk-class-marker
|
||||
(fn
|
||||
(class-name reason)
|
||||
(cond
|
||||
(= class-name "throw") (er-mk-throw-marker reason)
|
||||
(= class-name "error") (er-mk-error-marker reason)
|
||||
(= class-name "exit") (er-mk-exit-marker reason)
|
||||
:else (er-mk-error-marker reason))))
|
||||
|
||||
(define
|
||||
er-eval-of-clauses
|
||||
(fn
|
||||
(clauses subject env i)
|
||||
(if
|
||||
(>= i (len clauses))
|
||||
(raise
|
||||
(er-mk-error-marker
|
||||
(er-mk-tuple
|
||||
(list (er-mk-atom "try_clause") subject))))
|
||||
(let
|
||||
((c (nth clauses i)) (snap (er-env-copy env)))
|
||||
(if
|
||||
(and
|
||||
(er-match! (get c :pattern) subject env)
|
||||
(er-eval-guards (get c :guards) env))
|
||||
(er-eval-body (get c :body) env)
|
||||
(do
|
||||
(er-env-restore! env snap)
|
||||
(er-eval-of-clauses clauses subject env (+ i 1))))))))
|
||||
|
||||
Reference in New Issue
Block a user