From: Eric Botcazou Date: Tue, 5 Sep 2017 08:54:14 +0000 (+0000) Subject: trans.c (adjust_for_implicit_deref): New function. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=806fcf7183377c7df062a7fa0bcf9d0ce8ea1fc0;p=gcc.git trans.c (adjust_for_implicit_deref): New function. * gcc-interface/trans.c (adjust_for_implicit_deref): New function. (gnat_to_gnu) : Translate result type first. (N_Indexed_Component): Invoke adjust_for_implicit_deref on the prefix. (N_Slice): Likewise. (N_Selected_Component): Likewise. Do not try again to translate it. (N_Free_Statement): Invoke adjust_for_implicit_deref on the expression. From-SVN: r251699 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 40cc96557aa..61cd24bf370 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2017-09-05 Eric Botcazou + + * gcc-interface/trans.c (adjust_for_implicit_deref): New function. + (gnat_to_gnu) : Translate result type first. + (N_Indexed_Component): Invoke adjust_for_implicit_deref on the prefix. + (N_Slice): Likewise. + (N_Selected_Component): Likewise. Do not try again to translate it. + (N_Free_Statement): Invoke adjust_for_implicit_deref on the expression. + 2017-09-05 Eric Botcazou * repinfo.ads: Document new treatment of dynamic values. diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index eb777038234..78d918fcd89 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -242,6 +242,7 @@ static bool addressable_p (tree, tree); static tree assoc_to_constructor (Entity_Id, Node_Id, tree); static tree pos_to_constructor (Node_Id, tree, Entity_Id); static void validate_unchecked_conversion (Node_Id); +static Node_Id adjust_for_implicit_deref (Node_Id); static tree maybe_implicit_deref (tree); static void set_expr_location_from_node (tree, Node_Id, bool = false); static void set_gnu_expr_location_from_node (tree, Node_Id); @@ -6274,8 +6275,9 @@ gnat_to_gnu (Node_Id gnat_node) /*************************************/ case N_Explicit_Dereference: - gnu_result = gnat_to_gnu (Prefix (gnat_node)); + /* Make sure the designated type is complete before dereferencing. */ gnu_result_type = get_unpadded_type (Etype (gnat_node)); + gnu_result = gnat_to_gnu (Prefix (gnat_node)); gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result); /* If atomic access is required on the RHS, build the atomic load. */ @@ -6286,7 +6288,8 @@ gnat_to_gnu (Node_Id gnat_node) case N_Indexed_Component: { - tree gnu_array_object = gnat_to_gnu (Prefix (gnat_node)); + tree gnu_array_object + = gnat_to_gnu (adjust_for_implicit_deref (Prefix (gnat_node))); tree gnu_type; int ndim; int i; @@ -6399,7 +6402,8 @@ gnat_to_gnu (Node_Id gnat_node) case N_Slice: { - tree gnu_array_object = gnat_to_gnu (Prefix (gnat_node)); + tree gnu_array_object + = gnat_to_gnu (adjust_for_implicit_deref (Prefix (gnat_node))); gnu_result_type = get_unpadded_type (Etype (gnat_node)); @@ -6423,7 +6427,8 @@ gnat_to_gnu (Node_Id gnat_node) case N_Selected_Component: { - Entity_Id gnat_prefix = Prefix (gnat_node); + Entity_Id gnat_prefix + = adjust_for_implicit_deref (Prefix (gnat_node)); Entity_Id gnat_field = Entity (Selector_Name (gnat_node)); tree gnu_prefix = gnat_to_gnu (gnat_prefix); @@ -6456,17 +6461,6 @@ gnat_to_gnu (Node_Id gnat_node) { tree gnu_field = gnat_to_gnu_field_decl (gnat_field); - /* If the prefix has incomplete type, try again to translate it. - The idea is that the translation of the field just above may - have completed it through gnat_to_gnu_entity, in case it is - the dereference of an access to Taft Amendment type used in - the instantiation of a generic body from an external unit. */ - if (!COMPLETE_TYPE_P (TREE_TYPE (gnu_prefix))) - { - gnu_prefix = gnat_to_gnu (gnat_prefix); - gnu_prefix = maybe_implicit_deref (gnu_prefix); - } - gnu_result = build_component_ref (gnu_prefix, gnu_field, (Nkind (Parent (gnat_node)) @@ -7725,7 +7719,8 @@ gnat_to_gnu (Node_Id gnat_node) case N_Free_Statement: if (!type_annotate_only) { - tree gnu_ptr = gnat_to_gnu (Expression (gnat_node)); + tree gnu_ptr + = gnat_to_gnu (adjust_for_implicit_deref (Expression (gnat_node))); tree gnu_ptr_type = TREE_TYPE (gnu_ptr); tree gnu_obj_type, gnu_actual_obj_type; @@ -9913,6 +9908,21 @@ validate_unchecked_conversion (Node_Id gnat_node) } } +/* EXP is to be used in a context where access objects are implicitly + dereferenced. Handle the cases when it is an access object. */ + +static Node_Id +adjust_for_implicit_deref (Node_Id exp) +{ + Entity_Id type = Underlying_Type (Etype (exp)); + + /* Make sure the designated type is complete before dereferencing. */ + if (Is_Access_Type (type)) + gnat_to_gnu_entity (Designated_Type (type), NULL_TREE, false); + + return exp; +} + /* EXP is to be treated as an array or record. Handle the cases when it is an access object and perform the required dereferences. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a21730089ed..f6210be478b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2017-09-05 Eric Botcazou + + * gnat.dg/taft_type4.adb: New test. + * gnat.dg/taft_type4_pkg.ad[sb]: New helper. + 2017-09-05 Richard Biener PR tree-optimization/82102 diff --git a/gcc/testsuite/gnat.dg/taft_type4.adb b/gcc/testsuite/gnat.dg/taft_type4.adb new file mode 100644 index 00000000000..f6758638a63 --- /dev/null +++ b/gcc/testsuite/gnat.dg/taft_type4.adb @@ -0,0 +1,10 @@ +-- { dg-do compile } +-- { dg-options "-O -gnatn" } + +with Taft_Type4_Pkg; use Taft_Type4_Pkg; + +procedure Taft_Type4 is + Obj : T; +begin + Proc (Obj); +end; diff --git a/gcc/testsuite/gnat.dg/taft_type4_pkg.adb b/gcc/testsuite/gnat.dg/taft_type4_pkg.adb new file mode 100644 index 00000000000..40039c7cae7 --- /dev/null +++ b/gcc/testsuite/gnat.dg/taft_type4_pkg.adb @@ -0,0 +1,14 @@ +with Unchecked_Deallocation; + +package body Taft_Type4_Pkg is + + type Obj_T is null record; + + procedure Unchecked_Free is new Unchecked_Deallocation (Obj_T, T); + + procedure Proc (L : in out T) is + begin + Unchecked_Free (L); + end; + +end Taft_Type4_Pkg; diff --git a/gcc/testsuite/gnat.dg/taft_type4_pkg.ads b/gcc/testsuite/gnat.dg/taft_type4_pkg.ads new file mode 100644 index 00000000000..6b0dc349c48 --- /dev/null +++ b/gcc/testsuite/gnat.dg/taft_type4_pkg.ads @@ -0,0 +1,13 @@ +package Taft_Type4_Pkg is + + type T is private; + + procedure Proc (L : in out T); + pragma Inline (Proc); + +private + + type Obj_T; + type T is access Obj_T; + +end Taft_Type4_Pkg;