coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

erlang: code:purge/1 + code:soft_purge/1 (+10 eval tests)

Browse Source
This commit is contained in:
giles
2026-05-14 19:02:24 +00:00
parent 89a6b30501
commit cd45ebcc7a
5 changed files with 129 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
lib/erlang/scoreboard.json
View File

@@ -1,11 +1,11 @@
{
"language": "erlang",
"total_pass": 551,
"total": 551,
"total_pass": 561,
"total": 561,
"suites": [
{"name":"tokenize","pass":62,"total":62,"status":"ok"},
{"name":"parse","pass":52,"total":52,"status":"ok"},
{"name":"eval","pass":354,"total":354,"status":"ok"},
{"name":"eval","pass":364,"total":364,"status":"ok"},
{"name":"runtime","pass":52,"total":52,"status":"ok"},
{"name":"ring","pass":4,"total":4,"status":"ok"},
{"name":"ping-pong","pass":4,"total":4,"status":"ok"},

4
lib/erlang/scoreboard.md
View File

@@ -1,12 +1,12 @@
# Erlang-on-SX Scoreboard
**Total: 551 / 551 tests passing**
**Total: 561 / 561 tests passing**
| | Suite | Pass | Total |
|---|---|---|---|
| ✅ | tokenize | 62 | 62 |
| ✅ | parse | 52 | 52 |
| ✅ | eval | 354 | 354 |
| ✅ | eval | 364 | 364 |
| ✅ | runtime | 52 | 52 |
| ✅ | ring | 4 | 4 |
| ✅ | ping-pong | 4 | 4 |

52
lib/erlang/tests/eval.sx
View File

@@ -1157,6 +1157,58 @@
(nm (ev "element(2, code:load_binary(\"cl1\", \"x.erl\", \"-module(cl1). f() -> 0.\"))"))
"badarg")
;; ── Phase 7: code:purge/1 + code:soft_purge/1 ───────────────────
(er-modules-reset!)
;; purge unknown module → false
(er-eval-test "code:purge unknown"
(nm (ev "code:purge(nope)")) "false")
;; load, then purge without old version → false (nothing to purge)
(er-eval-test "code:purge no old"
(nm (ev "code:load_binary(pg1, \"pg1\", \"-module(pg1). v() -> 1.\"), code:purge(pg1)"))
"false")
;; load v1, load v2 (creates :old), purge with no live procs → true
(er-eval-test "code:purge after reload"
(nm (ev "code:load_binary(pg2, \"pg2\", \"-module(pg2). v() -> 1.\"), code:load_binary(pg2, \"pg2\", \"-module(pg2). v() -> 2.\"), code:purge(pg2)"))
"true")
;; idempotent: purging again returns false (already purged)
(er-eval-test "code:purge twice"
(nm (ev "code:load_binary(pg3, \"pg3\", \"-module(pg3). v() -> 1.\"), code:load_binary(pg3, \"pg3\", \"-module(pg3). v() -> 2.\"), code:purge(pg3), code:purge(pg3)"))
"false")
;; purge returns true whenever an :old slot exists, regardless of process tracking
;; (proper "kill lingering" semantics requires spawn/3 which is still stubbed)
(er-eval-test "code:purge with old slot present"
(nm (ev "code:load_binary(pg4, \"pg4\", \"-module(pg4). loop() -> receive stop -> ok end.\"),
Pid = spawn(fun () -> pg4:loop() end),
code:load_binary(pg4, \"pg4\", \"-module(pg4). loop() -> receive stop -> done end.\"),
code:purge(pg4)"))
"true")
;; soft_purge unknown → true (nothing to purge)
(er-eval-test "code:soft_purge unknown"
(nm (ev "code:soft_purge(nope)")) "true")
;; soft_purge with no old version → true
(er-eval-test "code:soft_purge no old"
(nm (ev "code:load_binary(sp1, \"sp1\", \"-module(sp1). v() -> 1.\"), code:soft_purge(sp1)"))
"true")
;; soft_purge with old + no lingering procs → true (clears :old)
(er-eval-test "code:soft_purge clean"
(nm (ev "code:load_binary(sp2, \"sp2\", \"-module(sp2). v() -> 1.\"), code:load_binary(sp2, \"sp2\", \"-module(sp2). v() -> 2.\"), code:soft_purge(sp2)"))
"true")
;; non-atom Mod is badarg (raise)
(er-eval-test "code:purge badarg"
(nm (ev "try code:purge(\"str\") catch error:badarg -> ok end")) "ok")
(er-eval-test "code:soft_purge badarg"
(nm (ev "try code:soft_purge(123) catch error:badarg -> ok end")) "ok")
(define
er-eval-test-summary
(str "eval " er-eval-test-pass "/" er-eval-test-count))

69
lib/erlang/transpile.sx
View File

@@ -1967,11 +1967,80 @@
:else
(er-mk-tuple (list (er-mk-atom "module") mod-arg))))))))))
(define er-procs-on-env
(fn (target-env)
(let ((all-keys (keys (er-sched-processes)))
(matches (list)))
(for-each
(fn (i)
(let ((proc (get (er-sched-processes) (nth all-keys i))))
(let ((init-fun (get proc :initial-fun)))
(when (and (not (= init-fun nil))
(er-fun? init-fun)
(= (get init-fun :env) target-env)
(not (= (get proc :state) "dead")))
(append! matches (get proc :pid))))))
(range 0 (len all-keys)))
matches)))
(define er-bif-code-purge
(fn (vs)
(let ((mod-arg (nth vs 0)))
(cond
(not (er-atom? mod-arg))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else
(let ((registry (er-modules-get)) (mod-name (get mod-arg :name)))
(cond
(not (dict-has? registry mod-name)) (er-mk-atom "false")
:else
(let ((slot (get registry mod-name)))
(cond
(= (er-module-old-env slot) nil) (er-mk-atom "false")
:else
(let ((procs (er-procs-on-env (er-module-old-env slot))))
(for-each
(fn (i) (er-cascade-exit! (nth procs i) (er-mk-atom "killed")))
(range 0 (len procs)))
(dict-set! registry mod-name
(er-mk-module-slot (er-module-current-env slot) nil
(er-module-version slot)))
(er-mk-atom "true"))))))))))
(define er-bif-code-soft-purge
(fn (vs)
(let ((mod-arg (nth vs 0)))
(cond
(not (er-atom? mod-arg))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else
(let ((registry (er-modules-get)) (mod-name (get mod-arg :name)))
(cond
(not (dict-has? registry mod-name)) (er-mk-atom "true")
:else
(let ((slot (get registry mod-name)))
(cond
(= (er-module-old-env slot) nil) (er-mk-atom "true")
:else
(let ((procs (er-procs-on-env (er-module-old-env slot))))
(cond
(> (len procs) 0) (er-mk-atom "false")
:else
(do
(dict-set! registry mod-name
(er-mk-module-slot (er-module-current-env slot) nil
(er-module-version slot)))
(er-mk-atom "true"))))))))))))
(define er-apply-code-bif
(fn (name vs)
(cond
(and (= name "load_binary") (= (len vs) 3))
(er-bif-code-load-binary vs)
(and (= name "purge") (= (len vs) 1))
(er-bif-code-purge vs)
(and (= name "soft_purge") (= (len vs) 1))
(er-bif-code-soft-purge vs)
:else (error
(str "Erlang: undefined function 'code:" name "/" (len vs) "'")))))