Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
116 lines
3.8 KiB
Plaintext
116 lines
3.8 KiB
Plaintext
;; Phase 5 collection tests — methods on SequenceableCollection / Array /
|
|
;; String / Symbol. Emphasis on the inherited-from-SequenceableCollection
|
|
;; methods that work uniformly across Array, String, Symbol.
|
|
|
|
(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. inject:into: (fold) ──
|
|
(st-test "Array inject:into: sum"
|
|
(ev "#(1 2 3 4) inject: 0 into: [:a :b | a + b]") 10)
|
|
|
|
(st-test "Array inject:into: product"
|
|
(ev "#(2 3 4) inject: 1 into: [:a :b | a * b]") 24)
|
|
|
|
(st-test "Array inject:into: empty array → initial"
|
|
(ev "#() inject: 99 into: [:a :b | a + b]") 99)
|
|
|
|
;; ── 2. detect: / detect:ifNone: ──
|
|
(st-test "detect: finds first match"
|
|
(ev "#(1 3 5 7) detect: [:x | x > 4]") 5)
|
|
|
|
(st-test "detect: returns nil if no match"
|
|
(ev "#(1 2 3) detect: [:x | x > 10]") nil)
|
|
|
|
(st-test "detect:ifNone: invokes block on miss"
|
|
(ev "#(1 2 3) detect: [:x | x > 10] ifNone: [#none]")
|
|
(make-symbol "none"))
|
|
|
|
;; ── 3. count: ──
|
|
(st-test "count: matches"
|
|
(ev "#(1 2 3 4 5 6) count: [:x | x > 3]") 3)
|
|
|
|
(st-test "count: zero matches"
|
|
(ev "#(1 2 3) count: [:x | x > 100]") 0)
|
|
|
|
;; ── 4. allSatisfy: / anySatisfy: ──
|
|
(st-test "allSatisfy: when all match"
|
|
(ev "#(2 4 6) allSatisfy: [:x | x > 0]") true)
|
|
|
|
(st-test "allSatisfy: when one fails"
|
|
(ev "#(2 4 -1) allSatisfy: [:x | x > 0]") false)
|
|
|
|
(st-test "anySatisfy: when at least one matches"
|
|
(ev "#(1 2 3) anySatisfy: [:x | x > 2]") true)
|
|
|
|
(st-test "anySatisfy: when none match"
|
|
(ev "#(1 2 3) anySatisfy: [:x | x > 100]") false)
|
|
|
|
;; ── 5. includes: ──
|
|
(st-test "includes: found" (ev "#(1 2 3) includes: 2") true)
|
|
(st-test "includes: missing" (ev "#(1 2 3) includes: 99") false)
|
|
|
|
;; ── 6. indexOf: / indexOf:ifAbsent: ──
|
|
(st-test "indexOf: returns 1-based index"
|
|
(ev "#(10 20 30 40) indexOf: 30") 3)
|
|
|
|
(st-test "indexOf: missing returns 0"
|
|
(ev "#(1 2 3) indexOf: 99") 0)
|
|
|
|
(st-test "indexOf:ifAbsent: invokes block"
|
|
(ev "#(1 2 3) indexOf: 99 ifAbsent: [-1]") -1)
|
|
|
|
;; ── 7. reject: (complement of select:) ──
|
|
(st-test "reject: removes matching"
|
|
(ev "#(1 2 3 4 5) reject: [:x | x > 3]")
|
|
(list 1 2 3))
|
|
|
|
;; ── 8. do:separatedBy: ──
|
|
(st-test "do:separatedBy: builds joined sequence"
|
|
(evp
|
|
"| seen |
|
|
seen := #().
|
|
#(1 2 3) do: [:e | seen := seen , (Array with: e)]
|
|
separatedBy: [seen := seen , #(0)].
|
|
^ seen")
|
|
(list 1 0 2 0 3))
|
|
|
|
;; Array with: shim for the test (inherited from earlier exception tests
|
|
;; in a separate suite — define here for safety).
|
|
(st-class-add-class-method! "Array" "with:"
|
|
(st-parse-method "with: x | a | a := Array new: 1. a at: 1 put: x. ^ a"))
|
|
|
|
;; ── 9. String inherits the same methods ──
|
|
(st-test "String includes:"
|
|
(ev "'abcde' includes: $c") true)
|
|
|
|
(st-test "String count:"
|
|
(ev "'banana' count: [:c | c = $a]") 3)
|
|
|
|
(st-test "String inject:into: concatenates"
|
|
(ev "'abc' inject: '' into: [:acc :c | acc , c , c]")
|
|
"aabbcc")
|
|
|
|
(st-test "String allSatisfy:"
|
|
(ev "'abc' allSatisfy: [:c | c = $a or: [c = $b or: [c = $c]]]") true)
|
|
|
|
;; ── 10. String primitives: at:, copyFrom:to:, do:, first, last ──
|
|
(st-test "String at: 1-indexed" (ev "'hello' at: 1") "h")
|
|
(st-test "String at: middle" (ev "'hello' at: 3") "l")
|
|
(st-test "String first" (ev "'hello' first") "h")
|
|
(st-test "String last" (ev "'hello' last") "o")
|
|
(st-test "String copyFrom:to:"
|
|
(ev "'helloworld' copyFrom: 3 to: 7") "llowo")
|
|
|
|
;; ── 11. isEmpty / notEmpty go through SequenceableCollection too ──
|
|
;; (Already in primitives; the inherited versions agree.)
|
|
(st-test "Array isEmpty" (ev "#() isEmpty") true)
|
|
(st-test "Array notEmpty" (ev "#(1) notEmpty") true)
|
|
|
|
(list st-test-pass st-test-fail)
|