[Ada] Fix bug in layout of aliased components

[Eric Botcazou <ebotcazou at adacore dot com>]

This one has probably been there since day #1: the layout of aliased components 
of record types with default discriminants and variant part can be incorrect 
in some cases.  The aliased components must be placed before the variant part, 
otherwise you risk having a dangling pointer.  But it is a little special: the 
AARM (Annotated Ada Reference Manual) specifically mentions it, so deviating 
from it is bit annoying.  Moreover the fix is straightforward now.

Tested on i586-suse-linux, applied on the mainline.


2012-01-27  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/ada-tree.h (DECL_ALIASED_P): New flag.
	* gcc-interface/decl.c (is_variable_size): Rename to...
	(type_has_variable_size): ...this.
	(adjust_packed): Adjust to above renaming.
	(gnat_to_gnu_field): Set DECL_ALIASED_P on the field.
	(field_is_artificial): New predicate.
	(field_is_aliased): Likewise.
	(field_has_self_size): Likewise.
	(field_has_variable_size): Likewise.
	(components_to_record): Record information for the final layout during
	the first pass on fields.
	If there is an aliased field placed after a field whose length depends
	on discriminants, put all the fields of the latter sort, last.


2012-01-27  Eric Botcazou  <ebotcazou@adacore.com>

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


-- 
Eric Botcazou

-- { dg-do run }

procedure Discr33 is

   subtype Int is Integer range 1..100;

   type T (D : Int := 1) is
      record
         A : Integer;
         B : String (1..D);
         C : aliased Integer;
      end record;

   Var : T := (D => 1, A => 1234, B => "x", C => 4567);

   type Int_Ref is access all Integer;
   Pointer_To_C : Int_Ref := Var.C'Access;

begin

   if Pointer_To_C.all /= 4567 then
      raise Program_Error;
   end if;

   Var := (D => 26, A => 1234, B => "abcdefghijklmnopqrstuvwxyz", C => 2345);

   if Pointer_To_C.all /= 2345 then
      raise Program_Error;
   end if;

end Discr33;

Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 183607)
+++ gcc-interface/decl.c	(working copy)
@@ -145,7 +145,7 @@ static void prepend_one_attribute_to (st
 				      enum attr_type, tree, tree, Node_Id);
 static void prepend_attributes (Entity_Id, struct attrib **);
 static tree elaborate_expression (Node_Id, Entity_Id, tree, bool, bool, bool);
-static bool is_variable_size (tree);
+static bool type_has_variable_size (tree);
 static tree elaborate_expression_1 (tree, Entity_Id, tree, bool, bool);
 static tree elaborate_expression_2 (tree, Entity_Id, tree, bool, bool,
 				    unsigned int);
@@ -6848,7 +6848,7 @@ adjust_packed (tree field_type, tree rec
      because we cannot create temporaries of non-fixed size in case
      we need to take the address of the field.  See addressable_p and
      the notes on the addressability issues for further details.  */
-  if (is_variable_size (field_type))
+  if (type_has_variable_size (field_type))
     return 0;
 
   /* If the alignment of the record is specified and the field type
@@ -7123,6 +7123,7 @@ gnat_to_gnu_field (Entity_Id gnat_field,
     = create_field_decl (gnu_field_id, gnu_field_type, gnu_record_type,
 			 gnu_size, gnu_pos, packed, Is_Aliased (gnat_field));
   Sloc_to_locus (Sloc (gnat_field), &DECL_SOURCE_LOCATION (gnu_field));
+  DECL_ALIASED_P (gnu_field) = Is_Aliased (gnat_field);
   TREE_THIS_VOLATILE (gnu_field) = TREE_SIDE_EFFECTS (gnu_field) = is_volatile;
 
   if (Ekind (gnat_field) == E_Discriminant)
@@ -7136,7 +7137,7 @@ gnat_to_gnu_field (Entity_Id gnat_field,
    field of variable size or is a record that has a field such a field.  */
 
 static bool
-is_variable_size (tree type)
+type_has_variable_size (tree type)
 {
   tree field;
 
@@ -7151,12 +7152,68 @@ is_variable_size (tree type)
     return false;
 
   for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
-    if (is_variable_size (TREE_TYPE (field)))
+    if (type_has_variable_size (TREE_TYPE (field)))
       return true;
 
   return false;
 }
 
+/* Return true if FIELD is an artificial field.  */
+
+static bool
+field_is_artificial (tree field)
+{
+  /* These fields are generated by the front-end proper.  */
+  if (IDENTIFIER_POINTER (DECL_NAME (field)) [0] == '_')
+    return true;
+
+  /* These fields are generated by gigi.  */
+  if (DECL_INTERNAL_P (field))
+    return true;
+
+  return false;
+}
+
+/* Return true if FIELD is a non-artificial aliased field.  */
+
+static bool
+field_is_aliased (tree field)
+{
+  if (field_is_artificial (field))
+    return false;
+
+  return DECL_ALIASED_P (field);
+}
+
+/* Return true if FIELD is a non-artificial field with self-referential
+   size.  */
+
+static bool
+field_has_self_size (tree field)
+{
+  if (field_is_artificial (field))
+    return false;
+
+  if (DECL_SIZE (field) && TREE_CODE (DECL_SIZE (field)) == INTEGER_CST)
+    return false;
+
+  return CONTAINS_PLACEHOLDER_P (TYPE_SIZE (TREE_TYPE (field)));
+}
+
+/* Return true if FIELD is a non-artificial field with variable size.  */
+
+static bool
+field_has_variable_size (tree field)
+{
+  if (field_is_artificial (field))
+    return false;
+
+  if (DECL_SIZE (field) && TREE_CODE (DECL_SIZE (field)) == INTEGER_CST)
+    return false;
+
+  return TREE_CODE (TYPE_SIZE (TREE_TYPE (field))) != INTEGER_CST;
+}
+
 /* qsort comparer for the bit positions of two record components.  */
 
 static int
@@ -7219,6 +7276,8 @@ components_to_record (tree gnu_record_ty
 {
   bool all_rep_and_size = all_rep && TYPE_SIZE (gnu_record_type);
   bool layout_with_rep = false;
+  bool has_self_field = false;
+  bool has_aliased_after_self_field = false;
   Node_Id component_decl, variant_part;
   tree gnu_field, gnu_next, gnu_last;
   tree gnu_rep_part = NULL_TREE;
@@ -7270,6 +7329,12 @@ components_to_record (tree gnu_record_ty
 		gnu_field_list = gnu_field;
 		if (!gnu_last)
 		  gnu_last = gnu_field;
+
+		/* And record information for the final layout.  */
+		if (field_has_self_size (gnu_field))
+		  has_self_field = true;
+		else if (has_self_field && field_is_aliased (gnu_field))
+		  has_aliased_after_self_field = true;
 	      }
 	  }
 
@@ -7505,25 +7570,17 @@ components_to_record (tree gnu_record_ty
 	  continue;
 	}
 
-      /* Reorder non-internal fields with non-fixed size.  */
-      if (reorder
-	  && !DECL_INTERNAL_P (gnu_field)
-	  && !(DECL_SIZE (gnu_field)
-	       && TREE_CODE (DECL_SIZE (gnu_field)) == INTEGER_CST))
+      if ((reorder || has_aliased_after_self_field)
+	  && field_has_self_size (gnu_field))
 	{
-	  tree type_size = TYPE_SIZE (TREE_TYPE (gnu_field));
-
-	  if (CONTAINS_PLACEHOLDER_P (type_size))
-	    {
-	      MOVE_FROM_FIELD_LIST_TO (gnu_self_list);
-	      continue;
-	    }
+	  MOVE_FROM_FIELD_LIST_TO (gnu_self_list);
+	  continue;
+	}
 
-	  if (TREE_CODE (type_size) != INTEGER_CST)
-	    {
-	      MOVE_FROM_FIELD_LIST_TO (gnu_var_list);
-	      continue;
-	    }
+      if (reorder && field_has_variable_size (gnu_field))
+	{
+	  MOVE_FROM_FIELD_LIST_TO (gnu_var_list);
+	  continue;
 	}
 
       gnu_last = gnu_field;
@@ -7531,7 +7588,7 @@ components_to_record (tree gnu_record_ty
 
 #undef MOVE_FROM_FIELD_LIST_TO
 
-  /* If permitted, we reorder the components as follows:
+  /* If permitted, we reorder the fields as follows:
 
        1) all fixed length fields,
        2) all fields whose length doesn't depend on discriminants,
@@ -7544,6 +7601,12 @@ components_to_record (tree gnu_record_ty
       = chainon (nreverse (gnu_self_list),
 		 chainon (nreverse (gnu_var_list), gnu_field_list));
 
+  /* Otherwise, if there is an aliased field placed after a field whose length
+     depends on discriminants, we put all the fields of the latter sort, last.
+     We need to do this in case an object of this record type is mutable.  */
+  else if (has_aliased_after_self_field)
+    gnu_field_list = chainon (nreverse (gnu_self_list), gnu_field_list);
+
   /* If P_REP_LIST is nonzero, this means that we are asked to move the fields
      in our REP list to the previous level because this level needs them in
      order to do a correct layout, i.e. avoid having overlapping fields.  */
Index: gcc-interface/ada-tree.h
===================================================================
--- gcc-interface/ada-tree.h	(revision 183604)
+++ gcc-interface/ada-tree.h	(working copy)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *          Copyright (C) 1992-2011, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2012, Free Software Foundation, Inc.         *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -344,6 +344,9 @@ do {						   \
    pair of INDIRECT_REFs is needed to access the object.  */
 #define DECL_BY_DOUBLE_REF_P(NODE) DECL_LANG_FLAG_0 (PARM_DECL_CHECK (NODE))
 
+/* Nonzero in a FIELD_DECL if it is declared as aliased.  */
+#define DECL_ALIASED_P(NODE) DECL_LANG_FLAG_0 (FIELD_DECL_CHECK (NODE))
+
 /* Nonzero in a TYPE_DECL if this is the declaration of a Taft amendment type
    in the main unit, i.e. the full declaration is available.  */
 #define DECL_TAFT_TYPE_P(NODE) DECL_LANG_FLAG_0 (TYPE_DECL_CHECK (NODE))