]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Deep delta aggregates incorrectly rejected with -gnatX.
authorSteve Baird <baird@adacore.com>
Wed, 21 Jan 2026 22:42:31 +0000 (14:42 -0800)
committerMarc Poulhiès <dkm@gcc.gnu.org>
Tue, 26 May 2026 08:38:17 +0000 (10:38 +0200)
To enable the use of deep delta aggregates, it should only be necessary to
enable core extensions (e.g., via -gnatX) as opposed to enabling all
extensions (e.g., via -gnatX0).

gcc/ada/ChangeLog:

* doc/gnat_rm/gnat_language_extensions.rst: Correct example
to avoid using a not-yet-implemented form of deep delta aggregate.
* exp_aggr.adb (Make_Delta_Choice_LHS): Call Core_Extensions_Allowed
instead of All_Extensions_Allowed.
* par-ch4.adb (P_Simple_Expression): Likewise.
* sem_aggr.adb (Resolve_Delta_Array_Aggregate): Likewise.
* gnat_rm.texi: Regenerate.

gcc/ada/doc/gnat_rm/gnat_language_extensions.rst
gcc/ada/exp_aggr.adb
gcc/ada/gnat_rm.texi
gcc/ada/par-ch4.adb
gcc/ada/sem_aggr.adb

index 3a73213e60f7c101f546730a65852380ebe73dac..92a9fc5589f6c3d2288e333eb969333bf1b7cae5 100644 (file)
@@ -272,9 +272,9 @@ Examples
       S : Segment := (1 .. 2 => (0, 0));
       T : Triangle := (1 .. 3 => (1 .. 2 => (0, 0)));
    begin
-      S := (S with delta (1).X | (2).Y => 12, (1).Y => 15);
+      S := (S with delta (1).X => 11, (2).Y => 12, (1).Y => 15);
 
-      pragma Assert (S (1).X = 12);
+      pragma Assert (S (1).X = 11);
       pragma Assert (S (2).Y = 12);
       pragma Assert (S (1).Y = 15);
 
index 82afcaaa0e80fb10ddb0e7b973a0dfeda55d4c59..4077a8e17d2641e7b1e01f03f027bb7101980ec9 100644 (file)
@@ -7848,7 +7848,7 @@ package body Exp_Aggr is
 
             else
                --  a deep delta aggregate choice
-               pragma Assert (All_Extensions_Allowed);
+               pragma Assert (Core_Extensions_Allowed);
 
                declare
                   --  recursively get name for prefix
index c61db7d9c4e9965c3e601bed4324e0bb5381a960..5a6d8372476d5f1417d5b669987defef3237413e 100644 (file)
@@ -31091,9 +31091,9 @@ declare
    S : Segment := (1 .. 2 => (0, 0));
    T : Triangle := (1 .. 3 => (1 .. 2 => (0, 0)));
 begin
-   S := (S with delta (1).X | (2).Y => 12, (1).Y => 15);
+   S := (S with delta (1).X => 11, (2).Y => 12, (1).Y => 15);
 
-   pragma Assert (S (1).X = 12);
+   pragma Assert (S (1).X = 11);
    pragma Assert (S (2).Y = 12);
    pragma Assert (S (1).Y = 15);
 
index 58bac211e781646aad72fcb63fef0e510f17d0e8..0a25ac853f7688c4533fd190edb0c3f33cb5111f 100644 (file)
@@ -2655,7 +2655,7 @@ package body Ch4 is
          end;
       end if;
 
-      --  If all extensions are enabled and we have a deep delta aggregate
+      --  If core extensions are enabled and we have a deep delta aggregate
       --  whose type is an array type with an element type that is a
       --  record type, then we can encounter legal things like
       --    with delta (Some_Index_Expression).Some_Component
@@ -2668,7 +2668,7 @@ package body Ch4 is
         and then Prev_Token = Tok_Right_Paren
         and then Serious_Errors_Detected = 0
         and then Inside_Delta_Aggregate
-        and then All_Extensions_Allowed
+        and then Core_Extensions_Allowed
       then
          if Token = Tok_Dot then
             Node2 := New_Node (N_Selected_Component, Token_Ptr);
index 4bb3cb21c21fc2f310d4cd3d613e93e7fa791d1e..65591d1d60aa1cbaa8a913c5540fb7e0f1d01b0c 100644 (file)
@@ -4520,7 +4520,7 @@ package body Sem_Aggr is
             Choice := First (Choice_List (Assoc));
             while Present (Choice) loop
                if Is_Deep_Choice (Choice, Typ) then
-                  pragma Assert (All_Extensions_Allowed);
+                  pragma Assert (Core_Extensions_Allowed);
                   Deep_Choice_Seen := True;
 
                   --  a deep delta aggregate
@@ -4796,7 +4796,8 @@ package body Sem_Aggr is
             Deep_Choice := Nkind (Choice) /= N_Identifier;
             if Deep_Choice then
                Error_Msg_GNAT_Extension
-                 ("deep delta aggregate", Sloc (Choice));
+                 ("deep delta aggregate", Sloc (Choice),
+                  Is_Core_Extension => True);
             end if;
 
             Comp_Type := Get_Component_Type