HS: as Date/Set/Map return real JS host objects (+4 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 45s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 45s
- hs-coerce "Date": new case returns (host-new "Date" value) - hs-coerce "Set": creates real JS Set via host-new + for-each add (was SX list) - hs-coerce "Map": creates real JS Map via host-new + for-each set (was SX list) - hs-make "Set"/"Map": use host-new instead of (list)/(dict) - hs-add-to!, hs-remove-from!, hs-empty-like, hs-append: handle real JS Sets - hs-run-filtered.js: add hs-is-set? and hs-is-map? natives - generator: MANUAL_TEST_BODIES for converts-as-Date (×2), as-Set, as-Map asExpression suite: 36/42 (was 32/42) Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -470,6 +470,7 @@
|
|||||||
(some (fn (x) (= x value)) target)
|
(some (fn (x) (= x value)) target)
|
||||||
target
|
target
|
||||||
(append target (list value))))
|
(append target (list value))))
|
||||||
|
((hs-is-set? target) (do (host-call target "add" value) target))
|
||||||
(true (do (host-call target "push" value) target)))))
|
(true (do (host-call target "push" value) target)))))
|
||||||
|
|
||||||
;; ── Object creation ─────────────────────────────────────────────
|
;; ── Object creation ─────────────────────────────────────────────
|
||||||
@@ -480,10 +481,10 @@
|
|||||||
hs-remove-from!
|
hs-remove-from!
|
||||||
(fn
|
(fn
|
||||||
(value target)
|
(value target)
|
||||||
(if
|
(cond
|
||||||
(list? target)
|
((list? target) (filter (fn (x) (not (= x value))) target))
|
||||||
(filter (fn (x) (not (= x value))) target)
|
((hs-is-set? target) (do (host-call target "delete" value) target))
|
||||||
(host-call target "splice" (host-call target "indexOf" value) 1))))
|
(true (host-call target "splice" (host-call target "indexOf" value) 1)))))
|
||||||
|
|
||||||
;; ── Behavior installation ───────────────────────────────────────
|
;; ── Behavior installation ───────────────────────────────────────
|
||||||
|
|
||||||
@@ -965,6 +966,7 @@
|
|||||||
(some (fn (x) (= x value)) target)
|
(some (fn (x) (= x value)) target)
|
||||||
target
|
target
|
||||||
(append target (list value))))
|
(append target (list value))))
|
||||||
|
((hs-is-set? target) (do (host-call target "add" value) target))
|
||||||
((hs-element? target)
|
((hs-element? target)
|
||||||
(do
|
(do
|
||||||
(dom-insert-adjacent-html
|
(dom-insert-adjacent-html
|
||||||
@@ -1260,22 +1262,24 @@
|
|||||||
value)
|
value)
|
||||||
value))
|
value))
|
||||||
((= type-name "Set")
|
((= type-name "Set")
|
||||||
(if
|
|
||||||
(list? value)
|
|
||||||
(reduce
|
|
||||||
(fn
|
|
||||||
(acc x)
|
|
||||||
(if (some (fn (a) (= a x)) acc) acc (append acc (list x))))
|
|
||||||
(list)
|
|
||||||
value)
|
|
||||||
value))
|
|
||||||
((= type-name "Map")
|
|
||||||
(if
|
|
||||||
(dict? value)
|
|
||||||
(let
|
(let
|
||||||
((ks (if (dict-has? value "_order") (get value "_order") (filter (fn (k) (not (= k "_order"))) (keys value)))))
|
((s (host-new "Set")))
|
||||||
(map (fn (k) (list k (get value k))) ks))
|
(do
|
||||||
value))
|
(when
|
||||||
|
(list? value)
|
||||||
|
(for-each (fn (x) (host-call s "add" x)) value))
|
||||||
|
s)))
|
||||||
|
((= type-name "Map")
|
||||||
|
(let
|
||||||
|
((m (host-new "Map")))
|
||||||
|
(do
|
||||||
|
(when
|
||||||
|
(dict? value)
|
||||||
|
(for-each
|
||||||
|
(fn (k) (host-call m "set" k (get value k)))
|
||||||
|
(filter (fn (k) (not (= k "_order"))) (keys value))))
|
||||||
|
m)))
|
||||||
|
((= type-name "Date") (host-new "Date" value))
|
||||||
(true value))))
|
(true value))))
|
||||||
|
|
||||||
(define
|
(define
|
||||||
@@ -1471,8 +1475,8 @@
|
|||||||
(cond
|
(cond
|
||||||
((= type-name "Object") (dict))
|
((= type-name "Object") (dict))
|
||||||
((= type-name "Array") (list))
|
((= type-name "Array") (list))
|
||||||
((= type-name "Set") (list))
|
((= type-name "Set") (host-new "Set"))
|
||||||
((= type-name "Map") (dict))
|
((= type-name "Map") (host-new "Map"))
|
||||||
(true (dict)))
|
(true (dict)))
|
||||||
(apply host-new (cons type-name args)))))))
|
(apply host-new (cons type-name args)))))))
|
||||||
(define
|
(define
|
||||||
@@ -1871,6 +1875,8 @@
|
|||||||
(cond
|
(cond
|
||||||
((list? v) (list))
|
((list? v) (list))
|
||||||
((dict? v) (dict))
|
((dict? v) (dict))
|
||||||
|
((hs-is-set? v) (host-new "Set"))
|
||||||
|
((hs-is-map? v) (host-new "Map"))
|
||||||
((string? v) "")
|
((string? v) "")
|
||||||
((nil? v) nil)
|
((nil? v) nil)
|
||||||
(true v))))
|
(true v))))
|
||||||
|
|||||||
@@ -3724,7 +3724,9 @@
|
|||||||
(deftest "can accept custom dynamic conversions"
|
(deftest "can accept custom dynamic conversions"
|
||||||
(error "SKIP (untranslated): can accept custom dynamic conversions"))
|
(error "SKIP (untranslated): can accept custom dynamic conversions"))
|
||||||
(deftest "can use the a modifier if you like"
|
(deftest "can use the a modifier if you like"
|
||||||
(error "SKIP (untranslated): can use the a modifier if you like"))
|
(let ((_result (eval-hs "1 as a Date")))
|
||||||
|
(assert= (host-call _result "getTime") 1))
|
||||||
|
)
|
||||||
(deftest "can use the an modifier if you'd like"
|
(deftest "can use the an modifier if you'd like"
|
||||||
(assert= (host-get (eval-hs "'{\"foo\":\"bar\"}' as an Object") "foo") "bar")
|
(assert= (host-get (eval-hs "'{\"foo\":\"bar\"}' as an Object") "foo") "bar")
|
||||||
)
|
)
|
||||||
@@ -3828,7 +3830,10 @@
|
|||||||
(assert= (eval-hs "[1,2,3] as Reversed") (list 3 2 1))
|
(assert= (eval-hs "[1,2,3] as Reversed") (list 3 2 1))
|
||||||
)
|
)
|
||||||
(deftest "converts array as Set"
|
(deftest "converts array as Set"
|
||||||
(error "SKIP (untranslated): converts array as Set"))
|
(let ((_result (eval-hs "[1,2,2,3] as Set")))
|
||||||
|
(assert (hs-is-set? _result))
|
||||||
|
(assert= (host-get _result "size") 3))
|
||||||
|
)
|
||||||
(deftest "converts array as Unique"
|
(deftest "converts array as Unique"
|
||||||
(assert= (eval-hs "[1,2,2,3,3] as Unique") (list 1 2 3))
|
(assert= (eval-hs "[1,2,2,3,3] as Unique") (list 1 2 3))
|
||||||
)
|
)
|
||||||
@@ -3881,7 +3886,11 @@
|
|||||||
(assert= (eval-hs "{a:1, b:2} as Keys") (list "a" "b"))
|
(assert= (eval-hs "{a:1, b:2} as Keys") (list "a" "b"))
|
||||||
)
|
)
|
||||||
(deftest "converts object as Map"
|
(deftest "converts object as Map"
|
||||||
(error "SKIP (untranslated): converts object as Map"))
|
(let ((_result (eval-hs "{a:1, b:2} as Map")))
|
||||||
|
(assert (hs-is-map? _result))
|
||||||
|
(assert= (host-call _result "get" "a") 1)
|
||||||
|
(assert= (host-get _result "size") 2))
|
||||||
|
)
|
||||||
(deftest "converts radio buttons into a Value correctly"
|
(deftest "converts radio buttons into a Value correctly"
|
||||||
(let ((_node (dom-create-element "form")))
|
(let ((_node (dom-create-element "form")))
|
||||||
(dom-set-inner-html _node "<div> <input type=\"radio\" name=\"gender\" value=\"Male\" checked> <input type=\"radio\" name=\"gender\" value=\"Female\"> <input type=\"radio\" name=\"gender\" value=\"Other\"> </div>")
|
(dom-set-inner-html _node "<div> <input type=\"radio\" name=\"gender\" value=\"Male\" checked> <input type=\"radio\" name=\"gender\" value=\"Female\"> <input type=\"radio\" name=\"gender\" value=\"Other\"> </div>")
|
||||||
@@ -3901,7 +3910,9 @@
|
|||||||
(assert= (eval-hs "'hello' as Boolean") true)
|
(assert= (eval-hs "'hello' as Boolean") true)
|
||||||
)
|
)
|
||||||
(deftest "converts value as Date"
|
(deftest "converts value as Date"
|
||||||
(error "SKIP (untranslated): converts value as Date"))
|
(let ((_result (eval-hs "1 as Date")))
|
||||||
|
(assert= (host-call _result "getTime") 1))
|
||||||
|
)
|
||||||
(deftest "converts value as Fixed"
|
(deftest "converts value as Fixed"
|
||||||
(assert= (eval-hs "'10.4' as Fixed") "10")
|
(assert= (eval-hs "'10.4' as Fixed") "10")
|
||||||
(assert= (eval-hs "'10.4899' as Fixed:2") "10.49")
|
(assert= (eval-hs "'10.4899' as Fixed:2") "10.49")
|
||||||
|
|||||||
@@ -593,6 +593,8 @@ K.registerNative('host-iter?',([obj])=>obj!=null&&typeof obj[Symbol.iterator]===
|
|||||||
K.registerNative('host-to-list',([obj])=>{try{return[...obj];}catch(e){return[];}});
|
K.registerNative('host-to-list',([obj])=>{try{return[...obj];}catch(e){return[];}});
|
||||||
K.registerNative('host-await',a=>{});
|
K.registerNative('host-await',a=>{});
|
||||||
K.registerNative('load-library!',()=>false);
|
K.registerNative('load-library!',()=>false);
|
||||||
|
K.registerNative('hs-is-set?',a=>a[0] instanceof Set);
|
||||||
|
K.registerNative('hs-is-map?',a=>a[0] instanceof Map);
|
||||||
// Upstream test fixtures: synchronous stubs matching OCaml run_tests.ml registrations
|
// Upstream test fixtures: synchronous stubs matching OCaml run_tests.ml registrations
|
||||||
globalThis.promiseAString = () => 'foo';
|
globalThis.promiseAString = () => 'foo';
|
||||||
globalThis.promiseAnInt = () => 42;
|
globalThis.promiseAnInt = () => 42;
|
||||||
|
|||||||
@@ -326,6 +326,26 @@ MANUAL_TEST_BODIES = {
|
|||||||
' (list (list (quote record) record)))',
|
' (list (list (quote record) record)))',
|
||||||
' "<div age=\\"21\\" style=\\"color:bleaux\\">John Connor</div>"))',
|
' "<div age=\\"21\\" style=\\"color:bleaux\\">John Connor</div>"))',
|
||||||
],
|
],
|
||||||
|
# asExpression: Date/Set/Map need real JS host objects
|
||||||
|
"converts value as Date": [
|
||||||
|
' (let ((_result (eval-hs "1 as Date")))',
|
||||||
|
' (assert= (host-call _result "getTime") 1))',
|
||||||
|
],
|
||||||
|
"can use the a modifier if you like": [
|
||||||
|
' (let ((_result (eval-hs "1 as a Date")))',
|
||||||
|
' (assert= (host-call _result "getTime") 1))',
|
||||||
|
],
|
||||||
|
"converts array as Set": [
|
||||||
|
' (let ((_result (eval-hs "[1,2,2,3] as Set")))',
|
||||||
|
' (assert (hs-is-set? _result))',
|
||||||
|
' (assert= (host-get _result "size") 3))',
|
||||||
|
],
|
||||||
|
"converts object as Map": [
|
||||||
|
' (let ((_result (eval-hs "{a:1, b:2} as Map")))',
|
||||||
|
' (assert (hs-is-map? _result))',
|
||||||
|
' (assert= (host-call _result "get" "a") 1)',
|
||||||
|
' (assert= (host-get _result "size") 2))',
|
||||||
|
],
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user