giles
a9d5a1082f
- Add make-wind-after-frame / make-wind-return-frame CEK frame types - Add *winders* global stack tracking active after-thunks - Add kont-unwind-to-handler (replaces kont-find-handler in raise-eval) — calls after-thunks for wind frames encountered while unwinding to handler - Add wind-escape-to — pops and calls after-thunks down to captured winders-len - Replace sf-dynamic-wind with step-sf-dynamic-wind (full CEK dispatch) - Fix "callcc" frame: store winders-len in continuation object - Fix callcc-continuation? case: call wind-escape-to before escape - JS platform: extend SxCallccContinuation to store windersLen; add callcc-continuation-winders-len accessor - 8 tests: normal return, raise escape, call/cc escape, nested LIFO, guard ordering - 1948/2500 (was 1940); zero regressions Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
114 lines
3.4 KiB
Plaintext
114 lines
3.4 KiB
Plaintext
;; Tests for dynamic-wind: after-thunk fires on normal return,
|
|
;; non-local exit via raise/guard, and call/cc escape.
|
|
|
|
(defsuite
|
|
"dynamic-wind-basic"
|
|
(deftest
|
|
"after fires on normal return"
|
|
(let
|
|
((log (list)))
|
|
(dynamic-wind
|
|
(fn () (append! log "before"))
|
|
(fn () (append! log "body"))
|
|
(fn () (append! log "after")))
|
|
(assert= 3 (len log))
|
|
(assert= "before" (nth log 0))
|
|
(assert= "body" (nth log 1))
|
|
(assert= "after" (nth log 2))))
|
|
(deftest
|
|
"after fires on raise escape"
|
|
(let
|
|
((log (list)))
|
|
(guard
|
|
(e (true nil))
|
|
(dynamic-wind
|
|
(fn () (append! log "before"))
|
|
(fn () (append! log "body") (error "boom"))
|
|
(fn () (append! log "after"))))
|
|
(assert= 3 (len log))
|
|
(assert= "before" (nth log 0))
|
|
(assert= "body" (nth log 1))
|
|
(assert= "after" (nth log 2))))
|
|
(deftest
|
|
"after fires on call/cc escape"
|
|
(let
|
|
((log (list)))
|
|
(call/cc
|
|
(fn
|
|
(k)
|
|
(dynamic-wind
|
|
(fn () (append! log "before"))
|
|
(fn () (append! log "body") (k nil))
|
|
(fn () (append! log "after")))))
|
|
(assert= 3 (len log))
|
|
(assert= "before" (nth log 0))
|
|
(assert= "body" (nth log 1))
|
|
(assert= "after" (nth log 2))))
|
|
(deftest
|
|
"nested dynamic-wind after-thunks fire LIFO on normal return"
|
|
(let
|
|
((log (list)))
|
|
(dynamic-wind
|
|
(fn () (append! log "outer-before"))
|
|
(fn
|
|
()
|
|
(dynamic-wind
|
|
(fn () (append! log "inner-before"))
|
|
(fn () (append! log "inner-body"))
|
|
(fn () (append! log "inner-after"))))
|
|
(fn () (append! log "outer-after")))
|
|
(assert= 5 (len log))
|
|
(assert= "outer-before" (nth log 0))
|
|
(assert= "inner-before" (nth log 1))
|
|
(assert= "inner-body" (nth log 2))
|
|
(assert= "inner-after" (nth log 3))
|
|
(assert= "outer-after" (nth log 4))))
|
|
(deftest
|
|
"nested dynamic-wind after-thunks fire LIFO on raise"
|
|
(let
|
|
((log (list)))
|
|
(guard
|
|
(e (true nil))
|
|
(dynamic-wind
|
|
(fn () (append! log "outer-before"))
|
|
(fn
|
|
()
|
|
(dynamic-wind
|
|
(fn () (append! log "inner-before"))
|
|
(fn () (append! log "inner-body") (error "boom"))
|
|
(fn () (append! log "inner-after"))))
|
|
(fn () (append! log "outer-after"))))
|
|
(assert= 5 (len log))
|
|
(assert= "outer-before" (nth log 0))
|
|
(assert= "inner-before" (nth log 1))
|
|
(assert= "inner-body" (nth log 2))
|
|
(assert= "inner-after" (nth log 3))
|
|
(assert= "outer-after" (nth log 4))))
|
|
(deftest
|
|
"before and after are called"
|
|
(let
|
|
((count 0))
|
|
(dynamic-wind
|
|
(fn () (set! count (+ count 1)))
|
|
(fn () nil)
|
|
(fn () (set! count (+ count 10))))
|
|
(assert= 11 count)))
|
|
(deftest
|
|
"dynamic-wind return value is body result"
|
|
(let
|
|
((result (dynamic-wind (fn () nil) (fn () 42) (fn () nil))))
|
|
(assert= 42 result)))
|
|
(deftest
|
|
"after fires before guard handler"
|
|
(let
|
|
((log (list)))
|
|
(guard
|
|
(e (true (append! log "guard-handler")))
|
|
(dynamic-wind
|
|
(fn () nil)
|
|
(fn () (error "boom"))
|
|
(fn () (append! log "after"))))
|
|
(assert= 2 (len log))
|
|
(assert= "after" (nth log 0))
|
|
(assert= "guard-handler" (nth log 1)))))
|