Fixing bug in dependency tracking for guarded method inlining

diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor
index 32e2fd0bd25e5171ba46884936e3d0349ad19b75..016440c799ad55d8abce75b1195d83b2c3f04a3c 100644 (file)
--- a/basis/compiler/tree/propagation/inlining/inlining.factor
+++ b/basis/compiler/tree/propagation/inlining/inlining.factor
@@ -53,6 +53,7 @@ ERROR: bad-splitting class generic ;
 :: split-code ( class generic -- quot/f )
     class generic method :> my-method
     my-method [ class generic bad-splitting ] unless
+    class generic my-method depends-on-method-is
     generic dispatch# (picker) :> picker
     [
         picker call class instance?
@@ -62,8 +63,8 @@ ERROR: bad-splitting class generic ;
 
 :: split-method-call ( class generic -- quot/f )
     class generic subclass-with-only-method [
-        class generic depends-on-single-method
-        generic split-code
+        [ class generic depends-on-single-method ]
+        [ generic split-code ] bi
     ] [ f ] if* ;
 
 : inlining-standard-method ( #call word -- class/f method/f )

diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index 473285e8c5599e42a9e199ad890130edd4f89582..07024f7e0d04b2eb6e785b534d93d4df2f6a5d12 100644 (file)
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -9,7 +9,7 @@ compiler.tree.debugger compiler.tree.checker slots.private words
 hashtables classes assocs locals specialized-arrays system
 sorting math.libm math.floats.private math.integers.private
 math.intervals quotations effects alien alien.data sets
-strings.private classes.tuple ;
+strings.private classes.tuple eval ;
 FROM: math => float ;
 SPECIALIZED-ARRAY: double
 SPECIALIZED-ARRAY: void*
@@ -999,3 +999,19 @@ UNION: ?fixnum fixnum POSTPONE: f ;
 [ f ] [ [ { integer } declare >fixnum ] { >fixnum } inlined? ] unit-test
 
 [ f ] [ [ { word } declare parent-word ] { parent-word } inlined? ] unit-test
+
+! Make sure guarded method inlining installs the right dependencies
+
+[ ] [
+    "IN: compiler.tree.propagation.tests
+    USING: kernel.private accessors ;
+    TUPLE: foo bar ;
+    UNION: ?foo foo POSTPONE: f ;
+    : baz ( ?foo -- bar ) { ?foo } declare bar>> ;" eval( -- )
+] unit-test
+
+[ 3 ] [ "USE: kernel IN: compiler.tree.propagation.tests 3 foo boa baz" eval( -- x ) ] unit-test
+
+[ ] [ "IN: compiler.tree.propagation.tests TUPLE: foo baz bar ;" eval( -- ) ] unit-test
+
+[ 3 ] [ "USE: kernel IN: compiler.tree.propagation.tests 2 3 foo boa baz" eval( -- x ) ] unit-test

diff --git a/basis/stack-checker/dependencies/dependencies.factor b/basis/stack-checker/dependencies/dependencies.factor
index 5d74e85e877d8677e7c88088e11b947c36d977ab..5a7386700643a3236b48ea88887a5260427f331e 100644 (file)
--- a/basis/stack-checker/dependencies/dependencies.factor
+++ b/basis/stack-checker/dependencies/dependencies.factor
@@ -145,11 +145,11 @@ TUPLE: depends-on-final class ;
 M: depends-on-final satisfied?
     class>> { [ class? ] [ final-class? ] } 1&& ;
 
-TUPLE: depends-on-single-method class generic ;
+TUPLE: depends-on-single-method method-class object-class generic ;
 
-: depends-on-single-method ( class generic -- )
-    [ nip depends-on-conditionally ]
-    [ \ depends-on-single-method add-conditional-dependency ] 2bi ;
+: depends-on-single-method ( method-class object-class generic -- )
+    [ nip [ depends-on-conditionally ] bi@ ]
+    [ \ depends-on-single-method add-conditional-dependency ] 3bi ;
 
 :: subclass-with-only-method ( class generic -- subclass/f )
     generic method-classes [ f ] [
@@ -161,7 +161,17 @@ TUPLE: depends-on-single-method class generic ;
     ] if-empty ;
 
 M: depends-on-single-method satisfied?
-    [ class>> ] [ generic>> ] bi subclass-with-only-method >boolean ;
+    [ method-class>> ] [ object-class>> ] [ generic>> ] tri
+    subclass-with-only-method = ;
+
+TUPLE: depends-on-method-is class generic method ;
+
+: depends-on-method-is ( class generic method -- )
+    [ [ depends-on-conditionally ] tri@ ]
+    [ \ depends-on-method-is add-conditional-dependency ] 3bi ;
+
+M: depends-on-method-is satisfied?
+    [ class>> ] [ generic>> method ] [ method>> ] tri = ;
 
 : init-dependencies ( -- )
     H{ } clone dependencies set