;; whileTrue: / whileTrue / whileFalse: / whileFalse tests.
;;
;; In Smalltalk these are *ordinary* messages sent to the condition block.
;; No special-form magic — just block sends. The runtime can intrinsify
;; them later in the JIT (Tier 1 of bytecode expansion) but the spec-level
;; semantics are what's pinned here.

(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. whileTrue: with body — basic counter ──
(st-test
  "whileTrue: counts down"
  (evp "| n | n := 5. [n > 0] whileTrue: [n := n - 1]. ^ n")
  0)

(st-test
  "whileTrue: returns nil"
  (evp "| n | n := 3. ^ [n > 0] whileTrue: [n := n - 1]")
  nil)

(st-test
  "whileTrue: zero iterations is fine"
  (evp "| n | n := 0. [n > 0] whileTrue: [n := n + 1]. ^ n")
  0)

;; ── 2. whileFalse: with body ──
(st-test
  "whileFalse: counts down (cond becomes true)"
  (evp "| n | n := 5. [n <= 0] whileFalse: [n := n - 1]. ^ n")
  0)

(st-test
  "whileFalse: returns nil"
  (evp "| n | n := 3. ^ [n <= 0] whileFalse: [n := n - 1]")
  nil)

;; ── 3. whileTrue (no arg) — body-less side-effect loop ──
(st-test
  "whileTrue without argument runs cond-only loop"
  (evp
    "| n decrement |
     n := 5.
     decrement := [n := n - 1. n > 0].
     decrement whileTrue.
     ^ n")
  0)

;; ── 4. whileFalse (no arg) ──
(st-test
  "whileFalse without argument"
  (evp
    "| n inc |
     n := 0.
     inc := [n := n + 1. n >= 3].
     inc whileFalse.
     ^ n")
  3)

;; ── 5. Cond block evaluated each iteration (not cached) ──
(st-test
  "whileTrue: re-evaluates cond on every iter"
  (evp
    "| n stop |
     n := 0. stop := false.
     [stop] whileFalse: [
       n := n + 1.
       n >= 4 ifTrue: [stop := true]].
     ^ n")
  4)

;; ── 6. Body block sees outer locals ──
(st-test
  "whileTrue: body reads + writes captured locals"
  (evp
    "| acc i |
     acc := 0. i := 1.
     [i <= 10] whileTrue: [acc := acc + i. i := i + 1].
     ^ acc")
  55)

;; ── 7. Nested while loops ──
(st-test
  "nested whileTrue: produces flat sum"
  (evp
    "| total i j |
     total := 0. i := 0.
     [i < 3] whileTrue: [
       j := 0.
       [j < 4] whileTrue: [total := total + 1. j := j + 1].
       i := i + 1].
     ^ total")
  12)

;; ── 8. ^ inside whileTrue: short-circuits the surrounding method ──
(st-class-define! "WhileEscape" "Object" (list))
(st-class-add-method! "WhileEscape" "firstOver:in:"
  (st-parse-method
    "firstOver: limit in: arr
       | i |
       i := 1.
       [i <= arr size] whileTrue: [
         (arr at: i) > limit ifTrue: [^ arr at: i].
         i := i + 1].
       ^ nil"))

(st-test
  "early ^ from whileTrue: body"
  (evp "^ WhileEscape new firstOver: 5 in: #(1 3 5 7 9)")
  7)

(st-test
  "whileTrue: completes when nothing matches"
  (evp "^ WhileEscape new firstOver: 100 in: #(1 2 3)")
  nil)

;; ── 9. whileTrue: invocations independent across calls ──
(st-class-define! "Counter2" "Object" (list "n"))
(st-class-add-method! "Counter2" "init"
  (st-parse-method "init n := 0. ^ self"))
(st-class-add-method! "Counter2" "n"
  (st-parse-method "n ^ n"))
(st-class-add-method! "Counter2" "tick:"
  (st-parse-method "tick: count [count > 0] whileTrue: [n := n + 1. count := count - 1]. ^ self"))

(st-test
  "instance state survives whileTrue: invocations"
  (evp
    "| c | c := Counter2 new init.
     c tick: 3. c tick: 4.
     ^ c n")
  7)

;; ── 10. Timing: whileTrue: on a never-true cond runs zero times ──
(st-test
  "whileTrue: with always-false cond"
  (evp "| ran | ran := false. [false] whileTrue: [ran := true]. ^ ran")
  false)

(list st-test-pass st-test-fail)