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

;; ==========================================================================
;; test-types.sx — Tests for the SX gradual type system
;;
;; Requires: test-framework.sx loaded first.
;; Modules tested: types.sx (subtype?, infer-type, check-component, etc.)
;;
;; Platform functions required (beyond test framework):
;;   All type system functions from types.sx must be loaded.
;;   test-prim-types — a dict of primitive return types for testing.
;; ==========================================================================


;; --------------------------------------------------------------------------
;; Subtype checking
;; --------------------------------------------------------------------------

(defsuite "subtype-basics"
  (deftest "any accepts everything"
    (assert-true (subtype? "number" "any"))
    (assert-true (subtype? "string" "any"))
    (assert-true (subtype? "nil" "any"))
    (assert-true (subtype? "boolean" "any"))
    (assert-true (subtype? "any" "any")))

  (deftest "never is subtype of everything"
    (assert-true (subtype? "never" "number"))
    (assert-true (subtype? "never" "string"))
    (assert-true (subtype? "never" "any"))
    (assert-true (subtype? "never" "nil")))

  (deftest "identical types"
    (assert-true (subtype? "number" "number"))
    (assert-true (subtype? "string" "string"))
    (assert-true (subtype? "boolean" "boolean"))
    (assert-true (subtype? "nil" "nil")))

  (deftest "different base types are not subtypes"
    (assert-false (subtype? "number" "string"))
    (assert-false (subtype? "string" "number"))
    (assert-false (subtype? "boolean" "number"))
    (assert-false (subtype? "string" "boolean")))

  (deftest "any is not subtype of specific type"
    (assert-false (subtype? "any" "number"))
    (assert-false (subtype? "any" "string"))))


(defsuite "subtype-nullable"
  (deftest "nil is subtype of nullable types"
    (assert-true (subtype? "nil" "string?"))
    (assert-true (subtype? "nil" "number?"))
    (assert-true (subtype? "nil" "dict?"))
    (assert-true (subtype? "nil" "boolean?")))

  (deftest "base is subtype of its nullable"
    (assert-true (subtype? "string" "string?"))
    (assert-true (subtype? "number" "number?"))
    (assert-true (subtype? "dict" "dict?")))

  (deftest "nullable is not subtype of base"
    (assert-false (subtype? "string?" "string"))
    (assert-false (subtype? "number?" "number")))

  (deftest "different nullable types are not subtypes"
    (assert-false (subtype? "number" "string?"))
    (assert-false (subtype? "string" "number?"))))


(defsuite "subtype-unions"
  (deftest "member is subtype of union"
    (assert-true (subtype? "number" (list "or" "number" "string")))
    (assert-true (subtype? "string" (list "or" "number" "string"))))

  (deftest "non-member is not subtype of union"
    (assert-false (subtype? "boolean" (list "or" "number" "string"))))

  (deftest "union is subtype if all members are"
    (assert-true (subtype? (list "or" "number" "string")
                           (list "or" "number" "string" "boolean")))
    (assert-true (subtype? (list "or" "number" "string") "any")))

  (deftest "union is not subtype if any member is not"
    (assert-false (subtype? (list "or" "number" "string") "number"))))


(defsuite "subtype-list-of"
  (deftest "list-of covariance"
    (assert-true (subtype? (list "list-of" "number") (list "list-of" "number")))
    (assert-true (subtype? (list "list-of" "number") (list "list-of" "any"))))

  (deftest "list-of is subtype of list"
    (assert-true (subtype? (list "list-of" "number") "list")))

  (deftest "list is subtype of list-of any"
    (assert-true (subtype? "list" (list "list-of" "any")))))


;; --------------------------------------------------------------------------
;; Type union
;; --------------------------------------------------------------------------

(defsuite "type-union"
  (deftest "same types"
    (assert-equal "number" (type-union "number" "number"))
    (assert-equal "string" (type-union "string" "string")))

  (deftest "any absorbs"
    (assert-equal "any" (type-union "any" "number"))
    (assert-equal "any" (type-union "number" "any")))

  (deftest "never is identity"
    (assert-equal "number" (type-union "never" "number"))
    (assert-equal "string" (type-union "string" "never")))

  (deftest "nil + base creates nullable"
    (assert-equal "string?" (type-union "nil" "string"))
    (assert-equal "number?" (type-union "number" "nil")))

  (deftest "subtype collapses"
    (assert-equal "string?" (type-union "string" "string?"))
    (assert-equal "string?" (type-union "string?" "string")))

  (deftest "incompatible creates union"
    (let ((result (type-union "number" "string")))
      (assert-true (= (type-of result) "list"))
      (assert-equal "or" (first result))
      (assert-true (contains? result "number"))
      (assert-true (contains? result "string")))))


;; --------------------------------------------------------------------------
;; Type narrowing
;; --------------------------------------------------------------------------

(defsuite "type-narrowing"
  (deftest "nil? narrows to nil in then branch"
    (let ((result (narrow-type "string?" "nil?")))
      (assert-equal "nil" (first result))
      (assert-equal "string" (nth result 1))))

  (deftest "nil? narrows any stays any"
    (let ((result (narrow-type "any" "nil?")))
      (assert-equal "nil" (first result))
      (assert-equal "any" (nth result 1))))

  (deftest "string? narrows to string in then branch"
    (let ((result (narrow-type "any" "string?")))
      (assert-equal "string" (first result))
      ;; else branch — can't narrow any
      (assert-equal "any" (nth result 1))))

  (deftest "nil? on nil type narrows to never in else"
    (let ((result (narrow-type "nil" "nil?")))
      (assert-equal "nil" (first result))
      (assert-equal "never" (nth result 1)))))


;; --------------------------------------------------------------------------
;; Type inference
;; --------------------------------------------------------------------------

(defsuite "infer-literals"
  (deftest "number literal"
    (assert-equal "number" (infer-type 42 (dict) (test-prim-types))))

  (deftest "string literal"
    (assert-equal "string" (infer-type "hello" (dict) (test-prim-types))))

  (deftest "boolean literal"
    (assert-equal "boolean" (infer-type true (dict) (test-prim-types))))

  (deftest "nil"
    (assert-equal "nil" (infer-type nil (dict) (test-prim-types)))))


(defsuite "infer-calls"
  (deftest "known primitive return type"
    ;; (+ 1 2) → number
    (let ((expr (sx-parse "(+ 1 2)")))
      (assert-equal "number"
        (infer-type (first expr) (dict) (test-prim-types)))))

  (deftest "str returns string"
    (let ((expr (sx-parse "(str 1 2)")))
      (assert-equal "string"
        (infer-type (first expr) (dict) (test-prim-types)))))

  (deftest "comparison returns boolean"
    (let ((expr (sx-parse "(= 1 2)")))
      (assert-equal "boolean"
        (infer-type (first expr) (dict) (test-prim-types)))))

  (deftest "component call returns element"
    (let ((expr (sx-parse "(~card :title \"hi\")")))
      (assert-equal "element"
        (infer-type (first expr) (dict) (test-prim-types)))))

  (deftest "unknown function returns any"
    (let ((expr (sx-parse "(unknown-fn 1 2)")))
      (assert-equal "any"
        (infer-type (first expr) (dict) (test-prim-types))))))


(defsuite "infer-special-forms"
  (deftest "if produces union of branches"
    (let ((expr (sx-parse "(if true 42 \"hello\")")))
      (let ((t (infer-type (first expr) (dict) (test-prim-types))))
        ;; number | string — should be a union
        (assert-true (or (equal? t (list "or" "number" "string"))
                         (= t "any"))))))

  (deftest "if with no else includes nil"
    (let ((expr (sx-parse "(if true 42)")))
      (let ((t (infer-type (first expr) (dict) (test-prim-types))))
        (assert-equal "number?" t))))

  (deftest "when includes nil"
    (let ((expr (sx-parse "(when true 42)")))
      (let ((t (infer-type (first expr) (dict) (test-prim-types))))
        (assert-equal "number?" t))))

  (deftest "do returns last type"
    (let ((expr (sx-parse "(do 1 2 \"hello\")")))
      (assert-equal "string"
        (infer-type (first expr) (dict) (test-prim-types)))))

  (deftest "let infers binding types"
    (let ((expr (sx-parse "(let ((x 42)) x)")))
      (assert-equal "number"
        (infer-type (first expr) (dict) (test-prim-types)))))

  (deftest "lambda returns lambda"
    (let ((expr (sx-parse "(fn (x) (+ x 1))")))
      (assert-equal "lambda"
        (infer-type (first expr) (dict) (test-prim-types))))))


;; --------------------------------------------------------------------------
;; Component call checking
;; --------------------------------------------------------------------------

(defsuite "check-component-calls"
  (deftest "type mismatch produces error"
    ;; Create a component with typed params, then check a bad call
    (let ((env (test-env)))
      ;; Define a typed component
      (do
        (define dummy-env env)
        (defcomp ~typed-card (&key title price) (div title price))
        (component-set-param-types! ~typed-card
          {:title "string" :price "number"}))
      ;; Check a call with wrong type
      (let ((diagnostics
              (check-component-call "~typed-card" ~typed-card
                (rest (first (sx-parse "(~typed-card :title 42 :price \"bad\")")))
                (dict) (test-prim-types))))
        (assert-true (> (len diagnostics) 0))
        (assert-equal "error" (dict-get (first diagnostics) "level")))))

  (deftest "correct call produces no errors"
    (let ((env (test-env)))
      (do
        (define dummy-env env)
        (defcomp ~ok-card (&key title price) (div title price))
        (component-set-param-types! ~ok-card
          {:title "string" :price "number"}))
      (let ((diagnostics
              (check-component-call "~ok-card" ~ok-card
                (rest (first (sx-parse "(~ok-card :title \"hi\" :price 42)")))
                (dict) (test-prim-types))))
        (assert-equal 0 (len diagnostics)))))

  (deftest "unknown kwarg produces warning"
    (let ((env (test-env)))
      (do
        (define dummy-env env)
        (defcomp ~warn-card (&key title) (div title))
        (component-set-param-types! ~warn-card
          {:title "string"}))
      (let ((diagnostics
              (check-component-call "~warn-card" ~warn-card
                (rest (first (sx-parse "(~warn-card :title \"hi\" :colour \"red\")")))
                (dict) (test-prim-types))))
        (assert-true (> (len diagnostics) 0))
        (assert-equal "warning" (dict-get (first diagnostics) "level"))))))


;; --------------------------------------------------------------------------
;; Annotation syntax: (name :as type) in defcomp params
;; --------------------------------------------------------------------------

(defsuite "typed-defcomp"
  (deftest "typed params are parsed and stored"
    (let ((env (test-env)))
      (defcomp ~typed-widget (&key (title :as string) (count :as number)) (div title count))
      (let ((pt (component-param-types ~typed-widget)))
        (assert-true (not (nil? pt)))
        (assert-equal "string" (dict-get pt "title"))
        (assert-equal "number" (dict-get pt "count")))))

  (deftest "mixed typed and untyped params"
    (let ((env (test-env)))
      (defcomp ~mixed-widget (&key (title :as string) subtitle) (div title subtitle))
      (let ((pt (component-param-types ~mixed-widget)))
        (assert-true (not (nil? pt)))
        (assert-equal "string" (dict-get pt "title"))
        ;; subtitle has no annotation — should not be in param-types
        (assert-false (has-key? pt "subtitle")))))

  (deftest "untyped defcomp has nil param-types"
    (let ((env (test-env)))
      (defcomp ~plain-widget (&key title subtitle) (div title subtitle))
      (assert-true (nil? (component-param-types ~plain-widget)))))

  (deftest "typed component catches type error on call"
    (let ((env (test-env)))
      (defcomp ~strict-card (&key (title :as string) (price :as number)) (div title price))
      ;; Call with wrong types
      (let ((diagnostics
              (check-component-call "~strict-card" ~strict-card
                (rest (first (sx-parse "(~strict-card :title 42 :price \"bad\")")))
                (dict) (test-prim-types))))
        ;; Should have errors for both wrong-type args
        (assert-true (>= (len diagnostics) 1))
        (assert-equal "error" (dict-get (first diagnostics) "level")))))

  (deftest "typed component passes correct call"
    (let ((env (test-env)))
      (defcomp ~ok-widget (&key (name :as string) (age :as number)) (div name age))
      (let ((diagnostics
              (check-component-call "~ok-widget" ~ok-widget
                (rest (first (sx-parse "(~ok-widget :name \"Alice\" :age 30)")))
                (dict) (test-prim-types))))
        (assert-equal 0 (len diagnostics)))))

  (deftest "nullable type accepts nil"
    (let ((env (test-env)))
      (defcomp ~nullable-widget (&key (title :as string) (subtitle :as string?)) (div title subtitle))
      ;; Passing nil for nullable param should be fine
      (let ((diagnostics
              (check-component-call "~nullable-widget" ~nullable-widget
                (rest (first (sx-parse "(~nullable-widget :title \"hi\" :subtitle nil)")))
                (dict) (test-prim-types))))
        (assert-equal 0 (len diagnostics))))))


;; --------------------------------------------------------------------------
;; Primitive call checking (Phase 5)
;; --------------------------------------------------------------------------

(defsuite "check-primitive-calls"
  (deftest "correct types produce no errors"
    (let ((ppt (test-prim-param-types)))
      (let ((diagnostics
              (check-primitive-call "+" (rest (first (sx-parse "(+ 1 2 3)")))
                (dict) (test-prim-types) ppt nil)))
        (assert-equal 0 (len diagnostics)))))

  (deftest "string arg to numeric primitive produces error"
    (let ((ppt (test-prim-param-types)))
      (let ((diagnostics
              (check-primitive-call "+" (rest (first (sx-parse "(+ 1 \"hello\")")))
                (dict) (test-prim-types) ppt nil)))
        (assert-true (> (len diagnostics) 0))
        (assert-equal "error" (get (first diagnostics) "level")))))

  (deftest "number arg to string primitive produces error"
    (let ((ppt (test-prim-param-types)))
      (let ((diagnostics
              (check-primitive-call "upper" (rest (first (sx-parse "(upper 42)")))
                (dict) (test-prim-types) ppt nil)))
        (assert-true (> (len diagnostics) 0))
        (assert-equal "error" (get (first diagnostics) "level")))))

  (deftest "positional and rest params both checked"
    ;; (- "bad" 1) — first positional arg is string, expects number
    (let ((ppt (test-prim-param-types)))
      (let ((diagnostics
              (check-primitive-call "-" (rest (first (sx-parse "(- \"bad\" 1)")))
                (dict) (test-prim-types) ppt nil)))
        (assert-true (> (len diagnostics) 0)))))

  (deftest "dict arg to keys is valid"
    (let ((ppt (test-prim-param-types)))
      (let ((diagnostics
              (check-primitive-call "keys" (rest (first (sx-parse "(keys {:a 1})")))
                (dict) (test-prim-types) ppt nil)))
        (assert-equal 0 (len diagnostics)))))

  (deftest "number arg to keys produces error"
    (let ((ppt (test-prim-param-types)))
      (let ((diagnostics
              (check-primitive-call "keys" (rest (first (sx-parse "(keys 42)")))
                (dict) (test-prim-types) ppt nil)))
        (assert-true (> (len diagnostics) 0)))))

  (deftest "variable with known type passes check"
    ;; Variable n is known to be number in type-env
    (let ((ppt (test-prim-param-types))
          (tenv {"n" "number"}))
      (let ((diagnostics
              (check-primitive-call "inc" (rest (first (sx-parse "(inc n)")))
                tenv (test-prim-types) ppt nil)))
        (assert-equal 0 (len diagnostics)))))

  (deftest "variable with wrong type fails check"
    ;; Variable s is known to be string in type-env
    (let ((ppt (test-prim-param-types))
          (tenv {"s" "string"}))
      (let ((diagnostics
              (check-primitive-call "inc" (rest (first (sx-parse "(inc s)")))
                tenv (test-prim-types) ppt nil)))
        (assert-true (> (len diagnostics) 0)))))

  (deftest "any-typed variable skips check"
    ;; Variable x has type any — should not produce errors
    (let ((ppt (test-prim-param-types))
          (tenv {"x" "any"}))
      (let ((diagnostics
              (check-primitive-call "upper" (rest (first (sx-parse "(upper x)")))
                tenv (test-prim-types) ppt nil)))
        (assert-equal 0 (len diagnostics)))))

  (deftest "body-walk catches primitive errors in component"
    ;; Manually build a component and check it via check-body-walk directly
    (let ((ppt (test-prim-param-types))
          (body (first (sx-parse "(div (+ name 1))")))
          (type-env {"name" "string"})
          (diagnostics (list)))
      (check-body-walk body "~bad-math" type-env (test-prim-types) ppt (test-env) diagnostics nil nil)
      (assert-true (> (len diagnostics) 0))
      (assert-equal "error" (get (first diagnostics) "level")))))


;; --------------------------------------------------------------------------
;; deftype — type aliases
;; --------------------------------------------------------------------------

(defsuite "deftype-alias"
  (deftest "simple alias resolves"
    (let ((registry {"price" {:name "price" :params () :body "number"}}))
      (assert-equal "number" (resolve-type "price" registry))))

  (deftest "alias chain resolves"
    (let ((registry {"price" {:name "price" :params () :body "number"}
                     "cost" {:name "cost" :params () :body "price"}}))
      (assert-equal "number" (resolve-type "cost" registry))))

  (deftest "unknown type passes through"
    (let ((registry {"price" {:name "price" :params () :body "number"}}))
      (assert-equal "string" (resolve-type "string" registry))))

  (deftest "subtype-resolved? works through alias"
    (let ((registry {"price" {:name "price" :params () :body "number"}}))
      (assert-true (subtype-resolved? "price" "number" registry))
      (assert-true (subtype-resolved? "number" "price" registry)))))


;; --------------------------------------------------------------------------
;; deftype — union types
;; --------------------------------------------------------------------------

(defsuite "deftype-union"
  (deftest "union resolves"
    (let ((registry {"status" {:name "status" :params (list) :body (list "or" "string" "number")}}))
      (let ((resolved (resolve-type "status" registry)))
        (assert-true (= (type-of resolved) "list"))
        (assert-equal "or" (first resolved)))))

  (deftest "subtype through named union"
    (let ((registry {"status" {:name "status" :params (list) :body (list "or" "string" "number")}}))
      (assert-true (subtype-resolved? "string" "status" registry))
      (assert-true (subtype-resolved? "number" "status" registry))
      (assert-false (subtype-resolved? "boolean" "status" registry)))))


;; --------------------------------------------------------------------------
;; deftype — record types
;; --------------------------------------------------------------------------

(defsuite "deftype-record"
  (deftest "record resolves to dict"
    (let ((registry {"card-props" {:name "card-props" :params ()
                     :body {"title" "string" "price" "number"}}}))
      (let ((resolved (resolve-type "card-props" registry)))
        (assert-equal "dict" (type-of resolved))
        (assert-equal "string" (get resolved "title"))
        (assert-equal "number" (get resolved "price")))))

  (deftest "record structural subtyping"
    (let ((registry {"card-props" {:name "card-props" :params ()
                     :body {"title" "string" "price" "number"}}
                     "titled" {:name "titled" :params ()
                     :body {"title" "string"}}}))
      ;; card-props has title+price, titled has just title
      ;; card-props <: titled (has all required fields)
      (assert-true (subtype-resolved? "card-props" "titled" registry))))

  (deftest "get infers field type from record"
    (let ((registry {"card-props" {:name "card-props" :params (list)
                     :body {"title" "string" "price" "number"}}})
          (type-env {"d" "card-props"})
          (expr (first (sx-parse "(get d :title)"))))
      (assert-equal "string"
        (infer-type expr type-env (test-prim-types) registry)))))


;; --------------------------------------------------------------------------
;; deftype — parameterized types
;; --------------------------------------------------------------------------

(defsuite "deftype-parameterized"
  (deftest "maybe instantiation"
    (let ((registry {"maybe" {:name "maybe" :params (list "a")
                     :body (list "or" "a" "nil")}}))
      (let ((resolved (resolve-type (list "maybe" "string") registry)))
        (assert-true (= (type-of resolved) "list"))
        (assert-equal "or" (first resolved))
        (assert-true (contains? resolved "string"))
        (assert-true (contains? resolved "nil")))))

  (deftest "subtype through parameterized type"
    (let ((registry {"maybe" {:name "maybe" :params (list "a")
                     :body (list "or" "a" "nil")}}))
      (assert-true (subtype-resolved? "string" (list "maybe" "string") registry))
      (assert-true (subtype-resolved? "nil" (list "maybe" "string") registry))
      (assert-false (subtype-resolved? "number" (list "maybe" "string") registry))))

  (deftest "substitute-type-vars works"
    (let ((result (substitute-type-vars (list "or" "a" "nil") (list "a") (list "number"))))
      (assert-equal "or" (first result))
      (assert-true (contains? result "number"))
      (assert-true (contains? result "nil")))))


;; --------------------------------------------------------------------------
;; defeffect — effect basics
;; --------------------------------------------------------------------------

(defsuite "defeffect-basics"
  (deftest "get-effects returns nil for unannotated"
    (let ((anns {"fetch" ("io")}))
      (assert-true (nil? (get-effects "unknown" anns)))))

  (deftest "get-effects returns effects for annotated"
    (let ((anns {"fetch" ("io")}))
      (assert-equal (list "io") (get-effects "fetch" anns))))

  (deftest "nil annotations returns nil"
    (assert-true (nil? (get-effects "anything" nil)))))


;; --------------------------------------------------------------------------
;; defeffect — effect checking
;; --------------------------------------------------------------------------

(defsuite "effect-checking"
  (deftest "pure cannot call io"
    (let ((anns {"~pure-comp" () "fetch" ("io")}))
      (let ((diagnostics (check-effect-call "fetch" (list) anns "~pure-comp")))
        (assert-true (> (len diagnostics) 0))
        (assert-equal "error" (get (first diagnostics) "level")))))

  (deftest "io context allows io"
    (let ((anns {"~io-comp" ("io") "fetch" ("io")}))
      (let ((diagnostics (check-effect-call "fetch" (list "io") anns "~io-comp")))
        (assert-equal 0 (len diagnostics)))))

  (deftest "unannotated caller allows everything"
    (let ((anns {"fetch" ("io")}))
      (let ((diagnostics (check-effect-call "fetch" nil anns "~unknown")))
        (assert-equal 0 (len diagnostics)))))

  (deftest "unannotated callee skips check"
    (let ((anns {"~pure-comp" ()}))
      (let ((diagnostics (check-effect-call "unknown-fn" (list) anns "~pure-comp")))
        (assert-equal 0 (len diagnostics))))))


;; --------------------------------------------------------------------------
;; defeffect — subset checking
;; --------------------------------------------------------------------------

(defsuite "effect-subset"
  (deftest "empty is subset of anything"
    (assert-true (effects-subset? (list) (list "io")))
    (assert-true (effects-subset? (list) (list))))

  (deftest "io is subset of io"
    (assert-true (effects-subset? (list "io") (list "io" "async"))))

  (deftest "io is not subset of pure"
    (assert-false (effects-subset? (list "io") (list))))

  (deftest "nil callee skips check"
    (assert-true (effects-subset? nil (list))))

  (deftest "nil caller allows all"
    (assert-true (effects-subset? (list "io") nil))))


;; --------------------------------------------------------------------------
;; build-effect-annotations
;; --------------------------------------------------------------------------

(defsuite "build-effect-annotations"
  (deftest "builds annotations from io declarations"
    (let ((decls (list {"name" "fetch"} {"name" "save!"}))
          (anns (build-effect-annotations decls)))
      (assert-equal (list "io") (get anns "fetch"))
      (assert-equal (list "io") (get anns "save!"))))

  (deftest "skips entries without name"
    (let ((decls (list {"name" "fetch"} {"other" "x"}))
          (anns (build-effect-annotations decls)))
      (assert-true (has-key? anns "fetch"))
      (assert-false (has-key? anns "other"))))

  (deftest "empty declarations produce empty dict"
    (let ((anns (build-effect-annotations (list))))
      (assert-equal 0 (len (keys anns))))))


;; --------------------------------------------------------------------------
;; check-component-effects
;; --------------------------------------------------------------------------

(defsuite "check-component-effects"
  (deftest "pure component calling io produces diagnostic"
    ;; Define component in a local env so check-component-effects can find it
    (let ((e (env-extend (test-env))))
      (eval-expr-cek (sx-parse-one "(defcomp ~eff-pure-card () :effects [] (div (fetch \"url\")))") e)
      (let ((anns {"~eff-pure-card" () "fetch" ("io")})
            (diagnostics (check-component-effects "~eff-pure-card" e anns)))
        (assert-true (> (len diagnostics) 0)))))

  (deftest "io component calling io produces no diagnostic"
    (let ((e (env-extend (test-env))))
      (eval-expr-cek (sx-parse-one "(defcomp ~eff-io-card () :effects [io] (div (fetch \"url\")))") e)
      (let ((anns {"~eff-io-card" ("io") "fetch" ("io")})
            (diagnostics (check-component-effects "~eff-io-card" e anns)))
        (assert-equal 0 (len diagnostics)))))

  (deftest "unannotated component skips check"
    (let ((e (env-extend (test-env))))
      (eval-expr-cek (sx-parse-one "(defcomp ~eff-unannot-card () (div (fetch \"url\")))") e)
      (let ((anns {"fetch" ("io")})
            (diagnostics (check-component-effects "~eff-unannot-card" e anns)))
        (assert-equal 0 (len diagnostics))))))