giles
45147bd8a6
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
108 lines
3.7 KiB
Plaintext
108 lines
3.7 KiB
Plaintext
;; doesNotUnderstand: tests.
|
|
|
|
(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. Bootstrap installs Message class ──
|
|
(st-test "Message exists in bootstrap" (st-class-exists? "Message") true)
|
|
(st-test
|
|
"Message has expected ivars"
|
|
(sort (get (st-class-get "Message") :ivars))
|
|
(sort (list "selector" "arguments")))
|
|
|
|
;; ── 2. Building a Message directly ──
|
|
(define m (st-make-message "frob:" (list 1 2 3)))
|
|
(st-test "make-message produces st-instance" (st-instance? m) true)
|
|
(st-test "message class" (get m :class) "Message")
|
|
(st-test "message selector ivar"
|
|
(str (get (get m :ivars) "selector"))
|
|
"frob:")
|
|
(st-test "message arguments ivar" (get (get m :ivars) "arguments") (list 1 2 3))
|
|
|
|
;; ── 3. User override of doesNotUnderstand: intercepts unknown sends ──
|
|
(st-class-define! "Logger" "Object" (list "log"))
|
|
(st-class-add-method! "Logger" "log"
|
|
(st-parse-method "log ^ log"))
|
|
(st-class-add-method! "Logger" "init"
|
|
(st-parse-method "init log := nil. ^ self"))
|
|
(st-class-add-method! "Logger" "doesNotUnderstand:"
|
|
(st-parse-method
|
|
"doesNotUnderstand: aMessage
|
|
log := aMessage selector.
|
|
^ #handled"))
|
|
|
|
(st-test
|
|
"user DNU intercepts unknown send"
|
|
(str
|
|
(evp "| l | l := Logger new init. l frobnicate. ^ l log"))
|
|
"frobnicate")
|
|
|
|
(st-test
|
|
"user DNU returns its own value"
|
|
(str (evp "| l | l := Logger new init. ^ l frobnicate"))
|
|
"handled")
|
|
|
|
;; Arguments are captured.
|
|
(st-class-add-method! "Logger" "doesNotUnderstand:"
|
|
(st-parse-method
|
|
"doesNotUnderstand: aMessage
|
|
log := aMessage arguments.
|
|
^ #handled"))
|
|
|
|
(st-test
|
|
"user DNU sees args in Message"
|
|
(evp "| l | l := Logger new init. l zip: 1 zap: 2. ^ l log")
|
|
(list 1 2))
|
|
|
|
;; ── 4. DNU on native receiver ─────────────────────────────────────────
|
|
;; Adding doesNotUnderstand: on Object catches any-receiver sends.
|
|
(st-class-add-method! "Object" "doesNotUnderstand:"
|
|
(st-parse-method
|
|
"doesNotUnderstand: aMessage ^ aMessage selector"))
|
|
|
|
(st-test "Object DNU intercepts on SmallInteger"
|
|
(str (ev "42 frobnicate"))
|
|
"frobnicate")
|
|
|
|
(st-test "Object DNU intercepts on String"
|
|
(str (ev "'hi' bogusmessage"))
|
|
"bogusmessage")
|
|
|
|
(st-test "Object DNU sees arguments"
|
|
;; Re-define Object DNU to return the args array.
|
|
(begin
|
|
(st-class-add-method! "Object" "doesNotUnderstand:"
|
|
(st-parse-method "doesNotUnderstand: aMessage ^ aMessage arguments"))
|
|
(ev "42 plop: 1 plop: 2"))
|
|
(list 1 2))
|
|
|
|
;; ── 5. Subclass DNU overrides Object DNU ──────────────────────────────
|
|
(st-class-define! "Proxy" "Object" (list))
|
|
(st-class-add-method! "Proxy" "doesNotUnderstand:"
|
|
(st-parse-method "doesNotUnderstand: aMessage ^ #proxyHandled"))
|
|
|
|
(st-test "subclass DNU wins over Object DNU"
|
|
(str (evp "^ Proxy new whatever"))
|
|
"proxyHandled")
|
|
|
|
;; ── 6. Defined methods bypass DNU ─────────────────────────────────────
|
|
(st-class-add-method! "Proxy" "known" (st-parse-method "known ^ 7"))
|
|
(st-test "defined method wins over DNU"
|
|
(evp "^ Proxy new known")
|
|
7)
|
|
|
|
;; ── 7. Block doesNotUnderstand: routes via Object ─────────────────────
|
|
(st-class-add-method! "Object" "doesNotUnderstand:"
|
|
(st-parse-method "doesNotUnderstand: aMessage ^ #blockDnu"))
|
|
(st-test "block unknown selector goes to DNU"
|
|
(str (ev "[1] frobnicate"))
|
|
"blockDnu")
|
|
|
|
(list st-test-pass st-test-fail)
|