2012-07-19 Eric Botcazou <ebotcazou@adacore.com>
+ * gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Try to ensure
+ that an object of CW type initialized to a value is sufficiently
+ aligned for this value.
+
+2012-07-19 Eric Botcazou <ebotcazou@adacore.com>
+
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Record_Subtype>: Do not
look up the REP part of the base type in advance. Deal with that of
the variant types.
debug_info_p);
}
+ /* ??? If this is an object of CW type initialized to a value, try to
+ ensure that the object is sufficient aligned for this value, but
+ without pessimizing the allocation. This is a kludge necessary
+ because we don't support dynamic alignment. */
+ if (align == 0
+ && Ekind (Etype (gnat_entity)) == E_Class_Wide_Subtype
+ && No (Renamed_Object (gnat_entity))
+ && No (Address_Clause (gnat_entity)))
+ align = get_target_system_allocator_alignment () * BITS_PER_UNIT;
+
#ifdef MINIMUM_ATOMIC_ALIGNMENT
/* If the size is a constant and no alignment is specified, force
the alignment to be the minimum valid atomic alignment. The
necessary and can interfere with constant replacement. Finally,
do not do it for Out parameters since that creates an
size inconsistency with In parameters. */
- if (align == 0 && MINIMUM_ATOMIC_ALIGNMENT > TYPE_ALIGN (gnu_type)
+ if (align == 0
+ && MINIMUM_ATOMIC_ALIGNMENT > TYPE_ALIGN (gnu_type)
&& !FLOAT_TYPE_P (gnu_type)
&& !const_flag && No (Renamed_Object (gnat_entity))
&& !imported_p && No (Address_Clause (gnat_entity))
+2012-07-19 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gnat.dg/derived_type3.adb: New test.
+ * gnat.dg/derived_type3_pkg.ad[sb]: New helper.
+
2012-07-19 Richard Guenther <rguenther@suse.de>
Eric Botcazou <ebotcazou@adacore.com>
--- /dev/null
+-- { dg-do run }
+
+with Derived_Type3_Pkg; use Derived_Type3_Pkg;
+
+procedure Derived_Type3 is
+begin
+ Proc1;
+ Proc2;
+end;
--- /dev/null
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+with Ada.Text_IO; use Ada.Text_IO;
+
+package body Derived_Type3_Pkg is
+
+ type Parent is tagged null record;
+
+ type Child is new Parent with
+ record
+ Image : Ada.Strings.Unbounded.Unbounded_String;
+ end record;
+
+ function Set_Image return Child'class is
+ Local_Data : Child;
+ begin
+ Local_Data.Image := To_Unbounded_String ("Hello");
+ return Local_Data;
+ end Set_Image;
+
+ procedure Proc1 is
+ The_Data : Parent'class := Set_Image;
+ begin
+ Put_Line ("Child'Alignment =" & Child'Alignment'Img);
+ Put_Line ("The_Data'Alignment =" & The_Data'Alignment'Img);
+ end;
+
+ procedure Proc2 is
+
+ procedure Nested (X : Parent'Class) is
+ The_Data : Parent'Class := X;
+ begin
+ Put_Line ("Child'Alignment =" & Child'Alignment'Img);
+ Put_Line ("The_Data'Alignment =" & The_Data'Alignment'Img);
+ end;
+
+ The_Data : Parent'Class := Set_Image;
+
+ begin
+ Nested (The_Data);
+ end;
+
+end Derived_Type3_Pkg;
--- /dev/null
+package Derived_Type3_Pkg is
+
+ procedure Proc1;
+ procedure Proc2;
+
+end Derived_Type3_Pkg;