From patchwork Tue Apr 25 08:57:09 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 754648 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3wBxtZ4ccCz9s85 for ; Tue, 25 Apr 2017 18:57:42 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="hRhroEla"; dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=lpsKiJD2SOVOj4/0z8qCDN4N7368YNIO3LWUpAlKaHVPLxzfHo 58OukDPsq246PDeECYBJnDu2s8IrcrRko77Ah/L2WPGdBqAbuwouqcsJJZw0wYU9 icyj8WLNB6YxH4ooULy8rk4aBfIdy0BFDGFNCHdL1Z5dCoErVeUKcglCI= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=s4600wv2+7mcempwG2HLIIa7h/0=; b=hRhroEla+L9S70fGshng TKLjKGnUeaxtHHmicwI6yM2H0N/WNIsomNhd05w97x3hOP2mzy7GB1lNRLZ3ybUy o9jhhMJIHAuVYboiwLkU558AnkaOCom7JzQon/ZXkOEulhsg64EIcvS1xqeqe8yo Wo0E9G/V8KkMsl0xBPerHXk= Received: (qmail 35023 invoked by alias); 25 Apr 2017 08:57:16 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 34551 invoked by uid 89); 25 Apr 2017 08:57:11 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-10.0 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=danger, Pack, cancel, tasks X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Tue, 25 Apr 2017 08:57:09 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 90EAF3536; Tue, 25 Apr 2017 04:57:09 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id yrSNUpemKhXr; Tue, 25 Apr 2017 04:57:09 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 81094350D; Tue, 25 Apr 2017 04:57:09 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id 7FCFA521; Tue, 25 Apr 2017 04:57:09 -0400 (EDT) Date: Tue, 25 Apr 2017 04:57:09 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Bob Duff Subject: [Ada] pragma Ignore_Pragma(Interface); is illegal Message-ID: <20170425085709.GA47398@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) 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 * 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. 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;