alias.h (record_alias_subset): Declare.

* alias.h (record_alias_subset): Declare.
	* alias.c (record_alias_subset): Make global.
ada/
	* gcc-interface/decl.c (enum alias_set_op): New enumeration.
	(copy_alias_set): Rename into...
	(relate_alias_sets): ...this.  Add third parameter OP.  Retrieve the
	underlying array of unconstrained arrays for the new type as well.
	If the old and new alias sets don't conflict, make one a subset of
	the other as per the OP parameter.
	(gnat_to_gnu_entity): Adjust calls to copy_alias_set.
	<E_Record_Type>: Do not copy the alias set for derived types.
	For all types, make the alias set of derived types a superset of
	that of their parent type.
	(make_aligning_type): Adjust calls to copy_alias_set.
	(make_packable_type): Likewise.
	* gcc-interface/trans.c (gnat_to_gnu)<N_Validate_Unchecked_Conversion>:
	Check for alias set conflict instead of strict equality to issue the
	warning.

From-SVN: r144084

gcc/ChangeLog

@@ -1,3 +1,8 @@
+2009-02-10  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* alias.h (record_alias_subset): Declare.
+	* alias.c (record_alias_subset): Make global.
+
 2009-02-10  Nick Clifton  <nickc@redhat.com>
 
 	* tree-parloops.c: Change license to GPLv3.

gcc/ada/ChangeLog

@@ -1,3 +1,22 @@
+2009-02-10  Olivier Hainque  <hainque@adacore.com>
+            Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/decl.c (enum alias_set_op): New enumeration.
+	(copy_alias_set): Rename into...
+	(relate_alias_sets): ...this.  Add third parameter OP.  Retrieve the
+	underlying array of unconstrained arrays for the new type as well.
+	If the old and new alias sets don't conflict, make one a subset of
+	the other as per the OP parameter.
+	(gnat_to_gnu_entity): Adjust calls to copy_alias_set.
+	<E_Record_Type>: Do not copy the alias set for derived types.
+	For all types, make the alias set of derived types a superset of
+	that of their parent type.
+	(make_aligning_type): Adjust calls to copy_alias_set.
+	(make_packable_type): Likewise.
+	* gcc-interface/trans.c (gnat_to_gnu)<N_Validate_Unchecked_Conversion>:
+	Check for alias set conflict instead of strict equality to issue the
+	warning.
+
 2009-02-09  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_String_Literal_Subtype>:

gcc/ada/gcc-interface/decl.c

@@ -115,7 +115,15 @@ static VEC (tree,heap) *defer_finalize_list;
 static GTY ((if_marked ("tree_int_map_marked_p"),
 	     param_is (struct tree_int_map))) htab_t annotate_value_cache;
 
-static void copy_alias_set (tree, tree);
+enum alias_set_op
+{
+  ALIAS_SET_COPY,
+  ALIAS_SET_SUBSET,
+  ALIAS_SET_SUPERSET
+};
+
+static void relate_alias_sets (tree, tree, enum alias_set_op);
+
 static tree substitution_list (Entity_Id, Entity_Id, tree, bool);
 static bool allocatable_size_p (tree, bool);
 static void prepend_one_attribute_to (struct attrib **,
@@ -1632,7 +1640,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
       /* Inherit our alias set from what we're a subtype of.  Subtypes
 	 are not different types and a pointer can designate any instance
 	 within a subtype hierarchy.  */
-      copy_alias_set (gnu_type, TREE_TYPE (gnu_type));
+      relate_alias_sets (gnu_type, TREE_TYPE (gnu_type), ALIAS_SET_COPY);
 
       /* If the type we are dealing with is to represent a packed array,
 	 we need to have the bits left justified on big-endian targets
@@ -1674,7 +1682,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	  TYPE_JUSTIFIED_MODULAR_P (gnu_type) = 1;
 	  SET_TYPE_ADA_SIZE (gnu_type, bitsize_int (esize));
 
-	  copy_alias_set (gnu_type, gnu_field_type);
+	  relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY);
 	}
 
       /* If the type we are dealing with has got a smaller alignment than the
@@ -1709,7 +1717,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	  TYPE_IS_PADDING_P (gnu_type) = 1;
 	  SET_TYPE_ADA_SIZE (gnu_type, bitsize_int (esize));
 
-	  copy_alias_set (gnu_type, gnu_field_type);
+	  relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY);
 	}
 
       /* Otherwise reset the alignment lest we computed it above.  */
@@ -1784,7 +1792,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
 	/* Inherit our alias set from what we're a subtype of, as for
 	   integer subtypes.  */
-	copy_alias_set (gnu_type, TREE_TYPE (gnu_type));
+	relate_alias_sets (gnu_type, TREE_TYPE (gnu_type), ALIAS_SET_COPY);
       }
     break;
 
@@ -2477,7 +2485,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
 	  /* Set our alias set to that of our base type.  This gives all
 	     array subtypes the same alias set.  */
-	  copy_alias_set (gnu_type, gnu_base_type);
+	  relate_alias_sets (gnu_type, gnu_base_type, ALIAS_SET_COPY);
 	}
 
       /* If this is a packed type, make this type the same as the packed
@@ -2617,7 +2625,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 			      gnu_index_type);
 	if (array_type_has_nonaliased_component (gnat_entity, gnu_type))
 	  TYPE_NONALIASED_COMPONENT (gnu_type) = 1;
-	copy_alias_set (gnu_type, gnu_string_type);
+	relate_alias_sets (gnu_type, gnu_string_type, ALIAS_SET_COPY);
       }
       break;
 
@@ -2880,14 +2888,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	if (Is_Tagged_Type (gnat_entity) || Is_Limited_Record (gnat_entity))
 	  SET_TYPE_MODE (gnu_type, BLKmode);
 
-	/* If this is a derived type, we must make the alias set of this type
-	   the same as that of the type we are derived from.  We assume here
-	   that the other type is already frozen.  */
-	if (Etype (gnat_entity) != gnat_entity
-	    && !(Is_Private_Type (Etype (gnat_entity))
-		 && Full_View (Etype (gnat_entity)) == gnat_entity))
-	  copy_alias_set (gnu_type, gnat_to_gnu_type (Etype (gnat_entity)));
-
 	/* Fill in locations of fields.  */
 	annotate_rep (gnat_entity, gnu_type);
 
@@ -3003,7 +3003,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	      TYPE_SIZE_UNIT (gnu_type) = TYPE_SIZE_UNIT (gnu_base_type);
 	      SET_TYPE_ADA_SIZE (gnu_type, TYPE_ADA_SIZE (gnu_base_type));
 	      TYPE_ALIGN (gnu_type) = TYPE_ALIGN (gnu_base_type);
-	      copy_alias_set (gnu_type, gnu_base_type);
+	      relate_alias_sets (gnu_type, gnu_base_type, ALIAS_SET_COPY);
 
 	      if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
 		for (gnu_temp = gnu_subst_list;
@@ -4531,6 +4531,49 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
     {
       gnu_type = TREE_TYPE (gnu_decl);
 
+      /* If this is a derived type, relate its alias set to that of its parent
+	 to avoid troubles when a call to an inherited primitive is inlined in
+	 a context where a derived object is accessed.  The inlined code works
+	 on the parent view so the resulting code may access the same object
+	 using both the parent and the derived alias sets, which thus have to
+	 conflict.  As the same issue arises with component references, the
+	 parent alias set also has to conflict with composite types enclosing
+	 derived components.  For instance, if we have:
+
+	    type D is new T;
+	    type R is record
+	       Component : D;
+	    end record;
+
+	 we want T to conflict with both D and R, in addition to R being a
+	 superset of D by record/component construction.
+
+	 One way to achieve this is to perform an alias set copy from the
+	 parent to the derived type.  This is not quite appropriate, though,
+	 as we don't want separate derived types to conflict with each other:
+
+	    type I1 is new Integer;
+	    type I2 is new Integer;
+
+	 We want I1 and I2 to both conflict with Integer but we do not want
+	 I1 to conflict with I2, and an alias set copy on derivation would
+	 have that effect.
+
+	 The option chosen is to make the alias set of the derived type a
+	 superset of that of its parent type.  It trivially fulfills the
+	 simple requirement for the Integer derivation example above, and
+	 the component case as well by superset transitivity:
+
+		   superset      superset
+		R ----------> D ----------> T
+
+	 The language rules ensure the parent type is already frozen here.  */
+      if (Is_Derived_Type (gnat_entity))
+	{
+	  tree gnu_parent_type = gnat_to_gnu_type (Etype (gnat_entity));
+	  relate_alias_sets (gnu_type, gnu_parent_type, ALIAS_SET_SUPERSET);
+	}
+
       /* Back-annotate the Alignment of the type if not already in the
 	 tree.  Likewise for sizes.  */
       if (Unknown_Alignment (gnat_entity))
@@ -5158,11 +5201,16 @@ mark_out_of_scope (Entity_Id gnat_entity)
     }
 }
 
-/* Set the alias set of GNU_NEW_TYPE to be that of GNU_OLD_TYPE.  If this
-   is a multi-dimensional array type, do this recursively.  */
+/* Relate the alias sets of GNU_NEW_TYPE and GNU_OLD_TYPE according to OP.
+   If this is a multi-dimensional array type, do this recursively.
+
+   OP may be
+   - ALIAS_SET_COPY:     the new set is made a copy of the old one.
+   - ALIAS_SET_SUPERSET: the new set is made a superset of the old one.
+   - ALIAS_SET_SUBSET:   the new set is made a subset of the old one.  */
 
 static void
-copy_alias_set (tree gnu_new_type, tree gnu_old_type)
+relate_alias_sets (tree gnu_new_type, tree gnu_old_type, enum alias_set_op op)
 {
   /* Remove any padding from GNU_OLD_TYPE.  It doesn't matter in the case
      of a one-dimensional array, since the padding has the same alias set
@@ -5173,30 +5221,60 @@ copy_alias_set (tree gnu_new_type, tree gnu_old_type)
 	     || TYPE_IS_PADDING_P (gnu_old_type)))
     gnu_old_type = TREE_TYPE (TYPE_FIELDS (gnu_old_type));
 
-  /* We need to be careful here in case GNU_OLD_TYPE is an unconstrained
-     array.  In that case, it doesn't have the same shape as GNU_NEW_TYPE,
-     so we need to go down to what does.  */
+  /* Unconstrained array types are deemed incomplete and would thus be given
+     alias set 0.  Retrieve the underlying array type.  */
   if (TREE_CODE (gnu_old_type) == UNCONSTRAINED_ARRAY_TYPE)
     gnu_old_type
       = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_old_type))));
+  if (TREE_CODE (gnu_new_type) == UNCONSTRAINED_ARRAY_TYPE)
+    gnu_new_type
+      = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_new_type))));
 
   if (TREE_CODE (gnu_new_type) == ARRAY_TYPE
       && TREE_CODE (TREE_TYPE (gnu_new_type)) == ARRAY_TYPE
       && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_new_type)))
-    copy_alias_set (TREE_TYPE (gnu_new_type), TREE_TYPE (gnu_old_type));
+    relate_alias_sets (TREE_TYPE (gnu_new_type), TREE_TYPE (gnu_old_type), op);
 
-  /* The alias set shouldn't be copied between array types with different
-     aliasing settings because this can break the aliasing relationship
-     between the array type and its element type.  */
+  switch (op)
+    {
+    case ALIAS_SET_COPY:
+      /* The alias set shouldn't be copied between array types with different
+	 aliasing settings because this can break the aliasing relationship
+	 between the array type and its element type.  */
 #ifndef ENABLE_CHECKING
-  if (flag_strict_aliasing)
+      if (flag_strict_aliasing)
 #endif
-    gcc_assert (!(TREE_CODE (gnu_new_type) == ARRAY_TYPE
-		  && TREE_CODE (gnu_old_type) == ARRAY_TYPE
-		  && TYPE_NONALIASED_COMPONENT (gnu_new_type)
-		     != TYPE_NONALIASED_COMPONENT (gnu_old_type)));
+	gcc_assert (!(TREE_CODE (gnu_new_type) == ARRAY_TYPE
+		      && TREE_CODE (gnu_old_type) == ARRAY_TYPE
+		      && TYPE_NONALIASED_COMPONENT (gnu_new_type)
+			 != TYPE_NONALIASED_COMPONENT (gnu_old_type)));
+
+      TYPE_ALIAS_SET (gnu_new_type) = get_alias_set (gnu_old_type);
+      break;
+
+    case ALIAS_SET_SUBSET:
+    case ALIAS_SET_SUPERSET:
+      {
+	alias_set_type old_set = get_alias_set (gnu_old_type);
+	alias_set_type new_set = get_alias_set (gnu_new_type);
+
+	/* Do nothing if the alias sets conflict.  This ensures that we
+	   never call record_alias_subset several times for the same pair
+	   or at all for alias set 0.  */
+	if (!alias_sets_conflict_p (old_set, new_set))
+	  {
+	    if (op == ALIAS_SET_SUBSET)
+	      record_alias_subset (old_set, new_set);
+	    else
+	      record_alias_subset (new_set, old_set);
+	  }
+      }
+      break;
+
+    default:
+      gcc_unreachable ();
+    }
 
-  TYPE_ALIAS_SET (gnu_new_type) = get_alias_set (gnu_old_type);
   record_component_aliases (gnu_new_type);
 }
 
@@ -5600,7 +5678,7 @@ make_aligning_type (tree type, unsigned int align, tree size,
 
   SET_TYPE_MODE (record_type, BLKmode);
 
-  copy_alias_set (record_type, type);
+  relate_alias_sets (record_type, type, ALIAS_SET_COPY);
   return record_type;
 }
 
@@ -5722,7 +5800,7 @@ make_packable_type (tree type, bool in_record)
     }
 
   finish_record_type (new_type, nreverse (field_list), 2, true);
-  copy_alias_set (new_type, type);
+  relate_alias_sets (new_type, type, ALIAS_SET_COPY);
 
   /* If this is a padding record, we never want to make the size smaller
      than what was specified.  For QUAL_UNION_TYPE, also copy the size.  */

gcc/ada/gcc-interface/trans.c

@@ -4940,8 +4940,9 @@ gnat_to_gnu (Node_Id gnat_node)
 			!= TYPE_DUMMY_P (gnu_target_desig_type))
 		    || (TYPE_DUMMY_P (gnu_source_desig_type)
 			&& gnu_source_desig_type != gnu_target_desig_type)
-		    || (get_alias_set (gnu_source_desig_type)
-			!= get_alias_set (gnu_target_desig_type))))
+		    || !alias_sets_conflict_p
+			(get_alias_set (gnu_source_desig_type),
+			 get_alias_set (gnu_target_desig_type))))
 	      {
 		post_error_ne
 		  ("?possible aliasing problem for type&",
@@ -4973,8 +4974,9 @@ gnat_to_gnu (Node_Id gnat_node)
 			!= TYPE_DUMMY_P (gnu_target_array_type))
 		    || (TYPE_DUMMY_P (gnu_source_array_type)
 			&& gnu_source_array_type != gnu_target_array_type)
-		    || (get_alias_set (gnu_source_array_type)
-			!= get_alias_set (gnu_target_array_type))))
+		    || !alias_sets_conflict_p
+			(get_alias_set (gnu_source_array_type),
+			 get_alias_set (gnu_target_array_type))))
 	      {
 		post_error_ne
 		  ("?possible aliasing problem for type&",

gcc/alias.c

@@ -167,7 +167,6 @@ static rtx adjust_offset_for_component_ref (tree, rtx);
 static int write_dependence_p (const_rtx, const_rtx, int);
 
 static void memory_modified_1 (rtx, const_rtx, void *);
-static void record_alias_subset (alias_set_type, alias_set_type);
 
 /* Set up all info needed to perform alias analysis on memory references.  */
 
@@ -735,7 +734,7 @@ new_alias_set (void)
    It is illegal for SUPERSET to be zero; everything is implicitly a
    subset of alias set zero.  */
 
-static void
+void
 record_alias_subset (alias_set_type superset, alias_set_type subset)
 {
   alias_set_entry superset_entry;

gcc/alias.h

@@ -36,6 +36,7 @@ extern alias_set_type get_varargs_alias_set (void);
 extern alias_set_type get_frame_alias_set (void);
 extern bool component_uses_parent_alias_set (const_tree);
 extern bool alias_set_subset_of (alias_set_type, alias_set_type);
+extern void record_alias_subset (alias_set_type, alias_set_type);
 extern void record_component_aliases (tree);
 extern int alias_sets_conflict_p (alias_set_type, alias_set_type);
 extern int alias_sets_must_conflict_p (alias_set_type, alias_set_type);

gcc/testsuite/ChangeLog

@@ -1,3 +1,8 @@
+2009-02-10  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/aliasing3.adb: New test.
+	* gnat.dg/aliasing3_pkg.ad[sb]: New helper.
+
 2009-02-10  Paolo Carlini  <paolo.carlini@oracle.com>
 
 	PR c++/34397

gcc/testsuite/gnat.dg/aliasing3.adb

@@ -0,0 +1,10 @@
+-- { dg-do run }
+-- { dg-options "-O2 -gnatn" }
+
+with Aliasing3_Pkg; use Aliasing3_Pkg;
+
+procedure Aliasing3 is
+begin
+  Pointer.A(1) := 5;
+  Test (Block.A);
+end;

gcc/testsuite/gnat.dg/aliasing3_pkg.adb

@@ -0,0 +1,10 @@
+package body Aliasing3_Pkg is
+
+  procedure Test (A : Arr) is
+  begin
+    if A(1) /= 5 then
+      raise Program_Error;
+    end if;
+  end;
+
+end Aliasing3_Pkg;

gcc/testsuite/gnat.dg/aliasing3_pkg.ads

@@ -0,0 +1,19 @@
+package Aliasing3_Pkg is
+
+  type Arr is array (1..3) of Integer;
+
+  procedure Test (A : Arr);
+  pragma Inline (Test);
+
+  type My_Arr is new Arr;
+
+  type Rec is record
+    A : My_Arr;
+  end record;
+
+  type Ptr is access all Rec;
+
+  Block : aliased Rec;
+  Pointer : Ptr := Block'Access;
+
+end Aliasing3_Pkg;