From: Ghjuvan Lacambre <lacambre@adacore.com>
Date: Wed, 30 Sep 2020 08:50:47 +0000 (+0200)
Subject: [Ada] Implement No_Unrecognized_{Aspects,Pragmas} restrictions
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=7883a610443b1dbde92ad4dc4f6082a5c4b6c799;p=gcc.git

[Ada] Implement No_Unrecognized_{Aspects,Pragmas} restrictions

gcc/ada/

	* libgnat/s-rident.ads (System.Rident): Register new restriction
	IDs.
	* par-ch13.adb (Get_Aspect_Specifications): Add restriction check.
	* par-prag.adb (Process_Restrictions_Or_Restriction_Warnings):
	Register No_Unrecognized_Aspects restriction.
	* sem_prag.adb (Analyze_Pragma): Add restriction check.
	* snames.ads-tmpl: Create restriction names.
---

diff --git a/gcc/ada/libgnat/s-rident.ads b/gcc/ada/libgnat/s-rident.ads
index 662721add9e..c6c3d3dd4ef 100644
--- a/gcc/ada/libgnat/s-rident.ads
+++ b/gcc/ada/libgnat/s-rident.ads
@@ -184,6 +184,8 @@ package System.Rident is
       No_Implicit_Loops,                         -- GNAT
       No_Elaboration_Code,                       -- GNAT
       No_Obsolescent_Features,                   -- Ada 2005 AI-368
+      No_Unrecognized_Aspects,                   -- AI12-0389-1/02
+      No_Unrecognized_Pragmas,                   -- AI12-0389-1/02
       No_Wide_Characters,                        -- GNAT
       Static_Dispatch_Tables,                    -- GNAT
       SPARK_05,                                  -- GNAT
diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb
index 95223a1a354..8bee84086be 100644
--- a/gcc/ada/par-ch13.adb
+++ b/gcc/ada/par-ch13.adb
@@ -23,6 +23,8 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Rident;    use Rident;
+with Restrict; use Restrict;
 pragma Style_Checks (All_Checks);
 --  Turn off subprogram body ordering check. Subprograms are in order
 --  by RM section rather than alphabetical
@@ -264,20 +266,28 @@ package body Ch13 is
          --  The aspect mark is not recognized
 
          if A_Id = No_Aspect then
-            Error_Msg_Warn := not Debug_Flag_2;
-            Error_Msg_N ("<<& is not a valid aspect identifier", Token_Node);
-            OK := False;
-
-            --  Check bad spelling
-
-            for J in Aspect_Id_Exclude_No_Aspect loop
-               if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then
-                  Error_Msg_Name_1 := Aspect_Names (J);
-                  Error_Msg_N -- CODEFIX
-                    ("\<<possible misspelling of%", Token_Node);
-                  exit;
+            declare
+               Msg_Issued : Boolean := False;
+            begin
+               Check_Restriction (Msg_Issued, No_Unrecognized_Aspects, Aspect);
+               if not Msg_Issued then
+                  Error_Msg_Warn := not Debug_Flag_2;
+                  Error_Msg_N
+                    ("<<& is not a valid aspect identifier", Token_Node);
+                  OK := False;
+
+                  --  Check bad spelling
+
+                  for J in Aspect_Id_Exclude_No_Aspect loop
+                     if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then
+                        Error_Msg_Name_1 := Aspect_Names (J);
+                        Error_Msg_N -- CODEFIX
+                          ("\<<possible misspelling of%", Token_Node);
+                        exit;
+                     end if;
+                  end loop;
                end if;
-            end loop;
+            end;
 
             Scan; -- past incorrect identifier
 
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index 5783c33d2db..51409f29dab 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -105,6 +105,9 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
    --    No_Dependence must be processed at parse time, since otherwise it gets
    --    handled too late.
    --
+   --    No_Unrecognized_Aspects must be processed at parse time, since
+   --    unrecognized aspects are ignored by the parser.
+   --
    --  Note that we don't need to do full error checking for badly formed cases
    --  of restrictions, since these will be caught during semantic analysis.
 
@@ -259,6 +262,12 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
                     ("??% restriction is obsolete and ignored, consider " &
                      "using 'S'P'A'R'K_'Mode and gnatprove instead", Arg);
 
+               when Name_No_Unrecognized_Aspects =>
+                  Set_Restriction
+                     (No_Unrecognized_Aspects,
+                      Pragma_Node,
+                      Prag_Id = Pragma_Restriction_Warnings);
+
                when others =>
                   null;
             end case;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index e53a9533f99..b5212017146 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -11364,19 +11364,26 @@ package body Sem_Prag is
       --  Deal with unrecognized pragma
 
       if not Is_Pragma_Name (Pname) then
-         if Warn_On_Unrecognized_Pragma then
-            Error_Msg_Name_1 := Pname;
-            Error_Msg_N ("?g?unrecognized pragma%!", Pragma_Identifier (N));
-
-            for PN in First_Pragma_Name .. Last_Pragma_Name loop
-               if Is_Bad_Spelling_Of (Pname, PN) then
-                  Error_Msg_Name_1 := PN;
-                  Error_Msg_N -- CODEFIX
-                    ("\?g?possible misspelling of %!", Pragma_Identifier (N));
-                  exit;
-               end if;
-            end loop;
-         end if;
+         declare
+            Msg_Issued : Boolean := False;
+         begin
+            Check_Restriction
+              (Msg_Issued, No_Unrecognized_Pragmas, Pragma_Identifier (N));
+            if not Msg_Issued and then Warn_On_Unrecognized_Pragma then
+               Error_Msg_Name_1 := Pname;
+               Error_Msg_N ("?g?unrecognized pragma%!", Pragma_Identifier (N));
+
+               for PN in First_Pragma_Name .. Last_Pragma_Name loop
+                  if Is_Bad_Spelling_Of (Pname, PN) then
+                     Error_Msg_Name_1 := PN;
+                     Error_Msg_N -- CODEFIX
+                       ("\?g?possible misspelling of %!",
+                        Pragma_Identifier (N));
+                     exit;
+                  end if;
+               end loop;
+            end if;
+         end;
 
          return;
       end if;
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index a9fd7c5c9f5..51fc283b056 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -839,6 +839,8 @@ package Snames is
    Name_No_Use_Of_Entity               : constant Name_Id := N + $;
    Name_No_Use_Of_Pragma               : constant Name_Id := N + $;
    Name_No_Unroll                      : constant Name_Id := N + $;
+   Name_No_Unrecognized_Aspects        : constant Name_Id := N + $;
+   Name_No_Unrecognized_Pragmas        : constant Name_Id := N + $;
    Name_No_Vector                      : constant Name_Id := N + $;
    Name_Nominal                        : constant Name_Id := N + $;
    Name_Non_Volatile                   : constant Name_Id := N + $;