;; 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)