From 1e039275b5781ba03565686eb723cb834919819a Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Fri, 20 Mar 2015 10:15:33 +0000 Subject: [PATCH] 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 | 8 ++++++++ gcc/ada/gcc-interface/trans.c | 29 +-------------------------- gcc/ada/gcc-interface/utils.c | 30 +++++++++++++++------------- gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/volatile13.adb | 11 ++++++++++ gcc/testsuite/gnat.dg/volatile13.ads | 19 ++++++++++++++++++ 6 files changed, 59 insertions(+), 42 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/volatile13.adb create mode 100644 gcc/testsuite/gnat.dg/volatile13.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e81f0150e9a..1d391324e20 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2015-03-20 Eric Botcazou + + 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 * 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 fe4ecae082c..a4ba82e5dfc 100644 --- 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 8d36cf74969..170aa4a9716 100644 --- 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 77649009638..7300bb6e17c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2015-03-20 Eric Botcazou + + * gnat.dg/volatile13.ad[sb]: New test. + 2015-03-20 Uros Bizjak PR rtl-optimization/60851 diff --git a/gcc/testsuite/gnat.dg/volatile13.adb b/gcc/testsuite/gnat.dg/volatile13.adb new file mode 100644 index 00000000000..eb0f5f60b24 --- /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 index 00000000000..d24d6598cb6 --- /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; -- 2.30.2