smalltalk: Behavior>>compile: + addSelector:/removeSelector: + 9 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:
@@ -189,4 +189,53 @@
|
||||
(st-test "respondsTo: with string arg"
|
||||
(evp "^ Cat new respondsTo: 'miaow'") true)
|
||||
|
||||
(list st-test-pass st-test-fail)
|
||||
;; ── 18. Behavior>>compile: — runtime method addition ──
|
||||
(st-test "compile: a unary method"
|
||||
(begin
|
||||
(evp "Cat compile: 'whisker ^ 99'")
|
||||
(evp "^ Cat new whisker"))
|
||||
99)
|
||||
|
||||
(st-test "compile: returns the selector as a symbol"
|
||||
(str (evp "^ Cat compile: 'twitch ^ #twitch'"))
|
||||
"twitch")
|
||||
|
||||
(st-test "compile: a keyword method"
|
||||
(begin
|
||||
(evp "Cat compile: 'doubled: x ^ x * 2'")
|
||||
(evp "^ Cat new doubled: 21"))
|
||||
42)
|
||||
|
||||
(st-test "compile: a method with temps and blocks"
|
||||
(begin
|
||||
(evp "Cat compile: 'sumTo: n | s | s := 0. 1 to: n do: [:i | s := s + i]. ^ s'")
|
||||
(evp "^ Cat new sumTo: 10"))
|
||||
55)
|
||||
|
||||
(st-test "recompile overrides existing method"
|
||||
(begin
|
||||
(evp "Cat compile: 'miaow ^ #ahem'")
|
||||
(str (evp "^ Cat new miaow")))
|
||||
"ahem")
|
||||
|
||||
;; methodDict reflects the new method.
|
||||
(st-test "compile: registers in methodDict"
|
||||
(has-key? (ev "Cat methodDict") "whisker") true)
|
||||
|
||||
;; respondsTo: notices the new method.
|
||||
(st-test "respondsTo: sees compiled method"
|
||||
(evp "^ Cat new respondsTo: #whisker") true)
|
||||
|
||||
;; Behavior>>removeSelector: takes a method back out.
|
||||
(st-test "removeSelector: drops the method"
|
||||
(begin
|
||||
(evp "Cat removeSelector: #whisker")
|
||||
(evp "^ Cat new respondsTo: #whisker"))
|
||||
false)
|
||||
|
||||
;; compile:classified: ignores the extra arg.
|
||||
(st-test "compile:classified: works"
|
||||
(begin
|
||||
(evp "Cat compile: 'taggedMethod ^ #yes' classified: 'demo'")
|
||||
(str (evp "^ Cat new taggedMethod")))
|
||||
"yes")
|
||||
|
||||
Reference in New Issue
Block a user