giles
ebb3445667
New test files: - test-collections.sx (79): list/dict edge cases, interop, equality - test-scope.sx (48): let/define/set!/closure/letrec/env isolation Python test runner (hosts/python/tests/run_tests.py): - Runs all spec tests against bootstrapped sx_ref.py - Tree-walk evaluator with full primitive env - Skips CEK/types/strict/continuations without --full Cross-host fixes (tests now host-neutral): - cons onto nil: platform-defined (JS: pair, Python: single) - = on lists: test identity only (JS: shallow, Python: deep) - str(true): accept "true" or "True" - (+ "a" 1): platform-defined (JS: coerces, Python: throws) - min/max: test with two args (Python single-arg expects iterable) - TCO depth: lowered to 500 (works on both hosts) - Strict mode tests moved to test-strict.sx (skipped on Python) Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
453 lines
16 KiB
Plaintext
453 lines
16 KiB
Plaintext
;; ==========================================================================
|
|
;; test-scope.sx — Comprehensive tests for scope, binding, and environment
|
|
;;
|
|
;; Requires: test-framework.sx loaded first.
|
|
;; Modules tested: eval.sx (let, define, set!, letrec, lambda, closure env)
|
|
;;
|
|
;; Covers edge cases that break with incorrect environment handling:
|
|
;; - let single/many bindings, multi-body, sequential binding, nesting
|
|
;; - define visibility at top-level, in do, in let body
|
|
;; - set! mutation through closure chains and loops
|
|
;; - Closure independence, mutual mutation, survival after scope exit
|
|
;; - letrec single/mutual recursion, plain values, ordering
|
|
;; - Env isolation: components, lambdas, higher-order callbacks
|
|
;; ==========================================================================
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; let edge cases
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "let-edge-cases"
|
|
(deftest "let with single binding"
|
|
(assert-equal 7 (let ((x 7)) x)))
|
|
|
|
(deftest "let with many bindings"
|
|
(let ((a 1) (b 2) (c 3) (d 4) (e 5))
|
|
(assert-equal 1 a)
|
|
(assert-equal 2 b)
|
|
(assert-equal 3 c)
|
|
(assert-equal 4 d)
|
|
(assert-equal 5 e)
|
|
(assert-equal 15 (+ a b c d e))))
|
|
|
|
(deftest "let body with multiple expressions returns last"
|
|
;; All expressions must be evaluated; only the last value is returned.
|
|
(let ((log (list)))
|
|
(let ((result
|
|
(let ((x 10))
|
|
(set! log (append log (list 1)))
|
|
(set! log (append log (list 2)))
|
|
x)))
|
|
(assert-equal 10 result)
|
|
(assert-equal (list 1 2) log))))
|
|
|
|
(deftest "let bindings are sequential — earlier visible in later"
|
|
;; SX let evaluates bindings sequentially (like let*).
|
|
;; The second binding CAN see the first.
|
|
(let ((x 100))
|
|
(let ((x 1) (y x))
|
|
(assert-equal 1 x)
|
|
(assert-equal 1 y))))
|
|
|
|
(deftest "nested let — inner shadows outer, outer restored after"
|
|
(let ((x 1))
|
|
(let ((x 2))
|
|
(assert-equal 2 x))
|
|
;; inner let is finished; outer x must be restored
|
|
(assert-equal 1 x)))
|
|
|
|
(deftest "let with computed binding value"
|
|
(let ((x (+ 1 2)))
|
|
(assert-equal 3 x))
|
|
(let ((y (* 4 5)))
|
|
(assert-equal 20 y))
|
|
(let ((z (str "hel" "lo")))
|
|
(assert-equal "hello" z)))
|
|
|
|
(deftest "let inside lambda body"
|
|
(let ((f (fn (n)
|
|
(let ((doubled (* n 2))
|
|
(incremented (+ n 1)))
|
|
(+ doubled incremented)))))
|
|
;; f(3) => doubled=6, incremented=4 => 10
|
|
(assert-equal 10 (f 3))
|
|
(assert-equal 16 (f 5))))
|
|
|
|
(deftest "lambda inside let binding value"
|
|
(let ((add (fn (a b) (+ a b)))
|
|
(mul (fn (a b) (* a b))))
|
|
(assert-equal 5 (add 2 3))
|
|
(assert-equal 6 (mul 2 3))
|
|
;; Both lambdas co-exist without interfering
|
|
(assert-equal 14 (add (mul 2 3) (add 2 6)))))
|
|
|
|
(deftest "let binding value that calls another let-bound function"
|
|
;; The inner let is evaluated left-to-right; double sees add.
|
|
(let ((add (fn (x) (+ x 1))))
|
|
(let ((result (add 41)))
|
|
(assert-equal 42 result))))
|
|
|
|
(deftest "deeply nested let all bindings remain accessible"
|
|
(let ((a 10))
|
|
(let ((b 20))
|
|
(let ((c 30))
|
|
;; All three outer bindings are visible here
|
|
(assert-equal 60 (+ a b c))
|
|
(let ((a 99))
|
|
;; a is shadowed, b and c still visible
|
|
(assert-equal 149 (+ a b c)))
|
|
;; After inner let, a is restored to 10
|
|
(assert-equal 60 (+ a b c)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; define scope
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "define-scope"
|
|
(deftest "define at top level visible in subsequent expressions"
|
|
(define scope-test-val 42)
|
|
(assert-equal 42 scope-test-val))
|
|
|
|
(deftest "define with lambda value, then call it"
|
|
(define scope-double (fn (n) (* n 2)))
|
|
(assert-equal 10 (scope-double 5))
|
|
(assert-equal 0 (scope-double 0))
|
|
(assert-equal -6 (scope-double -3)))
|
|
|
|
(deftest "define with result of another function call"
|
|
(define scope-sum (+ 10 20 30))
|
|
(assert-equal 60 scope-sum))
|
|
|
|
(deftest "define inside do block visible in later do expressions"
|
|
(do
|
|
(define do-local-x 77)
|
|
(assert-equal 77 do-local-x)
|
|
(define do-local-y (* do-local-x 2))
|
|
(assert-equal 154 do-local-y)))
|
|
|
|
(deftest "two defines with same name — second overwrites first"
|
|
(define redef-var "first")
|
|
(assert-equal "first" redef-var)
|
|
(define redef-var "second")
|
|
(assert-equal "second" redef-var))
|
|
|
|
(deftest "define lambda that calls another defined lambda"
|
|
(define scope-inc (fn (n) (+ n 1)))
|
|
(define scope-inc2 (fn (n) (scope-inc (scope-inc n))))
|
|
(assert-equal 7 (scope-inc2 5)))
|
|
|
|
(deftest "define inside let body is visible within that let body"
|
|
(let ((outer 10))
|
|
(define inner-def 20)
|
|
(assert-equal 30 (+ outer inner-def))))
|
|
|
|
(deftest "define with a conditional value"
|
|
(define scope-max-val (if (> 5 3) "big" "small"))
|
|
(assert-equal "big" scope-max-val)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; set! scope chain
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "set-scope-chain"
|
|
(deftest "set! on define'd variable"
|
|
(define setscope-x 1)
|
|
(set! setscope-x 99)
|
|
(assert-equal 99 setscope-x))
|
|
|
|
(deftest "set! on let binding"
|
|
(let ((x 0))
|
|
(set! x 42)
|
|
(assert-equal 42 x)))
|
|
|
|
(deftest "set! through one level of closure"
|
|
(let ((counter 0))
|
|
(let ((bump! (fn () (set! counter (+ counter 1)))))
|
|
(bump!)
|
|
(bump!)
|
|
(assert-equal 2 counter))))
|
|
|
|
(deftest "set! through two levels of closure"
|
|
(let ((value 0))
|
|
(let ((make-setter (fn ()
|
|
(fn (n) (set! value n)))))
|
|
(let ((setter (make-setter)))
|
|
(setter 100)
|
|
(assert-equal 100 value)
|
|
(setter 200)
|
|
(assert-equal 200 value)))))
|
|
|
|
(deftest "set! inside for-each loop body accumulates"
|
|
(let ((total 0))
|
|
(for-each (fn (n) (set! total (+ total n)))
|
|
(list 1 2 3 4 5))
|
|
(assert-equal 15 total)))
|
|
|
|
(deftest "set! updates are visible immediately in same scope"
|
|
(let ((x 1))
|
|
(set! x (+ x 1))
|
|
(set! x (+ x 1))
|
|
(set! x (+ x 1))
|
|
(assert-equal 4 x)))
|
|
|
|
(deftest "set! on undefined variable creates binding"
|
|
;; In SX, set! on an unbound name creates a new binding on the
|
|
;; immediate env (falls through after chain walk). This is
|
|
;; permissive behavior — strict mode could enforce this differently.
|
|
(let ((r (try-call (fn () (set! _test-set-undef 42)))))
|
|
(assert-true (get r "ok"))))
|
|
|
|
(deftest "set! mutation visible across sibling closures in same let"
|
|
(let ((shared 0))
|
|
(let ((writer (fn (v) (set! shared v)))
|
|
(reader (fn () shared)))
|
|
(assert-equal 0 (reader))
|
|
(writer 55)
|
|
(assert-equal 55 (reader))
|
|
(writer 99)
|
|
(assert-equal 99 (reader)))))
|
|
|
|
(deftest "set! does not affect outer scope bindings with same name"
|
|
;; Inner let introduces its own x; set! inside it must not touch outer x.
|
|
(let ((x 10))
|
|
(let ((x 20))
|
|
(set! x 999))
|
|
;; outer x must remain 10
|
|
(assert-equal 10 x))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; closure scope edge cases
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "closure-scope-edge"
|
|
(deftest "for-each captures independent value per iteration"
|
|
;; Each fn closure captures the loop variable value at call time.
|
|
;; Build thunks from map so each one sees its own x.
|
|
(let ((thunks (map (fn (x) (fn () x)) (list 10 20 30))))
|
|
(assert-equal 10 ((nth thunks 0)))
|
|
(assert-equal 20 ((nth thunks 1)))
|
|
(assert-equal 30 ((nth thunks 2)))))
|
|
|
|
(deftest "multiple closures from same let are independent"
|
|
;; Two closures from one let have separate parameter environments
|
|
;; but share the same closed-over bindings.
|
|
(define make-pair
|
|
(fn (init)
|
|
(let ((state init))
|
|
(list
|
|
(fn (v) (set! state v)) ;; setter
|
|
(fn () state))))) ;; getter
|
|
(let ((pair-a (make-pair 0))
|
|
(pair-b (make-pair 100)))
|
|
(let ((set-a (nth pair-a 0)) (get-a (nth pair-a 1))
|
|
(set-b (nth pair-b 0)) (get-b (nth pair-b 1)))
|
|
(set-a 7)
|
|
(set-b 42)
|
|
;; Each pair is independent — no crosstalk
|
|
(assert-equal 7 (get-a))
|
|
(assert-equal 42 (get-b))
|
|
(set-a 99)
|
|
(assert-equal 99 (get-a))
|
|
(assert-equal 42 (get-b)))))
|
|
|
|
(deftest "closure over closure — function returning a function"
|
|
(define make-adder-factory
|
|
(fn (base)
|
|
(fn (offset)
|
|
(fn (x) (+ base offset x)))))
|
|
(let ((factory (make-adder-factory 100)))
|
|
(let ((add-10 (factory 10))
|
|
(add-20 (factory 20)))
|
|
(assert-equal 115 (add-10 5))
|
|
(assert-equal 125 (add-20 5))
|
|
;; base=100 is shared by both; offset differs
|
|
(assert-equal 130 (add-10 20))
|
|
(assert-equal 140 (add-20 20)))))
|
|
|
|
(deftest "closure survives after creating scope is gone"
|
|
(define make-frozen-adder
|
|
(fn (n)
|
|
(fn (x) (+ n x))))
|
|
(let ((add5 (make-frozen-adder 5))
|
|
(add99 (make-frozen-adder 99)))
|
|
;; make-frozen-adder's local env is gone; closures still work
|
|
(assert-equal 10 (add5 5))
|
|
(assert-equal 105 (add5 100))
|
|
(assert-equal 100 (add99 1))
|
|
(assert-equal 199 (add99 100))))
|
|
|
|
(deftest "closure sees set! mutations from sibling closure"
|
|
;; Two closures close over the same let-bound variable.
|
|
;; When one mutates it, the other sees the new value.
|
|
(let ((shared 0))
|
|
(let ((inc! (fn () (set! shared (+ shared 1))))
|
|
(peek (fn () shared)))
|
|
(assert-equal 0 (peek))
|
|
(inc!)
|
|
(assert-equal 1 (peek))
|
|
(inc!)
|
|
(inc!)
|
|
(assert-equal 3 (peek)))))
|
|
|
|
(deftest "closure captures value not reference for immutable bindings"
|
|
;; Create closure when x=1, then shadow x=99 in an inner let.
|
|
;; The closure should see the x it closed over (1), not the shadowed one.
|
|
(let ((x 1))
|
|
(let ((f (fn () x)))
|
|
(let ((x 99))
|
|
(assert-equal 1 (f)))
|
|
;; Even after inner let ends, f still returns 1
|
|
(assert-equal 1 (f))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; letrec edge cases
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "letrec-edge"
|
|
(deftest "letrec with single recursive binding"
|
|
(letrec ((sum-to (fn (n)
|
|
(if (<= n 0)
|
|
0
|
|
(+ n (sum-to (- n 1)))))))
|
|
(assert-equal 0 (sum-to 0))
|
|
(assert-equal 1 (sum-to 1))
|
|
(assert-equal 10 (sum-to 4))
|
|
(assert-equal 55 (sum-to 10))))
|
|
|
|
(deftest "letrec with two mutually recursive functions"
|
|
(letrec ((my-even? (fn (n)
|
|
(if (= n 0) true (my-odd? (- n 1)))))
|
|
(my-odd? (fn (n)
|
|
(if (= n 0) false (my-even? (- n 1))))))
|
|
(assert-true (my-even? 0))
|
|
(assert-false (my-even? 1))
|
|
(assert-true (my-even? 10))
|
|
(assert-false (my-even? 7))
|
|
(assert-true (my-odd? 1))
|
|
(assert-false (my-odd? 0))
|
|
(assert-true (my-odd? 9))))
|
|
|
|
(deftest "letrec non-recursive bindings work too"
|
|
(letrec ((constant 42)
|
|
(label "hello"))
|
|
(assert-equal 42 constant)
|
|
(assert-equal "hello" label)))
|
|
|
|
(deftest "letrec body can use all bindings"
|
|
(letrec ((double (fn (n) (* n 2)))
|
|
(triple (fn (n) (* n 3)))
|
|
(base 5))
|
|
;; Body accesses all three bindings together
|
|
(assert-equal 10 (double base))
|
|
(assert-equal 15 (triple base))
|
|
(assert-equal 25 (+ (double base) (triple base)))))
|
|
|
|
(deftest "letrec — later binding can call earlier binding"
|
|
;; In letrec all bindings see all others, regardless of order.
|
|
(letrec ((square (fn (n) (* n n)))
|
|
(sum-of-squares (fn (a b) (+ (square a) (square b)))))
|
|
;; sum-of-squares calls square, which was defined before it
|
|
(assert-equal 25 (sum-of-squares 3 4))
|
|
(assert-equal 13 (sum-of-squares 2 3))))
|
|
|
|
(deftest "letrec with three-way mutual recursion"
|
|
;; a → b → c → a cycle
|
|
(letrec ((fa (fn (n) (if (<= n 0) "a-done" (fb (- n 1)))))
|
|
(fb (fn (n) (if (<= n 0) "b-done" (fc (- n 1)))))
|
|
(fc (fn (n) (if (<= n 0) "c-done" (fa (- n 1))))))
|
|
;; n=0: fa returns immediately
|
|
(assert-equal "a-done" (fa 0))
|
|
;; n=1: fa→fb, fb returns
|
|
(assert-equal "b-done" (fa 1))
|
|
;; n=2: fa→fb→fc, fc returns
|
|
(assert-equal "c-done" (fa 2))
|
|
;; n=3: fa→fb→fc→fa, fa returns
|
|
(assert-equal "a-done" (fa 3)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; environment isolation
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "environment-isolation"
|
|
(deftest "lambda call does not leak its params to caller scope"
|
|
(let ((x 99))
|
|
(let ((f (fn (x) (* x 2))))
|
|
(f 5)
|
|
;; Caller's x must be unchanged after call
|
|
(assert-equal 99 x))))
|
|
|
|
(deftest "lambda call does not leak its local defines to caller scope"
|
|
(let ((f (fn ()
|
|
(define iso-local 123)
|
|
iso-local)))
|
|
(assert-equal 123 (f))
|
|
;; iso-local defined inside f must not be visible here
|
|
(assert-throws (fn () iso-local))))
|
|
|
|
(deftest "for-each callback does not leak its param to caller scope"
|
|
(let ((n 1000))
|
|
(for-each (fn (n) n) (list 1 2 3))
|
|
;; Caller's n must be unaffected by callback's parameter n
|
|
(assert-equal 1000 n)))
|
|
|
|
(deftest "map callback does not leak its param to caller scope"
|
|
(let ((item "original"))
|
|
(map (fn (item) (str item "!")) (list "a" "b" "c"))
|
|
(assert-equal "original" item)))
|
|
|
|
(deftest "nested lambda calls don't interfere with each other's locals"
|
|
;; Two independent calls to the same lambda must not share state.
|
|
(define iso-make-counter
|
|
(fn (start)
|
|
(let ((n start))
|
|
(fn ()
|
|
(set! n (+ n 1))
|
|
n))))
|
|
(let ((c1 (iso-make-counter 0))
|
|
(c2 (iso-make-counter 100)))
|
|
(assert-equal 1 (c1))
|
|
(assert-equal 2 (c1))
|
|
(assert-equal 101 (c2))
|
|
;; c1 and c2 are fully independent
|
|
(assert-equal 3 (c1))
|
|
(assert-equal 102 (c2))))
|
|
|
|
(deftest "map callback env is isolated per call"
|
|
;; Each map callback invocation should start with a fresh param binding.
|
|
(let ((results (map (fn (x)
|
|
(let ((local (* x 10)))
|
|
local))
|
|
(list 1 2 3 4 5))))
|
|
(assert-equal (list 10 20 30 40 50) results)))
|
|
|
|
(deftest "filter callback does not pollute caller scope"
|
|
(let ((threshold 5))
|
|
(let ((big (filter (fn (threshold) (> threshold 5))
|
|
(list 3 6 9 2 7))))
|
|
;; The callback shadowed 'threshold' — caller's binding must survive
|
|
(assert-equal 5 threshold)
|
|
(assert-equal (list 6 9 7) big))))
|
|
|
|
(deftest "reduce callback accumulates without leaking"
|
|
(let ((acc "untouched"))
|
|
(let ((sum (reduce (fn (acc x) (+ acc x)) 0 (list 1 2 3 4))))
|
|
(assert-equal 10 sum)
|
|
;; Outer acc must be unaffected by reduce's internal use of acc
|
|
(assert-equal "untouched" acc))))
|
|
|
|
(deftest "component call does not expose its closure to caller"
|
|
;; Define a component that binds a local name; caller should not
|
|
;; be able to see that name after the component is invoked.
|
|
(defcomp ~iso-comp (&key val)
|
|
(do
|
|
(define iso-comp-secret (* val 999))
|
|
(div (str val))))
|
|
;; Component exists and is callable (we can't inspect its internals)
|
|
(assert-true (not (nil? ~iso-comp)))))
|