smalltalk: HashedCollection/Set/Dictionary/IdentityDictionary + 29 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
This commit is contained in:
216
lib/smalltalk/tests/hashed.sx
Normal file
216
lib/smalltalk/tests/hashed.sx
Normal file
@@ -0,0 +1,216 @@
|
||||
;; HashedCollection / Set / Dictionary / IdentityDictionary tests.
|
||||
;; These are user classes implemented in `runtime.sx` with array-backed
|
||||
;; storage. Set: single ivar `array`. Dictionary: parallel `keys`/`values`.
|
||||
|
||||
(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. Class hierarchy ──
|
||||
(st-test "Set < HashedCollection" (st-class-inherits-from? "Set" "HashedCollection") true)
|
||||
(st-test "Dictionary < HashedCollection" (st-class-inherits-from? "Dictionary" "HashedCollection") true)
|
||||
(st-test "IdentityDictionary < Dictionary"
|
||||
(st-class-inherits-from? "IdentityDictionary" "Dictionary") true)
|
||||
|
||||
;; ── 2. Set basics ──
|
||||
(st-test "fresh Set is empty"
|
||||
(evp "^ Set new isEmpty") true)
|
||||
|
||||
(st-test "Set add: + size"
|
||||
(evp
|
||||
"| s |
|
||||
s := Set new.
|
||||
s add: 1. s add: 2. s add: 3.
|
||||
^ s size")
|
||||
3)
|
||||
|
||||
(st-test "Set add: deduplicates"
|
||||
(evp
|
||||
"| s |
|
||||
s := Set new.
|
||||
s add: 1. s add: 1. s add: 1.
|
||||
^ s size")
|
||||
1)
|
||||
|
||||
(st-test "Set includes: found"
|
||||
(evp
|
||||
"| s | s := Set new. s add: #a. s add: #b. ^ s includes: #a")
|
||||
true)
|
||||
|
||||
(st-test "Set includes: missing"
|
||||
(evp
|
||||
"| s | s := Set new. s add: #a. ^ s includes: #z")
|
||||
false)
|
||||
|
||||
(st-test "Set remove: drops the element"
|
||||
(evp
|
||||
"| s |
|
||||
s := Set new.
|
||||
s add: 1. s add: 2. s add: 3.
|
||||
s remove: 2.
|
||||
^ s includes: 2")
|
||||
false)
|
||||
|
||||
(st-test "Set remove: keeps the others"
|
||||
(evp
|
||||
"| s |
|
||||
s := Set new.
|
||||
s add: 1. s add: 2. s add: 3.
|
||||
s remove: 2.
|
||||
^ s size")
|
||||
2)
|
||||
|
||||
(st-test "Set do: iterates"
|
||||
(evp
|
||||
"| s sum |
|
||||
s := Set new.
|
||||
s add: 1. s add: 2. s add: 3.
|
||||
sum := 0.
|
||||
s do: [:e | sum := sum + e].
|
||||
^ sum")
|
||||
6)
|
||||
|
||||
(st-test "Set addAll: with an Array"
|
||||
(evp
|
||||
"| s |
|
||||
s := Set new.
|
||||
s addAll: #(1 2 3 2 1).
|
||||
^ s size")
|
||||
3)
|
||||
|
||||
;; ── 3. Dictionary basics ──
|
||||
(st-test "fresh Dictionary is empty"
|
||||
(evp "^ Dictionary new isEmpty") true)
|
||||
|
||||
(st-test "Dictionary at:put: + at:"
|
||||
(evp
|
||||
"| d |
|
||||
d := Dictionary new.
|
||||
d at: #a put: 1.
|
||||
d at: #b put: 2.
|
||||
^ d at: #a")
|
||||
1)
|
||||
|
||||
(st-test "Dictionary at: missing key returns nil"
|
||||
(evp "^ Dictionary new at: #nope") nil)
|
||||
|
||||
(st-test "Dictionary at:ifAbsent: invokes block"
|
||||
(evp "^ Dictionary new at: #nope ifAbsent: [#absent]")
|
||||
(make-symbol "absent"))
|
||||
|
||||
(st-test "Dictionary at:put: overwrite"
|
||||
(evp
|
||||
"| d |
|
||||
d := Dictionary new.
|
||||
d at: #x put: 1.
|
||||
d at: #x put: 99.
|
||||
^ d at: #x")
|
||||
99)
|
||||
|
||||
(st-test "Dictionary size after several puts"
|
||||
(evp
|
||||
"| d |
|
||||
d := Dictionary new.
|
||||
d at: #a put: 1. d at: #b put: 2. d at: #c put: 3.
|
||||
^ d size")
|
||||
3)
|
||||
|
||||
(st-test "Dictionary includesKey: found"
|
||||
(evp
|
||||
"| d | d := Dictionary new. d at: #a put: 1. ^ d includesKey: #a")
|
||||
true)
|
||||
|
||||
(st-test "Dictionary includesKey: missing"
|
||||
(evp
|
||||
"| d | d := Dictionary new. d at: #a put: 1. ^ d includesKey: #z")
|
||||
false)
|
||||
|
||||
(st-test "Dictionary removeKey:"
|
||||
(evp
|
||||
"| d |
|
||||
d := Dictionary new.
|
||||
d at: #a put: 1. d at: #b put: 2. d at: #c put: 3.
|
||||
d removeKey: #b.
|
||||
^ d size")
|
||||
2)
|
||||
|
||||
(st-test "Dictionary removeKey: drops only that key"
|
||||
(evp
|
||||
"| d |
|
||||
d := Dictionary new.
|
||||
d at: #a put: 1. d at: #b put: 2. d at: #c put: 3.
|
||||
d removeKey: #b.
|
||||
^ d at: #a")
|
||||
1)
|
||||
|
||||
;; ── 4. Dictionary iteration ──
|
||||
(st-test "Dictionary do: yields values"
|
||||
(evp
|
||||
"| d sum |
|
||||
d := Dictionary new.
|
||||
d at: #a put: 1. d at: #b put: 2. d at: #c put: 3.
|
||||
sum := 0.
|
||||
d do: [:v | sum := sum + v].
|
||||
^ sum")
|
||||
6)
|
||||
|
||||
(st-test "Dictionary keysDo: yields keys"
|
||||
(evp
|
||||
"| d log |
|
||||
d := Dictionary new.
|
||||
d at: #a put: 1. d at: #b put: 2.
|
||||
log := #().
|
||||
d keysDo: [:k | log := log , (Array with: k)].
|
||||
^ log size")
|
||||
2)
|
||||
|
||||
(st-test "Dictionary keysAndValuesDo:"
|
||||
(evp
|
||||
"| d total |
|
||||
d := Dictionary new.
|
||||
d at: #a put: 10. d at: #b put: 20.
|
||||
total := 0.
|
||||
d keysAndValuesDo: [:k :v | total := total + v].
|
||||
^ total")
|
||||
30)
|
||||
|
||||
;; Helper used by some tests above:
|
||||
(st-class-add-class-method! "Array" "with:"
|
||||
(st-parse-method "with: x | a | a := Array new: 1. a at: 1 put: x. ^ a"))
|
||||
|
||||
(st-test "Dictionary keys returns Array"
|
||||
(sort
|
||||
(evp
|
||||
"| d | d := Dictionary new.
|
||||
d at: #x put: 1. d at: #y put: 2. d at: #z put: 3.
|
||||
^ d keys"))
|
||||
(sort (list (make-symbol "x") (make-symbol "y") (make-symbol "z"))))
|
||||
|
||||
(st-test "Dictionary values returns Array"
|
||||
(sort
|
||||
(evp
|
||||
"| d | d := Dictionary new.
|
||||
d at: #x put: 100. d at: #y put: 200.
|
||||
^ d values"))
|
||||
(sort (list 100 200)))
|
||||
|
||||
;; ── 5. Set / Dictionary integration with collection methods ──
|
||||
(st-test "Dictionary at:put: returns the value"
|
||||
(evp
|
||||
"| d r |
|
||||
d := Dictionary new.
|
||||
r := d at: #a put: 42.
|
||||
^ r")
|
||||
42)
|
||||
|
||||
(st-test "Set has its class"
|
||||
(evp "^ Set new class name") "Set")
|
||||
|
||||
(st-test "Dictionary has its class"
|
||||
(evp "^ Dictionary new class name") "Dictionary")
|
||||
|
||||
(list st-test-pass st-test-fail)
|
||||
Reference in New Issue
Block a user