[Ada] Implement No_Unrecognized_{Aspects,Pragmas} restrictions
authorGhjuvan Lacambre <lacambre@adacore.com>
Wed, 30 Sep 2020 08:50:47 +0000 (10:50 +0200)
committerPierre-Marie de Rodat <derodat@adacore.com>
Tue, 24 Nov 2020 10:16:04 +0000 (05:16 -0500)
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.

gcc/ada/libgnat/s-rident.ads
gcc/ada/par-ch13.adb
gcc/ada/par-prag.adb
gcc/ada/sem_prag.adb
gcc/ada/snames.ads-tmpl

index 662721add9e251711fd2fe77589d3afb26edc143..c6c3d3dd4ef5862a68ebd293d1987fa16a88d986 100644 (file)
@@ -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
index 95223a1a354d56515462a33491c20773d290ddb9..8bee84086bebebe91692c061ec6710d5d793619d 100644 (file)
@@ -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
 
index 5783c33d2dbdc0765aba5b3a7dca44c1d2176ec5..51409f29dabc7cecc9960df956b3c9fa26c00c52 100644 (file)
@@ -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;
index e53a9533f99b185a800776f9c95459d83407a90d..b5212017146295d9eb3d19da5689e121a10cf4d1 100644 (file)
@@ -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;
index a9fd7c5c9f569e33659524fb9275b50674513184..51fc283b05652ed753cf7a24e493ceaebc7af828 100644 (file)
@@ -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 + $;