trans.c (Identifier_to_gnu): Minor tweaks.

	* gcc-interface/trans.c (Identifier_to_gnu): Minor tweaks.
	(gnat_to_gnu): Do not convert the result if it is a reference to an
	unconstrained array used as the prefix of an attribute reference that
	requires an lvalue.

From-SVN: r271654

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5f71324cbe06272b87de5788875e21fd655346d7..9bfb21d3e76f0b76ee539481edc9e8cd03708193 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2019-05-27  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/trans.c (Identifier_to_gnu): Minor tweaks.
+       (gnat_to_gnu): Do not convert the result if it is a reference to an
+       unconstrained array used as the prefix of an attribute reference that
+       requires an lvalue.
+
 2019-05-27  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/trans.c (Gigi_Types_Compatible): New predicate.

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 16e17c5c510d28f54a8872adece1b8dcccea01c6..a04bb26ced1e5e7c7cf6ab7c8a4ed3db44482ffe 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -1110,11 +1110,12 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
     }
   else
     {
-      /* We want to use the Actual_Subtype if it has already been elaborated,
-        otherwise the Etype.  Avoid using Actual_Subtype for packed arrays to
-        simplify things.  */
+      /* We use the Actual_Subtype only if it has already been elaborated,
+        as we may be invoked precisely during its elaboration, otherwise
+        the Etype.  Avoid using it for packed arrays to simplify things.  */
       if ((Ekind (gnat_entity) == E_Constant
-          || Ekind (gnat_entity) == E_Variable || Is_Formal (gnat_entity))
+          || Ekind (gnat_entity) == E_Variable
+          || Is_Formal (gnat_entity))
          && !(Is_Array_Type (Etype (gnat_entity))
               && Present (Packed_Array_Impl_Type (Etype (gnat_entity))))
          && Present (Actual_Subtype (gnat_entity))
@@ -8681,7 +8682,11 @@ gnat_to_gnu (Node_Id gnat_node)
          declaration, return the result unmodified because we want to use the
          return slot optimization in this case.
 
-       5. Finally, if the type of the result is already correct.  */
+       5. If this is a reference to an unconstrained array which is used as the
+         prefix of an attribute reference that requires an lvalue, return the
+         result unmodified because we want return the original bounds.
+
+       6. Finally, if the type of the result is already correct.  */
 
   if (Present (Parent (gnat_node))
       && (lhs_or_actual_p (gnat_node)
@@ -8730,13 +8735,19 @@ gnat_to_gnu (Node_Id gnat_node)
   else if (gnu_result == error_mark_node || gnu_result_type == void_type_node)
     gnu_result = error_mark_node;
 
-  else if (Present (Parent (gnat_node))
+  else if (TREE_CODE (gnu_result) == CALL_EXPR
+          && Present (Parent (gnat_node))
           && (Nkind (Parent (gnat_node)) == N_Object_Declaration
               || Nkind (Parent (gnat_node)) == N_Object_Renaming_Declaration)
-          && TREE_CODE (gnu_result) == CALL_EXPR
           && return_type_with_variable_size_p (TREE_TYPE (gnu_result)))
     ;
 
+  else if (TREE_CODE (gnu_result) == UNCONSTRAINED_ARRAY_REF
+          && Present (Parent (gnat_node))
+          && Nkind (Parent (gnat_node)) == N_Attribute_Reference
+          && lvalue_required_for_attribute_p (Parent (gnat_node)))
+    ;
+
   else if (TREE_TYPE (gnu_result) != gnu_result_type)
     gnu_result = convert (gnu_result_type, gnu_result);
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index bfe5591f4ae68c2f1d29621cfb67e0258d953bbd..c38e5a7dfca23a78d25af674bfb614ee6e5de9f0 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-05-27  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/aliased2.adb: New test.
+
 2019-05-27  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gnat.dg/limited_with7.ad[sb]: New test.

diff --git a/gcc/testsuite/gnat.dg/aliased2.adb b/gcc/testsuite/gnat.dg/aliased2.adb
new file mode 100644 (file)
index 0000000..0e1adac
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/aliased2.adb
@@ -0,0 +1,23 @@
+-- { dg-do run }
+
+procedure Aliased2 is
+
+  type Rec is record
+    Data : access constant String;
+  end record;
+
+  function Get (S : aliased String) return Rec is
+    R : Rec := (Data => S'Unchecked_Access);
+  begin
+    return R;
+  end;
+
+  S : aliased String := "Hello";
+
+  R : Rec := Get (S);
+
+begin
+  if R.Data'Length /= S'Length then
+    raise Program_Error;
+  end if;
+end;