diff mbox series

[COMMITTED] ada: Fix internal error on array constant in expression function

Message ID 20230530072059.2500113-1-poulhies@adacore.com
State New
Headers show
Series [COMMITTED] ada: Fix internal error on array constant in expression function | expand

Commit Message

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

This happens when the peculiar check emitted by Check_Large_Modular_Array
is applied to an object whose actual subtype is an itype with dynamic size,
because the first reference to the itype in the expanded code may turn out
to be within the raise statement, which is problematic for the eloboration
of this itype by the code generator at library level.

gcc/ada/

	* freeze.adb (Check_Large_Modular_Array): Fix head comment, use
	Standard_Long_Long_Integer_Size directly and generate a reference
	just before the raise statement if the Etype of the object is an
	itype declared in an open scope.

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

---
 gcc/ada/freeze.adb | 25 +++++++++++++++++++++----
 1 file changed, 21 insertions(+), 4 deletions(-)
diff mbox series

Patch

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 8ebf10bd576..83ce0300871 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -4110,9 +4110,10 @@  package body Freeze is
          procedure Check_Large_Modular_Array (Typ : Entity_Id);
          --  Check that the size of array type Typ can be computed without
          --  overflow, and generates a Storage_Error otherwise. This is only
-         --  relevant for array types whose index has System_Max_Integer_Size
-         --  bits, where wrap-around arithmetic might yield a meaningless value
-         --  for the length of the array, or its corresponding attribute.
+         --  relevant for array types whose index is a modular type with
+         --  Standard_Long_Long_Integer_Size bits: wrap-around arithmetic
+         --  might yield a meaningless value for the length of the array,
+         --  or its corresponding attribute.
 
          procedure Check_Pragma_Thread_Local_Storage (Var_Id : Entity_Id);
          --  Ensure that the initialization state of variable Var_Id subject
@@ -4170,8 +4171,24 @@  package body Freeze is
             --  Storage_Error.
 
             if Is_Modular_Integer_Type (Idx_Typ)
-              and then RM_Size (Idx_Typ) = RM_Size (Standard_Long_Long_Integer)
+              and then RM_Size (Idx_Typ) = Standard_Long_Long_Integer_Size
             then
+               --  Ensure that the type of the object is elaborated before
+               --  the check itself is emitted to avoid elaboration issues
+               --  in the code generator at the library level.
+
+               if Is_Itype (Etype (E))
+                 and then In_Open_Scopes (Scope (Etype (E)))
+               then
+                  declare
+                     Ref_Node : constant Node_Id :=
+                                  Make_Itype_Reference (Obj_Loc);
+                  begin
+                     Set_Itype (Ref_Node, Etype (E));
+                     Insert_Action (Declaration_Node (E), Ref_Node);
+                  end;
+               end if;
+
                Insert_Action (Declaration_Node (E),
                  Make_Raise_Storage_Error (Obj_Loc,
                    Condition =>