rose-ash/spec/tests/test-foreign.sx

;; FFI tests — define-foreign, *foreign-registry*, foreign-dispatch

(defsuite
  "foreign-registry-basic"
  (deftest
    "define-foreign registers in *foreign-registry*"
    (define-foreign my-abs (x :as number) :returns :number :js "Math.abs")
    (assert (foreign-registered? "my-abs")))
  (deftest
    "foreign-lookup returns spec dict"
    (define-foreign my-floor (x :as number) :returns :number :js "Math.floor")
    (let
      ((spec (foreign-lookup "my-floor")))
      (assert= (get spec "name") "my-floor")
      (assert= (get spec "js") "Math.floor")
      (assert= (get spec "returns") "number")))
  (deftest
    "foreign-names includes registered names"
    (define-foreign my-ceil (x :as number) :returns :number :js "Math.ceil")
    (assert (contains? (foreign-names) "my-ceil")))
  (deftest
    "define-foreign creates callable lambda"
    (define-foreign my-round (x :as number) :returns :number :js "Math.round")
    (assert (lambda? my-round)))
  (deftest
    "multiple define-foreign coexist"
    (define-foreign ff-a () :js "Date.now")
    (define-foreign ff-b (s :as string) :js "parseInt")
    (assert (foreign-registered? "ff-a"))
    (assert (foreign-registered? "ff-b"))))

(defsuite
  "foreign-param-parsing"
  (deftest
    "single param with type"
    (define-foreign fp-one (url :as string) :js "encodeURI")
    (let
      ((spec (foreign-lookup "fp-one")))
      (let
        ((params (get spec "params")))
        (assert= (len params) 1)
        (assert= (get (first params) "name") "url")
        (assert= (get (first params) "type") "string"))))
  (deftest
    "multiple params with types"
    (define-foreign fp-two (base :as string radix :as number) :js "parseInt")
    (let
      ((spec (foreign-lookup "fp-two")))
      (let
        ((params (get spec "params")))
        (assert= (len params) 2)
        (assert= (get (first params) "name") "base")
        (assert= (get (first params) "type") "string")
        (assert= (get (nth params 1) "name") "radix")
        (assert= (get (nth params 1) "type") "number"))))
  (deftest
    "no params"
    (define-foreign fp-none () :js "Date.now")
    (let
      ((spec (foreign-lookup "fp-none")))
      (assert= (len (get spec "params")) 0)))
  (deftest
    "param without :as defaults to any"
    (define-foreign fp-any (x) :js "String")
    (let
      ((spec (foreign-lookup "fp-any")))
      (let
        ((params (get spec "params")))
        (assert= (get (first params) "type") "any"))))
  (deftest
    "callback param type"
    (define-foreign fp-cb (handler :as callback) :js "setTimeout")
    (let
      ((spec (foreign-lookup "fp-cb")))
      (assert= (get (first (get spec "params")) "type") "callback"))))

(defsuite
  "foreign-binding-resolution"
  (deftest
    "dotted binding splits into object + method"
    (let
      ((resolved (foreign-resolve-binding "localStorage.getItem")))
      (assert= (get resolved "object") "localStorage")
      (assert= (get resolved "method") "getItem")))
  (deftest
    "simple binding has nil object"
    (let
      ((resolved (foreign-resolve-binding "parseInt")))
      (assert= (get resolved "object") nil)
      (assert= (get resolved "method") "parseInt")))
  (deftest
    "deep dotted binding preserves object path"
    (let
      ((resolved (foreign-resolve-binding "window.navigator.language")))
      (assert= (get resolved "object") "window.navigator")
      (assert= (get resolved "method") "language")))
  (deftest
    "single segment is method only"
    (let
      ((resolved (foreign-resolve-binding "alert")))
      (assert= (get resolved "object") nil)
      (assert= (get resolved "method") "alert"))))

(defsuite
  "foreign-kwargs"
  (deftest
    "returns keyword parsed correctly"
    (define-foreign fk-ret (x :as number) :returns :number :js "Math.abs")
    (assert= (get (foreign-lookup "fk-ret") "returns") "number"))
  (deftest
    "doc keyword stored"
    (define-foreign fk-doc () :js "Date.now" :doc "Get current timestamp")
    (assert= (get (foreign-lookup "fk-doc") "doc") "Get current timestamp"))
  (deftest
    "capability keyword stored"
    (define-foreign
      fk-cap
      (url :as string)
      :returns :promise
      :js "window.fetch"
      :capability :network)
    (assert= (get (foreign-lookup "fk-cap") "capability") "network"))
  (deftest
    "promise return type"
    (define-foreign
      fk-async
      (url :as string)
      :returns :promise
      :js "window.fetch")
    (assert= (get (foreign-lookup "fk-async") "returns") "promise")))

(defsuite
  "foreign-build-lambda"
  (deftest
    "sync foreign builds non-perform lambda"
    (define-foreign fbl-sync (x :as number) :returns :number :js "Math.abs")
    (let
      ((spec (foreign-lookup "fbl-sync")))
      (let
        ((expr (foreign-build-lambda spec)))
        (assert (list? expr))
        (assert= (symbol-name (first expr)) "fn"))))
  (deftest
    "async foreign builds perform-wrapping lambda"
    (define-foreign
      fbl-async
      (url :as string)
      :returns :promise
      :js "window.fetch")
    (let
      ((spec (foreign-lookup "fbl-async")))
      (let
        ((expr (foreign-build-lambda spec)))
        (assert (list? expr))
        (let
          ((body (nth expr 2)))
          (assert= (symbol-name (first body)) "perform"))))))

(defsuite
  "foreign-type-checking"
  (deftest
    "foreign-check-args accepts correct types"
    (foreign-check-args "test" (list {:type "number" :name "x"}) (list 42))
    (assert true))
  (deftest
    "foreign-check-args rejects wrong type"
    (let
      ((err (guard (e (#t (error-message e))) (foreign-check-args "test" (list {:type "number" :name "x"}) (list "not-a-number")) nil)))
      (assert (contains? err "expected number"))))
  (deftest
    "foreign-check-args accepts any type"
    (foreign-check-args "test" (list {:type "any" :name "x"}) (list "hello"))
    (foreign-check-args "test" (list {:type "any" :name "x"}) (list 42))
    (assert true))
  (deftest
    "foreign-check-args rejects too few args"
    (let
      ((err (guard (e (#t (error-message e))) (foreign-check-args "test" (list {:type "number" :name "x"} {:type "number" :name "y"}) (list 1)) nil)))
      (assert (contains? err "expected 2 args")))))