From 4ccf713e545cc77ba13218c12ec47d21b01bab4e Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 3 Feb 2020 05:22:57 -0500 Subject: [PATCH] [Ada] Support 'Reduce under -gnatX 2020-06-05 Arnaud Charlet 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. --- 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 e3da051..db32694 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 5e6ad38..5fef9c2 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 16b902e..b118a97 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 9534bff..968f80e 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 -- 2.7.4