giles
2d7dd7d582
Wraps all core .sx files in R7RS define-library with explicit export lists, plus (import ...) at end for backward-compatible global re-export. Libraries registered: (sx bytecode) — 83 opcode constants (sx render) — 15 tag registries + render helpers (sx signals) — 23 reactive signal primitives (sx r7rs) — 21 R7RS aliases (sx compiler) — 42 compiler functions (sx vm) — 32 VM functions (sx freeze) — 9 freeze/thaw functions (sx content) — 6 content store functions (sx callcc) — 1 call/cc wrapper (sx highlight) — 13 syntax highlighting functions (sx stdlib) — 47 stdlib functions (sx swap) — 13 swap algebra functions (sx render-trace) — 8 render trace functions (sx harness) — 21 test harness functions (sx canonical) — 12 canonical serialization functions (web adapter-html) — 13 HTML renderer functions (web adapter-sx) — 13 SX wire format functions (web engine) — 33 hypermedia engine functions (web request-handler) — 4 request handling functions (web page-helpers) — 12 page helper functions (web router) — 36 routing functions (web deps) — 19 dependency analysis functions (web orchestration) — 59 page orchestration functions Key changes: - define-library now inherits parent env (env-extend env instead of env-extend make-env) so library bodies can access platform primitives - sx_server.ml: added resolve_library_path + load_library_file for import resolution (maps library specs to file paths) - cek_run_with_io: handles "import" locally instead of sending to Python bridge 2608/2608 tests passing. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
95 lines
6.0 KiB
Plaintext
95 lines
6.0 KiB
Plaintext
;; Assert condition is truthy, error with message
|
|
|
|
(define-library (sx harness)
|
|
(export
|
|
assert
|
|
assert=
|
|
default-platform
|
|
make-harness
|
|
harness-reset!
|
|
harness-log
|
|
harness-get
|
|
harness-set!
|
|
make-interceptor
|
|
install-interceptors
|
|
io-calls
|
|
io-call-count
|
|
io-call-nth
|
|
io-call-args
|
|
io-call-result
|
|
assert-io-called
|
|
assert-no-io
|
|
assert-io-count
|
|
assert-io-args
|
|
assert-io-result
|
|
assert-state)
|
|
(begin
|
|
|
|
(define assert (fn (condition msg) (when (not condition) (error (or msg "Assertion failed")))))
|
|
|
|
;; Assert two values are equal
|
|
(define assert= (fn (actual expected msg) (when (not (= actual expected)) (error (or msg (str "Expected " expected ", got " actual))))))
|
|
|
|
;; Dict of mock IO operations for testing
|
|
(define default-platform {:current-user (fn () nil) :csrf-token (fn () "test-csrf-token") :app-url (fn (service &rest path) "/mock-app-url") :frag (fn (service comp &rest args) "") :sleep (fn (ms) nil) :local-storage-set (fn (key val) nil) :set-cookie (fn (name val &rest opts) nil) :url-for (fn (endpoint &rest args) "/mock-url") :create-element (fn (tag) nil) :request-path (fn () "/") :config (fn (key) nil) :set-attr (fn (el name val) nil) :set-text (fn (el text) nil) :remove-child (fn (parent child) nil) :fetch (fn (url &rest opts) {:status 200 :body "" :ok true}) :query (fn (service name &rest args) (list)) :add-class (fn (el cls) nil) :get-element (fn (id) nil) :now (fn () 0) :abort (fn (code) nil) :action (fn (service name &rest args) {:ok true}) :remove-class (fn (el cls) nil) :append-child (fn (parent child) nil) :request-arg (fn (name) nil) :emit-dom (fn (op &rest args) nil) :local-storage-get (fn (key) nil) :get-cookie (fn (name) nil)})
|
|
|
|
;; Create a test session with mock IO platform
|
|
(define make-harness :effects () (fn (&key platform) (let ((merged (if (nil? platform) default-platform (merge default-platform platform)))) {:log (list) :platform merged :state {:cookies {} :storage {} :dom nil}})))
|
|
|
|
;; Clear IO log and state for a new test
|
|
(define harness-reset! :effects () (fn (session) (dict-set! session "log" (list)) (dict-set! session "state" {:cookies {} :storage {} :dom nil}) session))
|
|
|
|
;; Append an IO call record to session log
|
|
(define harness-log :effects () (fn (session &key op) (let ((log (get session "log"))) (if (nil? op) log (filter (fn (entry) (= (get entry "op") op)) log)))))
|
|
|
|
;; Read state value from session store
|
|
(define harness-get :effects () (fn (session key) (get (get session "state") key)))
|
|
|
|
;; Write state value to session store
|
|
(define harness-set! :effects () (fn (session key value) (dict-set! (get session "state") key value) nil))
|
|
|
|
;; Wrap a mock fn to record calls in the IO log
|
|
(define make-interceptor :effects () (fn (session op-name mock-fn) (fn (&rest args) (let ((result (if (empty? args) (mock-fn) (if (= 1 (len args)) (mock-fn (first args)) (if (= 2 (len args)) (mock-fn (first args) (nth args 1)) (if (= 3 (len args)) (mock-fn (first args) (nth args 1) (nth args 2)) (apply mock-fn args)))))) (log (get session "log"))) (append! log {:args args :result result :op op-name}) result))))
|
|
|
|
;; Bind all interceptors into the eval environment
|
|
(define install-interceptors :effects () (fn (session env) (for-each (fn (key) (let ((mock-fn (get (get session "platform") key)) (interceptor (make-interceptor session key mock-fn))) (env-bind! env key interceptor))) (keys (get session "platform"))) env))
|
|
|
|
;; Query IO log: all calls, or filtered by op name
|
|
(define io-calls :effects () (fn (session op-name) (filter (fn (entry) (= (get entry "op") op-name)) (get session "log"))))
|
|
|
|
;; Count IO calls, optionally filtered by op name
|
|
(define io-call-count :effects () (fn (session op-name) (len (io-calls session op-name))))
|
|
|
|
;; Get the nth IO call record
|
|
(define io-call-nth :effects () (fn (session op-name n) (let ((calls (io-calls session op-name))) (if (< n (len calls)) (nth calls n) nil))))
|
|
|
|
;; Get args from the nth call to an operation
|
|
(define io-call-args :effects () (fn (session op-name n) (let ((call (io-call-nth session op-name n))) (if (nil? call) nil (get call "args")))))
|
|
|
|
;; Get return value from the nth call to an operation
|
|
(define io-call-result :effects () (fn (session op-name n) (let ((call (io-call-nth session op-name n))) (if (nil? call) nil (get call "result")))))
|
|
|
|
;; Assert an IO operation was called at least once
|
|
(define assert-io-called :effects () (fn (session op-name) (assert (> (io-call-count session op-name) 0) (str "Expected IO operation " op-name " to be called but it was not"))))
|
|
|
|
;; Assert an IO operation was never called
|
|
(define assert-no-io :effects () (fn (session op-name) (assert (= (io-call-count session op-name) 0) (str "Expected IO operation " op-name " not to be called but it was called " (io-call-count session op-name) " time(s)"))))
|
|
|
|
;; Assert exact call count for an operation
|
|
(define assert-io-count :effects () (fn (session op-name expected) (let ((actual (io-call-count session op-name))) (assert (= actual expected) (str "Expected " op-name " to be called " expected " time(s) but was called " actual " time(s)")))))
|
|
|
|
;; Assert args of the nth call match expected
|
|
(define assert-io-args :effects () (fn (session op-name n expected-args) (let ((actual (io-call-args session op-name n))) (assert (equal? actual expected-args) (str "Expected call " n " to " op-name " with args " (str expected-args) " but got " (str actual))))))
|
|
|
|
;; Assert result of the nth call matches expected
|
|
(define assert-io-result :effects () (fn (session op-name n expected) (let ((actual (io-call-result session op-name n))) (assert (equal? actual expected) (str "Expected call " n " to " op-name " to return " (str expected) " but got " (str actual))))))
|
|
|
|
;; Assert a state key has the expected value
|
|
(define assert-state :effects () (fn (session key expected) (let ((actual (harness-get session key))) (assert (equal? actual expected) (str "Expected state " key " to be " (str expected) " but got " (str actual))))))
|
|
|
|
|
|
)) ;; end define-library
|
|
|
|
;; Re-export to global namespace for backward compatibility
|
|
(import (sx harness))
|