]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Fix crash on box-initialized component with No_Default_Initialization
authorEric Botcazou <ebotcazou@adacore.com>
Tue, 11 Jun 2024 21:06:22 +0000 (23:06 +0200)
committerMarc Poulhiès <dkm@gcc.gnu.org>
Tue, 2 Jul 2024 13:20:34 +0000 (15:20 +0200)
The problem is that the implementation of the No_Default_Initialization
restriction assumes that no type initialization routines are needed and,
therefore, builds a dummy version of them, which goes against their use
for box-initialized components in aggregates.

Therefore this use needs to be flagged as violating the restriction too.

gcc/ada/

* doc/gnat_rm/standard_and_implementation_defined_restrictions.rst
(No_Default_Initialization): Mention components alongside variables.
* exp_aggr.adb (Build_Array_Aggr_Code.Gen_Assign): Check that the
restriction No_Default_Initialization is not in effect for default
initialized component.
(Build_Record_Aggr_Code): Likewise.
* gnat_rm.texi: Regenerate.

gcc/ada/doc/gnat_rm/standard_and_implementation_defined_restrictions.rst
gcc/ada/exp_aggr.adb
gcc/ada/gnat_rm.texi

index cf4657b7050f8245d6ed4594d8bcd24b7b716e2b..0e9162a190623255055041c99aa45b852c189b57 100644 (file)
@@ -163,8 +163,8 @@ No_Default_Initialization
 .. index:: No_Default_Initialization
 
 [GNAT] This restriction prohibits any instance of default initialization
-of variables.  The binder implements a consistency rule which prevents
-any unit compiled without the restriction from with'ing a unit with the
+of variables or components. The binder implements a consistency check that
+prevents any unit without the restriction from with'ing a unit with the
 restriction (this allows the generation of initialization procedures to
 be skipped, since you can be sure that no call is ever generated to an
 initialization procedure in a unit with the restriction active). If used
index 01ad1dcd43793d47874825eef94716ab503b692a..df228713a28fb37b4ca73163791ded90b3b0d598 100644 (file)
@@ -1486,14 +1486,16 @@ package body Exp_Aggr is
          --  object creation that will invoke it otherwise.
 
          else
-            if Present (Base_Init_Proc (Base_Type (Ctype)))
-              or else Has_Task (Base_Type (Ctype))
-            then
-               Append_List_To (Stmts,
-                 Build_Initialization_Call (N,
-                   Id_Ref            => Indexed_Comp,
-                   Typ               => Ctype,
-                   With_Default_Init => True));
+            if Present (Base_Init_Proc (Ctype)) then
+               Check_Restriction (No_Default_Initialization, N);
+
+               if not Restriction_Active (No_Default_Initialization) then
+                  Append_List_To (Stmts,
+                    Build_Initialization_Call (N,
+                      Id_Ref            => Indexed_Comp,
+                      Typ               => Ctype,
+                      With_Default_Init => True));
+               end if;
 
                --  If the component type has invariants, add an invariant
                --  check after the component is default-initialized. It will
@@ -3185,6 +3187,8 @@ package body Exp_Aggr is
          elsif Box_Present (Comp)
            and then Has_Non_Null_Base_Init_Proc (Etype (Selector))
          then
+            Check_Restriction (No_Default_Initialization, N);
+
             if Ekind (Selector) /= E_Discriminant then
                Generate_Finalization_Actions;
             end if;
@@ -3216,15 +3220,18 @@ package body Exp_Aggr is
                end if;
             end;
 
-            Append_List_To (L,
-              Build_Initialization_Call (N,
-                Id_Ref            => Make_Selected_Component (Loc,
-                                       Prefix        => New_Copy_Tree (Target),
-                                       Selector_Name =>
-                                         New_Occurrence_Of (Selector, Loc)),
-                Typ               => Etype (Selector),
-                Enclos_Type       => Typ,
-                With_Default_Init => True));
+            if not Restriction_Active (No_Default_Initialization) then
+               Append_List_To (L,
+                 Build_Initialization_Call (N,
+                   Id_Ref            => Make_Selected_Component (Loc,
+                                          Prefix        =>
+                                            New_Copy_Tree (Target),
+                                          Selector_Name =>
+                                            New_Occurrence_Of (Selector, Loc)),
+                   Typ               => Etype (Selector),
+                   Enclos_Type       => Typ,
+                   With_Default_Init => True));
+            end if;
 
          --  Prepare for component assignment
 
index dc5721689cbe4134bbb2a61c150dd2d0adcdb505..4feef7e1f9fcb15bb26fe3b7a9087620d4f7da11 100644 (file)
@@ -19,7 +19,7 @@
 
 @copying
 @quotation
-GNAT Reference Manual , Jun 24, 2024
+GNAT Reference Manual , Jun 27, 2024
 
 AdaCore
 
@@ -12594,8 +12594,8 @@ coextensions. See 3.10.2.
 @geindex No_Default_Initialization
 
 [GNAT] This restriction prohibits any instance of default initialization
-of variables.  The binder implements a consistency rule which prevents
-any unit compiled without the restriction from with’ing a unit with the
+of variables or components. The binder implements a consistency check that
+prevents any unit without the restriction from with’ing a unit with the
 restriction (this allows the generation of initialization procedures to
 be skipped, since you can be sure that no call is ever generated to an
 initialization procedure in a unit with the restriction active). If used