smalltalk: BlockContext value family + 19 tests

lib/smalltalk/tests/blocks.sx

@@ -0,0 +1,92 @@
+;; BlockContext>>value family tests.
+;;
+;; The runtime already implements value, value:, value:value:, value:value:value:,
+;; value:value:value:value:, and valueWithArguments: in st-block-dispatch.
+;; This file pins each variant down with explicit tests + closure semantics.
+
+(set! st-test-pass 0)
+(set! st-test-fail 0)
+(set! st-test-fails (list))
+
+(st-bootstrap-classes!)
+(define ev (fn (src) (smalltalk-eval src)))
+(define evp (fn (src) (smalltalk-eval-program src)))
+
+;; ── 1. The value/valueN family ──
+(st-test "value: zero-arg block"     (ev "[42] value")                              42)
+(st-test "value: one-arg block"      (ev "[:a | a + 1] value: 10")                  11)
+(st-test "value:value: two-arg"       (ev "[:a :b | a * b] value: 3 value: 4")       12)
+(st-test "value:value:value: three"  (ev "[:a :b :c | a + b + c] value: 1 value: 2 value: 3") 6)
+(st-test "value:value:value:value: four"
+  (ev "[:a :b :c :d | a + b + c + d] value: 1 value: 2 value: 3 value: 4")          10)
+
+;; ── 2. valueWithArguments: ──
+(st-test "valueWithArguments: zero-arg"
+  (ev "[99] valueWithArguments: #()")                                               99)
+(st-test "valueWithArguments: one-arg"
+  (ev "[:x | x * x] valueWithArguments: #(7)")                                      49)
+(st-test "valueWithArguments: many"
+  (ev "[:a :b :c | a , b , c] valueWithArguments: #('foo' '-' 'bar')")              "foo-bar")
+
+;; ── 3. Block returns last expression ──
+(st-test "block last-expression result" (ev "[1. 2. 3] value") 3)
+(st-test "block with temps initial state"
+  (ev "[| t u | t := 5. u := t * 2. u] value") 10)
+
+;; ── 4. Closure over outer locals ──
+(st-test
+  "block reads outer let temps"
+  (evp "| n | n := 5. ^ [n * n] value")
+  25)
+(st-test
+  "block writes outer locals (mutating)"
+  (evp "| n | n := 10. [:x | n := n + x] value: 5. ^ n")
+  15)
+
+;; ── 5. Block sees later mutation of captured local ──
+(st-test
+  "block re-reads outer local on each invocation"
+  (evp
+    "| n b r1 r2 |
+     n := 1. b := [n].
+     r1 := b value.
+     n := 99.
+     r2 := b value.
+     ^ r1 + r2")
+  100)
+
+;; ── 6. Re-entrant invocations ──
+(st-test
+  "calling same block twice independent results"
+  (evp
+    "| sq |
+     sq := [:x | x * x].
+     ^ (sq value: 3) + (sq value: 4)")
+  25)
+
+;; ── 7. Nested blocks ──
+(st-test
+  "nested block closes over both scopes"
+  (evp
+    "| a |
+     a := [:x | [:y | x + y]].
+     ^ ((a value: 10) value: 5)")
+  15)
+
+;; ── 8. Block as method argument ──
+(st-class-define! "BlockUser" "Object" (list))
+(st-class-add-method! "BlockUser" "apply:to:"
+  (st-parse-method "apply: aBlock to: x ^ aBlock value: x"))
+
+(st-test
+  "method invokes block argument"
+  (evp "^ BlockUser new apply: [:n | n * n] to: 9")
+  81)
+
+;; ── 9. numArgs + class ──
+(st-test "numArgs zero"    (ev "[] numArgs")        0)
+(st-test "numArgs three"   (ev "[:a :b :c | a] numArgs") 3)
+(st-test "block class is BlockClosure"
+  (str (ev "[1] class name")) "BlockClosure")
+
+(list st-test-pass st-test-fail)