giles
a7272ad162
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
146 lines
3.7 KiB
Plaintext
146 lines
3.7 KiB
Plaintext
;; 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)
|