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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e81f0150e9a732c6bd3f236204930cc13798913c..1d391324e203610e4d17ea57c98c7cf2056e879b 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+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

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index fe4ecae082cf849f9e660eb8d1aac5670eba4aca..a4ba82e5dfce4917715774fc2a39ca07deeb5536 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/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

diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index 8d36cf74969e3d82ca686c734f068dff1b5c03c7..170aa4a97167cdd3752643da3fd48f7d82a61e61 100644 (file)
--- a/gcc/ada/gcc-interface/utils.c
+++ b/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),

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 776490096387356e9a8a56301b6c5b1a7348e795..7300bb6e17cc19fecab2d8846ec42c55e1d29031 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+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

diff --git a/gcc/testsuite/gnat.dg/volatile13.adb b/gcc/testsuite/gnat.dg/volatile13.adb
new file mode 100644 (file)
index 0000000..eb0f5f6
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/volatile13.adb
@@ -0,0 +1,11 @@
+-- { 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;

diff --git a/gcc/testsuite/gnat.dg/volatile13.ads b/gcc/testsuite/gnat.dg/volatile13.ads
new file mode 100644 (file)
index 0000000..d24d659
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/volatile13.ads
@@ -0,0 +1,19 @@
+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;