giles
bc1a69925e
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
140 lines
4.7 KiB
Plaintext
140 lines
4.7 KiB
Plaintext
;; Erlang runtime tests — scheduler + process-record primitives.
|
|
|
|
(define er-rt-test-count 0)
|
|
(define er-rt-test-pass 0)
|
|
(define er-rt-test-fails (list))
|
|
|
|
(define
|
|
er-rt-test
|
|
(fn
|
|
(name actual expected)
|
|
(set! er-rt-test-count (+ er-rt-test-count 1))
|
|
(if
|
|
(= actual expected)
|
|
(set! er-rt-test-pass (+ er-rt-test-pass 1))
|
|
(append! er-rt-test-fails {:actual actual :expected expected :name name}))))
|
|
|
|
;; ── queue ─────────────────────────────────────────────────────────
|
|
(er-rt-test "queue empty len" (er-q-len (er-q-new)) 0)
|
|
(er-rt-test "queue empty?" (er-q-empty? (er-q-new)) true)
|
|
|
|
(define q1 (er-q-new))
|
|
(er-q-push! q1 "a")
|
|
(er-q-push! q1 "b")
|
|
(er-q-push! q1 "c")
|
|
(er-rt-test "queue push len" (er-q-len q1) 3)
|
|
(er-rt-test "queue empty? after push" (er-q-empty? q1) false)
|
|
(er-rt-test "queue peek" (er-q-peek q1) "a")
|
|
(er-rt-test "queue pop 1" (er-q-pop! q1) "a")
|
|
(er-rt-test "queue pop 2" (er-q-pop! q1) "b")
|
|
(er-rt-test "queue len after pops" (er-q-len q1) 1)
|
|
(er-rt-test "queue pop 3" (er-q-pop! q1) "c")
|
|
(er-rt-test "queue empty again" (er-q-empty? q1) true)
|
|
(er-rt-test "queue pop empty" (er-q-pop! q1) nil)
|
|
|
|
;; Queue FIFO under interleaved push/pop
|
|
(define q2 (er-q-new))
|
|
(er-q-push! q2 1)
|
|
(er-q-push! q2 2)
|
|
(er-q-pop! q2)
|
|
(er-q-push! q2 3)
|
|
(er-rt-test "queue interleave peek" (er-q-peek q2) 2)
|
|
(er-rt-test "queue to-list" (er-q-to-list q2) (list 2 3))
|
|
|
|
;; ── scheduler init ─────────────────────────────────────────────
|
|
(er-sched-init!)
|
|
(er-rt-test "sched process count 0" (er-sched-process-count) 0)
|
|
(er-rt-test "sched runnable count 0" (er-sched-runnable-count) 0)
|
|
(er-rt-test "sched current nil" (er-sched-current-pid) nil)
|
|
|
|
;; ── pid allocation ─────────────────────────────────────────────
|
|
(define pa (er-pid-new!))
|
|
(define pb (er-pid-new!))
|
|
(er-rt-test "pid tag" (get pa :tag) "pid")
|
|
(er-rt-test "pid ids distinct" (= (er-pid-id pa) (er-pid-id pb)) false)
|
|
(er-rt-test "pid? true" (er-pid? pa) true)
|
|
(er-rt-test "pid? false" (er-pid? 42) false)
|
|
(er-rt-test
|
|
"pid-equal same"
|
|
(er-pid-equal? pa (er-mk-pid (er-pid-id pa)))
|
|
true)
|
|
(er-rt-test "pid-equal diff" (er-pid-equal? pa pb) false)
|
|
|
|
;; ── process lifecycle ──────────────────────────────────────────
|
|
(er-sched-init!)
|
|
(define p1 (er-proc-new! {}))
|
|
(define p2 (er-proc-new! {}))
|
|
(er-rt-test "proc count 2" (er-sched-process-count) 2)
|
|
(er-rt-test "runnable count 2" (er-sched-runnable-count) 2)
|
|
(er-rt-test
|
|
"proc state runnable"
|
|
(er-proc-field (get p1 :pid) :state)
|
|
"runnable")
|
|
(er-rt-test
|
|
"proc mailbox empty"
|
|
(er-proc-mailbox-size (get p1 :pid))
|
|
0)
|
|
(er-rt-test
|
|
"proc lookup"
|
|
(er-pid-equal? (get (er-proc-get (get p1 :pid)) :pid) (get p1 :pid))
|
|
true)
|
|
(er-rt-test "proc exists" (er-proc-exists? (get p1 :pid)) true)
|
|
(er-rt-test
|
|
"proc no-such-pid"
|
|
(er-proc-exists? (er-mk-pid 9999))
|
|
false)
|
|
|
|
;; runnable queue dequeue order
|
|
(er-rt-test
|
|
"dequeue first"
|
|
(er-pid-equal? (er-sched-next-runnable!) (get p1 :pid))
|
|
true)
|
|
(er-rt-test
|
|
"dequeue second"
|
|
(er-pid-equal? (er-sched-next-runnable!) (get p2 :pid))
|
|
true)
|
|
(er-rt-test "dequeue empty" (er-sched-next-runnable!) nil)
|
|
|
|
;; current-pid get/set
|
|
(er-sched-set-current! (get p1 :pid))
|
|
(er-rt-test
|
|
"current pid set"
|
|
(er-pid-equal? (er-sched-current-pid) (get p1 :pid))
|
|
true)
|
|
|
|
;; ── mailbox push ──────────────────────────────────────────────
|
|
(er-proc-mailbox-push! (get p1 :pid) {:tag "atom" :name "ping"})
|
|
(er-proc-mailbox-push! (get p1 :pid) 42)
|
|
(er-rt-test "mailbox size 2" (er-proc-mailbox-size (get p1 :pid)) 2)
|
|
|
|
;; ── field update ──────────────────────────────────────────────
|
|
(er-proc-set! (get p1 :pid) :state "waiting")
|
|
(er-rt-test
|
|
"proc state waiting"
|
|
(er-proc-field (get p1 :pid) :state)
|
|
"waiting")
|
|
(er-proc-set! (get p1 :pid) :trap-exit true)
|
|
(er-rt-test
|
|
"proc trap-exit"
|
|
(er-proc-field (get p1 :pid) :trap-exit)
|
|
true)
|
|
|
|
;; ── fresh scheduler ends in clean state ───────────────────────
|
|
(er-sched-init!)
|
|
(er-rt-test
|
|
"sched init resets count"
|
|
(er-sched-process-count)
|
|
0)
|
|
(er-rt-test
|
|
"sched init resets queue"
|
|
(er-sched-runnable-count)
|
|
0)
|
|
(er-rt-test
|
|
"sched init resets current"
|
|
(er-sched-current-pid)
|
|
nil)
|
|
|
|
(define
|
|
er-rt-test-summary
|
|
(str "runtime " er-rt-test-pass "/" er-rt-test-count))
|