giles
e762cc2e32
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 22s
(timeout budget node) bounds a node deterministically: nodes opt in via (tick), budget ticks are allowed, the next raises flow-timeout. No scheduler/clock in pure SX so the budget is a step count, not wall-clock. Budgets nest and are per-run. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
180 lines
7.4 KiB
Plaintext
180 lines
7.4 KiB
Plaintext
;; lib/flow/tests/control.sx — Phase 2: control flow + error handling.
|
|
|
|
(define flow-ctl-pass 0)
|
|
(define flow-ctl-fail 0)
|
|
(define flow-ctl-fails (list))
|
|
|
|
(define
|
|
flow-ctl-test
|
|
(fn
|
|
(name actual expected)
|
|
(if
|
|
(= actual expected)
|
|
(set! flow-ctl-pass (+ flow-ctl-pass 1))
|
|
(begin
|
|
(set! flow-ctl-fail (+ flow-ctl-fail 1))
|
|
(append! flow-ctl-fails {:name name :expected expected :actual actual})))))
|
|
|
|
(define flow-c (fn (src) (flow-run src)))
|
|
(define flow-cs (fn (src) (get (flow-run src) :scm-string)))
|
|
|
|
;; ── branch ──────────────────────────────────────────────────────
|
|
(flow-ctl-test
|
|
"branch: true selects then"
|
|
(flow-c
|
|
"(flow/start (branch (lambda (x) (> x 0)) (lambda (x) (* x 100)) (lambda (x) (- 0 x))) 5)")
|
|
500)
|
|
(flow-ctl-test
|
|
"branch: false selects else"
|
|
(flow-c
|
|
"(flow/start (branch (lambda (x) (> x 0)) (lambda (x) (* x 100)) (lambda (x) (- 0 x))) -3)")
|
|
3)
|
|
(flow-ctl-test
|
|
"branch: predicate sees the threaded input"
|
|
(flow-c
|
|
"(flow/start (sequence (lambda (x) (+ x 1)) (branch (lambda (x) (> x 3)) (flow-const 100) (flow-const 0))) 3)")
|
|
100)
|
|
(flow-ctl-test
|
|
"branch: branches are full nodes (sequence inside)"
|
|
(flow-c
|
|
"(flow/start (branch (lambda (x) (< x 10)) (sequence (lambda (x) (+ x 1)) (lambda (x) (* x 2))) (flow-const 0)) 4)")
|
|
10)
|
|
(flow-ctl-test
|
|
"branch: nested branch (3-way sign)"
|
|
(flow-c
|
|
"(defflow sign (branch (lambda (x) (> x 0)) (flow-const 1) (branch (lambda (x) (< x 0)) (flow-const -1) (flow-const 0)))) (list (flow/start sign 7) (flow/start sign -7) (flow/start sign 0))")
|
|
(list 1 -1 0))
|
|
(flow-ctl-test
|
|
"branch: publish-shaped approval gate"
|
|
(flow-cs
|
|
"(defflow publish (branch (lambda (post) (>= (string-length post) 3)) (lambda (post) (string-append post \" [published]\")) (lambda (post) (string-append post \" [rejected]\")))) (flow/start publish \"ok\")")
|
|
"ok [rejected]")
|
|
|
|
;; ── error model — explicit (fail reason) values ─────────────────
|
|
(flow-ctl-test
|
|
"fail: failed? is true for a failure value"
|
|
(flow-c "(failed? (fail 404))")
|
|
true)
|
|
(flow-ctl-test
|
|
"fail: fail-reason extracts the reason"
|
|
(flow-c "(fail-reason (fail 404))")
|
|
404)
|
|
(flow-ctl-test
|
|
"fail: failed? is false for a plain value"
|
|
(flow-c "(failed? 7)")
|
|
false)
|
|
(flow-ctl-test
|
|
"fail: failed? is false for an ordinary list"
|
|
(flow-c "(failed? (list 1 2 3))")
|
|
false)
|
|
(flow-ctl-test
|
|
"fail: a node may emit a failure as data"
|
|
(flow-c
|
|
"(defflow validate (lambda (s) (if (>= (string-length s) 3) s (fail (quote too-short))))) (failed? (flow/start validate \"hi\"))")
|
|
true)
|
|
(flow-ctl-test
|
|
"fail: failure flows downstream, branch recovers"
|
|
(flow-c
|
|
"(defflow guarded (sequence (lambda (s) (if (>= (string-length s) 3) (string-length s) (fail (quote too-short)))) (branch failed? (lambda (f) (list (quote recovered) (fail-reason f))) (lambda (n) (list (quote ok) n))))) (flow/start guarded \"hi\")")
|
|
(list "recovered" "too-short"))
|
|
|
|
;; ── try-catch — reify raised exceptions ─────────────────────────
|
|
(flow-ctl-test
|
|
"try-catch: no exception returns node result"
|
|
(flow-c "(flow/start (try-catch (lambda (x) (* x 2)) (lambda (e) -1)) 5)")
|
|
10)
|
|
(flow-ctl-test
|
|
"try-catch: handler runs on raise"
|
|
(flow-c
|
|
"(flow/start (try-catch (lambda (x) (raise (quote boom))) (flow-const 99)) 1)")
|
|
99)
|
|
(flow-ctl-test
|
|
"try-catch: handler receives the reified error"
|
|
(flow-c "(flow/start (try-catch (lambda (x) (raise 42)) (lambda (e) e)) 0)")
|
|
42)
|
|
(flow-ctl-test
|
|
"try-catch: catches exception from deep inside a sequence"
|
|
(flow-c
|
|
"(flow/start (try-catch (sequence (lambda (x) (+ x 1)) (lambda (x) (raise (quote deep)))) (flow-const -99)) 5)")
|
|
-99)
|
|
(flow-ctl-test
|
|
"try-catch: handler may convert to a failure value"
|
|
(flow-c
|
|
"(failed? (flow/start (try-catch (lambda (x) (raise (quote bad))) (lambda (e) (fail e))) 0))")
|
|
true)
|
|
(flow-ctl-test
|
|
"try-catch: composes — recover then continue"
|
|
(flow-c
|
|
"(flow/start (sequence (try-catch (lambda (x) (raise (quote x))) (flow-const 10)) (lambda (n) (* n 5))) 0)")
|
|
50)
|
|
|
|
;; ── retry — re-run on raised exceptions ─────────────────────────
|
|
(flow-ctl-test
|
|
"retry: succeeds after transient failures"
|
|
(flow-c
|
|
"(define ctr 0) (defflow flaky (lambda (x) (set! ctr (+ ctr 1)) (if (< ctr 3) (raise (quote nope)) (* x 10)))) (list (flow/start (retry 5 flaky) 7) ctr)")
|
|
(list 70 3))
|
|
(flow-ctl-test
|
|
"retry: exhausted re-raises (caught by try-catch)"
|
|
(flow-c
|
|
"(flow/start (try-catch (retry 2 (lambda (x) (raise (quote always)))) (flow-const (quote gaveup))) 0)")
|
|
"gaveup")
|
|
(flow-ctl-test
|
|
"retry: n=1 means a single attempt"
|
|
(flow-c
|
|
"(define ctr 0) (flow/start (try-catch (retry 1 (lambda (x) (set! ctr (+ ctr 1)) (raise (quote bad)))) (lambda (e) ctr)) 0)")
|
|
1)
|
|
(flow-ctl-test
|
|
"retry: success on first attempt does not re-run"
|
|
(flow-c
|
|
"(define ctr 0) (flow/start (sequence (retry 5 (lambda (x) (set! ctr (+ ctr 1)) (* x 2))) (lambda (n) ctr)) 21)")
|
|
1)
|
|
(flow-ctl-test
|
|
"retry: does not retry explicit failure values"
|
|
(flow-c
|
|
"(define ctr 0) (failed? (flow/start (retry 5 (lambda (x) (set! ctr (+ ctr 1)) (fail (quote bad)))) 0))")
|
|
true)
|
|
(flow-ctl-test
|
|
"retry: failure-value path runs node exactly once"
|
|
(flow-c
|
|
"(define ctr 0) (flow/start (sequence (retry 5 (lambda (x) (set! ctr (+ ctr 1)) (fail (quote bad)))) (lambda (f) ctr)) 0)")
|
|
1)
|
|
|
|
;; ── timeout — cooperative step budget ───────────────────────────
|
|
(flow-ctl-test
|
|
"timeout: work within budget completes"
|
|
(flow-c
|
|
"(define (cd n) (if (<= n 0) 99 (begin (tick) (cd (- n 1))))) (flow/start (try-catch (timeout 10 (lambda (x) (cd x))) (flow-const (quote timed-out))) 5)")
|
|
99)
|
|
(flow-ctl-test
|
|
"timeout: work exceeding budget raises flow-timeout"
|
|
(flow-c
|
|
"(define (cd n) (if (<= n 0) 99 (begin (tick) (cd (- n 1))))) (flow/start (try-catch (timeout 10 (lambda (x) (cd x))) (flow-const (quote timed-out))) 20)")
|
|
"timed-out")
|
|
(flow-ctl-test
|
|
"timeout: exact budget boundary completes"
|
|
(flow-c
|
|
"(define (cd n) (if (<= n 0) 99 (begin (tick) (cd (- n 1))))) (flow/start (try-catch (timeout 5 (lambda (x) (cd x))) (flow-const (quote timed-out))) 5)")
|
|
99)
|
|
(flow-ctl-test
|
|
"timeout: one tick over the budget raises"
|
|
(flow-c
|
|
"(define (cd n) (if (<= n 0) 99 (begin (tick) (cd (- n 1))))) (flow/start (try-catch (timeout 5 (lambda (x) (cd x))) (flow-const (quote timed-out))) 6)")
|
|
"timed-out")
|
|
(flow-ctl-test
|
|
"timeout: the raised error is identifiable"
|
|
(flow-c
|
|
"(define (cd n) (if (<= n 0) 99 (begin (tick) (cd (- n 1))))) (flow/start (try-catch (timeout 2 (lambda (x) (cd x))) (lambda (e) e)) 9)")
|
|
"flow-timeout")
|
|
(flow-ctl-test
|
|
"timeout: a node that never ticks is unbounded"
|
|
(flow-c "(flow/start (timeout 0 (lambda (x) (* x 2))) 5)")
|
|
10)
|
|
(flow-ctl-test
|
|
"timeout: budget is restored across sequential timeouts"
|
|
(flow-c
|
|
"(define (cd n) (if (<= n 0) 1 (begin (tick) (cd (- n 1))))) (flow/start (sequence (timeout 4 (lambda (x) (cd x))) (timeout 4 (lambda (x) (cd 3))) (lambda (x) (begin (tick) (+ x 100)))) 3)")
|
|
101)
|
|
|
|
(define flow-ctl-tests-run! (fn () {:total (+ flow-ctl-pass flow-ctl-fail) :passed flow-ctl-pass :failed flow-ctl-fail :fails flow-ctl-fails}))
|