trans.c (adjust_for_implicit_deref): New function.

	* gcc-interface/trans.c (adjust_for_implicit_deref): New function.
	(gnat_to_gnu) <N_Explicit_Dereference>: 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 40cc96557aa1a4c57f1384c407e1dc0b8ecf332a..61cd24bf370cf4e7b5f3aebf37e3b79c39fc7f33 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2017-09-05  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/trans.c (adjust_for_implicit_deref): New function.
+       (gnat_to_gnu) <N_Explicit_Dereference>: 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  <ebotcazou@adacore.com>
 
        * 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 eb777038234ec3eee226f5a150bf31a0d7a24754..78d918fcd89c4fe9aa0f0c238ece317074e780ab 100644 (file)
--- 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)
     }
 }
 \f
+/* 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 a21730089edaad7d8ccc721a09670c3d8c8cbd1a..f6210be478bd150c2a72757e74141f9ac39b4841 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2017-09-05  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/taft_type4.adb: New test.
+       * gnat.dg/taft_type4_pkg.ad[sb]: New helper.
+
 2017-09-05  Richard Biener  <rguenther@suse.de>
 
        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 (file)
index 0000000..f675863
--- /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 (file)
index 0000000..40039c7
--- /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 (file)
index 0000000..6b0dc34
--- /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;