[Ada] Work around issue with overaligned derived types

Message ID 201207192305.41588.ebotcazou@adacore.com
State New
Headers show

Commit Message

Eric Botcazou July 19, 2012, 9:05 p.m.
This is a regression present on the mainline and 4.7 branch and visible on 
SPARC/Solaris, although it is latent everywhere.  When a derived type is more 
aligned than its base type, things can go wrong when an object of the class-
wide type is initialized with a value whose type is the derived type and is 
later used for dispatching, because the primitive operations (methods) of the 
derived type expect the larger alignment.

Tested on x86_64-suse-linux, applied on the mainline and 4.7 branch.

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>

	* gnat.dg/derived_type3.adb: New test.
	* gnat.dg/derived_type3_pkg.ad[sb]: New helper.


Index: ada/gcc-interface/decl.c
--- ada/gcc-interface/decl.c	(revision 189666)
+++ ada/gcc-interface/decl.c	(working copy)
@@ -895,6 +895,16 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
+	/* ??? 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;
 	/* If the size is a constant and no alignment is specified, force
 	   the alignment to be the minimum valid atomic alignment.  The
@@ -904,7 +914,8 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 	   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
 	    && !FLOAT_TYPE_P (gnu_type)
 	    && !const_flag && No (Renamed_Object (gnat_entity))
 	    && !imported_p && No (Address_Clause (gnat_entity))