From cabb0467ab4d1f1f6e5d26f89652a21ff781fc17 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 26 Apr 2026 18:45:58 +0000 Subject: [PATCH] =?UTF-8?q?HS:=20E37=20tokenizer=20API=20=E2=80=94=2016/17?= =?UTF-8?q?=20conformance=20tests=20passing?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add hs-raw->api-token, hs-eof-sentinel, hs-api-list, hs-tokens-of, hs-stream-token, hs-stream-consume, hs-stream-has-more, hs-token-type, hs-token-value, hs-token-op? to runtime. Fix tokenizer to emit whitespace tokens and handle dot/hash after closing brackets. Fix hs-tokens-of to accept bare :template keyword flag via &rest args + some() check. Remaining failure (string interpolation isnt surprising) requires full DOM activation infrastructure. Co-Authored-By: Claude Sonnet 4.6 --- lib/hyperscript/runtime.sx | 156 +++++++++ lib/hyperscript/tokenizer.sx | 83 +++-- shared/static/wasm/sx/hs-runtime.sx | 156 +++++++++ shared/static/wasm/sx/hs-tokenizer.sx | 83 +++-- spec/tests/test-hyperscript-behavioral.sx | 388 +++++++++++++++++++--- 5 files changed, 775 insertions(+), 91 deletions(-) diff --git a/lib/hyperscript/runtime.sx b/lib/hyperscript/runtime.sx index a3625171..0a0fd4b6 100644 --- a/lib/hyperscript/runtime.sx +++ b/lib/hyperscript/runtime.sx @@ -2615,3 +2615,159 @@ (raise (host-get state "value")) (if state (host-get state "value") result))) result))))) + +(define + hs-raw->api-token + (fn + (raw) + (let + ((type (dict-get raw :type)) (value (dict-get raw :value))) + (cond + (= type "ident") + {:value value :type "IDENTIFIER" :op false} + (= type "keyword") + {:value value :type "IDENTIFIER" :op false} + (= type "number") + {:value value :type "NUMBER" :op false} + (= type "string") + {:value value :type "STRING" :op false} + (= type "class") + {:value (str "." value) :type "CLASS_REF" :op false} + (= type "id") + {:value (str "#" value) :type "ID_REF" :op false} + (= type "attr") + {:value value :type "ATTRIBUTE_REF" :op false} + (= type "style") + {:value value :type "STYLE_REF" :op false} + (= type "selector") + {:value value :type "QUERY_REF" :op false} + (= type "eof") + {:value "<<>>" :type "EOF" :op false} + (= type "paren-open") + {:value value :type "L_PAREN" :op true} + (= type "paren-close") + {:value value :type "R_PAREN" :op true} + (= type "bracket-open") + {:value value :type "L_BRACKET" :op true} + (= type "bracket-close") + {:value value :type "R_BRACKET" :op true} + (= type "brace-open") + {:value value :type "L_BRACE" :op true} + (= type "brace-close") + {:value value :type "R_BRACE" :op true} + (= type "comma") + {:value value :type "COMMA" :op true} + (= type "dot") + {:value value :type "PERIOD" :op true} + (= type "colon") + {:value value :type "COLON" :op true} + (= type "op") + (cond + (= value "+") + {:value value :type "PLUS" :op true} + (= value "-") + {:value value :type "MINUS" :op true} + (= value "*") + {:value value :type "MULTIPLY" :op true} + (= value "/") + {:value value :type "SLASH" :op true} + (= value "!") + {:value value :type "EXCLAMATION" :op true} + (= value "?") + {:value value :type "QUESTION" :op true} + (= value "#") + {:value value :type "POUND" :op true} + (= value "&") + {:value value :type "AMPERSAND" :op true} + (= value "=") + {:value value :type "EQUALS" :op true} + (= value "<") + {:value value :type "L_ANG" :op true} + (= value ">") + {:value value :type "R_ANG" :op true} + (= value "<=") + {:value value :type "LTE_ANG" :op true} + (= value ">=") + {:value value :type "GTE_ANG" :op true} + (= value "==") + {:value value :type "EQ" :op true} + (= value "===") + {:value value :type "EQQ" :op true} + (= value "..") + {:value value :type "PERIOD_PERIOD" :op true} + :else {:value value :type value :op true}) + :else {:value (or value "") :type (str type) :op false})))) + +(define hs-eof-sentinel {:value "<<>>" :type "EOF" :op false}) + +(define + hs-api-list + (fn + (raw-tokens) + (filter + (fn (t) (not (= (dict-get t :type) "EOF"))) + (map hs-raw->api-token raw-tokens)))) + +(define + hs-tokens-of + (fn + (src &rest args) + (let + ((template (some (fn (a) (equal? a :template)) args))) + (let + ((raw (if template (hs-tokenize-template src) (hs-tokenize src)))) + {:pos 0 :list (hs-api-list raw) :source src})))) + +(define + hs-stream-token + (fn + (s i) + (let + ((lst (get s "list")) (start (get s "pos"))) + (define + find-nth + (fn + (j count) + (let + ((tok (or (nth lst j) hs-eof-sentinel))) + (if + (= (get tok "type") "whitespace") + (find-nth (+ j 1) count) + (if (= count 0) tok (find-nth (+ j 1) (- count 1))))))) + (find-nth start i)))) + +(define + hs-stream-consume + (fn + (s) + (let + ((lst (get s "list"))) + (define + skip-ws + (fn + (j) + (let + ((tok (or (nth lst j) nil))) + (if + (and tok (= (get tok "type") "whitespace")) + (skip-ws (+ j 1)) + j)))) + (let + ((j (skip-ws (get s "pos")))) + (let + ((tok (or (nth lst j) hs-eof-sentinel))) + (do + (when + (not (= (get tok "type") "EOF")) + (dict-set! s :pos (+ j 1))) + tok)))))) + +(define + hs-stream-has-more + (fn (s) (not (= (get (hs-stream-token s 0) "type") "EOF")))) + +(define hs-token-type (fn (tok) (get tok "type"))) + +(define hs-token-value (fn (tok) (get tok "value"))) + +(define hs-token-op? (fn (tok) (get tok "op"))) diff --git a/lib/hyperscript/tokenizer.sx b/lib/hyperscript/tokenizer.sx index 6b1a8742..a461fb60 100644 --- a/lib/hyperscript/tokenizer.sx +++ b/lib/hyperscript/tokenizer.sx @@ -334,11 +334,17 @@ (= ch "r") (do (append! chars "\r") (hs-advance! 1)) (= ch "b") - (do (append! chars (char-from-code 8)) (hs-advance! 1)) + (do + (append! chars (char-from-code 8)) + (hs-advance! 1)) (= ch "f") - (do (append! chars (char-from-code 12)) (hs-advance! 1)) + (do + (append! chars (char-from-code 12)) + (hs-advance! 1)) (= ch "v") - (do (append! chars (char-from-code 11)) (hs-advance! 1)) + (do + (append! chars (char-from-code 11)) + (hs-advance! 1)) (= ch "\\") (do (append! chars "\\") (hs-advance! 1)) (= ch quote-char) @@ -353,12 +359,16 @@ (hs-hex-digit? (hs-peek 1))) (let ((d1 (hs-hex-val (hs-cur))) - (d2 (hs-hex-val (hs-peek 1)))) - (append! chars (char-from-code (+ (* d1 16) d2))) + (d2 (hs-hex-val (hs-peek 1)))) + (append! + chars + (char-from-code (+ (* d1 16) d2))) (hs-advance! 2)) (error "Invalid hexadecimal escape: \\x"))) - :else - (do (append! chars "\\") (append! chars ch) (hs-advance! 1))))) + :else (do + (append! chars "\\") + (append! chars ch) + (hs-advance! 1))))) (loop)) (= (hs-cur) quote-char) (hs-advance! 1) @@ -465,7 +475,13 @@ scan! (fn () - (skip-ws!) + (do + (let + ((ws-start pos)) + (skip-ws!) + (when + (and (> (len tokens) 0) (> pos ws-start)) + (hs-emit! "whitespace" (slice src ws-start pos) ws-start)))) (when (< pos src-len) (let @@ -489,6 +505,25 @@ (do (hs-emit! "selector" (read-selector) start) (scan!)) (and (= ch ".") (< (+ pos 1) src-len) (= (hs-peek 1) ".")) (do (hs-emit! "op" ".." start) (hs-advance! 2) (scan!)) + (and + (= ch ".") + (< (+ pos 1) src-len) + (or + (hs-letter? (hs-peek 1)) + (= (hs-peek 1) "-") + (= (hs-peek 1) "_")) + (> (len tokens) 0) + (let + ((lt (dict-get (nth tokens (- (len tokens) 1)) :type))) + (or + (= lt "paren-close") + (= lt "brace-close") + (= lt "bracket-close")))) + (do + (hs-emit! "dot" "." start) + (hs-advance! 1) + (hs-emit! "ident" (read-ident pos) start) + (scan!)) (and (= ch ".") (< (+ pos 1) src-len) @@ -500,6 +535,22 @@ (hs-advance! 1) (hs-emit! "class" (read-class-name pos) start) (scan!)) + (and + (= ch "#") + (< (+ pos 1) src-len) + (hs-ident-start? (hs-peek 1)) + (> (len tokens) 0) + (let + ((lt (dict-get (nth tokens (- (len tokens) 1)) :type))) + (or + (= lt "paren-close") + (= lt "brace-close") + (= lt "bracket-close")))) + (do + (hs-emit! "op" "#" start) + (hs-advance! 1) + (hs-emit! "ident" (read-ident pos) start) + (scan!)) (and (= ch "#") (< (+ pos 1) src-len) @@ -569,21 +620,7 @@ (let ((word (read-ident start))) (let - ((full-word - (if - (and - (< pos src-len) - (= (hs-cur) "'") - (< (+ pos 1) src-len) - (hs-letter? (hs-peek 1)) - (not - (and - (= (hs-peek 1) "s") - (or - (>= (+ pos 2) src-len) - (not (hs-ident-char? (hs-peek 2))))))) - (do (hs-advance! 1) (str word "'" (read-ident pos))) - word))) + ((full-word (if (and (< pos src-len) (= (hs-cur) "'") (< (+ pos 1) src-len) (hs-letter? (hs-peek 1)) (not (and (= (hs-peek 1) "s") (or (>= (+ pos 2) src-len) (not (hs-ident-char? (hs-peek 2))))))) (do (hs-advance! 1) (str word "'" (read-ident pos))) word))) (hs-emit! (if (hs-keyword? full-word) "keyword" "ident") full-word diff --git a/shared/static/wasm/sx/hs-runtime.sx b/shared/static/wasm/sx/hs-runtime.sx index a3625171..0a0fd4b6 100644 --- a/shared/static/wasm/sx/hs-runtime.sx +++ b/shared/static/wasm/sx/hs-runtime.sx @@ -2615,3 +2615,159 @@ (raise (host-get state "value")) (if state (host-get state "value") result))) result))))) + +(define + hs-raw->api-token + (fn + (raw) + (let + ((type (dict-get raw :type)) (value (dict-get raw :value))) + (cond + (= type "ident") + {:value value :type "IDENTIFIER" :op false} + (= type "keyword") + {:value value :type "IDENTIFIER" :op false} + (= type "number") + {:value value :type "NUMBER" :op false} + (= type "string") + {:value value :type "STRING" :op false} + (= type "class") + {:value (str "." value) :type "CLASS_REF" :op false} + (= type "id") + {:value (str "#" value) :type "ID_REF" :op false} + (= type "attr") + {:value value :type "ATTRIBUTE_REF" :op false} + (= type "style") + {:value value :type "STYLE_REF" :op false} + (= type "selector") + {:value value :type "QUERY_REF" :op false} + (= type "eof") + {:value "<<>>" :type "EOF" :op false} + (= type "paren-open") + {:value value :type "L_PAREN" :op true} + (= type "paren-close") + {:value value :type "R_PAREN" :op true} + (= type "bracket-open") + {:value value :type "L_BRACKET" :op true} + (= type "bracket-close") + {:value value :type "R_BRACKET" :op true} + (= type "brace-open") + {:value value :type "L_BRACE" :op true} + (= type "brace-close") + {:value value :type "R_BRACE" :op true} + (= type "comma") + {:value value :type "COMMA" :op true} + (= type "dot") + {:value value :type "PERIOD" :op true} + (= type "colon") + {:value value :type "COLON" :op true} + (= type "op") + (cond + (= value "+") + {:value value :type "PLUS" :op true} + (= value "-") + {:value value :type "MINUS" :op true} + (= value "*") + {:value value :type "MULTIPLY" :op true} + (= value "/") + {:value value :type "SLASH" :op true} + (= value "!") + {:value value :type "EXCLAMATION" :op true} + (= value "?") + {:value value :type "QUESTION" :op true} + (= value "#") + {:value value :type "POUND" :op true} + (= value "&") + {:value value :type "AMPERSAND" :op true} + (= value "=") + {:value value :type "EQUALS" :op true} + (= value "<") + {:value value :type "L_ANG" :op true} + (= value ">") + {:value value :type "R_ANG" :op true} + (= value "<=") + {:value value :type "LTE_ANG" :op true} + (= value ">=") + {:value value :type "GTE_ANG" :op true} + (= value "==") + {:value value :type "EQ" :op true} + (= value "===") + {:value value :type "EQQ" :op true} + (= value "..") + {:value value :type "PERIOD_PERIOD" :op true} + :else {:value value :type value :op true}) + :else {:value (or value "") :type (str type) :op false})))) + +(define hs-eof-sentinel {:value "<<>>" :type "EOF" :op false}) + +(define + hs-api-list + (fn + (raw-tokens) + (filter + (fn (t) (not (= (dict-get t :type) "EOF"))) + (map hs-raw->api-token raw-tokens)))) + +(define + hs-tokens-of + (fn + (src &rest args) + (let + ((template (some (fn (a) (equal? a :template)) args))) + (let + ((raw (if template (hs-tokenize-template src) (hs-tokenize src)))) + {:pos 0 :list (hs-api-list raw) :source src})))) + +(define + hs-stream-token + (fn + (s i) + (let + ((lst (get s "list")) (start (get s "pos"))) + (define + find-nth + (fn + (j count) + (let + ((tok (or (nth lst j) hs-eof-sentinel))) + (if + (= (get tok "type") "whitespace") + (find-nth (+ j 1) count) + (if (= count 0) tok (find-nth (+ j 1) (- count 1))))))) + (find-nth start i)))) + +(define + hs-stream-consume + (fn + (s) + (let + ((lst (get s "list"))) + (define + skip-ws + (fn + (j) + (let + ((tok (or (nth lst j) nil))) + (if + (and tok (= (get tok "type") "whitespace")) + (skip-ws (+ j 1)) + j)))) + (let + ((j (skip-ws (get s "pos")))) + (let + ((tok (or (nth lst j) hs-eof-sentinel))) + (do + (when + (not (= (get tok "type") "EOF")) + (dict-set! s :pos (+ j 1))) + tok)))))) + +(define + hs-stream-has-more + (fn (s) (not (= (get (hs-stream-token s 0) "type") "EOF")))) + +(define hs-token-type (fn (tok) (get tok "type"))) + +(define hs-token-value (fn (tok) (get tok "value"))) + +(define hs-token-op? (fn (tok) (get tok "op"))) diff --git a/shared/static/wasm/sx/hs-tokenizer.sx b/shared/static/wasm/sx/hs-tokenizer.sx index 6b1a8742..a461fb60 100644 --- a/shared/static/wasm/sx/hs-tokenizer.sx +++ b/shared/static/wasm/sx/hs-tokenizer.sx @@ -334,11 +334,17 @@ (= ch "r") (do (append! chars "\r") (hs-advance! 1)) (= ch "b") - (do (append! chars (char-from-code 8)) (hs-advance! 1)) + (do + (append! chars (char-from-code 8)) + (hs-advance! 1)) (= ch "f") - (do (append! chars (char-from-code 12)) (hs-advance! 1)) + (do + (append! chars (char-from-code 12)) + (hs-advance! 1)) (= ch "v") - (do (append! chars (char-from-code 11)) (hs-advance! 1)) + (do + (append! chars (char-from-code 11)) + (hs-advance! 1)) (= ch "\\") (do (append! chars "\\") (hs-advance! 1)) (= ch quote-char) @@ -353,12 +359,16 @@ (hs-hex-digit? (hs-peek 1))) (let ((d1 (hs-hex-val (hs-cur))) - (d2 (hs-hex-val (hs-peek 1)))) - (append! chars (char-from-code (+ (* d1 16) d2))) + (d2 (hs-hex-val (hs-peek 1)))) + (append! + chars + (char-from-code (+ (* d1 16) d2))) (hs-advance! 2)) (error "Invalid hexadecimal escape: \\x"))) - :else - (do (append! chars "\\") (append! chars ch) (hs-advance! 1))))) + :else (do + (append! chars "\\") + (append! chars ch) + (hs-advance! 1))))) (loop)) (= (hs-cur) quote-char) (hs-advance! 1) @@ -465,7 +475,13 @@ scan! (fn () - (skip-ws!) + (do + (let + ((ws-start pos)) + (skip-ws!) + (when + (and (> (len tokens) 0) (> pos ws-start)) + (hs-emit! "whitespace" (slice src ws-start pos) ws-start)))) (when (< pos src-len) (let @@ -489,6 +505,25 @@ (do (hs-emit! "selector" (read-selector) start) (scan!)) (and (= ch ".") (< (+ pos 1) src-len) (= (hs-peek 1) ".")) (do (hs-emit! "op" ".." start) (hs-advance! 2) (scan!)) + (and + (= ch ".") + (< (+ pos 1) src-len) + (or + (hs-letter? (hs-peek 1)) + (= (hs-peek 1) "-") + (= (hs-peek 1) "_")) + (> (len tokens) 0) + (let + ((lt (dict-get (nth tokens (- (len tokens) 1)) :type))) + (or + (= lt "paren-close") + (= lt "brace-close") + (= lt "bracket-close")))) + (do + (hs-emit! "dot" "." start) + (hs-advance! 1) + (hs-emit! "ident" (read-ident pos) start) + (scan!)) (and (= ch ".") (< (+ pos 1) src-len) @@ -500,6 +535,22 @@ (hs-advance! 1) (hs-emit! "class" (read-class-name pos) start) (scan!)) + (and + (= ch "#") + (< (+ pos 1) src-len) + (hs-ident-start? (hs-peek 1)) + (> (len tokens) 0) + (let + ((lt (dict-get (nth tokens (- (len tokens) 1)) :type))) + (or + (= lt "paren-close") + (= lt "brace-close") + (= lt "bracket-close")))) + (do + (hs-emit! "op" "#" start) + (hs-advance! 1) + (hs-emit! "ident" (read-ident pos) start) + (scan!)) (and (= ch "#") (< (+ pos 1) src-len) @@ -569,21 +620,7 @@ (let ((word (read-ident start))) (let - ((full-word - (if - (and - (< pos src-len) - (= (hs-cur) "'") - (< (+ pos 1) src-len) - (hs-letter? (hs-peek 1)) - (not - (and - (= (hs-peek 1) "s") - (or - (>= (+ pos 2) src-len) - (not (hs-ident-char? (hs-peek 2))))))) - (do (hs-advance! 1) (str word "'" (read-ident pos))) - word))) + ((full-word (if (and (< pos src-len) (= (hs-cur) "'") (< (+ pos 1) src-len) (hs-letter? (hs-peek 1)) (not (and (= (hs-peek 1) "s") (or (>= (+ pos 2) src-len) (not (hs-ident-char? (hs-peek 2))))))) (do (hs-advance! 1) (str word "'" (read-ident pos))) word))) (hs-emit! (if (hs-keyword? full-word) "keyword" "ident") full-word 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) ──