[COMMITTED] ada: Fix internal error on array constant in expression function
Checks
Commit Message
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(-)
@@ -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 =>