* 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
+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.
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
/* 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;
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);
{
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
+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 ...
--- /dev/null
+-- { 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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;