;; super-send tests.
;;
;; super looks up methods starting at the *defining class*'s superclass —
;; not the receiver's class. This means an inherited method that uses
;; `super` always reaches the same parent regardless of where in the
;; subclass chain the receiver actually sits.

(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. Basic super: subclass override calls parent ──
(st-class-define! "Animal" "Object" (list))
(st-class-add-method! "Animal" "speak"
  (st-parse-method "speak ^ #generic"))

(st-class-define! "Dog" "Animal" (list))
(st-class-add-method! "Dog" "speak"
  (st-parse-method "speak ^ super speak"))

(st-test
  "super reaches parent's speak"
  (str (evp "^ Dog new speak"))
  "generic")

(st-class-add-method! "Dog" "loud"
  (st-parse-method "loud ^ super speak , #'!' asString"))
;; The above tries to use `, #'!' asString` which won't quite work with my
;; primitives. Replace with a simpler test.
(st-class-add-method! "Dog" "loud"
  (st-parse-method "loud | s | s := super speak. ^ s"))

(st-test
  "method calls super and returns same"
  (str (evp "^ Dog new loud"))
  "generic")

;; ── 2. Super with argument ──
(st-class-add-method! "Animal" "greet:"
  (st-parse-method "greet: name ^ name , ' (animal)'"))
(st-class-add-method! "Dog" "greet:"
  (st-parse-method "greet: name ^ super greet: name"))

(st-test
  "super with arg reaches parent and threads value"
  (evp "^ Dog new greet: 'Rex'")
  "Rex (animal)")

;; ── 3. Inherited method uses *defining* class for super ──
;; A defines speak ^ 'A'
;; A defines speakLog: which sends `super speak`. super starts at Object → no
;; speak there → DNU. So invoke speakLog from A subclass to test that super
;; resolves to A's parent (Object), not the subclass's parent.
(st-class-define! "RootSpeaker" "Object" (list))
(st-class-add-method! "RootSpeaker" "speak"
  (st-parse-method "speak ^ #root"))
(st-class-add-method! "RootSpeaker" "speakDelegate"
  (st-parse-method "speakDelegate ^ super speak"))
;; Object has no speak (and we add a temporary DNU for testing).
(st-class-add-method! "Object" "doesNotUnderstand:"
  (st-parse-method "doesNotUnderstand: aMessage ^ #dnu"))

(st-class-define! "ChildSpeaker" "RootSpeaker" (list))
(st-class-add-method! "ChildSpeaker" "speak"
  (st-parse-method "speak ^ #child"))

(st-test
  "inherited speakDelegate uses RootSpeaker's super, not ChildSpeaker's"
  (str (evp "^ ChildSpeaker new speakDelegate"))
  "dnu")

;; A non-inherited path: ChildSpeaker overrides speak, but speakDelegate is
;; inherited from RootSpeaker. The super inside speakDelegate must resolve to
;; *Object* (RootSpeaker's parent), not to RootSpeaker (ChildSpeaker's parent).
(st-test
  "inherited method's super does not call subclass override"
  (str (evp "^ ChildSpeaker new speak"))
  "child")

;; Remove the Object DNU shim now that those tests are done.
(st-class-remove-method! "Object" "doesNotUnderstand:")

;; ── 4. Multi-level: A → B → C ──
(st-class-define! "GA" "Object" (list))
(st-class-add-method! "GA" "level"
  (st-parse-method "level ^ #ga"))

(st-class-define! "GB" "GA" (list))
(st-class-add-method! "GB" "level"
  (st-parse-method "level ^ super level"))

(st-class-define! "GC" "GB" (list))
(st-class-add-method! "GC" "level"
  (st-parse-method "level ^ super level"))

(st-test
  "super chains to grandparent"
  (str (evp "^ GC new level"))
  "ga")

;; ── 5. Super inside a block ──
(st-class-add-method! "Dog" "delayed"
  (st-parse-method "delayed ^ [super speak] value"))
(st-test
  "super inside a block resolves correctly"
  (str (evp "^ Dog new delayed"))
  "generic")

;; ── 6. Super send keeps receiver as self ──
(st-class-define! "Counter" "Object" (list "count"))
(st-class-add-method! "Counter" "init"
  (st-parse-method "init count := 0. ^ self"))
(st-class-add-method! "Counter" "incr"
  (st-parse-method "incr count := count + 1. ^ self"))
(st-class-add-method! "Counter" "count"
  (st-parse-method "count ^ count"))

(st-class-define! "DoubleCounter" "Counter" (list))
(st-class-add-method! "DoubleCounter" "incr"
  (st-parse-method "incr super incr. super incr. ^ self"))

(st-test
  "super uses same receiver — ivars on self update"
  (evp "| c | c := DoubleCounter new init. c incr. ^ c count")
  2)

;; ── 7. Super on a class without an immediate parent definition ──
;; Mid-chain class with no override at this level: super resolves correctly
;; through the missing rung.
(st-class-define! "Mid" "Animal" (list))
(st-class-define! "Pup" "Mid" (list))
(st-class-add-method! "Pup" "speak"
  (st-parse-method "speak ^ super speak"))

(st-test
  "super walks past intermediate class with no override"
  (str (evp "^ Pup new speak"))
  "generic")

;; ── 8. Super outside any method errors ──
;; (We don't have try/catch in SX from here; skip the negative test —
;;  documented behaviour is that st-super-send errors when method-class is nil.)

(list st-test-pass st-test-fail)