[Ada] Fix layout of variant record types with aliased components

[Eric Botcazou <ebotcazou at adacore dot com>]

The layout of variant record types doesn't always guarantee the proper 
alignment of aliased components if the record types are also packed.

Fixed thusly, tested on x86_64-suse-linux, applied on the mainline.


2012-11-23  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/decl.c (components_need_strict_alignment): New.
	(components_to_record): Do not pack the variants if one of the fields
	needs strict alignment.  Likewise for the variant part as a whole.
	Specify the position of the variants even if the size isn't specified,
	but do not specify the size of the variant part in this case.


2012-11-23  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/discr39.adb: New test.


-- 
Eric Botcazou

Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 193720)
+++ gcc-interface/decl.c	(working copy)
@@ -6650,6 +6650,30 @@ gnat_to_gnu_field (Entity_Id gnat_field,
   return gnu_field;
 }
 
+/* Return true if at least one member of COMPONENT_LIST needs strict
+   alignment.  */
+
+static bool
+components_need_strict_alignment (Node_Id component_list)
+{
+  Node_Id component_decl;
+
+  for (component_decl = First_Non_Pragma (Component_Items (component_list));
+       Present (component_decl);
+       component_decl = Next_Non_Pragma (component_decl))
+    {
+      Entity_Id gnat_field = Defining_Entity (component_decl);
+
+      if (Is_Aliased (gnat_field))
+	return True;
+
+      if (Strict_Alignment (Etype (gnat_field)))
+	return True;
+    }
+
+  return False;
+}
+
 /* Return true if TYPE is a type with variable size or a padding type with a
    field of variable size or a record that has a field with such a type.  */
 
@@ -6880,6 +6904,7 @@ components_to_record (tree gnu_record_ty
 		       "XVN");
       tree gnu_union_type, gnu_union_name;
       tree this_first_free_pos, gnu_variant_list = NULL_TREE;
+      bool union_field_needs_strict_alignment = false;
 
       if (TREE_CODE (gnu_name) == TYPE_DECL)
 	gnu_name = DECL_NAME (gnu_name);
@@ -6980,8 +7005,18 @@ components_to_record (tree gnu_record_ty
 	  else
 	    {
 	      /* Deal with packedness like in gnat_to_gnu_field.  */
-	      int field_packed
-		= adjust_packed (gnu_variant_type, gnu_record_type, packed);
+	      bool field_needs_strict_alignment
+	        = components_need_strict_alignment (Component_List (variant));
+	      int field_packed;
+
+	      if (field_needs_strict_alignment)
+		{
+		  field_packed = 0;
+		  union_field_needs_strict_alignment = true;
+		}
+	      else
+		field_packed
+		  = adjust_packed (gnu_variant_type, gnu_record_type, packed);
 
 	      /* Finalize the record type now.  We used to throw away
 		 empty records but we no longer do that because we need
@@ -6997,8 +7032,7 @@ components_to_record (tree gnu_record_ty
 				     gnu_union_type,
 				     all_rep_and_size
 				     ? TYPE_SIZE (gnu_variant_type) : 0,
-				     all_rep_and_size
-				     ? bitsize_zero_node : 0,
+				     all_rep ? bitsize_zero_node : 0,
 				     field_packed, 0);
 
 	      DECL_INTERNAL_P (gnu_field) = 1;
@@ -7041,12 +7075,16 @@ components_to_record (tree gnu_record_ty
 			    NULL, true, debug_info, gnat_component_list);
 
 	  /* Deal with packedness like in gnat_to_gnu_field.  */
-	  union_field_packed
-	    = adjust_packed (gnu_union_type, gnu_record_type, packed);
+	  if (union_field_needs_strict_alignment)
+	    union_field_packed = 0;
+	  else
+	    union_field_packed
+	      = adjust_packed (gnu_union_type, gnu_record_type, packed);
 
 	  gnu_variant_part
 	    = create_field_decl (gnu_var_name, gnu_union_type, gnu_record_type,
-				 all_rep ? TYPE_SIZE (gnu_union_type) : 0,
+				 all_rep_and_size
+				 ? TYPE_SIZE (gnu_union_type) : 0,
 				 all_rep || this_first_free_pos
 				 ? bitsize_zero_node : 0,
 				 union_field_packed, 0);

-- { dg-do run }

with System.Storage_Elements; use System.Storage_Elements;

procedure Discr39 is

  type Rec (Has_Src : Boolean) is record
     case Has_Src is
        when True  => Src : aliased Integer;
        when False => null;
     end case;
  end record;
  pragma Pack(Rec);
  for Rec'Alignment use Integer'Alignment;

  R : Rec (Has_Src => True);

begin
  if R.Src'Address mod Integer'Alignment /= 0 then
     raise Program_Error;
  end if;
end;