* 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_7-branch@189683 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4aed369..3d0fa9b 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,11 @@
 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.

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 643012f..33cad2c 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -911,6 +911,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                                                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
@@ -920,7 +930,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
           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))

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3f4a0dc..8d8a615 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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>
 

diff --git a/gcc/testsuite/gnat.dg/derived_type3.adb b/gcc/testsuite/gnat.dg/derived_type3.adb
new file mode 100644 (file)
index 0000000..7661feb
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/derived_type3.adb
@@ -0,0 +1,9 @@
+-- { dg-do run }
+
+with Derived_Type3_Pkg; use Derived_Type3_Pkg;
+
+procedure Derived_Type3 is
+begin
+   Proc1;
+   Proc2;
+end;

diff --git a/gcc/testsuite/gnat.dg/derived_type3_pkg.adb b/gcc/testsuite/gnat.dg/derived_type3_pkg.adb
new file mode 100644 (file)
index 0000000..ef3de83
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/derived_type3_pkg.adb
@@ -0,0 +1,42 @@
+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;

diff --git a/gcc/testsuite/gnat.dg/derived_type3_pkg.ads b/gcc/testsuite/gnat.dg/derived_type3_pkg.ads
new file mode 100644 (file)
index 0000000..c3d8297
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/derived_type3_pkg.ads
@@ -0,0 +1,6 @@
+package Derived_Type3_Pkg is
+
+   procedure Proc1;
+   procedure Proc2;
+
+end Derived_Type3_Pkg;