From cb59fbba1345f8f94c602e98a4ac5955c11b9ea1 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 26 Apr 2026 20:15:24 +0000 Subject: [PATCH] HS: transition to initial + commit pending E37/E40 test impls parser.sx: detect bare ident "initial" after "to" in parse-one-transition, emit string sentinel instead of (ref "initial") which evaluated to nil. runtime.sx: hs-transition stores pre-first-transition style as data-hs-init-{prop}; restores it when value=="initial". Also commits E37 tokenizer and E40 fetch test implementations that accumulated in the working tree but weren't staged in prior commits. Co-Authored-By: Claude Sonnet 4.6 --- lib/hyperscript/parser.sx | 2 +- lib/hyperscript/runtime.sx | 23 +- plans/hs-conformance-scoreboard.md | 10 +- shared/static/wasm/sx/hs-parser.sx | 2 +- shared/static/wasm/sx/hs-runtime.sx | 23 +- spec/tests/test-hyperscript-behavioral.sx | 388 +++++++++++++++++++--- 6 files changed, 380 insertions(+), 68 deletions(-) diff --git a/lib/hyperscript/parser.sx b/lib/hyperscript/parser.sx index 3d6e5136..9bba0878 100644 --- a/lib/hyperscript/parser.sx +++ b/lib/hyperscript/parser.sx @@ -1694,7 +1694,7 @@ ((from-val (if (match-kw "from") (let ((v (parse-atom))) (if (and v (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v)) nil))) (expect-kw! "to") (let - ((value (let ((v (parse-atom))) (if (and v (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v)))) + ((value (if (and (= (tp-type) "ident") (= (tp-val) "initial")) (do (adv!) "initial") (let ((v (parse-atom))) (if (and v (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v))))) (let ((dur (if (match-kw "over") (let ((v (parse-atom))) (if (and (number? v) (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v)) nil))) (let diff --git a/lib/hyperscript/runtime.sx b/lib/hyperscript/runtime.sx index 4c901aad..a7ef69b1 100644 --- a/lib/hyperscript/runtime.sx +++ b/lib/hyperscript/runtime.sx @@ -1362,14 +1362,21 @@ hs-transition (fn (target prop value duration) - (when - duration - (dom-set-style - target - "transition" - (str prop " " (/ duration 1000) "s"))) - (dom-set-style target prop value) - (when duration (hs-settle target)))) + (let + ((init-attr (str "data-hs-init-" prop))) + (when + (not (dom-get-attr target init-attr)) + (dom-set-attr target init-attr (dom-get-style target prop))) + (let + ((actual-value (if (= value "initial") (dom-get-attr target init-attr) value))) + (when + duration + (dom-set-style + target + "transition" + (str prop " " (/ duration 1000) "s"))) + (dom-set-style target prop actual-value) + (when duration (hs-settle target)))))) (define hs-transition-from diff --git a/plans/hs-conformance-scoreboard.md b/plans/hs-conformance-scoreboard.md index 14a345ea..b8f2702b 100644 --- a/plans/hs-conformance-scoreboard.md +++ b/plans/hs-conformance-scoreboard.md @@ -4,10 +4,10 @@ Live tally for `plans/hs-conformance-to-100.md`. Update after every cluster comm ``` Baseline: 1213/1496 (81.1%) -Merged: 1312/1496 (87.7%) delta +99 +Merged: 1330/1496 (88.9%) delta +117 Worktree: all landed Target: 1496/1496 (100.0%) -Remaining: ~192 tests (clusters 17/29(partial)/31 blocked; 33/34 partial) +Remaining: ~174 tests (clusters 17/29(partial)/31 blocked; 33/34 partial) ``` ## Cluster ledger @@ -30,7 +30,7 @@ Remaining: ~192 tests (clusters 17/29(partial)/31 blocked; 33/34 partial) | 12 | `show` multi-element + display retention | done | +2 | 98c957b3 | | 13 | `toggle` multi-class + timed + until-event | partial | +2 | bd821c04 | | 14 | `unless` modifier | done | +1 | c4da0698 | -| 15 | `transition` query-ref + multi-prop + initial | partial | +2 | 3d352055 | +| 15 | `transition` query-ref + multi-prop + initial | partial | +3 | 3d352055 | | 16 | `send can reference sender` | done | +1 | ed8d71c9 | | 17 | `tell` semantics | blocked | — | — | | 18 | `throw` respond async/sync | done | +2 | dda3becb | @@ -73,7 +73,7 @@ Remaining: ~192 tests (clusters 17/29(partial)/31 blocked; 33/34 partial) | # | Cluster | Status | Design doc | |---|---------|--------|------------| | 36 | WebSocket + `socket` + RPC proxy | design-done | `plans/designs/e36-websocket.md` | -| 37 | Tokenizer-as-API | design-done | `plans/designs/e37-tokenizer-api.md` | +| 37 | Tokenizer-as-API | done | +17 | 54b54f4e | | 38 | SourceInfo API | design-done | `plans/designs/e38-sourceinfo.md` | | 39 | WebWorker plugin | design-done | `plans/designs/e39-webworker.md` | | 40 | Fetch non-2xx / before-fetch / real response | done | +7 | d7244d1d | @@ -97,7 +97,7 @@ Defer until A–D drain. Estimated ~25 recoverable tests. | B | 7 | 0 | 0 | 0 | 0 | — | 7 | | C | 4 | 1 | 0 | 0 | 0 | — | 5 | | D | 2 | 2 | 0 | 0 | 1 | — | 5 | -| E | 1 | 0 | 0 | 0 | 0 | 4 | 5 | +| E | 2 | 0 | 0 | 0 | 0 | 3 | 5 | | F | — | — | — | ~10 | — | — | ~10 | ## Maintenance diff --git a/shared/static/wasm/sx/hs-parser.sx b/shared/static/wasm/sx/hs-parser.sx index 3d6e5136..9bba0878 100644 --- a/shared/static/wasm/sx/hs-parser.sx +++ b/shared/static/wasm/sx/hs-parser.sx @@ -1694,7 +1694,7 @@ ((from-val (if (match-kw "from") (let ((v (parse-atom))) (if (and v (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v)) nil))) (expect-kw! "to") (let - ((value (let ((v (parse-atom))) (if (and v (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v)))) + ((value (if (and (= (tp-type) "ident") (= (tp-val) "initial")) (do (adv!) "initial") (let ((v (parse-atom))) (if (and v (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v))))) (let ((dur (if (match-kw "over") (let ((v (parse-atom))) (if (and (number? v) (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v)) nil))) (let diff --git a/shared/static/wasm/sx/hs-runtime.sx b/shared/static/wasm/sx/hs-runtime.sx index 4c901aad..a7ef69b1 100644 --- a/shared/static/wasm/sx/hs-runtime.sx +++ b/shared/static/wasm/sx/hs-runtime.sx @@ -1362,14 +1362,21 @@ hs-transition (fn (target prop value duration) - (when - duration - (dom-set-style - target - "transition" - (str prop " " (/ duration 1000) "s"))) - (dom-set-style target prop value) - (when duration (hs-settle target)))) + (let + ((init-attr (str "data-hs-init-" prop))) + (when + (not (dom-get-attr target init-attr)) + (dom-set-attr target init-attr (dom-get-style target prop))) + (let + ((actual-value (if (= value "initial") (dom-get-attr target init-attr) value))) + (when + duration + (dom-set-style + target + "transition" + (str prop " " (/ duration 1000) "s"))) + (dom-set-style target prop actual-value) + (when duration (hs-settle target)))))) (define hs-transition-from diff --git a/spec/tests/test-hyperscript-behavioral.sx b/spec/tests/test-hyperscript-behavioral.sx index eed2aafc..a5106fbf 100644 --- a/spec/tests/test-hyperscript-behavioral.sx +++ b/spec/tests/test-hyperscript-behavioral.sx @@ -2008,8 +2008,8 @@ (dom-set-attr _el-d2 "id" "d2") (dom-set-attr _el-div "_" "on click make a

then put #i1.value into its textContent put it.outerHTML at end of #d2") (dom-append (dom-body) _el-i1) - (dom-append _el-i1 _el-d2) - (dom-append _el-i1 _el-div) + (dom-append (dom-body) _el-d2) + (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch (dom-query "div:nth-of-type(2)") "click" nil) )) @@ -2510,41 +2510,287 @@ ;; ── core/tokenizer (17 tests) ── (defsuite "hs-upstream-core/tokenizer" (deftest "handles $ in template properly" - (error "SKIP (untranslated): handles $ in template properly")) + (assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"" :template) 0)) "\"") + ) (deftest "handles all special escapes properly" - (error "SKIP (untranslated): handles all special escapes properly")) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\b\""))) (char-from-code 8)) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\f\""))) (char-from-code 12)) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\n\""))) "\n") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\r\""))) "\r") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\t\""))) "\t") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\v\""))) (char-from-code 11)) + ) (deftest "handles basic token types" - (error "SKIP (untranslated): handles basic token types")) + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "foo"))) "IDENTIFIER") + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1"))) "NUMBER") + (let ((s (hs-tokens-of "1.1"))) + (let ((tok (hs-stream-consume s))) + (assert= (hs-token-type tok) "NUMBER") + (assert= (hs-stream-has-more s) false))) + (let ((s (hs-tokens-of "1e6"))) + (let ((tok (hs-stream-consume s))) + (assert= (hs-token-type tok) "NUMBER") + (assert= (hs-stream-has-more s) false))) + (let ((s (hs-tokens-of "1e-6"))) + (let ((tok (hs-stream-consume s))) + (assert= (hs-token-type tok) "NUMBER") + (assert= (hs-stream-has-more s) false))) + (let ((s (hs-tokens-of "1.1e6"))) + (let ((tok (hs-stream-consume s))) + (assert= (hs-token-type tok) "NUMBER") + (assert= (hs-stream-has-more s) false))) + (let ((s (hs-tokens-of "1.1e-6"))) + (let ((tok (hs-stream-consume s))) + (assert= (hs-token-type tok) "NUMBER") + (assert= (hs-stream-has-more s) false))) + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of ".a"))) "CLASS_REF") + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "#a"))) "ID_REF") + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "\"asdf\""))) "STRING") + ) (deftest "handles class identifiers properly" - (error "SKIP (untranslated): handles class identifiers properly")) + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of ".a"))) "CLASS_REF") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of ".a"))) ".a") + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of " .a"))) "CLASS_REF") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of " .a"))) ".a") + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "a.a"))) "IDENTIFIER") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "a.a"))) "a") + (assert= (hs-token-type (nth (get (hs-tokens-of "(a).a") "list") 4)) "IDENTIFIER") + (assert= (hs-token-value (nth (get (hs-tokens-of "(a).a") "list") 4)) "a") + (assert= (hs-token-type (nth (get (hs-tokens-of "{a}.a") "list") 4)) "IDENTIFIER") + (assert= (hs-token-value (nth (get (hs-tokens-of "{a}.a") "list") 4)) "a") + (assert= (hs-token-type (nth (get (hs-tokens-of "[a].a") "list") 4)) "IDENTIFIER") + (assert= (hs-token-value (nth (get (hs-tokens-of "[a].a") "list") 4)) "a") + (assert= (hs-token-type (nth (get (hs-tokens-of "(a(.a") "list") 3)) "CLASS_REF") + (assert= (hs-token-value (nth (get (hs-tokens-of "(a(.a") "list") 3)) ".a") + (assert= (hs-token-type (nth (get (hs-tokens-of "{a{.a") "list") 3)) "CLASS_REF") + (assert= (hs-token-value (nth (get (hs-tokens-of "{a{.a") "list") 3)) ".a") + (assert= (hs-token-type (nth (get (hs-tokens-of "[a[.a") "list") 3)) "CLASS_REF") + (assert= (hs-token-value (nth (get (hs-tokens-of "[a[.a") "list") 3)) ".a") + ) (deftest "handles comments properly" - (error "SKIP (untranslated): handles comments properly")) + (assert= (len (get (hs-tokens-of "--") "list")) 0) + (assert= (len (get (hs-tokens-of "asdf--") "list")) 1) + (assert= (len (get (hs-tokens-of "-- asdf") "list")) 0) + (assert= (len (get (hs-tokens-of "--\nasdf") "list")) 1) + (assert= (len (get (hs-tokens-of "--\nasdf--") "list")) 1) + (assert= (len (get (hs-tokens-of "---asdf") "list")) 0) + (assert= (len (get (hs-tokens-of "----\n---asdf") "list")) 0) + (assert= (len (get (hs-tokens-of "----asdf----") "list")) 0) + (assert= (len (get (hs-tokens-of "---\nasdf---") "list")) 1) + (assert= (len (get (hs-tokens-of "// asdf") "list")) 0) + (assert= (len (get (hs-tokens-of "///asdf") "list")) 0) + (assert= (len (get (hs-tokens-of "asdf//") "list")) 1) + (assert= (len (get (hs-tokens-of "asdf\n//") "list")) 2) + ) (deftest "handles hex escapes properly" - (error "SKIP (untranslated): handles hex escapes properly")) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\x1f\""))) (char-from-code 31)) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\x41\""))) "A") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\x41\\x61\""))) "Aa") + (let ((threw false)) + (guard (e (true (set! threw true))) (hs-stream-consume (hs-tokens-of "\"\\x\""))) + (assert threw)) + (let ((threw false)) + (guard (e (true (set! threw true))) (hs-stream-consume (hs-tokens-of "\"\\xGG\""))) + (assert threw)) + (let ((threw false)) + (guard (e (true (set! threw true))) (hs-stream-consume (hs-tokens-of "\"\\x4\""))) + (assert threw)) + ) (deftest "handles id references properly" - (error "SKIP (untranslated): handles id references properly")) + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "#a"))) "ID_REF") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "#a"))) "#a") + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of " #a"))) "ID_REF") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of " #a"))) "#a") + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "a#a"))) "IDENTIFIER") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "a#a"))) "a") + (assert= (hs-token-type (nth (get (hs-tokens-of "(a)#a") "list") 4)) "IDENTIFIER") + (assert= (hs-token-value (nth (get (hs-tokens-of "(a)#a") "list") 4)) "a") + (assert= (hs-token-type (nth (get (hs-tokens-of "{a}#a") "list") 4)) "IDENTIFIER") + (assert= (hs-token-value (nth (get (hs-tokens-of "{a}#a") "list") 4)) "a") + (assert= (hs-token-type (nth (get (hs-tokens-of "[a]#a") "list") 4)) "IDENTIFIER") + (assert= (hs-token-value (nth (get (hs-tokens-of "[a]#a") "list") 4)) "a") + (assert= (hs-token-type (nth (get (hs-tokens-of "(a(#a") "list") 3)) "ID_REF") + (assert= (hs-token-value (nth (get (hs-tokens-of "(a(#a") "list") 3)) "#a") + (assert= (hs-token-type (nth (get (hs-tokens-of "{a{#a") "list") 3)) "ID_REF") + (assert= (hs-token-value (nth (get (hs-tokens-of "{a{#a") "list") 3)) "#a") + (assert= (hs-token-type (nth (get (hs-tokens-of "[a[#a") "list") 3)) "ID_REF") + (assert= (hs-token-value (nth (get (hs-tokens-of "[a[#a") "list") 3)) "#a") + ) (deftest "handles identifiers properly" - (error "SKIP (untranslated): handles identifiers properly")) + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "foo"))) "IDENTIFIER") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "foo"))) "foo") + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of " foo "))) "IDENTIFIER") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of " foo "))) "foo") + (let ((s (hs-tokens-of " foo bar"))) + (let ((tok1 (hs-stream-consume s))) + (assert= (hs-token-type tok1) "IDENTIFIER") + (assert= (hs-token-value tok1) "foo") + (let ((tok2 (hs-stream-consume s))) + (assert= (hs-token-type tok2) "IDENTIFIER") + (assert= (hs-token-value tok2) "bar")))) + (let ((s (hs-tokens-of " foo\n-- a comment\n bar"))) + (let ((tok1 (hs-stream-consume s))) + (assert= (hs-token-type tok1) "IDENTIFIER") + (assert= (hs-token-value tok1) "foo") + (let ((tok2 (hs-stream-consume s))) + (assert= (hs-token-type tok2) "IDENTIFIER") + (assert= (hs-token-value tok2) "bar")))) + ) (deftest "handles identifiers with numbers properly" - (error "SKIP (untranslated): handles identifiers with numbers properly")) + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "f1oo"))) "IDENTIFIER") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "f1oo"))) "f1oo") + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "fo1o"))) "IDENTIFIER") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "fo1o"))) "fo1o") + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "foo1"))) "IDENTIFIER") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "foo1"))) "foo1") + ) (deftest "handles look ahead property" - (error "SKIP (untranslated): handles look ahead property")) + (assert= (hs-token-value (hs-stream-token (hs-tokens-of "a 1 + 1") 0)) "a") + (assert= (hs-token-value (hs-stream-token (hs-tokens-of "a 1 + 1") 1)) "1") + (assert= (hs-token-value (hs-stream-token (hs-tokens-of "a 1 + 1") 2)) "+") + (assert= (hs-token-value (hs-stream-token (hs-tokens-of "a 1 + 1") 3)) "1") + (assert= (hs-token-value (hs-stream-token (hs-tokens-of "a 1 + 1") 4)) "<<>>") + ) (deftest "handles numbers properly" - (error "SKIP (untranslated): handles numbers properly")) + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1"))) "NUMBER") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "1"))) "1") + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1.1"))) "NUMBER") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "1.1"))) "1.1") + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1234567890.1234567890"))) "NUMBER") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "1234567890.1234567890"))) "1234567890.1234567890") + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1e6"))) "NUMBER") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "1e6"))) "1e6") + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1e-6"))) "NUMBER") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "1e-6"))) "1e-6") + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1.1e6"))) "NUMBER") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "1.1e6"))) "1.1e6") + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1.1e-6"))) "NUMBER") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "1.1e-6"))) "1.1e-6") + (assert= (hs-token-type (nth (get (hs-tokens-of "1.1.1") "list") 0)) "NUMBER") + (assert= (hs-token-type (nth (get (hs-tokens-of "1.1.1") "list") 1)) "PERIOD") + (assert= (hs-token-type (nth (get (hs-tokens-of "1.1.1") "list") 2)) "NUMBER") + (assert= (len (get (hs-tokens-of "1.1.1") "list")) 3) + ) (deftest "handles operators properly" - (error "SKIP (untranslated): handles operators properly")) + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "+"))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "+"))) "+") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "-"))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "-"))) "-") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "*"))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "*"))) "*") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "."))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "."))) ".") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "\\"))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\\"))) "\\") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of ":"))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of ":"))) ":") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "%"))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "%"))) "%") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "|"))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "|"))) "|") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "!"))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "!"))) "!") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "?"))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "?"))) "?") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "#"))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "#"))) "#") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "&"))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "&"))) "&") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of ";"))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of ";"))) ";") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of ","))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of ","))) ",") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "("))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "("))) "(") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of ")"))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of ")"))) ")") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "<"))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "<"))) "<") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of ">"))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of ">"))) ">") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "{"))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "{"))) "{") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "}"))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "}"))) "}") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "["))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "["))) "[") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "]"))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "]"))) "]") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "="))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "="))) "=") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "<="))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "<="))) "<=") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of ">="))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of ">="))) ">=") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "=="))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "=="))) "==") + (assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "==="))) true) + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "==="))) "===") + ) (deftest "handles strings properly" - (error "SKIP (untranslated): handles strings properly")) + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "\"foo\""))) "STRING") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"foo\""))) "foo") + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "\"fo'o\""))) "STRING") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"fo'o\""))) "fo'o") + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "\"fo\\\"o\""))) "STRING") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"fo\\\"o\""))) "fo\"o") + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "'foo'"))) "STRING") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "'foo'"))) "foo") + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "'fo\"o'"))) "STRING") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "'fo\"o'"))) "fo\"o") + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "'fo\\'o'"))) "STRING") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "'fo\\'o'"))) "fo'o") + (let ((threw false)) + (guard (e (true (set! threw true))) (hs-stream-consume (hs-tokens-of "'"))) + (assert threw)) + (let ((threw false)) + (guard (e (true (set! threw true))) (hs-stream-consume (hs-tokens-of "\""))) + (assert threw)) + ) (deftest "handles strings properly 2" - (error "SKIP (untranslated): handles strings properly 2")) + (assert= (hs-token-type (hs-stream-consume (hs-tokens-of "'foo'"))) "STRING") + (assert= (hs-token-value (hs-stream-consume (hs-tokens-of "'foo'"))) "foo") + ) (deftest "handles template bootstrap properly" - (error "SKIP (untranslated): handles template bootstrap properly")) + (assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"" :template) 0)) "\"") + (assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"$" :template) 0)) "\"") + (assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"$" :template) 1)) "$") + (assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${" :template) 0)) "\"") + (assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${" :template) 1)) "$") + (assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${" :template) 2)) "{") + (assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"" :template) 0)) "\"") + (assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"" :template) 1)) "$") + (assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"" :template) 2)) "{") + (assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"" :template) 3)) "asdf") + (assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"}\"" :template) 0)) "\"") + (assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"}\"" :template) 1)) "$") + (assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"}\"" :template) 2)) "{") + (assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"}\"" :template) 3)) "asdf") + (assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"}\"" :template) 4)) "}") + (assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"}\"" :template) 5)) "\"") + ) (deftest "handles whitespace properly" - (error "SKIP (untranslated): handles whitespace properly")) + (assert= (len (get (hs-tokens-of " ") "list")) 0) + (assert= (len (get (hs-tokens-of " asdf") "list")) 1) + (assert= (len (get (hs-tokens-of " asdf ") "list")) 2) + (assert= (len (get (hs-tokens-of "asdf ") "list")) 2) + (assert= (len (get (hs-tokens-of "\n") "list")) 0) + (assert= (len (get (hs-tokens-of "\nasdf") "list")) 1) + (assert= (len (get (hs-tokens-of "\nasdf\n") "list")) 2) + (assert= (len (get (hs-tokens-of "asdf\n") "list")) 2) + (assert= (len (get (hs-tokens-of "\r") "list")) 0) + (assert= (len (get (hs-tokens-of "\rasdf") "list")) 1) + (assert= (len (get (hs-tokens-of "\rasdf\r") "list")) 2) + (assert= (len (get (hs-tokens-of "asdf\r") "list")) 2) + (assert= (len (get (hs-tokens-of "\t") "list")) 0) + (assert= (len (get (hs-tokens-of "\tasdf") "list")) 1) + (assert= (len (get (hs-tokens-of "\tasdf\t") "list")) 2) + (assert= (len (get (hs-tokens-of "asdf\t") "list")) 2) + ) (deftest "string interpolation isnt surprising" (hs-cleanup!) (let ((_el-div (dom-create-element "div"))) - (dom-set-attr _el-div "_" "on click set x to 42 then put `test${x} test ${x} test$x test $x test $x test ${x} test$x test_$x test_${x} test-$x test.$x` into my.innerHTML") + (dom-set-attr _el-div "_" "on click set x to 42 then put `test\\${x} test ${x} test\\$x test $x test \\$x test \\${x} test$x test_$x test_${x} test-$x test.$x` into my.innerHTML") (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) @@ -3392,7 +3638,7 @@ (assert= (eval-hs "[1 + 1, 2 * 3, 10 - 5]") (list 2 6 5)) ) (deftest "arrays containing objects work" - (assert= (eval-hs "[{a: 1}, {b: 2}]") (list {:a 1} {:b 2})) + (assert-equal (list {:a 1} {:b 2}) (eval-hs "[{a: 1}, {b: 2}]")) ) (deftest "deeply nested array literals work" (assert= (eval-hs "[[[1]], [[2, 3]]]") (list (list (list 1)) (list (list 2 3)))) @@ -3495,11 +3741,11 @@ (dom-set-attr _el-input6 "value" "555-1212") (dom-append (dom-body) _el-qsdiv) (dom-append _el-qsdiv _el-input) - (dom-append _el-input _el-br) - (dom-append _el-br _el-input3) - (dom-append _el-input3 _el-br4) - (dom-append _el-br4 _el-input5) - (dom-append _el-input5 _el-input6) + (dom-append _el-qsdiv _el-br) + (dom-append _el-qsdiv _el-input3) + (dom-append _el-qsdiv _el-br4) + (dom-append _el-qsdiv _el-input5) + (dom-append _el-qsdiv _el-input6) (hs-activate! _el-qsdiv) )) (deftest "converts an array into HTML" @@ -4131,9 +4377,9 @@ (dom-append _el-table _el-tr) (dom-append _el-tr _el-td) (dom-append _el-td _el-input) - (dom-append _el-input _el-input4) - (dom-append _el-input4 _el-master) - (dom-append _el-master _el-out) + (dom-append _el-td _el-input4) + (dom-append _el-td _el-master) + (dom-append (dom-body) _el-out) (hs-activate! _el-master) (dom-dispatch (dom-query-by-id "master") "click" nil) (assert= (dom-text-content (dom-query-by-id "out")) "2") @@ -4214,13 +4460,13 @@ (dom-append _el-table _el-tr) (dom-append _el-tr _el-td) (dom-append _el-td _el-input) - (dom-append _el-input _el-tr4) + (dom-append _el-table _el-tr4) (dom-append _el-tr4 _el-td5) (dom-append _el-td5 _el-input6) - (dom-append _el-input6 _el-tr7) + (dom-append _el-table _el-tr7) (dom-append _el-tr7 _el-td8) (dom-append _el-td8 _el-input9) - (dom-append _el-input9 _el-tr10) + (dom-append _el-table _el-tr10) (dom-append _el-tr10 _el-td11) (dom-append _el-td11 _el-master) (hs-activate! _el-master) @@ -4402,13 +4648,13 @@ (dom-append _el-table _el-tr) (dom-append _el-tr _el-td) (dom-append _el-td _el-input) - (dom-append _el-input _el-tr4) + (dom-append _el-table _el-tr4) (dom-append _el-tr4 _el-td5) (dom-append _el-td5 _el-input6) - (dom-append _el-input6 _el-tr7) + (dom-append _el-table _el-tr7) (dom-append _el-tr7 _el-td8) (dom-append _el-td8 _el-input9) - (dom-append _el-input9 _el-tr10) + (dom-append _el-table _el-tr10) (dom-append _el-tr10 _el-td11) (dom-append _el-td11 _el-master) (hs-activate! _el-master) @@ -4427,9 +4673,9 @@ (dom-set-inner-html _el-script " in #box where it is not me on change set checked of the :checkboxes to my checked\">") (dom-append (dom-body) _el-box) (dom-append _el-box _el-input) - (dom-append _el-input _el-input2) - (dom-append _el-input2 _el-script) - (dom-append _el-input2 _el-test-where-me) + (dom-append _el-box _el-input2) + (dom-append (dom-body) _el-script) + (dom-append (dom-body) _el-test-where-me) (dom-dispatch (dom-query "test-where-me input") "click" nil) )) (deftest "works with DOM elements" @@ -5345,7 +5591,7 @@ (deftest "can invoke global function w/ async arg" (error "SKIP (untranslated): can invoke global function w/ async arg")) (deftest "can pass an array literal as an argument" - (assert= (eval-hs-locals "sum([1, 2, 3, 4])" (list (list (quote sum) (fn (arr) (host-call arr "reduce" (fn (a b) (+ a b)) 0))))) 10) + (assert= (eval-hs-locals "sum([1, 2, 3, 4])" (list (list (quote sum) (fn (arr) (reduce (fn (a b) (+ a b)) 0 arr))))) 10) ) (deftest "can pass an expression as an argument" (assert= (eval-hs-locals "double(3 + 4)" (list (list (quote double) (fn (n) (* n 2))))) 14) @@ -7213,7 +7459,14 @@ ;; ── fetch (23 tests) ── (defsuite "hs-upstream-fetch" (deftest "Response can be converted to JSON via as JSON" - (error "SKIP (skip-list): Response can be converted to JSON via as JSON")) + (hs-cleanup!) + (let ((_el-div (dom-create-element "div"))) + (dom-set-attr _el-div "_" "on click fetch /test as Response then put (it as JSON).name into me") + (dom-append (dom-body) _el-div) + (hs-activate! _el-div) + (dom-dispatch _el-div "click" nil) + (assert= (dom-text-content _el-div) "Joe") + )) (deftest "allows the event handler to change the fetch parameters" (hs-cleanup!) (let ((_el-div (dom-create-element "div"))) @@ -7224,9 +7477,23 @@ (assert= (dom-text-content _el-div) "yay") )) (deftest "as response does not throw on 404" - (error "SKIP (skip-list): as response does not throw on 404")) + (hs-cleanup!) + (let ((_el-div (dom-create-element "div"))) + (dom-set-attr _el-div "_" "on click fetch /test as response then put it.status into me") + (dom-append (dom-body) _el-div) + (hs-activate! _el-div) + (dom-dispatch _el-div "click" nil) + (assert= (dom-text-content _el-div) "404") + )) (deftest "can catch an error that occurs when using fetch" - (error "SKIP (skip-list): can catch an error that occurs when using fetch")) + (hs-cleanup!) + (let ((_el-div (dom-create-element "div"))) + (dom-set-attr _el-div "_" "on click fetch /test catch e log e put \"yay\" into me") + (dom-append (dom-body) _el-div) + (hs-activate! _el-div) + (dom-dispatch _el-div "click" nil) + (assert= (dom-text-content _el-div) "yay") + )) (deftest "can do a simple fetch" (hs-cleanup!) (let ((_el-div (dom-create-element "div"))) @@ -7347,9 +7614,23 @@ (assert= (dom-text-content _el-div) "yay") )) (deftest "do not throw passes through 404 response" - (error "SKIP (skip-list): do not throw passes through 404 response")) + (hs-cleanup!) + (let ((_el-div (dom-create-element "div"))) + (dom-set-attr _el-div "_" "on click fetch /test do not throw then put it into me") + (dom-append (dom-body) _el-div) + (hs-activate! _el-div) + (dom-dispatch _el-div "click" nil) + (assert= (dom-text-content _el-div) "the body") + )) (deftest "don't throw passes through 404 response" - (error "SKIP (skip-list): don't throw passes through 404 response")) + (hs-cleanup!) + (let ((_el-div (dom-create-element "div"))) + (dom-set-attr _el-div "_" "on click fetch /test don't throw then put it into me") + (dom-append (dom-body) _el-div) + (hs-activate! _el-div) + (dom-dispatch _el-div "click" nil) + (assert= (dom-text-content _el-div) "the body") + )) (deftest "submits the fetch parameters to the event handler" (hs-cleanup!) (host-set! (host-global "window") "headerCheckPassed" false) @@ -7361,9 +7642,26 @@ (assert= (dom-text-content _el-div) "yay") )) (deftest "throws on non-2xx response by default" - (error "SKIP (skip-list): throws on non-2xx response by default")) + (hs-cleanup!) + (let ((_el-div (dom-create-element "div"))) + (dom-set-attr _el-div "_" "on click fetch /test catch e put \"caught\" into me") + (dom-append (dom-body) _el-div) + (hs-activate! _el-div) + (dom-dispatch _el-div "click" nil) + (assert= (dom-text-content _el-div) "caught") + )) (deftest "triggers an event just before fetching" - (error "SKIP (skip-list): triggers an event just before fetching")) + (hs-cleanup!) + (host-call (host-global "window") "addEventListener" "hyperscript:beforeFetch" (fn (_event) (dom-set-attr (host-get _event "target") "class" "foo-set"))) + (let ((_el-div (dom-create-element "div"))) + (dom-set-attr _el-div "_" "on click fetch \"/test\" then put it into my.innerHTML end") + (dom-append (dom-body) _el-div) + (hs-activate! _el-div) + (assert (not (dom-has-class? _el-div "foo-set"))) + (dom-dispatch _el-div "click" nil) + (assert (dom-has-class? _el-div "foo-set")) + (assert= (dom-text-content _el-div) "yay") + )) ) ;; ── focus (3 tests) ──