[COMMITTED,29/31] ada: Give a warning for huge imported objects

Message ID 20250911091904.1505690-29-poulhies@adacore.com
State Committed
Commit 7efa3b5b2fa1d5e21d6a7e6bf124ffc100501938
Headers
Series [COMMITTED,01/31] ada: Disable new warning for composite equality ops that can raise Program_Error |

Commit Message

Marc Poulhiès Sept. 11, 2025, 9:19 a.m. UTC
  From: Eric Botcazou <ebotcazou@adacore.com>

This is a follow-up to a recent change, where a warning was implemented
for huge library-level objects.  However it is not given if the objects
are imported, although an indirection is also added for them under the
hood to match the export side.

gcc/ada/ChangeLog:

	* gcc-interface/decl.cc (gnat_to_gnu_entity) <E_Variable>: Give a
	warning for huge imported objects as well.

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

---
 gcc/ada/gcc-interface/decl.cc | 61 +++++++++++++++++++++--------------
 1 file changed, 36 insertions(+), 25 deletions(-)
  

Patch

diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
index 771325d8ce6c..00ccac3978e6 100644
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -1388,16 +1388,15 @@  gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 	      }
 	  }
 
-	/* If we are at top level and this object is of variable size,
-	   make the actual type a hidden pointer to the real type and
-	   make the initializer be a memory allocation and initialization.
-	   Likewise for objects we aren't defining (presumed to be
-	   external references from other packages), but there we do
-	   not set up an initialization.
-
-	   If the object's size overflows, make an allocator too, so that
-	   Storage_Error gets raised.  Note that we will never free
-	   such memory, so we presume it never will get allocated.  */
+	/* If we are at top level and this object is of variable size, make
+	   the actual type a reference to the real type and the initializer
+	   be a memory allocation and initialization.  Likewise for an object
+	   that we aren't defining or is imported (presumed to be an external
+	   reference from another package), but in this case we do not set up
+	   an initialization.  Likewise if the object's size is constant but
+	   too large.  In either case, this will also cause Storage_Error to
+	   be raised if the size ends up overflowing.  Note that we will never
+	   free such memory, but it will be allocated only at top level.  */
 	if (!allocatable_size_p (TYPE_SIZE_UNIT (gnu_type),
 				 global_bindings_p ()
 				 || !definition
@@ -1411,6 +1410,29 @@  gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 					|| !definition
 					|| static_flag)))
 	  {
+	    /* Give a warning if the size is constant.  */
+	    if ((TREE_CODE (TYPE_SIZE_UNIT (gnu_type)) == INTEGER_CST
+		 || (gnu_size && TREE_CODE (gnu_size) == INTEGER_CST))
+		&& definition)
+	      {
+		if (imported_p)
+		  {
+		    post_error
+		      ("??too large object cannot be imported directly",
+		       gnat_entity);
+		    post_error ("\\??indirect import will be used instead",
+				gnat_entity);
+		  }
+		else if (global_bindings_p () || static_flag)
+		  {
+		    post_error
+		      ("??too large object cannot be allocated statically",
+		       gnat_entity);
+		    post_error ("\\??dynamic allocation will be used instead",
+				gnat_entity);
+		  }
+	      }
+
 	    if (volatile_flag && !TYPE_VOLATILE (gnu_type))
 	      gnu_type = change_qualified_type (gnu_type, TYPE_QUAL_VOLATILE);
 	    gnu_type = build_reference_type (gnu_type);
@@ -1453,21 +1475,10 @@  gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 		  }
 
 		/* Give a warning if the size is constant but too large.  */
-		if (TREE_CODE (TYPE_SIZE_UNIT (gnu_alloc_type)) == INTEGER_CST)
-		  {
-		    if (valid_constant_size_p (TYPE_SIZE_UNIT (gnu_alloc_type)))
-		      {
-			post_error
-			  ("??too large object cannot be allocated statically",
-			   gnat_entity);
-			post_error ("\\??dynamic allocation will be used instead",
-				    gnat_entity);
-		      }
-
-		    else
-		      post_error ("??Storage_Error will be raised at run time!",
-				  gnat_entity);
-		  }
+		if (TREE_CODE (TYPE_SIZE_UNIT (gnu_alloc_type)) == INTEGER_CST
+		    && !valid_constant_size_p (TYPE_SIZE_UNIT (gnu_alloc_type)))
+		  post_error ("??Storage_Error will be raised at run time!",
+			      gnat_entity);
 
 		gnu_expr
 		  = build_allocator (gnu_alloc_type, gnu_expr, gnu_type,