rose-ash/spec/tests/test-gate-pins.sx

;; ==========================================================================
;; test-gate-pins.sx — W14 regression pins for the review's landed fixes
;;
;; The quick-wins batch (commit dc7aa709 + siblings) landed real semantics
;; fixes but shipped WITHOUT pinning tests, so a regression would pass
;; silently. This file pins each confirmed-and-fixed finding with a minimal
;; repro lifted from the review lane files (plans/sx-review/*.md). One suite
;; per finding.
;;
;; TEST-ONLY: no semantics edits. If a pin fails, the fix regressed — do NOT
;; relax the assertion; investigate the evaluator/primitive change.
;; NB: assert= uses `=` (not `equal?`); compare lists with `=`.
;; ==========================================================================

;; --------------------------------------------------------------------------
;; K18 [W7, high] expt silently wrapped at 63-bit int — now promotes to float
;; like +/*. Repro (core.md): (expt 2 62) -> -4611686018427387904 (wrapped);
;; (expt 2 100) -> 0. Fixed: both are positive floats.
;; --------------------------------------------------------------------------
(defsuite
  "gate-K18-expt-overflow"
  (deftest
    "small integer exponents stay exact"
    (do
      (assert= (expt 2 0) 1)
      (assert= (expt 2 10) 1024)))
  (deftest
    "expt 2^62 does not wrap to a negative int"
    (assert (> (expt 2 62) 0)))
  (deftest
    "expt 2^100 does not wrap to zero"
    (assert (> (expt 2 100) 0)))
  (deftest
    "expt 2^100 promotes to float"
    (assert (number? (expt 2 100)))))

;; --------------------------------------------------------------------------
;; K20 [W7, high] contains? did not support dicts in the real runtime —
;; (contains? {:a 1} :a) threw "contains?: 2 args", contradicting its :doc
;; ("Dicts: key check"). Fixed: dict key membership works; lists/strings
;; unchanged. Repro (core.md).
;; --------------------------------------------------------------------------
(defsuite
  "gate-K20-contains-dict"
  (deftest
    "contains? finds a present dict key"
    (assert (contains? {:a 1 :b 2} :a)))
  (deftest
    "contains? reports a missing dict key as false"
    (assert (not (contains? {:a 1 :b 2} :zz))))
  (deftest
    "contains? still works on list membership"
    (do
      (assert (contains? (list 10 20 30) 20))
      (assert
        (not (contains? (list 10 20 30) 99)))))
  (deftest
    "contains? still works on string substrings"
    (assert (contains? "hello" "ell"))))

;; --------------------------------------------------------------------------
;; K09 [W5, high] R7RS longhand (unquote-splicing X) silently no-spliced —
;; only shorthand ,@/`splice-unquote` was recognized, so the longhand
;; serialized literally (zero-splice). Fixed: aliased to splice-unquote.
;; Repro (core.md).
;; --------------------------------------------------------------------------
(defsuite
  "gate-K09-longhand-unquote-splicing"
  (deftest
    "longhand unquote-splicing splices a list"
    (assert=
      (quasiquote
        (1
          (unquote-splicing (list 2 3))
          4))
      (list 1 2 3 4)))
  (deftest
    "longhand unquote-splicing of an empty list contributes nothing"
    (assert=
      (quasiquote (0 (unquote-splicing (list)) 9))
      (list 0 9)))
  (deftest
    "shorthand splice-unquote still works"
    (assert=
      (quasiquote (a (splice-unquote (list 2 3)) z))
      (list (quote a) 2 3 (quote z)))))

;; --------------------------------------------------------------------------
;; K11 [W5, high] guard re-raise sentinel was a plain forgeable symbol — a
;; body/clause legitimately returning (list '__guard-reraise__ X) was
;; misread as a re-raise of X. Fixed: sentinel gensym'd per execution, so a
;; user value with that head is returned as data. Repro (core.md).
;; --------------------------------------------------------------------------
(defsuite
  "gate-K11-guard-reraise-forgeable"
  (deftest
    "body value shaped like the sentinel is returned as data"
    (assert=
      (guard (e (true "caught")) (list (quote __guard-reraise__) "hi"))
      (list (quote __guard-reraise__) "hi")))
  (deftest
    "clause returning the forged sentinel is not re-raised"
    (assert=
      (guard
        (e (true (list (quote __guard-reraise__) "forged")))
        (error "boom"))
      (list (quote __guard-reraise__) "forged"))))

;; --------------------------------------------------------------------------
;; K39 [W5, med] `do` misparsed a first form whose head is a list (an IIFE)
;; as a Scheme do-loop binding spec. Repro (core.md): (do ((fn (x) x) 5) 99)
;; threw "first: expected list, got 5"; expected 99. Fixed: `do` is begin.
;; --------------------------------------------------------------------------
(defsuite
  "gate-K39-do-iife-head"
  (deftest
    "do with an IIFE first form returns the last form (not a do-loop)"
    (assert= (do ((fn (x) x) 5) 99) 99))
  (deftest
    "do with a single IIFE form returns its value"
    (assert= (do ((fn () 42))) 42)))

;; --------------------------------------------------------------------------
;; K49 [W8, med] Five void elements (area base embed param track) were in
;; VOID_ELEMENTS but missing from HTML_TAGS — render fell through to
;; function-call dispatch: (render-to-html '(base :href "x")) threw
;; "Undefined symbol: base". dc7aa709 fixed the SPEC registry
;; (spec/render.sx). NB: the generated OCaml render library
;; (hosts/ocaml/lib/sx_render.ml, bootstrap_render.py output) still carries
;; a STALE html_tags_list without these five — the runner's native
;; `render-html` convenience therefore still errors. That regen drift is
;; W14 item F13 (regen-diff gate); this suite pins the spec side only.
;; --------------------------------------------------------------------------
(defsuite
  "gate-K49-void-elements-renderable"
  (deftest
    "spec HTML_TAGS registry contains all five void elements"
    (for-each
      (fn
        (t)
        (assert (contains? HTML_TAGS t) (str "HTML_TAGS missing " t)))
      (list "area" "base" "embed" "param" "track")))
  (deftest
    "spec render-to-html renders base self-closing with attr"
    (assert-equal
      "<base href=\"x\" />"
      (render-to-html (quote (base :href "x")) (make-env))))
  (deftest
    "spec render-to-html renders all five as self-closing voids"
    (for-each
      (fn
        (form)
        (let
          ((html (render-to-html form (make-env))))
          (assert
            (string-contains? html "/>")
            (str (first form) " not self-closing: " html))))
      (list
        (quote (area))
        (quote (base))
        (quote (embed))
        (quote (param))
        (quote (track))))))

;; --------------------------------------------------------------------------
;; crit-2 [W1, critical] signal-return frame stored the saved kont under :f
;; but the reader looked up "saved-kont" — the resume kont was always nil,
;; so the handler value became the WHOLE program's result and every frame
;; outside the signal site (including the covering test's own assert!) was
;; silently discarded. The shipped test "signal returns handler value to
;; call site" passed VACUOUSLY — the bug defeated its own test.
;;
;; A plain assert around the repro would inherit the same vacuity on
;; regression (the dropped continuation includes the assert frame). So this
;; pin uses a side-effect sentinel: test 1 runs the repro and then sets a
;; flag; test 2 independently asserts the flag was reached. If crit-2
;; regresses, test 1 still "passes" (vacuously) but test 2 FAILS.
;; Repro (core.md).
;; --------------------------------------------------------------------------
(define *gate-crit2-after-signal* false)
(define *gate-crit2-result* nil)
(define *gate-crit2-rc-result* nil)

(defsuite
  "gate-crit2-signal-return-kont"
  (deftest
    "continuable signal resumes at the raise site"
    (do
      (set!
        *gate-crit2-result*
        (list
          "outer"
          (handler-bind
            (((fn (c) true) (fn (c) 42)))
            (+ 1 (signal-condition 5)))
          "end"))
      (set!
        *gate-crit2-rc-result*
        (handler-bind
          (((fn (c) true) (fn (c) (+ c 100))))
          (+ 1 (raise-continuable 42))))
      (set! *gate-crit2-after-signal* true)
      (assert= *gate-crit2-result* (list "outer" 43 "end"))
      (assert= *gate-crit2-rc-result* 143)))
  (deftest
    "non-vacuity sentinel: the continuation after the signal actually ran"
    (do
      (assert
        *gate-crit2-after-signal*
        "continuation dropped — crit-2 regressed (previous test passed vacuously)")
      (assert= *gate-crit2-result* (list "outer" 43 "end"))
      (assert= *gate-crit2-rc-result* 143)))
  (deftest
    "handler value feeds the arithmetic frame, not the program result"
    (assert=
      (handler-bind
        (((fn (c) true) (fn (c) (* c 10))))
        (+ 1 (signal-condition 5)))
      51)))

(defsuite
  "gate-C22-throwing-mock-logged"
  (deftest
    "throwing mock still leaves an IO-log entry"
    (let
      ((h (make-harness))
        (f (make-interceptor h "fetch" (fn (url) (error "boom-io")))))
      (let
        ((r (try-call (fn () (f "http://a")))))
        (assert (not (get r "ok")) "mock error must propagate")
        (assert-io-called h "fetch")
        (assert-io-count h "fetch" 1)
        (assert= (get (io-call-nth h "fetch" 0) "result") nil))))
  (deftest
    "successful mock entry gets its result updated in place"
    (let
      ((h (make-harness))
        (f (make-interceptor h "fetch" (fn (url) (str "got:" url)))))
      (f "http://a")
      (assert-io-count h "fetch" 1)
      (assert-io-result h "fetch" 0 "got:http://a")
      (assert-io-args h "fetch" 0 (list "http://a"))))
  (deftest
    "mixed throwing and successful calls are all counted"
    (let
      ((h (make-harness))
        (bomb (make-interceptor h "action" (fn (x) (error "nope"))))
        (ok-f (make-interceptor h "action" (fn (x) "done"))))
      (try-call (fn () (bomb 1)))
      (ok-f 2)
      (try-call (fn () (bomb 3)))
      (assert-io-count h "action" 3)
      (assert= (get (io-call-nth h "action" 1) "result") "done"))))