re PR ada/65451 (compiler crash on volatile access type)

	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.

From-SVN: r221531

gcc/ada/ChangeLog

+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.
+
+	* gcc-interface/trans.c (Attribute_to_gnu): Revert latest change.
+
 2015-03-16  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc-interface/utils2.c (gnat_invariant_expr): Return null if the type

gcc/ada/gcc-interface/trans.c

@@ -155,14 +155,6 @@ struct GTY(()) language_function {
 #define f_gnat_ret \
   DECL_STRUCT_FUNCTION (current_function_decl)->language->gnat_ret
 
-/* Expected to be defined from the tm headers, though not always available.
-   0 indicates that function symbols designate function descriptors on the
-   target so we don't need to use runtime descriptors of our own.  */
-
-#ifndef USE_RUNTIME_DESCRIPTORS
-#define USE_RUNTIME_DESCRIPTORS (-1)
-#endif
-
 /* A structure used to gather together information about a statement group.
    We use this to gather related statements, for example the "then" part
    of a IF.  In the case where it represents a lexical scope, we may also
@@ -1734,32 +1726,13 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
 			  gnu_result_type, gnu_prefix);
 
       /* For 'Code_Address, find an inner ADDR_EXPR and mark it so that we
-	 don't try to build a trampoline.  Then if the function address
-	 denotes a function descriptor on this target, fetch the code address
-	 from the descriptor.  */
+	 don't try to build a trampoline.  */
       if (attribute == Attr_Code_Address)
 	{
 	  gnu_expr = remove_conversions (gnu_result, false);
 
 	  if (TREE_CODE (gnu_expr) == ADDR_EXPR)
 	    TREE_NO_TRAMPOLINE (gnu_expr) = TREE_CONSTANT (gnu_expr) = 1;
-
-	  /* On targets on which function symbols denote a function
-	     descriptor, the code address is always stored within the
-	     first slot of the descriptor.  */
-
-	  if (USE_RUNTIME_DESCRIPTORS == 0)
-	    {
-	      /* result = * ((result_type *) result),
-		 where we expect result to be of some pointer type already.  */
-
-	      const tree result_ptr_type
-		= build_pointer_type (gnu_result_type);
-
-	      gnu_result = build_unary_op
-		(INDIRECT_REF, gnu_result_type,
-		 convert (result_ptr_type, gnu_result));
-	    }
 	}
 
       /* For 'Access, issue an error message if the prefix is a C++ method

gcc/ada/gcc-interface/utils.c

@@ -787,19 +787,17 @@ gnat_pushdecl (tree decl, Node_Id gnat_node)
 	{
 	  /* 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_node)
 	       && (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),

gcc/testsuite/ChangeLog

+2015-03-20  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/volatile13.ad[sb]: New test.
+
 2015-03-20  Uros Bizjak  <ubizjak@gmail.com>
 
 	PR rtl-optimization/60851

gcc/testsuite/gnat.dg/volatile13.adb

+-- { 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;

gcc/testsuite/gnat.dg/volatile13.ads

+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;