erlang: register/whereis, Phase 5 complete (+12 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:
@@ -149,6 +149,7 @@
|
||||
:next-ref 0
|
||||
:current nil
|
||||
:processes {}
|
||||
:registered {}
|
||||
:runnable (er-q-new)})))
|
||||
|
||||
(define er-sched (fn () (nth er-scheduler 0)))
|
||||
@@ -324,6 +325,104 @@
|
||||
er-bif-is-reference
|
||||
(fn (vs) (er-bool (er-ref? (er-bif-arg1 vs "is_reference")))))
|
||||
|
||||
;; ── name registry ─────────────────────────────────────────────
|
||||
(define er-registered (fn () (get (er-sched) :registered)))
|
||||
|
||||
(define
|
||||
er-bif-register
|
||||
(fn
|
||||
(vs)
|
||||
(if
|
||||
(not (= (len vs) 2))
|
||||
(error "Erlang: register/2: arity")
|
||||
(let
|
||||
((name (nth vs 0)) (pid (nth vs 1)))
|
||||
(cond
|
||||
(not (er-atom? name))
|
||||
(raise (er-mk-error-marker (er-mk-atom "badarg")))
|
||||
(not (er-pid? pid))
|
||||
(raise (er-mk-error-marker (er-mk-atom "badarg")))
|
||||
(not (er-proc-exists? pid))
|
||||
(raise (er-mk-error-marker (er-mk-atom "badarg")))
|
||||
(dict-has? (er-registered) (get name :name))
|
||||
(raise (er-mk-error-marker (er-mk-atom "badarg")))
|
||||
:else (do
|
||||
(dict-set! (er-registered) (get name :name) pid)
|
||||
(er-mk-atom "true")))))))
|
||||
|
||||
(define
|
||||
er-bif-unregister
|
||||
(fn
|
||||
(vs)
|
||||
(let
|
||||
((name (er-bif-arg1 vs "unregister")))
|
||||
(cond
|
||||
(not (er-atom? name))
|
||||
(raise (er-mk-error-marker (er-mk-atom "badarg")))
|
||||
(not (dict-has? (er-registered) (get name :name)))
|
||||
(raise (er-mk-error-marker (er-mk-atom "badarg")))
|
||||
:else (do
|
||||
(dict-delete! (er-registered) (get name :name))
|
||||
(er-mk-atom "true"))))))
|
||||
|
||||
(define
|
||||
er-bif-whereis
|
||||
(fn
|
||||
(vs)
|
||||
(let
|
||||
((name (er-bif-arg1 vs "whereis")))
|
||||
(cond
|
||||
(not (er-atom? name))
|
||||
(raise (er-mk-error-marker (er-mk-atom "badarg")))
|
||||
(dict-has? (er-registered) (get name :name))
|
||||
(get (er-registered) (get name :name))
|
||||
:else (er-mk-atom "undefined")))))
|
||||
|
||||
(define
|
||||
er-bif-registered
|
||||
(fn
|
||||
(vs)
|
||||
(if
|
||||
(not (= (len vs) 0))
|
||||
(error "Erlang: registered/0: arity")
|
||||
(let
|
||||
((ks (keys (er-registered))) (out (er-mk-nil)))
|
||||
(for-each
|
||||
(fn
|
||||
(i)
|
||||
(let
|
||||
((k (nth ks (- (- (len ks) 1) i))))
|
||||
(set! out (er-mk-cons (er-mk-atom k) out))))
|
||||
(range 0 (len ks)))
|
||||
out))))
|
||||
|
||||
;; Find the registered name for a pid, if any. Returns string or nil.
|
||||
(define
|
||||
er-find-registration
|
||||
(fn
|
||||
(pid)
|
||||
(let
|
||||
((reg (er-registered)) (ks (keys reg)) (found (list nil)))
|
||||
(for-each
|
||||
(fn
|
||||
(i)
|
||||
(when
|
||||
(= (nth found 0) nil)
|
||||
(let
|
||||
((k (nth ks i)))
|
||||
(when (er-pid-equal? (get reg k) pid) (set-nth! found 0 k)))))
|
||||
(range 0 (len ks)))
|
||||
(nth found 0))))
|
||||
|
||||
;; Drop pid from the registry (called on process death).
|
||||
(define
|
||||
er-unregister-pid!
|
||||
(fn
|
||||
(pid)
|
||||
(let
|
||||
((name (er-find-registration pid)))
|
||||
(when (not (= name nil)) (dict-delete! (er-registered) name)))))
|
||||
|
||||
(define
|
||||
er-bif-process-flag
|
||||
(fn
|
||||
@@ -643,12 +742,14 @@
|
||||
(er-proc-set! pid :exit-reason (get r :reason))
|
||||
(er-proc-set! pid :exit-result nil)
|
||||
(er-proc-set! pid :continuation nil)
|
||||
(er-unregister-pid! pid)
|
||||
(er-propagate-exit! pid (get r :reason)))
|
||||
:else (do
|
||||
(er-proc-set! pid :state "dead")
|
||||
(er-proc-set! pid :exit-reason (er-mk-atom "normal"))
|
||||
(er-proc-set! pid :exit-result r)
|
||||
(er-proc-set! pid :continuation nil)
|
||||
(er-unregister-pid! pid)
|
||||
(er-propagate-exit! pid (er-mk-atom "normal"))))))
|
||||
(er-sched-set-current! nil)))
|
||||
|
||||
|
||||
@@ -1,11 +1,11 @@
|
||||
{
|
||||
"language": "erlang",
|
||||
"total_pass": 432,
|
||||
"total": 432,
|
||||
"total_pass": 444,
|
||||
"total": 444,
|
||||
"suites": [
|
||||
{"name":"tokenize","pass":62,"total":62,"status":"ok"},
|
||||
{"name":"parse","pass":52,"total":52,"status":"ok"},
|
||||
{"name":"eval","pass":248,"total":248,"status":"ok"},
|
||||
{"name":"eval","pass":260,"total":260,"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: 432 / 432 tests passing**
|
||||
**Total: 444 / 444 tests passing**
|
||||
|
||||
| | Suite | Pass | Total |
|
||||
|---|---|---|---|
|
||||
| ✅ | tokenize | 62 | 62 |
|
||||
| ✅ | parse | 52 | 52 |
|
||||
| ✅ | eval | 248 | 248 |
|
||||
| ✅ | eval | 260 | 260 |
|
||||
| ✅ | runtime | 39 | 39 |
|
||||
| ✅ | ring | 4 | 4 |
|
||||
| ✅ | ping-pong | 4 | 4 |
|
||||
|
||||
@@ -843,6 +843,65 @@
|
||||
(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")
|
||||
|
||||
(define
|
||||
er-eval-test-summary
|
||||
(str "eval " er-eval-test-pass "/" er-eval-test-count))
|
||||
|
||||
@@ -597,6 +597,10 @@
|
||||
(= name "monitor") (er-bif-monitor vs)
|
||||
(= name "demonitor") (er-bif-demonitor vs)
|
||||
(= name "process_flag") (er-bif-process-flag vs)
|
||||
(= name "register") (er-bif-register vs)
|
||||
(= name "unregister") (er-bif-unregister vs)
|
||||
(= name "whereis") (er-bif-whereis vs)
|
||||
(= name "registered") (er-bif-registered 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
|
||||
@@ -966,6 +970,8 @@
|
||||
(reduce str "" out)))))
|
||||
|
||||
;; ── send: Pid ! Msg ──────────────────────────────────────────────
|
||||
;; Target may be a pid or a registered atom name. Atom resolution
|
||||
;; goes through the scheduler's `:registered` table.
|
||||
(define
|
||||
er-eval-send
|
||||
(fn
|
||||
@@ -973,18 +979,36 @@
|
||||
(let
|
||||
((to-val (er-eval-expr (get node :to) env))
|
||||
(msg-val (er-eval-expr (get node :msg) env)))
|
||||
(if
|
||||
(not (er-pid? to-val))
|
||||
(error "Erlang: '!': target is not a pid")
|
||||
(do
|
||||
(let
|
||||
((pid (er-resolve-send-target to-val)))
|
||||
(when
|
||||
(er-proc-exists? pid)
|
||||
(er-proc-mailbox-push! pid msg-val)
|
||||
(when
|
||||
(er-proc-exists? to-val)
|
||||
(er-proc-mailbox-push! to-val msg-val)
|
||||
(when
|
||||
(= (er-proc-field to-val :state) "waiting")
|
||||
(er-proc-set! to-val :state "runnable")
|
||||
(er-sched-enqueue! to-val)))
|
||||
msg-val)))))
|
||||
(= (er-proc-field pid :state) "waiting")
|
||||
(er-proc-set! pid :state "runnable")
|
||||
(er-sched-enqueue! pid)))
|
||||
msg-val))))
|
||||
|
||||
(define
|
||||
er-resolve-send-target
|
||||
(fn
|
||||
(v)
|
||||
(cond
|
||||
(er-pid? v) v
|
||||
(er-atom? v)
|
||||
(let
|
||||
((name (get v :name)))
|
||||
(if
|
||||
(dict-has? (er-registered) name)
|
||||
(get (er-registered) name)
|
||||
(raise
|
||||
(er-mk-error-marker
|
||||
(er-mk-tuple
|
||||
(list (er-mk-atom "badarg") v))))))
|
||||
:else (raise
|
||||
(er-mk-error-marker
|
||||
(er-mk-tuple (list (er-mk-atom "badarg") v)))))))
|
||||
|
||||
;; ── receive (selective, delimited-continuation suspension) ──────
|
||||
(define
|
||||
|
||||
Reference in New Issue
Block a user