diff mbox series

[Ada] Do not generate dangling references to bounds

Message ID 1946860.3htyPdm6oa@polaris
State New
Headers show
Series [Ada] Do not generate dangling references to bounds | expand

Commit Message

Eric Botcazou May 27, 2019, 11:07 a.m. UTC 
This prevents gigi from generating dangling references to the bounds of an 
aliased parameter of an unconstrained array type.  This cannot happen in 
strict Ada but you can bypass the rules by means of 'Unchecked_Access.

Tested on x86_64-suse-linux, applied on the mainline and 9 branch.


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>

	* gnat.dg/aliased2.adb: New test.
diff mbox series

Patch

Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 271650)
+++ gcc-interface/trans.c	(working copy)
@@ -1110,11 +1110,12 @@  Identifier_to_gnu (Node_Id gnat_node, tr
     }
   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))
@@ -8685,7 +8686,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)
@@ -8734,13 +8739,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);