Fixing another bug in the method inlining improvement

diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor
index 07ff719d0947a796d952bbc7ae13e6a57fd211d9..26639bc0153525d5a1b46a786a2ac1cd06a07fbc 100644 (file)
--- a/basis/compiler/tree/propagation/inlining/inlining.factor
+++ b/basis/compiler/tree/propagation/inlining/inlining.factor
@@ -61,16 +61,19 @@ M: callable splicing-nodes splicing-body ;
         [ nip t ] [ 2drop f f ] if
     ] if ;
 
+:: find-method-call ( class generic -- subclass/f ? )
+    object generic method-classes 
+    [| last-class new-class |
+        class new-class classes-intersect? [
+            new-class class class< [
+                last-class new-class class-min
+            ] [ object f ] if
+        ] [ last-class t ] if
+    ] all? ;
+
 :: split-method-call ( class generic -- quot/f )
     class object = [ f ] [
-        object generic method-classes 
-        [| last-class new-class |
-            class new-class classes-intersect? [
-                new-class class class<= [
-                    last-class new-class class-min
-                ] [ object f ] if
-            ] [ last-class t ] if
-        ] all?
+        class generic find-method-call
         [ generic split-code ] [ drop f ] if
     ] if ;
 

diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index 4fc623b7dc0d7830f6d0d6966c2fdd813f98deb1..3b831aeb541322f583910cd484d1a61312355c73 100644 (file)
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -997,3 +997,5 @@ UNION: ?fixnum fixnum POSTPONE: f ;
 
 [ t ] [ [ { ?fixnum } declare >fixnum ] { >fixnum } inlined? ] unit-test
 [ f ] [ [ { integer } declare >fixnum ] { >fixnum } inlined? ] unit-test
+
+[ f ] [ [ { word } declare parent-word ] { parent-word } inlined? ] unit-test