giles
06666ac8c4
The core evaluator (spec/evaluator.sx) is now the irreducible computational core with zero web, rendering, or type-system knowledge. 2531 → 2313 lines. - Add extensible special form registry (*custom-special-forms* + register-special-form!) - Add render dispatch hooks (*render-check* / *render-fn*) replacing hardcoded render-active?/is-render-expr?/render-expr - Extract freeze scopes → spec/freeze.sx (library, not core) - Extract content addressing → spec/content.sx (library, not core) - Move sf-deftype/sf-defeffect → spec/types.sx (self-registering) - Move sf-defstyle → web/forms.sx (self-registering with all web forms) - Move web tests (defpage, streaming) → web/tests/test-forms.sx - Add is-else-clause? helper (replaces 5 inline patterns) - Make escape-html/escape-attr library functions in render.sx (pure SX, not platform-provided) - Add foundations plan: Step 3.5 (data representations), Step 3.7 (verified components), OCaml for Step 4d - Update all three bootstrappers (JS 957/957, Python 744/744, OCaml 952/952) Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
185 lines
7.6 KiB
Plaintext
185 lines
7.6 KiB
Plaintext
;; ==========================================================================
|
|
;; test-forms.sx — Tests for web-platform definition forms
|
|
;;
|
|
;; Requires: test-framework.sx, forms.sx loaded.
|
|
;; Tests defpage, streaming functions, and the multi-stream data protocol.
|
|
;;
|
|
;; These tests were previously in spec/tests/test-eval.sx but belong here
|
|
;; because they test web-specific forms, not the core evaluator.
|
|
;; ==========================================================================
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; defpage — page definition form
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "defpage"
|
|
(deftest "basic defpage returns page-def"
|
|
(let ((p (defpage test-basic :path "/test" :auth :public :content (div "hello"))))
|
|
(assert-true (not (nil? p)))
|
|
(assert-equal "test-basic" (get p "name"))
|
|
(assert-equal "/test" (get p "path"))
|
|
(assert-equal "public" (get p "auth"))))
|
|
|
|
(deftest "defpage content expr is unevaluated AST"
|
|
(let ((p (defpage test-content :path "/c" :auth :public :content (~my-comp :title "hi"))))
|
|
(assert-true (not (nil? (get p "content"))))))
|
|
|
|
(deftest "defpage with :stream"
|
|
(let ((p (defpage test-stream :path "/s" :auth :public :stream true :content (div "x"))))
|
|
(assert-equal true (get p "stream"))))
|
|
|
|
(deftest "defpage with :shell"
|
|
(let ((p (defpage test-shell :path "/sh" :auth :public :stream true
|
|
:shell (~my-layout (~suspense :id "data" :fallback (div "loading...")))
|
|
:content (~my-streamed :data data-val))))
|
|
(assert-true (not (nil? (get p "shell"))))
|
|
(assert-true (not (nil? (get p "content"))))))
|
|
|
|
(deftest "defpage with :fallback"
|
|
(let ((p (defpage test-fallback :path "/f" :auth :public :stream true
|
|
:fallback (div :class "skeleton" "loading")
|
|
:content (div "done"))))
|
|
(assert-true (not (nil? (get p "fallback"))))))
|
|
|
|
(deftest "defpage with :data"
|
|
(let ((p (defpage test-data :path "/d" :auth :public
|
|
:data (fetch-items)
|
|
:content (~items-list :items items))))
|
|
(assert-true (not (nil? (get p "data"))))))
|
|
|
|
(deftest "defpage missing fields are nil"
|
|
(let ((p (defpage test-minimal :path "/m" :auth :public :content (div "x"))))
|
|
(assert-nil (get p "data"))
|
|
(assert-nil (get p "filter"))
|
|
(assert-nil (get p "aside"))
|
|
(assert-nil (get p "menu"))
|
|
(assert-nil (get p "shell"))
|
|
(assert-nil (get p "fallback"))
|
|
(assert-equal false (get p "stream")))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Multi-stream data protocol
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "stream-chunk-id"
|
|
(deftest "extracts stream-id from chunk"
|
|
(assert-equal "my-slot" (stream-chunk-id {"stream-id" "my-slot" "x" 1})))
|
|
|
|
(deftest "defaults to stream-content when missing"
|
|
(assert-equal "stream-content" (stream-chunk-id {"x" 1 "y" 2}))))
|
|
|
|
(defsuite "stream-chunk-bindings"
|
|
(deftest "removes stream-id from chunk"
|
|
(let ((bindings (stream-chunk-bindings {"stream-id" "slot" "name" "alice" "age" 30})))
|
|
(assert-equal "alice" (get bindings "name"))
|
|
(assert-equal 30 (get bindings "age"))
|
|
(assert-nil (get bindings "stream-id"))))
|
|
|
|
(deftest "returns all keys when no stream-id"
|
|
(let ((bindings (stream-chunk-bindings {"a" 1 "b" 2})))
|
|
(assert-equal 1 (get bindings "a"))
|
|
(assert-equal 2 (get bindings "b")))))
|
|
|
|
(defsuite "normalize-binding-key"
|
|
(deftest "converts underscores to hyphens"
|
|
(assert-equal "my-key" (normalize-binding-key "my_key")))
|
|
|
|
(deftest "leaves hyphens unchanged"
|
|
(assert-equal "my-key" (normalize-binding-key "my-key")))
|
|
|
|
(deftest "handles multiple underscores"
|
|
(assert-equal "a-b-c" (normalize-binding-key "a_b_c"))))
|
|
|
|
(defsuite "bind-stream-chunk"
|
|
(deftest "creates fresh env with bindings"
|
|
(let ((base {"existing" 42})
|
|
(chunk {"stream-id" "slot" "user-name" "bob" "count" 5})
|
|
(env (bind-stream-chunk chunk base)))
|
|
;; Base env bindings are preserved
|
|
(assert-equal 42 (get env "existing"))
|
|
;; Chunk bindings are added (stream-id removed)
|
|
(assert-equal "bob" (get env "user-name"))
|
|
(assert-equal 5 (get env "count"))
|
|
;; stream-id is not in env
|
|
(assert-nil (get env "stream-id"))))
|
|
|
|
(deftest "isolates env from base — bindings don't leak to base"
|
|
(let ((base {"x" 1})
|
|
(chunk {"stream-id" "s" "y" 2})
|
|
(env (bind-stream-chunk chunk base)))
|
|
;; Chunk bindings should not appear in base
|
|
(assert-nil (get base "y"))
|
|
;; Base bindings should be in derived env
|
|
(assert-equal 1 (get env "x")))))
|
|
|
|
(defsuite "validate-stream-data"
|
|
(deftest "valid: list of dicts"
|
|
(assert-true (validate-stream-data
|
|
(list {"stream-id" "a" "x" 1}
|
|
{"stream-id" "b" "y" 2}))))
|
|
|
|
(deftest "valid: empty list"
|
|
(assert-true (validate-stream-data (list))))
|
|
|
|
(deftest "invalid: single dict (not a list)"
|
|
(assert-equal false (validate-stream-data {"x" 1})))
|
|
|
|
(deftest "invalid: list containing non-dict"
|
|
(assert-equal false (validate-stream-data (list {"x" 1} "oops" {"y" 2})))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Multi-stream end-to-end scenarios
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "multi-stream routing"
|
|
(deftest "stream-chunk-id routes different chunks to different slots"
|
|
(let ((chunks (list
|
|
{"stream-id" "stream-fast" "msg" "quick"}
|
|
{"stream-id" "stream-medium" "msg" "steady"}
|
|
{"stream-id" "stream-slow" "msg" "slow"}))
|
|
(ids (map stream-chunk-id chunks)))
|
|
(assert-equal "stream-fast" (nth ids 0))
|
|
(assert-equal "stream-medium" (nth ids 1))
|
|
(assert-equal "stream-slow" (nth ids 2))))
|
|
|
|
(deftest "bind-stream-chunk creates isolated envs per chunk"
|
|
(let ((base {"layout" "main"})
|
|
(chunk-a {"stream-id" "a" "title" "First" "count" 1})
|
|
(chunk-b {"stream-id" "b" "title" "Second" "count" 2})
|
|
(env-a (bind-stream-chunk chunk-a base))
|
|
(env-b (bind-stream-chunk chunk-b base)))
|
|
;; Each env has its own bindings
|
|
(assert-equal "First" (get env-a "title"))
|
|
(assert-equal "Second" (get env-b "title"))
|
|
(assert-equal 1 (get env-a "count"))
|
|
(assert-equal 2 (get env-b "count"))
|
|
;; Both share base
|
|
(assert-equal "main" (get env-a "layout"))
|
|
(assert-equal "main" (get env-b "layout"))
|
|
;; Neither leaks into base
|
|
(assert-nil (get base "title"))))
|
|
|
|
(deftest "normalize-binding-key applied to chunk keys"
|
|
(let ((chunk {"stream-id" "s" "user_name" "alice" "item_count" 3})
|
|
(bindings (stream-chunk-bindings chunk)))
|
|
;; Keys with underscores need normalizing for SX env
|
|
(assert-equal "alice" (get bindings "user_name"))
|
|
;; normalize-binding-key converts them
|
|
(assert-equal "user-name" (normalize-binding-key "user_name"))
|
|
(assert-equal "item-count" (normalize-binding-key "item_count"))))
|
|
|
|
(deftest "defpage stream flag defaults to false"
|
|
(let ((p (defpage test-no-stream :path "/ns" :auth :public :content (div "x"))))
|
|
(assert-equal false (get p "stream"))))
|
|
|
|
(deftest "defpage stream true recorded in page-def"
|
|
(let ((p (defpage test-with-stream :path "/ws" :auth :public
|
|
:stream true
|
|
:shell (~layout (~suspense :id "data"))
|
|
:content (~chunk :val val))))
|
|
(assert-equal true (get p "stream"))
|
|
(assert-true (not (nil? (get p "shell")))))))
|