]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Fix internal error on expression function called for default expression
authorEric Botcazou <ebotcazou@adacore.com>
Mon, 14 Apr 2025 08:04:27 +0000 (10:04 +0200)
committerEric Botcazou <ebotcazou@adacore.com>
Mon, 30 Jun 2025 17:06:55 +0000 (19:06 +0200)
This happens for the default expression of a controlled component when an
aggregate is used for the record type, because of a freeze node generated
for the expression within an artificial block that is needed to implement
the cleanup actions attached to the assignment of the component.

This is fixed by extending the special treatment applied to freeze nodes
by Insert_Actions, in the case of loops generated for aggregates, to the
case of blocks generated for aggregates.

gcc/ada/ChangeLog:

* exp_util.adb (Insert_Actions): Extend special treatment applied
to freeze nodes to the case of blocks generated for aggregates.

gcc/ada/exp_util.adb

index 5fc4ed87358d68c433fab06cd9a86a1f1ee4d8cd..8b9877f1c5684e1aee00f61dd8b8494caefda192 100644 (file)
@@ -8195,20 +8195,24 @@ package body Exp_Util is
                elsif Nkind (Parent (P)) in N_Variant | N_Record_Definition then
                   null;
 
-               --  Do not insert freeze nodes within the loop generated for
-               --  an aggregate, because they may be elaborated too late for
-               --  subsequent use in the back end: within a package spec the
-               --  loop is part of the elaboration procedure and is only
-               --  elaborated during the second pass.
-
-               --  If the loop comes from source, or the entity is local to the
-               --  loop itself it must remain within.
-
-               elsif Nkind (Parent (P)) = N_Loop_Statement
-                 and then not Comes_From_Source (Parent (P))
+               --  Do not insert freeze nodes within a block or loop generated
+               --  for an aggregate, because they may be elaborated too late
+               --  for subsequent use in the back end: within a package spec,
+               --  the block or loop is part of the elaboration procedure and
+               --  is only elaborated during the second pass.
+
+               --  If the block or loop comes from source, or the entity is
+               --  local to the block or loop itself, it must remain within.
+
+               elsif ((Nkind (Parent (P)) = N_Handled_Sequence_Of_Statements
+                        and then
+                          Nkind (Parent (Parent (P))) = N_Block_Statement
+                        and then not Comes_From_Source (Parent (Parent (P))))
+                      or else (Nkind (Parent (P)) = N_Loop_Statement
+                                and then not Comes_From_Source (Parent (P))))
                  and then Nkind (First (Ins_Actions)) = N_Freeze_Entity
-                 and then
-                   Scope (Entity (First (Ins_Actions))) /= Current_Scope
+                 and then not
+                   Within_Scope (Entity (First (Ins_Actions)), Current_Scope)
                then
                   null;