diff mbox

[Ada] pragma Ignore_Pragma(Interface); is illegal

Message ID 20170425085709.GA47398@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet April 25, 2017, 8:57 a.m. UTC
This patch fixes a bug in which pragma Ignore_Pragma(Interface); is illegal,
except in Ada 83 mode. It should be legal in all modes.

The following test should compile quietly.

--  gnat.adc

pragma Ignore_Pragma(Interface);


--  legal_interface.ads

package Legal_Interface is
   procedure Interface_Or_Not;
   pragma Interface (Esperanto, Interface_Or_Not);
   --  The pragma should be ignored, so the body of Interface_Or_Not is legal,
   --  and the fact that Esperanto is not a supported language is irrelevant.
end Legal_Interface;


--  legal_interface.adb

package body Legal_Interface is
   procedure Interface_Or_Not is
   begin
      null;
   end Interface_Or_Not;
end Legal_Interface;

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

2017-04-25  Bob Duff  <duff@adacore.com>

	* par-ch2.adb, scans.ads, scn.adb: Do not give an error for
	reserved words inside pragmas. This is necessary to allow the
	pragma name Interface to be used in pragma Ignore_Pragma.
	* par.adb: Minor comment fix.
diff mbox

Patch

Index: par-ch2.adb
===================================================================
--- par-ch2.adb	(revision 247135)
+++ par-ch2.adb	(working copy)
@@ -268,6 +268,7 @@ 
    --  Start of processing for P_Pragma
 
    begin
+      Inside_Pragma := True;
       Prag_Node := New_Node (N_Pragma, Token_Ptr);
       Scan; -- past PRAGMA
       Prag_Name := Token_Name;
@@ -362,9 +363,10 @@ 
 
       Semicolon_Loc := Token_Ptr;
 
-      --  Cancel indication of being within Depends pragm. Can be done
-      --  unconditionally, since quicker than doing a test.
+      --  Cancel indication of being within a pragma or in particular a Depends
+      --  pragma.
 
+      Inside_Pragma  := False;
       Inside_Depends := False;
 
       --  Now we have two tasks left, we need to scan out the semicolon
@@ -388,12 +390,11 @@ 
          Skip_Pragma_Semicolon;
          return Par.Prag (Prag_Node, Semicolon_Loc);
       end if;
-
    exception
       when Error_Resync =>
          Resync_Past_Semicolon;
+         Inside_Pragma := False;
          return Error;
-
    end P_Pragma;
 
    --  This routine is called if a pragma is encountered in an inappropriate
Index: scans.ads
===================================================================
--- scans.ads	(revision 247135)
+++ scans.ads	(working copy)
@@ -484,9 +484,13 @@ 
    --  Is it really right for this to be a Name rather than a String, what
    --  about the case of Wide_Wide_Characters???
 
+   Inside_Pragma : Boolean := False;
+   --  True within a pragma. Used to avoid complaining about reserved words
+   --  within pragmas (see Scan_Reserved_Identifier).
+
    Inside_Depends : Boolean := False;
-   --  Flag set True for parsing the argument of a Depends pragma or aspect
-   --  (used to allow/require non-standard style rules for =>+ with -gnatyt).
+   --  True while parsing the argument of a Depends pragma or aspect (used to
+   --  allow/require non-standard style rules for =>+ with -gnatyt).
 
    Inside_If_Expression : Nat := 0;
    --  This is a counter that is set non-zero while scanning out an if
Index: par.adb
===================================================================
--- par.adb	(revision 247146)
+++ par.adb	(working copy)
@@ -70,8 +70,8 @@ 
    --  Par.Ch5.Get_Loop_Block_Name).
 
    Inside_Record_Definition : Boolean := False;
-   --  Flag set True within a record definition. Used to control warning
-   --  for redefinition of standard entities (not issued for field names).
+   --  True within a record definition. Used to control warning for
+   --  redefinition of standard entities (not issued for field names).
 
    --------------------
    -- Error Recovery --
Index: scn.adb
===================================================================
--- scn.adb	(revision 247135)
+++ scn.adb	(working copy)
@@ -255,9 +255,7 @@ 
 
       --  Clear flags for reserved words used as identifiers
 
-      for J in Token_Type loop
-         Used_As_Identifier (J) := False;
-      end loop;
+      Used_As_Identifier := (others => False);
    end Initialize_Scanner;
 
    ---------------
@@ -380,8 +378,8 @@ 
    ------------------------------
 
    procedure Scan_Reserved_Identifier (Force_Msg : Boolean) is
-      Token_Chars : constant String := Token_Type'Image (Token);
-
+      Token_Chars : String := Token_Type'Image (Token);
+      Len         : Natural := 0;
    begin
       --  AI12-0125 : '@' denotes the target_name, i.e. serves as an
       --  abbreviation for the LHS of an assignment.
@@ -394,16 +392,24 @@ 
       --  We have in Token_Chars the image of the Token name, i.e. Tok_xxx.
       --  This code extracts the xxx and makes an identifier out of it.
 
-      Name_Len := 0;
-
       for J in 5 .. Token_Chars'Length loop
-         Name_Len := Name_Len + 1;
-         Name_Buffer (Name_Len) := Fold_Lower (Token_Chars (J));
+         Len := Len + 1;
+         Token_Chars (Len) := Fold_Lower (Token_Chars (J));
       end loop;
 
-      Token_Name := Name_Find;
+      Token_Name := Name_Find (Token_Chars (1 .. Len));
 
-      if not Used_As_Identifier (Token) or else Force_Msg then
+      --  If Inside_Pragma is True, we don't give an error. This is to allow
+      --  things like "pragma Ignore_Pragma (Interface)", where "Interface" is
+      --  a reserved word. There is no danger of missing errors, because any
+      --  misuse must have been preceded by an illegal declaration. For
+      --  example, in "pragma Pack (Begin);", either Begin is not declared,
+      --  which is an error, or it is declared, which will be an error on that
+      --  declaration.
+
+      if (not Used_As_Identifier (Token) or else Force_Msg)
+        and then not Inside_Pragma
+      then
          Error_Msg_Name_1 := Token_Name;
          Error_Msg_SC ("reserved word* cannot be used as identifier!");
          Used_As_Identifier (Token) := True;