Fix PR ada/65451

[Eric Botcazou <ebotcazou at adacore dot com>]

This is a regression present on the mainline: gigi gets confused translating a 
volatile access type whose designated type has its elaboration delayed.

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


2015-03-20  Eric Botcazou  <ebotcazou@adacore.com>

	PR ada/65451
	* gcc-interface/utils.c (gnat_pushdecl): Tidy up and improve comment.
	Make sure to chain only main variants through TYPE_NEXT_PTR_TO.


2015-03-20  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/volatile13.ad[sb]: New test.

-- 
Eric Botcazou

Index: gcc-interface/utils.c
===================================================================
--- gcc-interface/utils.c	(revision 221457)
+++ gcc-interface/utils.c	(working copy)
@@ -787,19 +787,17 @@ gnat_pushdecl (tree decl, Node_Id gnat_n
 	{
 	  /* Array types aren't "tagged" types so we force the type to be
 	     associated with its typedef in the DWARF back-end, in order to
-	     make sure that the latter is always preserved.  We used to do the
-	     same for pointer types, but to have consistent DWARF output we now
-	     create copies for DECL_ORIGINAL_TYPE just like the C front-end
-	     does in c-common.c:set_underlying_type.  */
+	     make sure that the latter is always preserved, by creating an
+	     on-side copy for DECL_ORIGINAL_TYPE.  We used to do the same
+	     for pointer types, but to have consistent DWARF output we now
+	     create a copy for the type itself and use the original type
+	     for DECL_ORIGINAL_TYPE like the C front-end.  */
 	  if (!DECL_ARTIFICIAL (decl) && TREE_CODE (t) == ARRAY_TYPE)
 	    {
 	      tree tt = build_distinct_type_copy (t);
-	      if (TREE_CODE (t) == POINTER_TYPE)
-		TYPE_NEXT_PTR_TO (t) = tt;
-	      /* Array types need to have a name so that they can be related to
-		 their GNAT encodings.  */
-	      if (TREE_CODE (t) == ARRAY_TYPE)
-		TYPE_NAME (tt) = DECL_NAME (decl);
+	      /* Array types need to have a name so that they can be related
+		 to their GNAT encodings.  */
+	      TYPE_NAME (tt) = DECL_NAME (decl);
 	      defer_or_set_type_context (tt,
 					 DECL_CONTEXT (decl),
 					 deferred_decl_context);
@@ -811,13 +809,17 @@ gnat_pushdecl (tree decl, Node_Id gnat_n
 	       && (TREE_CODE (t) == POINTER_TYPE || TYPE_IS_FAT_POINTER_P (t)))
 	{
 	  tree tt;
-	  /* ??? We need a variant for the placeholder machinery to work.  */
+	  /* ??? Copy and original type are not supposed to be variant but we
+	     really need a variant for the placeholder machinery to work.  */
 	  if (TYPE_IS_FAT_POINTER_P (t))
 	    tt = build_variant_type_copy (t);
 	  else
-	    tt = build_distinct_type_copy (t);
-	  if (TREE_CODE (t) == POINTER_TYPE)
-	    TYPE_NEXT_PTR_TO (t) = tt;
+	    {
+	      /* TYPE_NEXT_PTR_TO is a chain of main variants.  */
+	      tt = build_distinct_type_copy (TYPE_MAIN_VARIANT (t));
+	      TYPE_NEXT_PTR_TO (TYPE_MAIN_VARIANT (t)) = tt;
+	      tt = build_qualified_type (tt, TYPE_QUALS (t));
+	    }
 	  TYPE_NAME (tt) = decl;
 	  defer_or_set_type_context (tt,
 				     DECL_CONTEXT (decl),

-- { dg-do compile }

package body Volatile13 is

   procedure Compute_Index_Map (Self : Shared_String) is
      Map : Index_Map_Access := Self.Index_Map;
   begin
      Map := new Index_Map (Self.Length);
   end;

end Volatile13;

package Volatile13 is

   type Index_Map (Length : Natural) is record
      Map : String (1 .. Length);
   end record;

   type Index_Map_Access is access all Index_Map;
   pragma Volatile (Index_Map_Access);

   type Shared_String (Size : Natural) is limited record
      Length    : Natural := 0;
      Index_Map : Index_Map_Access := null;
   end record;

   Shared_Empty : Shared_String := (Size => 64, others => <>);

   procedure Compute_Index_Map (Self : Shared_String);

end Volatile13;