diff mbox

[Ada] Implement new pragma Ignore_Pragma

Message ID 20150512081139.GA14513@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet May 12, 2015, 8:11 a.m. UTC
This implements a new configuration pragma Ignore_Pragma (IDENTIFIER)
which causes any subsequent occurrences of pragma IDENTIFIER (...) to
be completely ignored. The following test program compiles as shown:

     1. procedure IgnorePR is
     2. begin
     3.    pragma Ignore_Pragma;
           |
        >>> wrong number of arguments for pragma "Ignore_Pragma"

     4.    pragma Ignore_Pragma ("abc");
                                 |
        >>> incorrect argument for pragma "Ignore_Pragma"

     5.    pragma Ignore_Pragma (Import);
     6.    pragma Import (RUBBISH);
     7. end;

Here lines 3 and 4 have invalid uses of the pragma, properly
flagged, but the junk pragma Import on line 6 is ignored
because of the correctly used Ignore_Pragma on line 5.

Tested on x86_64-pc-linux-gnu, committed on trunk

2015-05-12  Robert Dewar  <dewar@adacore.com>

	* exp_prag.adb (Expand_N_Pragma): Rewrite ignored pragma as
	Null statements.
	* namet.ads (Boolean3): Document this flag used for Ignore_Pragma.
	* par-prag.adb (Prag): Implement Ignore_Pragma.
	* sem_prag.adb: Implement Ignore_Pragma.
	* snames.ads-tmpl: Add entries for pragma Ignore_Pragma.
diff mbox

Patch

Index: exp_prag.adb
===================================================================
--- exp_prag.adb	(revision 223033)
+++ exp_prag.adb	(working copy)
@@ -843,6 +843,15 @@ 
       Pname : constant Name_Id := Pragma_Name (N);
 
    begin
+      --  Rewrite pragma ignored by Ignore_Pragma to null statement, so that/
+      --  back end or the expander here does not get over-enthusiastic and
+      --  start processing such a pragma!
+
+      if Get_Name_Table_Boolean3 (Pname) then
+         Rewrite (N, Make_Null_Statement (Sloc (N)));
+         return;
+      end if;
+
       --  Note: we may have a pragma whose Pragma_Identifier field is not a
       --  recognized pragma, and we must ignore it at this stage.
 
Index: sem_prag.adb
===================================================================
--- sem_prag.adb	(revision 223033)
+++ sem_prag.adb	(working copy)
@@ -9373,6 +9373,12 @@ 
          return;
       end if;
 
+      --  Ignore pragma if Ignore_Pragma applies
+
+      if Get_Name_Table_Boolean3 (Pname) then
+         return;
+      end if;
+
       --  Here to start processing for recognized pragma
 
       Prag_Id := Get_Pragma_Id (Pname);
@@ -14239,6 +14245,17 @@ 
             end;
          end Ident;
 
+         -------------------
+         -- Ignore_Pragma --
+         -------------------
+
+         --  pragma Ignore_Pragma (pragma_IDENTIFIER);
+
+         --  Entirely handled in the parser, nothing to do here
+
+         when Pragma_Ignore_Pragma =>
+            null;
+
          ----------------------------
          -- Implementation_Defined --
          ----------------------------
@@ -25690,6 +25707,7 @@ 
       Pragma_Ghost                          =>  0,
       Pragma_Global                         => -1,
       Pragma_Ident                          => -1,
+      Pragma_Ignore_Pragma                  =>  0,
       Pragma_Implementation_Defined         => -1,
       Pragma_Implemented                    => -1,
       Pragma_Implicit_Packing               =>  0,
Index: par-prag.adb
===================================================================
--- par-prag.adb	(revision 223033)
+++ par-prag.adb	(working copy)
@@ -290,6 +290,12 @@ 
       return Pragma_Node;
    end if;
 
+   --  Ignore pragma previously flagged by Ignore_Pragma
+
+   if Get_Name_Table_Boolean3 (Prag_Name) then
+      return Pragma_Node;
+   end if;
+
    --  Count number of arguments. This loop also checks if any of the arguments
    --  are Error, indicating a syntax error as they were parsed. If so, we
    --  simply return, because we get into trouble with cascaded errors if we
@@ -425,6 +431,28 @@ 
             Ada_Version := Ada_Version_Explicit;
          end if;
 
+      -------------------
+      -- Ignore_Pragma --
+      -------------------
+
+      --  Processing for this pragma must be done at parse time, since we want
+      --  be able to ignore pragmas that are otherwise processed at parse time.
+
+      when Pragma_Ignore_Pragma => Ignore_Pragma : declare
+         A : Node_Id;
+
+      begin
+         Check_Arg_Count (1);
+         Check_No_Identifier (Arg1);
+         A := Expression (Arg1);
+
+         if Nkind (A) /= N_Identifier then
+            Error_Msg ("incorrect argument for pragma %", Sloc (A));
+         else
+            Set_Name_Table_Boolean3 (Chars (A), True);
+         end if;
+      end Ignore_Pragma;
+
       ----------------
       -- List (2.8) --
       ----------------
Index: namet.ads
===================================================================
--- namet.ads	(revision 223033)
+++ namet.ads	(working copy)
@@ -135,7 +135,8 @@ 
 --      Restriction[_Warning]s pragmas for No_Use_Of_Entity. This avoids most
 --      unnecessary searches of the No_Use_Of_Entity table.
 
---      The Boolean3 field is not used
+--      The Boolean3 field is set for names of pragmas that are to be ignored
+--      because of the occurrence of a corresponding pragma Ignore_Pragma.
 
 --    In the binder, we have the following uses:
 
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl	(revision 223033)
+++ snames.ads-tmpl	(working copy)
@@ -401,6 +401,7 @@ 
    --  Fast_Math.
 
    Name_Favor_Top_Level                : constant Name_Id := N + $; -- GNAT
+   Name_Ignore_Pragma                  : constant Name_Id := N + $; -- GNAT
    Name_Implicit_Packing               : constant Name_Id := N + $; -- GNAT
    Name_Initialize_Scalars             : constant Name_Id := N + $; -- GNAT
    Name_Interrupt_State                : constant Name_Id := N + $; -- GNAT
@@ -1749,6 +1750,7 @@ 
       Pragma_Extensions_Allowed,
       Pragma_External_Name_Casing,
       Pragma_Favor_Top_Level,
+      Pragma_Ignore_Pragma,
       Pragma_Implicit_Packing,
       Pragma_Initialize_Scalars,
       Pragma_Interrupt_State,