[gcc(refs/users/marxin/heads/slp-function-v2)] [Ada] Support 'Reduce under -gnatX

[gcc(refs/users/marxin/heads/slp-function-v2)] [Ada] Support 'Reduce under -gnatX

[Martin Liska]

https://gcc.gnu.org/g:4ccf713e545cc77ba13218c12ec47d21b01bab4e

commit 4ccf713e545cc77ba13218c12ec47d21b01bab4e
Author: Arnaud Charlet <charlet@adacore.com>
Date:   Mon Feb 3 05:22:57 2020 -0500

    [Ada] Support 'Reduce under -gnatX
    
    2020-06-05  Arnaud Charlet  <charlet@adacore.com>
    
    gcc/ada/
    
            * scng.adb (Scan): Fix typo to take into account all future
            versions of Ada.
            * sem_attr.ads (Attribute_Impl_Def): Add Attribute_Reduce for
            now.
            * sem_attr.adb (Analyze_Attribute): Only allow 'Reduce under
            -gnatX.
            * snames.ads-tmpl (Name_Reduce): Update comment.

Diff:
---
 gcc/ada/scng.adb        | 2 +-
 gcc/ada/sem_attr.adb    | 5 +++++
 gcc/ada/sem_attr.ads    | 7 +++++++
 gcc/ada/snames.ads-tmpl | 2 +-
 4 files changed, 14 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb
index e3da051f41b..db326943911 100644
--- a/gcc/ada/scng.adb
+++ b/gcc/ada/scng.adb
@@ -1701,7 +1701,7 @@ package body Scng is
             if Source (Scan_Ptr + 1) = '"' then
                goto Scan_Wide_Character;
 
-            elsif Ada_Version = Ada_2020 then
+            elsif Ada_Version >= Ada_2020 then
                Scan_Ptr := Scan_Ptr + 1;
                Token := Tok_Left_Bracket;
                return;
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 5e6ad38030c..5fef9c27fcf 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -5572,6 +5572,11 @@ package body Sem_Attr is
       when Attribute_Reduce =>
          Check_E2;
 
+         if not Extensions_Allowed then
+            Error_Attr
+              ("% attribute only supported under -gnatX", P);
+         end if;
+
          declare
             Stream : constant Node_Id := Prefix (N);
             Typ    : Entity_Id;
diff --git a/gcc/ada/sem_attr.ads b/gcc/ada/sem_attr.ads
index 16b902e1c72..b118a97ed4a 100644
--- a/gcc/ada/sem_attr.ads
+++ b/gcc/ada/sem_attr.ads
@@ -397,6 +397,13 @@ package Sem_Attr is
       --  as Range applied to the array itself. The result is of type universal
       --  integer.
 
+      ------------
+      -- Reduce --
+      ------------
+
+      Attribute_Reduce => True,
+      --  See AI12-0262-1
+
       ---------
       -- Ref --
       ---------
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 9534bffd935..968f80ef819 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -976,7 +976,7 @@ package Snames is
    Name_Priority                       : constant Name_Id := N + $; -- Ada 05
    Name_Range                          : constant Name_Id := N + $;
    Name_Range_Length                   : constant Name_Id := N + $; -- GNAT
-   Name_Reduce                         : constant Name_Id := N + $;
+   Name_Reduce                         : constant Name_Id := N + $; -- GNAT
    Name_Ref                            : constant Name_Id := N + $; -- GNAT
    Name_Restriction_Set                : constant Name_Id := N + $; -- GNAT
    Name_Result                         : constant Name_Id := N + $; -- GNAT