smalltalk: Object>>becomeForward: + 6 tests

lib/smalltalk/eval.sx

@@ -565,6 +565,24 @@
             (cond
               ((not (st-class-ref? arg)) false)
               (else (= target-cls (get arg :name))))))
+        ;; Object>>becomeForward: aReceiver — one-way become. The receiver's
+        ;; class and ivars are mutated in place to match the target. Every
+        ;; existing reference to the receiver dict sees the new identity.
+        ;; Note: receiver and target remain distinct dicts (not == in the
+        ;; SX-identity sense), but receiver behaves as though it were the
+        ;; target — which is the practical Pharo guarantee.
+        ((= selector "becomeForward:")
+          (let ((other (nth args 0)))
+            (cond
+              ((not (st-instance? receiver))
+                (error "becomeForward: only supported on user instances"))
+              ((not (st-instance? other))
+                (error "becomeForward: target must be a user instance"))
+              (else
+                (begin
+                  (dict-set! receiver :class (get other :class))
+                  (dict-set! receiver :ivars (get other :ivars))
+                  receiver)))))
         ((or (= cls "SmallInteger") (= cls "Float"))
           (st-num-send receiver selector args))
         ((or (= cls "String") (= cls "Symbol"))

lib/smalltalk/tests/reflection.sx

@@ -239,3 +239,66 @@
     (evp "Cat compile: 'taggedMethod ^ #yes' classified: 'demo'")
     (str (evp "^ Cat new taggedMethod")))
   "yes")
+
+;; ── 19. Object>>becomeForward: ──
+(st-class-define! "Box" "Object" (list "value"))
+(st-class-add-method! "Box" "value"  (st-parse-method "value ^ value"))
+(st-class-add-method! "Box" "value:" (st-parse-method "value: v value := v. ^ self"))
+(st-class-add-method! "Box" "kind"   (st-parse-method "kind ^ #box"))
+
+(st-class-define! "Crate" "Object" (list "value"))
+(st-class-add-method! "Crate" "value"  (st-parse-method "value ^ value"))
+(st-class-add-method! "Crate" "value:" (st-parse-method "value: v value := v. ^ self"))
+(st-class-add-method! "Crate" "kind"   (st-parse-method "kind ^ #crate"))
+
+(st-test "before becomeForward: instance reports its class"
+  (str (evp "^ (Box new value: 1) class name"))
+  "Box")
+
+(st-test "becomeForward: changes the receiver's class"
+  (evp
+    "| a b |
+     a := Box new value: 1.
+     b := Crate new value: 99.
+     a becomeForward: b.
+     ^ a class name")
+  "Crate")
+
+(st-test "becomeForward: routes future sends through new class"
+  (evp
+    "| a b |
+     a := Box new value: 1.
+     b := Crate new value: 99.
+     a becomeForward: b.
+     ^ a kind")
+  (make-symbol "crate"))
+
+(st-test "becomeForward: takes target's ivars"
+  (evp
+    "| a b |
+     a := Box new value: 1.
+     b := Crate new value: 99.
+     a becomeForward: b.
+     ^ a value")
+  99)
+
+(st-test "becomeForward: leaves the *target* instance unchanged"
+  (evp
+    "| a b |
+     a := Box new value: 1.
+     b := Crate new value: 99.
+     a becomeForward: b.
+     ^ b kind")
+  (make-symbol "crate"))
+
+(st-test "every reference to the receiver sees the new identity"
+  (evp
+    "| a alias b |
+     a := Box new value: 1.
+     alias := a.
+     b := Crate new value: 99.
+     a becomeForward: b.
+     ^ alias kind")
+  (make-symbol "crate"))
+
+(list st-test-pass st-test-fail)