[COMMITTED,18/31] ada: Fix small inaccuracy for Size attribute applied to objects

Message ID 20240521073035.314024-18-poulhies@adacore.com
State Committed
Commit dc775b12224ca18088b5f6a8a7759c426a58b116
Headers
Series [COMMITTED,01/31] ada: Add new Mingw task priority mapping |

Commit Message

Marc Poulhiès May 21, 2024, 7:30 a.m. UTC
  From: Eric Botcazou <ebotcazou@adacore.com>

This reverts a change made some time ago in lvalue_required_for_attribute_p
whereby the Size attribute applied to objects would no longer be considered
as requiring an lvalue.

While not wrong in principle, this turns out to be problematic because the
implementation in Attribute_to_gnu needs to look at the translated prefix
to spot particular cases and not only at the actual type of its value.

This of course requires a small adjustment in gnat_to_gnu to compensate.

gcc/ada/

	* gcc-interface/trans.cc (access_attribute_p): New predicate.
	(lvalue_required_for_attribute_p): Return again 1 for Size and add
	the missing terminating call to gcc_unreachable.
	(gnat_to_gnu): Return the result unmodified for a reference to an
	unconstrained array only if it is the prefix of an access attribute.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/gcc-interface/trans.cc | 28 +++++++++++++++++++++++++---
 1 file changed, 25 insertions(+), 3 deletions(-)
  

Patch

diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc
index 8c7ffbf5687..6f761766559 100644
--- a/gcc/ada/gcc-interface/trans.cc
+++ b/gcc/ada/gcc-interface/trans.cc
@@ -745,6 +745,26 @@  build_raise_check (int check, enum exception_info_kind kind)
   return result;
 }
 
+/* Return true if GNAT_NODE, which is an N_Attribute_Reference, is one of the
+   access attributes.  */
+
+static bool
+access_attribute_p (Node_Id gnat_node)
+{
+  switch (Get_Attribute_Id (Attribute_Name (gnat_node)))
+    {
+    case Attr_Access:
+    case Attr_Unchecked_Access:
+    case Attr_Unrestricted_Access:
+      return true;
+
+    default:
+      return false;
+    }
+
+  gcc_unreachable ();
+}
+
 /* Return a positive value if an lvalue is required for GNAT_NODE, which is
    an N_Attribute_Reference.  */
 
@@ -760,7 +780,6 @@  lvalue_required_for_attribute_p (Node_Id gnat_node)
     case Attr_Range_Length:
     case Attr_Length:
     case Attr_Object_Size:
-    case Attr_Size:
     case Attr_Value_Size:
     case Attr_Component_Size:
     case Attr_Descriptor_Size:
@@ -786,11 +805,14 @@  lvalue_required_for_attribute_p (Node_Id gnat_node)
     case Attr_First_Bit:
     case Attr_Last_Bit:
     case Attr_Bit:
+    case Attr_Size:
     case Attr_Asm_Input:
     case Attr_Asm_Output:
     default:
       return 1;
     }
+
+  gcc_unreachable ();
 }
 
 /* Return a positive value if an lvalue is required for GNAT_NODE.  GNU_TYPE
@@ -8472,7 +8494,7 @@  gnat_to_gnu (Node_Id gnat_node)
 	  return slot optimization in this case.
 
        5. If this is a reference to an unconstrained array which is used either
-	  as the prefix of an attribute reference that requires an lvalue or in
+	  as the prefix of an attribute reference for an access attribute or in
 	  a return statement without storage pool, return the result unmodified
 	  because we want to return the original bounds.
 
@@ -8539,7 +8561,7 @@  gnat_to_gnu (Node_Id gnat_node)
   else if (TREE_CODE (TREE_TYPE (gnu_result)) == UNCONSTRAINED_ARRAY_TYPE
 	   && Present (Parent (gnat_node))
 	   && ((Nkind (Parent (gnat_node)) == N_Attribute_Reference
-	        && lvalue_required_for_attribute_p (Parent (gnat_node)))
+	        && access_attribute_p (Parent (gnat_node)))
 	       || (Nkind (Parent (gnat_node)) == N_Simple_Return_Statement
 		   && No (Storage_Pool (Parent (gnat_node))))))
     ;