;; 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)



;; ── Phase 7: module-version slots ───────────────────────────────
(er-modules-reset!)

(define er-rt-slot1 (er-mk-module-slot (er-env-new) nil 1))
(er-rt-test "slot tag"     (get er-rt-slot1 :tag)              "module")
(er-rt-test "slot version" (er-module-version er-rt-slot1)     1)
(er-rt-test "slot old nil" (er-module-old-env er-rt-slot1)     nil)
(er-rt-test "slot current not nil" (= (er-module-current-env er-rt-slot1) nil) false)

(erlang-load-module "-module(hr1). a() -> 1.")
(define er-rt-reg (er-modules-get))
(er-rt-test "registry has hr1"     (dict-has? er-rt-reg "hr1")                       true)
(er-rt-test "v1 on first load"     (er-module-version (get er-rt-reg "hr1"))         1)
(er-rt-test "v1 old is nil"        (er-module-old-env (get er-rt-reg "hr1"))         nil)
(er-rt-test "v1 current not nil"   (= (er-module-current-env (get er-rt-reg "hr1")) nil) false)

(define er-rt-env-v1 (er-module-current-env (get er-rt-reg "hr1")))
(erlang-load-module "-module(hr1). a() -> 2.")
(er-rt-test "v2 on second load"    (er-module-version (get er-rt-reg "hr1"))         2)
(er-rt-test "v2 old is v1 env"     (er-module-old-env (get er-rt-reg "hr1"))         er-rt-env-v1)
(er-rt-test "v2 current is new"    (= (er-module-current-env (get er-rt-reg "hr1")) er-rt-env-v1) false)

(erlang-load-module "-module(hr1). a() -> 3.")
(er-rt-test "v3 on third load"     (er-module-version (get er-rt-reg "hr1"))         3)

(er-modules-reset!)
(er-rt-test "registry-reset clears" (dict-has? (er-modules-get) "hr1")              false)




;; ── Phase 8: FFI BIF registry ──────────────────────────────────
(er-bif-registry-reset!)

(er-rt-test "empty registry" (len (er-list-bifs)) 0)
(er-rt-test "lookup miss" (er-lookup-bif "crypto" "hash" 2) nil)

(er-register-bif! "fake" "echo" 1 (fn (vs) (nth vs 0)))
(er-rt-test "register grows registry" (len (er-list-bifs)) 1)

(define er-rt-bif-hit (er-lookup-bif "fake" "echo" 1))
(er-rt-test "lookup hit module" (get er-rt-bif-hit :module) "fake")
(er-rt-test "lookup hit name"   (get er-rt-bif-hit :name)   "echo")
(er-rt-test "lookup hit arity"  (get er-rt-bif-hit :arity)  1)
(er-rt-test "lookup hit pure?"  (get er-rt-bif-hit :pure?)  false)

(er-rt-test "fn invocable" ((get er-rt-bif-hit :fn) (list 42)) 42)

;; Re-register replaces (same key)
(er-register-bif! "fake" "echo" 1 (fn (vs) "replaced"))
(er-rt-test "re-register same key, count unchanged" (len (er-list-bifs)) 1)
(er-rt-test "re-register replaces fn"
  ((get (er-lookup-bif "fake" "echo" 1) :fn) (list 99)) "replaced")

;; Pure variant
(er-register-pure-bif! "fake" "pure" 2 (fn (vs) (+ (nth vs 0) (nth vs 1))))
(er-rt-test "pure registered separately, count 2" (len (er-list-bifs)) 2)
(er-rt-test "pure flag true"
  (get (er-lookup-bif "fake" "pure" 2) :pure?) true)
(er-rt-test "pure fn invocable"
  ((get (er-lookup-bif "fake" "pure" 2) :fn) (list 7 8)) 15)

;; Arity disambiguation: same module+name, different arity = distinct entries
(er-register-bif! "fake" "echo" 2 (fn (vs) (list (nth vs 0) (nth vs 1))))
(er-rt-test "arity disambiguation count" (len (er-list-bifs)) 3)
(er-rt-test "arity-1 lookup still works"
  ((get (er-lookup-bif "fake" "echo" 1) :fn) (list 11)) "replaced")
(er-rt-test "arity-2 lookup independent"
  (len ((get (er-lookup-bif "fake" "echo" 2) :fn) (list 1 2))) 2)

;; Reset clears the registry
(er-bif-registry-reset!)
(er-rt-test "reset clears" (len (er-list-bifs)) 0)
(er-rt-test "reset lookup nil" (er-lookup-bif "fake" "echo" 1) nil)



;; ── Phase 8: term marshalling (er-to-sx / er-of-sx) ─────────────

;; er-to-sx: Erlang → SX
(er-rt-test "to-sx atom"      (er-to-sx (er-mk-atom "foo"))         (make-symbol "foo"))
(er-rt-test "to-sx atom is symbol" (type-of (er-to-sx (er-mk-atom "x"))) "symbol")
(er-rt-test "to-sx nil"       (er-to-sx (er-mk-nil))                (list))
(er-rt-test "to-sx integer passthrough" (er-to-sx 42)               42)
(er-rt-test "to-sx float passthrough"   (er-to-sx 3.14)             3.14)
(er-rt-test "to-sx boolean passthrough" (er-to-sx true)             true)
(er-rt-test "to-sx binary → string"
  (er-to-sx (er-mk-binary (list 104 105 33))) "hi!")
(er-rt-test "to-sx cons → list"
  (er-to-sx (er-mk-cons 1 (er-mk-cons 2 (er-mk-cons 3 (er-mk-nil))))) (list 1 2 3))
(er-rt-test "to-sx tuple → list"
  (er-to-sx (er-mk-tuple (list 1 2 3))) (list 1 2 3))
(er-rt-test "to-sx nested cons"
  (er-to-sx (er-mk-cons (er-mk-atom "a") (er-mk-cons 7 (er-mk-nil))))
  (list (make-symbol "a") 7))

;; er-of-sx: SX → Erlang
(er-rt-test "of-sx symbol"
  (get (er-of-sx (make-symbol "ok")) :name) "ok")
(er-rt-test "of-sx symbol is atom"
  (er-atom? (er-of-sx (make-symbol "x"))) true)
(er-rt-test "of-sx string is binary"
  (er-binary? (er-of-sx "hi")) true)
(er-rt-test "of-sx string bytes"
  (get (er-of-sx "hi") :bytes) (list 104 105))
(er-rt-test "of-sx integer passthrough"
  (er-of-sx 42) 42)
(er-rt-test "of-sx empty list → nil"
  (er-nil? (er-of-sx (list))) true)
(er-rt-test "of-sx list → cons chain length"
  (er-list-length (er-of-sx (list 1 2 3 4))) 4)
(er-rt-test "of-sx list head/tail"
  (get (er-of-sx (list 10 20)) :head) 10)

;; Round-trips
(er-rt-test "rtrip integer" (er-to-sx (er-of-sx 99)) 99)
(er-rt-test "rtrip atom"
  (get (er-of-sx (er-to-sx (er-mk-atom "abc"))) :name) "abc")
(er-rt-test "rtrip binary bytes"
  (get (er-of-sx (er-to-sx (er-mk-binary (list 1 2 3)))) :bytes) (list 1 2 3))
(er-rt-test "rtrip cons-of-ints length"
  (er-list-length (er-of-sx (er-to-sx
    (er-mk-cons 1 (er-mk-cons 2 (er-mk-cons 3 (er-mk-nil))))))) 3)

;; Tuples don't round-trip exactly (er-to-sx flattens tuples to lists);
;; documented one-way conversion.
(er-rt-test "to-sx of tuple loses tag"
  (er-cons? (er-of-sx (er-to-sx (er-mk-tuple (list 1 2 3))))) true)


;; Re-populate built-in BIFs so subsequent test files (ring, ping-pong, etc.)
;; can call length/spawn/etc. The migration onto the registry means a reset
;; here would otherwise break the rest of the conformance suite.
(er-register-builtin-bifs!)


(define
  er-rt-test-summary
  (str "runtime " er-rt-test-pass "/" er-rt-test-count))