gimple.h (compare_field_offset): Rename into...
authorEric Botcazou <ebotcazou@adacore.com>
Sat, 15 May 2010 19:05:06 +0000 (19:05 +0000)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Sat, 15 May 2010 19:05:06 +0000 (19:05 +0000)
* gimple.h (compare_field_offset): Rename into...
(gimple_compare_field_offset): ...this.
* gimple.c (compare_field_offset): Rename into...
(gimple_compare_field_offset): ...this.  Compare the full access if
the offset is self-referential.
(gimple_types_compatible_p): Adjust for above renaming.
* lto-streamer-in.c (input_gimple_stmt): Likewise.  Also compare the
DECL_NONADDRESSABLE_P flag of fields before merging them.

From-SVN: r159438

gcc/ChangeLog
gcc/gimple.c
gcc/gimple.h
gcc/lto-streamer-in.c
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/lto9.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/lto9_pkg1.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/lto9_pkg2.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/lto9_pkg2.ads [new file with mode: 0644]

index 05a01ab95efa27d90c3947656d5bb7758aaf80dd..61d08427dca74c8fb68c2d3f5a8fe5f066d6875e 100644 (file)
@@ -1,3 +1,14 @@
+2010-05-15  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gimple.h (compare_field_offset): Rename into...
+       (gimple_compare_field_offset): ...this.
+       * gimple.c (compare_field_offset): Rename into...
+       (gimple_compare_field_offset): ...this.  Compare the full access if
+       the offset is self-referential.
+       (gimple_types_compatible_p): Adjust for above renaming.
+       * lto-streamer-in.c (input_gimple_stmt): Likewise.  Also compare the
+       DECL_NONADDRESSABLE_P flag of fields before merging them.
+
 2010-05-15  Nathan Froyd  <froydnj@codesourcery.com>
 
        * tree.h (ctor_to_list): Delete.
index ace53b92f8743205a73fd4f277d079398be89264..1ff9b3a63f688f95f7ce195ca441f44f3498e0a8 100644 (file)
@@ -3219,16 +3219,35 @@ compare_type_names_p (tree t1, tree t2, bool for_completion_p)
   return false;
 }
 
-/* Return true if the field decls F1 and F2 are at the same offset.  */
+/* Return true if the field decls F1 and F2 are at the same offset.
+
+   This is intended to be used on GIMPLE types only.  In order to
+   compare GENERIC types, use fields_compatible_p instead.  */
 
 bool
-compare_field_offset (tree f1, tree f2)
+gimple_compare_field_offset (tree f1, tree f2)
 {
   if (DECL_OFFSET_ALIGN (f1) == DECL_OFFSET_ALIGN (f2))
-    return (operand_equal_p (DECL_FIELD_OFFSET (f1),
-                            DECL_FIELD_OFFSET (f2), 0)
-           && tree_int_cst_equal (DECL_FIELD_BIT_OFFSET (f1),
-                                  DECL_FIELD_BIT_OFFSET (f2)));
+    {
+      tree offset1 = DECL_FIELD_OFFSET (f1);
+      tree offset2 = DECL_FIELD_OFFSET (f2);
+      return ((offset1 == offset2
+              /* Once gimplification is done, self-referential offsets are
+                 instantiated as operand #2 of the COMPONENT_REF built for
+                 each access and reset.  Therefore, they are not relevant
+                 anymore and fields are interchangeable provided that they
+                 represent the same access.  */
+              || (TREE_CODE (offset1) == PLACEHOLDER_EXPR
+                  && TREE_CODE (offset2) == PLACEHOLDER_EXPR
+                  && (DECL_SIZE (f1) == DECL_SIZE (f2)
+                      || (TREE_CODE (DECL_SIZE (f1)) == PLACEHOLDER_EXPR
+                          && TREE_CODE (DECL_SIZE (f2)) == PLACEHOLDER_EXPR)
+                      || operand_equal_p (DECL_SIZE (f1), DECL_SIZE (f2), 0))
+                  && DECL_ALIGN (f1) == DECL_ALIGN (f2))
+              || operand_equal_p (offset1, offset2, 0))
+             && tree_int_cst_equal (DECL_FIELD_BIT_OFFSET (f1),
+                                    DECL_FIELD_BIT_OFFSET (f2)));
+    }
 
   /* Fortran and C do not always agree on what DECL_OFFSET_ALIGN
      should be, so handle differing ones specially by decomposing
@@ -3576,7 +3595,7 @@ gimple_types_compatible_p (tree t1, tree t2)
            /* The fields must have the same name, offset and type.  */
            if (DECL_NAME (f1) != DECL_NAME (f2)
                || DECL_NONADDRESSABLE_P (f1) != DECL_NONADDRESSABLE_P (f2)
-               || !compare_field_offset (f1, f2)
+               || !gimple_compare_field_offset (f1, f2)
                || !gimple_types_compatible_p (TREE_TYPE (f1),
                                               TREE_TYPE (f2)))
              goto different_types;
index e9d21a99c73bc51a42fe76862f53b07aefc89ae2..d54550c26948a49037e786ac39a108bf3602ae81 100644 (file)
@@ -954,7 +954,7 @@ extern bool is_gimple_call_addr (tree);
 extern tree get_call_expr_in (tree t);
 
 extern void recalculate_side_effects (tree);
-extern bool compare_field_offset (tree, tree);
+extern bool gimple_compare_field_offset (tree, tree);
 extern tree gimple_register_type (tree);
 extern void print_gimple_types_stats (void);
 extern void free_gimple_type_tables (void);
index 3c31b04f8c386a8a980cd1234dd821e813684583..5c6658a9f992c10ebb2db558108e2cc762261806 100644 (file)
@@ -1094,7 +1094,9 @@ input_gimple_stmt (struct lto_input_block *ib, struct data_in *data_in,
                    {
                      if (tem == field
                          || (TREE_TYPE (tem) == TREE_TYPE (field)
-                             && compare_field_offset (tem, field)))
+                             && DECL_NONADDRESSABLE_P (tem)
+                                == DECL_NONADDRESSABLE_P (field)
+                             && gimple_compare_field_offset (tem, field)))
                        break;
                    }
                  /* In case of type mismatches across units we can fail
index 441b2a4f60872e2acefef88db81b4c36c57b01e3..1ce44f0c05c4cb9d1517db99d41bec44955955d7 100644 (file)
@@ -1,3 +1,9 @@
+2010-05-15  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/lto9.adb: New test.
+       * gnat.dg/lto9_pkg1.ads: New helper.
+       * gnat.dg/lto9_pkg2.ad[sb]: Likewise.
+
 2010-05-15  Jan Hubicka  <jh@suse.cz>
 
        * gcc.dg/lto/ipareference_1.c: Rename to ...
diff --git a/gcc/testsuite/gnat.dg/lto9.adb b/gcc/testsuite/gnat.dg/lto9.adb
new file mode 100644 (file)
index 0000000..f4ec040
--- /dev/null
@@ -0,0 +1,15 @@
+-- { dg-do run }
+-- { dg-options "-flto" { target lto } }
+
+with Lto9_Pkg1; use Lto9_Pkg1;
+
+procedure Lto9 is
+
+begin
+
+   District_Subscription_Lists.Put
+     (List     => District_01_Subscribers,
+      Elem_Ptr => New_Subscriber_01'Access,
+      Location => 1);
+
+end;
diff --git a/gcc/testsuite/gnat.dg/lto9_pkg1.ads b/gcc/testsuite/gnat.dg/lto9_pkg1.ads
new file mode 100644 (file)
index 0000000..a094392
--- /dev/null
@@ -0,0 +1,24 @@
+with Lto9_Pkg2;
+
+package Lto9_Pkg1 is
+
+   subtype Lengths is Natural range 0 .. 50;
+
+   type Subscriber (NLen, ALen: Lengths := 50) is record
+      Name    : String(1 .. NLen);
+      Address : String(1 .. ALen);
+   end record;
+
+   type Subscriber_Ptr is access all Subscriber;
+
+   package District_Subscription_Lists is new Lto9_Pkg2
+     (Element_Type => Subscriber,
+      Element_Ptr  => Subscriber_Ptr,
+      Size         => 100);
+
+   District_01_Subscribers : District_Subscription_Lists.List_Type;
+
+   New_Subscriber_01 : aliased Subscriber :=
+     (12, 23, "Brown, Silas", "King's Pyland, Dartmoor");
+
+end Lto9_Pkg1;
diff --git a/gcc/testsuite/gnat.dg/lto9_pkg2.adb b/gcc/testsuite/gnat.dg/lto9_pkg2.adb
new file mode 100644 (file)
index 0000000..0291d60
--- /dev/null
@@ -0,0 +1,10 @@
+package body Lto9_Pkg2 is
+
+   procedure Put (List     : in out List_Type;
+                  Elem_Ptr : in     Element_Ptr;
+                  Location : in     Index) is
+   begin
+      List.Elements(Location) := Elem_Ptr;
+   end Put;
+
+end Lto9_Pkg2;
diff --git a/gcc/testsuite/gnat.dg/lto9_pkg2.ads b/gcc/testsuite/gnat.dg/lto9_pkg2.ads
new file mode 100644 (file)
index 0000000..881d02b
--- /dev/null
@@ -0,0 +1,21 @@
+generic
+
+   Size : in Positive;
+   type Element_Type (<>) is private;
+   type Element_Ptr       is access all Element_Type;
+
+package Lto9_Pkg2 is
+
+   subtype Index is Positive range 1 .. (Size + 1);
+
+   type List_Array is array (Index) of Element_Ptr;
+
+   type List_Type is record
+      Elements : List_Array;
+   end record;
+
+   procedure Put (List     : in out List_Type;
+                  Elem_Ptr : in     Element_Ptr;
+                  Location : in     Index);
+
+end Lto9_Pkg2;