]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Fix wrong finalization for qualified aggregate of limited type in allocator
authorEric Botcazou <ebotcazou@adacore.com>
Thu, 16 Nov 2023 18:45:41 +0000 (19:45 +0100)
committerMarc Poulhiès <poulhies@adacore.com>
Thu, 30 Nov 2023 10:12:46 +0000 (11:12 +0100)
This happens with -gnata when the limited type has controlled components
and a predicate, because the predicate check generated for the aggregate
causes the creation of a temporary that is used as the expression of the
allocator.  Now this combination is illegal for a limited type, so the
compiler does not generate the deep adjustment that would be necessary
for the access value, which ultimately results in a wrong finalization.

gcc/ada/

* checks.adb (Apply_Predicate_Check): Also deal specifically with
an expression that is a qualified aggregate in an allocator.

gcc/ada/checks.adb

index 6525982aef9133354a7f0abd3586ffd974855d55..84a21b2c177459dbba9da1cf88a375af587fdfda 100644 (file)
@@ -2851,6 +2851,27 @@ package body Checks is
                 (Typ, Duplicate_Subexpr (Name (Par))));
             return;
 
+         --  Similarly, if the expression is a qualified aggregate in an
+         --  allocator, apply the check to the dereference of the access
+         --  value, rather than create a temporary. This is necessary for
+         --  inherently limited types, for which the temporary is illegal.
+
+         elsif Nkind (Par) = N_Allocator then
+            declare
+               Deref : constant Node_Id :=
+                         Make_Explicit_Dereference (Sloc (N),
+                           Prefix => Duplicate_Subexpr (Par));
+
+            begin
+               --  This is required by Predicate_Check_In_Scope ???
+
+               Preserve_Comes_From_Source (Deref, N);
+
+               Insert_Action_After (Parent (Par),
+                 Make_Predicate_Check (Typ, Deref));
+               return;
+            end;
+
          --  Similarly, if the expression is an aggregate in an object
          --  declaration, apply it to the object after the declaration.