smalltalk: method-lookup cache + 10 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:
@@ -179,4 +179,77 @@
|
||||
(st-test "after re-bootstrap Account gone" (st-class-exists? "Account") false)
|
||||
(st-test "after re-bootstrap Object stays" (st-class-exists? "Object") true)
|
||||
|
||||
;; ── 10. Method-lookup cache ──
|
||||
(st-bootstrap-classes!)
|
||||
(st-class-define! "Foo" "Object" (list))
|
||||
(st-class-define! "Bar" "Foo" (list))
|
||||
(st-class-add-method! "Foo" "greet" (st-parse-method "greet ^ 1"))
|
||||
|
||||
;; Bootstrap clears cache; record stats from now.
|
||||
(st-method-cache-reset-stats!)
|
||||
|
||||
;; First lookup is a miss; second is a hit.
|
||||
(st-method-lookup "Bar" "greet" false)
|
||||
(st-test
|
||||
"first lookup recorded as miss"
|
||||
(get (st-method-cache-stats) :misses)
|
||||
1)
|
||||
(st-test
|
||||
"first lookup recorded as hit count zero"
|
||||
(get (st-method-cache-stats) :hits)
|
||||
0)
|
||||
|
||||
(st-method-lookup "Bar" "greet" false)
|
||||
(st-test
|
||||
"second lookup hits cache"
|
||||
(get (st-method-cache-stats) :hits)
|
||||
1)
|
||||
|
||||
;; Misses are also cached as :not-found.
|
||||
(st-method-lookup "Bar" "frobnicate" false)
|
||||
(st-method-lookup "Bar" "frobnicate" false)
|
||||
(st-test
|
||||
"negative-result caches"
|
||||
(get (st-method-cache-stats) :hits)
|
||||
2)
|
||||
|
||||
;; Adding a new method invalidates the cache.
|
||||
(st-class-add-method! "Bar" "greet" (st-parse-method "greet ^ 2"))
|
||||
(st-test
|
||||
"cache cleared on method add"
|
||||
(get (st-method-cache-stats) :size)
|
||||
0)
|
||||
(st-test
|
||||
"after invalidation lookup picks up override"
|
||||
(get (st-method-lookup "Bar" "greet" false) :defining-class)
|
||||
"Bar")
|
||||
|
||||
;; Removing a method also invalidates and exposes the inherited one.
|
||||
(st-class-remove-method! "Bar" "greet")
|
||||
(st-test
|
||||
"after remove lookup falls through to Foo"
|
||||
(get (st-method-lookup "Bar" "greet" false) :defining-class)
|
||||
"Foo")
|
||||
|
||||
;; Cache survives across unrelated class-table mutations? No — define! clears.
|
||||
(st-method-lookup "Foo" "greet" false) ; warm cache
|
||||
(st-class-define! "Baz" "Object" (list))
|
||||
(st-test
|
||||
"class-define clears cache"
|
||||
(get (st-method-cache-stats) :size)
|
||||
0)
|
||||
|
||||
;; Class-side and instance-side cache entries are separate keys.
|
||||
(st-class-add-class-method! "Foo" "make" (st-parse-method "make ^ self new"))
|
||||
(st-method-lookup "Foo" "make" true)
|
||||
(st-method-lookup "Foo" "make" false)
|
||||
(st-test
|
||||
"class-side hit found, instance-side stored as not-found"
|
||||
(= (st-method-lookup "Foo" "make" true) nil)
|
||||
false)
|
||||
(st-test
|
||||
"instance-side same selector returns nil"
|
||||
(st-method-lookup "Foo" "make" false)
|
||||
nil)
|
||||
|
||||
(list st-test-pass st-test-fail)
|
||||
|
||||
Reference in New Issue
Block a user