giles
7492ceac4e
Reset to last known-good state (908f4f80) where links, stepper, and
islands all work, then recovered all hyperscript implementation,
conformance tests, behavioral tests, Playwright specs, site sandbox,
IO-aware server loading, and upstream test suite from f271c88a.
Excludes runtime changes (VM resolve hook, VmSuspended browser handler,
sx_ref.ml guard recovery) that need careful re-integration.
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
345 lines
12 KiB
Plaintext
345 lines
12 KiB
Plaintext
;; _hyperscript compiler tests
|
|
;; Tests that hs-to-sx (AST → SX) produces correct output
|
|
;; Uses hs-to-sx-from-source for end-to-end source→SX tests
|
|
|
|
;; ── Class commands ────────────────────────────────────────────
|
|
(defsuite
|
|
"hs-emit-classes"
|
|
(deftest
|
|
"add class to me"
|
|
(let
|
|
((sx (hs-to-sx-from-source "add .active to me")))
|
|
(assert= (quote dom-add-class) (first sx))
|
|
(assert= (quote me) (nth sx 1))
|
|
(assert= "active" (nth sx 2))))
|
|
(deftest
|
|
"remove class from target"
|
|
(let
|
|
((sx (hs-to-sx-from-source "remove .old from #box")))
|
|
(assert= (quote dom-remove-class) (first sx))
|
|
(assert= (quote dom-query) (first (nth sx 1)))
|
|
(assert= "old" (nth sx 2))))
|
|
(deftest
|
|
"toggle class"
|
|
(let
|
|
((sx (hs-to-sx-from-source "toggle .visible on me")))
|
|
(assert= (quote hs-toggle-class!) (first sx))
|
|
(assert= (quote me) (nth sx 1)))))
|
|
|
|
;; ── Set command ───────────────────────────────────────────────
|
|
(defsuite
|
|
"hs-emit-set"
|
|
(deftest
|
|
"set variable to value"
|
|
(let
|
|
((sx (hs-to-sx-from-source "set x to 42")))
|
|
(assert= (quote set!) (first sx))
|
|
(assert= (quote x) (nth sx 1))
|
|
(assert= 42 (nth sx 2))))
|
|
(deftest
|
|
"set attribute"
|
|
(let
|
|
((sx (hs-to-sx-from-source "set @title to 'hello'")))
|
|
(assert= (quote dom-set-attr) (first sx))
|
|
(assert= "title" (nth sx 2))
|
|
(assert= "hello" (nth sx 3))))
|
|
(deftest
|
|
"set style"
|
|
(let
|
|
((sx (hs-to-sx-from-source "set *color to 'red'")))
|
|
(assert= (quote dom-set-style) (first sx))
|
|
(assert= "color" (nth sx 2))
|
|
(assert= "red" (nth sx 3)))))
|
|
|
|
;; ── Arithmetic ────────────────────────────────────────────────
|
|
(defsuite
|
|
"hs-emit-arithmetic"
|
|
(deftest
|
|
"addition passes through"
|
|
(let
|
|
((val (hs-to-sx-from-source "1 + 2")))
|
|
(assert= (quote hs-add) (first val))
|
|
(assert= 1 (nth val 1))
|
|
(assert= 2 (nth val 2))))
|
|
(deftest
|
|
"comparison emits correctly"
|
|
(let
|
|
((sx (hs-to-sx-from-source "if x == 5 log x end")))
|
|
(let ((cnd (nth sx 1))) (assert= (quote =) (first cnd))))))
|
|
|
|
;; ── Control flow ──────────────────────────────────────────────
|
|
(defsuite
|
|
"hs-emit-control-flow"
|
|
(deftest
|
|
"if-then becomes when"
|
|
(let
|
|
((sx (hs-to-sx-from-source "if true log 1 end")))
|
|
(assert= (quote when) (first sx))))
|
|
(deftest
|
|
"if-else becomes if"
|
|
(let
|
|
((sx (hs-to-sx-from-source "if true log 1 else log 2 end")))
|
|
(assert= (quote if) (first sx))))
|
|
(deftest
|
|
"for becomes for-each"
|
|
(let
|
|
((sx (hs-to-sx-from-source "for item in items log item end")))
|
|
(assert= (quote for-each) (first sx))
|
|
(assert= (quote fn) (first (nth sx 1)))))
|
|
(deftest
|
|
"tell rebinds me"
|
|
(let
|
|
((sx (hs-to-sx-from-source "tell <div/> add .active end")))
|
|
(assert= (quote let) (first sx))
|
|
(assert= (quote me) (first (first (nth sx 1)))))))
|
|
|
|
;; ── DOM commands ──────────────────────────────────────────────
|
|
(defsuite
|
|
"hs-emit-dom-commands"
|
|
(deftest
|
|
"hide sets display none"
|
|
(let
|
|
((sx (hs-to-sx-from-source "hide")))
|
|
(assert= (quote dom-set-style) (first sx))
|
|
(assert= (quote me) (nth sx 1))
|
|
(assert= "display" (nth sx 2))
|
|
(assert= "none" (nth sx 3))))
|
|
(deftest
|
|
"show clears display"
|
|
(let
|
|
((sx (hs-to-sx-from-source "show")))
|
|
(assert= (quote dom-set-style) (first sx))
|
|
(assert= (quote me) (nth sx 1))
|
|
(assert= "" (nth sx 3))))
|
|
(deftest
|
|
"log passes through"
|
|
(let
|
|
((sx (hs-to-sx-from-source "log 'hello'")))
|
|
(assert= (quote console-log) (first sx))
|
|
(assert= "hello" (nth sx 1))))
|
|
(deftest
|
|
"append becomes dom-append"
|
|
(let
|
|
((sx (hs-to-sx-from-source "append 'text' to me")))
|
|
(assert= (quote dom-append) (first sx)))))
|
|
|
|
;; ── Expressions ───────────────────────────────────────────────
|
|
(defsuite
|
|
"hs-emit-expressions"
|
|
(deftest
|
|
"me emits as symbol"
|
|
(let ((sx (hs-to-sx (list (quote me))))) (assert= (quote me) sx)))
|
|
(deftest
|
|
"ref emits as symbol"
|
|
(let
|
|
((sx (hs-to-sx (list (quote ref) "myVar"))))
|
|
(assert= (quote myVar) sx)))
|
|
(deftest
|
|
"query emits dom-query"
|
|
(let
|
|
((sx (hs-to-sx (list (quote query) ".foo"))))
|
|
(assert= (quote dom-query) (first sx))
|
|
(assert= ".foo" (nth sx 1))))
|
|
(deftest
|
|
"attr emits dom-get-attr"
|
|
(let
|
|
((sx (hs-to-sx (list (quote attr) "href" (list (quote me))))))
|
|
(assert= (quote dom-get-attr) (first sx))
|
|
(assert= "href" (nth sx 2))))
|
|
(deftest
|
|
"exists becomes not nil?"
|
|
(let
|
|
((sx (hs-to-sx (list (quote exists?) (list (quote ref) "x")))))
|
|
(assert= (quote not) (first sx))
|
|
(assert= (quote nil?) (first (nth sx 1)))))
|
|
(deftest
|
|
"array becomes list"
|
|
(let
|
|
((sx (hs-to-sx (list (quote array) 1 2 3))))
|
|
(assert= (quote list) (first sx))
|
|
(assert= 1 (nth sx 1))
|
|
(assert= 3 (nth sx 3)))))
|
|
|
|
;; ── On feature ────────────────────────────────────────────────
|
|
(defsuite
|
|
"hs-emit-on"
|
|
(deftest
|
|
"on click add class"
|
|
(let
|
|
((sx (hs-to-sx-from-source "on click add .active end")))
|
|
(assert= (quote hs-on) (first sx))
|
|
(assert= (quote me) (nth sx 1))
|
|
(assert= "click" (nth sx 2))
|
|
(assert= (quote fn) (first (nth sx 3)))))
|
|
(deftest
|
|
"on click from target"
|
|
(let
|
|
((sx (hs-to-sx-from-source "on click from #btn add .clicked end")))
|
|
(assert= (quote hs-on) (first sx))
|
|
(assert= (quote dom-query) (first (nth sx 1)))))
|
|
(deftest
|
|
"on every click"
|
|
(let
|
|
((sx (hs-to-sx-from-source "on every click add .pulse end")))
|
|
(assert= (quote hs-on-every) (first sx)))))
|
|
|
|
;; ── Def and behavior ─────────────────────────────────────────
|
|
(defsuite
|
|
"hs-emit-def-behavior"
|
|
(deftest
|
|
"def becomes define"
|
|
(let
|
|
((sx (hs-to-sx-from-source "def greet(name) log name end")))
|
|
(assert= (quote define) (first sx))
|
|
(assert= (quote greet) (nth sx 1))
|
|
(assert= (quote fn) (first (nth sx 2)))))
|
|
(deftest
|
|
"init wraps in hs-init"
|
|
(let
|
|
((sx (hs-to-sx-from-source "init log 'ready' end")))
|
|
(assert= (quote hs-init) (first sx))
|
|
(assert= (quote fn) (first (nth sx 1))))))
|
|
|
|
;; ── Return and throw ─────────────────────────────────────────
|
|
(defsuite
|
|
"hs-emit-render"
|
|
(deftest
|
|
"render emits render-to-html"
|
|
(let
|
|
((sx (hs-to-sx-from-source "render ~card")))
|
|
(assert= (quote render-to-html) (first sx))
|
|
(assert= (quote ~card) (nth sx 1))))
|
|
(deftest
|
|
"render with kwargs emits keywords"
|
|
(let
|
|
((sx (hs-to-sx-from-source "render ~card :title 'Hi'")))
|
|
(assert= (quote render-to-html) (first sx))
|
|
(assert= (quote ~card) (nth sx 1))
|
|
(assert= (make-keyword "title") (nth sx 2))
|
|
(assert= "Hi" (nth sx 3))))
|
|
(deftest
|
|
"render into emits hs-put!"
|
|
(let
|
|
((sx (hs-to-sx-from-source "render ~card into #box")))
|
|
(assert= (quote hs-put!) (first sx))
|
|
(assert= (quote render-to-html) (first (nth sx 1)))
|
|
(assert= "into" (nth sx 2))))
|
|
(deftest
|
|
"component ref emits symbol"
|
|
(let
|
|
((sx (hs-to-sx (list (quote component) "~badge"))))
|
|
(assert= (quote ~badge) sx))))
|
|
|
|
;; ── Increment / decrement ────────────────────────────────────
|
|
(defsuite
|
|
"hs-emit-sx-eval"
|
|
(deftest
|
|
"eval inlines SX at compile time"
|
|
(let
|
|
((sx (hs-to-sx-from-source "set x to eval (+ 1 2)")))
|
|
(assert= (quote set!) (first sx))
|
|
(let
|
|
((val (nth sx 2)))
|
|
(assert= (quote +) (first val))
|
|
(assert= 1 (nth val 1))
|
|
(assert= 2 (nth val 2)))))
|
|
(deftest
|
|
"eval preserves variable refs"
|
|
(let
|
|
((sx (hs-to-sx-from-source "eval (log x)")))
|
|
(assert= (quote log) (first sx))
|
|
(assert= (quote x) (nth sx 1)))))
|
|
|
|
(defsuite
|
|
"hs-emit-return-throw"
|
|
(deftest
|
|
"return unwraps to value"
|
|
(let ((sx (hs-to-sx-from-source "return 42"))) (assert= 42 sx)))
|
|
(deftest
|
|
"throw becomes raise"
|
|
(let
|
|
((sx (hs-to-sx-from-source "throw 'oops'")))
|
|
(assert= (quote raise) (first sx))
|
|
(assert= "oops" (nth sx 1))))
|
|
(deftest
|
|
"wait emits hs-wait"
|
|
(let
|
|
((sx (hs-to-sx-from-source "wait 100ms")))
|
|
(assert= (quote hs-wait) (first sx))
|
|
(assert= 100 (nth sx 1))))
|
|
(deftest
|
|
"wait for emits hs-wait-for"
|
|
(let
|
|
((sx (hs-to-sx-from-source "wait for transitionend")))
|
|
(assert= (quote hs-wait-for) (first sx))
|
|
(assert= "transitionend" (nth sx 2)))))
|
|
|
|
(defsuite
|
|
"hs-emit-inc-dec"
|
|
(deftest
|
|
"increment attribute"
|
|
(let
|
|
((sx (hs-to-sx-from-source "increment @count")))
|
|
(assert= (quote dom-set-attr) (first sx))))
|
|
(deftest
|
|
"decrement attribute"
|
|
(let
|
|
((sx (hs-to-sx-from-source "decrement @count")))
|
|
(assert= (quote dom-set-attr) (first sx)))))
|
|
|
|
(defsuite
|
|
"hs-live-demo-toggle"
|
|
(deftest
|
|
"toggle class on me compiles to single hs-on"
|
|
(let
|
|
((sx (hs-to-sx-from-source "on click toggle .bg-violet-600 on me then toggle .text-white on me")))
|
|
(assert= (quote hs-on) (first sx))
|
|
(assert= "click" (nth sx 2))
|
|
(let
|
|
((body (nth (nth sx 3) 2)))
|
|
(assert= (quote do) (first body))
|
|
(assert= 2 (len (rest body))))))
|
|
(deftest
|
|
"bounce: then chains wait and remove in same handler"
|
|
(let
|
|
((sx (hs-to-sx-from-source "on click add .animate-bounce to me then wait 1s then remove .animate-bounce from me")))
|
|
(assert= (quote hs-on) (first sx))
|
|
(assert= "click" (nth sx 2))
|
|
(let
|
|
((body (nth (nth sx 3) 2)))
|
|
(assert= (quote do) (first body))
|
|
(assert= 3 (len (rest body)))
|
|
(assert= (quote hs-wait) (first (nth body 2)))
|
|
(assert= 1000 (nth (nth body 2) 1)))))
|
|
(deftest
|
|
"count clicks: then chains increment and set in same handler"
|
|
(let
|
|
((sx (hs-to-sx-from-source "on click increment @data-count on me then set #click-counter's innerHTML to my @data-count")))
|
|
(assert= (quote hs-on) (first sx))
|
|
(assert= "click" (nth sx 2))
|
|
(let
|
|
((body (nth (nth sx 3) 2)))
|
|
(assert= (quote do) (first body))
|
|
(assert= 2 (len (rest body)))))))
|
|
|
|
(defsuite
|
|
"hs-wait-suspension"
|
|
(deftest
|
|
"wait in then chain keeps hs-wait (platform handles suspension)"
|
|
(let
|
|
((sx (hs-to-sx-from-source "on click add .bounce to me then wait 1s then remove .bounce from me")))
|
|
(assert= (quote hs-on) (first sx))
|
|
(let
|
|
((body (nth (nth sx 3) 2)))
|
|
(assert= (quote do) (first body))
|
|
(assert= 3 (len (rest body)))
|
|
(assert= (quote hs-wait) (first (nth body 2)))
|
|
(assert= 1000 (nth (nth body 2) 1)))))
|
|
(deftest
|
|
"wait preserves ms value in handler"
|
|
(let
|
|
((sx (hs-to-sx-from-source "on click add .a then wait 2s then add .b")))
|
|
(let
|
|
((body (nth (nth sx 3) 2)))
|
|
(assert= (quote hs-wait) (first (nth body 2)))
|
|
(assert= 2000 (nth (nth body 2) 1)))))) |