[gcc r14-1381] ada: Fix internal error on array constant in expression function

[gcc r14-1381] ada: Fix internal error on array constant in expression function

[Marc Poulhi?s]

https://gcc.gnu.org/g:cab8bb2b3b9ab5b83ac054b088ffd925a0668bdb

commit r14-1381-gcab8bb2b3b9ab5b83ac054b088ffd925a0668bdb
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Fri Apr 14 11:14:47 2023 +0200

    ada: Fix internal error on array constant in expression function
    
    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.

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

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 =>