From patchwork Fri Jan 6 11:56:21 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 711883 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 3tw31S0zLnz9t0X for ; Fri, 6 Jan 2017 22:56:43 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="NWdpMaF0"; 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=bzJ5y4CvnqzCgiAbqEujp+p0r9wkQIpotAyqmqk6pTSi0FyUHD DaqTDWSeYbH+ADlGo1Y8wzD2QlkP/wwMcSzRYg3xeiBFxuL7K7pWHsvw4KpvP6xb udMwIQ7ej1JobOoK1ikINh8+yZo3wKmvG9VXl+NhJ4TB9kr2l+l0s412A= 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=0XnChqPLF1kiPl1nDIEIyqbTXuE=; b=NWdpMaF02YqRpiCoc7Ex rD9WdkZGeU44D4cDea00BD91/SivpFiE8EwWJjLBRVMUhnNkbgzJvzwgIWbjOFTL NtWYt6imcf+yZUsTdX8bAGNgZfsATP65BW2njdPnSGrMpWbFp8VDhVgG6gNGZ+V9 Wx3Vug4hp3Dw19nLkNFGp+k= Received: (qmail 38391 invoked by alias); 6 Jan 2017 11:56:34 -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 38377 invoked by uid 89); 6 Jan 2017 11:56:33 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=4.0 required=5.0 tests=AWL, BAYES_99, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS, T_FILL_THIS_FORM_SHORT autolearn=no version=3.3.2 spammy=Nam, Natural, Specification, elsif 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; Fri, 06 Jan 2017 11:56:23 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id A291A116F5E; Fri, 6 Jan 2017 06:56:21 -0500 (EST) 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 iMoeeESqBwdk; Fri, 6 Jan 2017 06:56:21 -0500 (EST) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 848EE116A2C; Fri, 6 Jan 2017 06:56:21 -0500 (EST) Received: by tron.gnat.com (Postfix, from userid 4192) id 7FC7D41A; Fri, 6 Jan 2017 06:56:21 -0500 (EST) Date: Fri, 6 Jan 2017 06:56:21 -0500 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Bob Duff Subject: [Ada] pragma Rename_Pragma Message-ID: <20170106115621.GA94941@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) This patch implements a new GNAT-specific pragma Rename_Pragma, which is helpful when porting code from other compilers that have similar pragmas but with different names. pragma Rename_Pragma (New_Name => Inline_Only, Renamed => Inline_Always); causes GNAT to treat "pragma Inline_Only ..." as if you had written "pragma Inline_Always ...". The following test must compile quietly: -- gnat.adc: pragma Rename_Pragma (New_Name => Inline_Only, Renamed => Inline_Always); -- rename_pragma.ads: package Rename_Pragma is pragma Pure; procedure P; pragma INLINE_ONLY (P); end Rename_Pragma; -- rename_pragma.adb: package body Rename_Pragma is procedure P is begin null; end; end Rename_Pragma; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-01-06 Bob Duff * snames.ads-tmpl (Renamed): New name for the pragma argument. * par-ch2.adb: Allow the new pragma (with analysis deferred to Sem_Prag). * sinfo.ads, sinfo.adb (Map_Pragma_Name, Pragma_Name_Mapped): Keep a mapping from new pragma names to old names. * sem_prag.adb: Check legality of pragma Rename_Pragma, and implement it by calling Map_Pragma_Name. * checks.adb, contracts.adb, einfo.adb, errout.adb, * exp_attr.adb, exp_ch3.adb, exp_ch6.adb, exp_ch7.adb, exp_ch9.adb, * exp_prag.adb, exp_util.adb, freeze.adb, frontend.adb, ghost.adb, * inline.adb, lib-writ.adb, scans.adb, scans.ads, sem_attr.adb, * sem_aux.adb, sem_ch10.adb, sem_ch13.adb, sem_ch6.adb, sem_ch9.adb, * sem_elab.adb, sem_res.adb, sem_util.adb, sem_util.ads, * sem_warn.adb: Call Pragma_Name_Mapped instead of Pragma_Name as appropriate. Index: checks.adb =================================================================== --- checks.adb (revision 244136) +++ checks.adb (working copy) @@ -2412,8 +2412,7 @@ begin Prag := Make_Pragma (Loc, - Pragma_Identifier => - Make_Identifier (Loc, Prag_Nam), + Chars => Prag_Nam, Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Chars => Name_Check, Index: contracts.adb =================================================================== --- contracts.adb (revision 244124) +++ contracts.adb (working copy) @@ -115,16 +115,14 @@ -- Local variables - Prag_Nam : Name_Id; - - -- Start of processing for Add_Contract_Item - - begin -- A contract must contain only pragmas pragma Assert (Nkind (Prag) = N_Pragma); - Prag_Nam := Pragma_Name (Prag); + Prag_Nam : constant Name_Id := Pragma_Name_Mapped (Prag); + -- Start of processing for Add_Contract_Item + + begin -- Create a new contract when adding the first item if No (Items) then @@ -577,7 +575,7 @@ Prag := Contract_Test_Cases (Items); while Present (Prag) loop - Prag_Nam := Pragma_Name (Prag); + Prag_Nam := Pragma_Name_Mapped (Prag); if Prag_Nam = Name_Contract_Cases then @@ -606,7 +604,7 @@ Prag := Classifications (Items); while Present (Prag) loop - Prag_Nam := Pragma_Name (Prag); + Prag_Nam := Pragma_Name_Mapped (Prag); if Prag_Nam = Name_Depends then Depends := Prag; @@ -1021,7 +1019,7 @@ Prag := Classifications (Items); while Present (Prag) loop - Prag_Nam := Pragma_Name (Prag); + Prag_Nam := Pragma_Name_Mapped (Prag); if Prag_Nam = Name_Initial_Condition then Init_Cond := Prag; @@ -1787,7 +1785,7 @@ if Present (Items) then Prag := Contract_Test_Cases (Items); while Present (Prag) loop - if Pragma_Name (Prag) = Name_Contract_Cases then + if Pragma_Name_Mapped (Prag) = Name_Contract_Cases then Expand_Pragma_Contract_Cases (CCs => Prag, Subp_Id => Subp_Id, @@ -1840,7 +1838,7 @@ if Present (Items) then Prag := Pre_Post_Conditions (Items); while Present (Prag) loop - if Pragma_Name (Prag) = Post_Nam then + if Pragma_Name_Mapped (Prag) = Post_Nam then Append_Enabled_Item (Item => Build_Pragma_Check_Equivalent (Prag), List => Stmts); @@ -1862,7 +1860,7 @@ -- Note that non-matching pragmas are skipped if Nkind (Decl) = N_Pragma then - if Pragma_Name (Decl) = Post_Nam then + if Pragma_Name_Mapped (Decl) = Post_Nam then Append_Enabled_Item (Item => Build_Pragma_Check_Equivalent (Decl), List => Stmts); @@ -1904,7 +1902,7 @@ if Present (Items) then Prag := Pre_Post_Conditions (Items); while Present (Prag) loop - if Pragma_Name (Prag) = Name_Postcondition then + if Pragma_Name_Mapped (Prag) = Name_Postcondition then Append_Enabled_Item (Item => Build_Pragma_Check_Equivalent (Prag), List => Stmts); @@ -1924,7 +1922,7 @@ if Present (Items) then Prag := Pre_Post_Conditions (Items); while Present (Prag) loop - if Pragma_Name (Prag) = Name_Postcondition + if Pragma_Name_Mapped (Prag) = Name_Postcondition and then Class_Present (Prag) then Append_Enabled_Item @@ -2191,7 +2189,7 @@ if Present (Items) then Prag := Pre_Post_Conditions (Items); while Present (Prag) loop - if Pragma_Name (Prag) = Name_Precondition + if Pragma_Name_Mapped (Prag) = Name_Precondition and then Class_Present (Prag) then Check_Prag := @@ -2240,7 +2238,7 @@ if Present (Items) then Prag := Pre_Post_Conditions (Items); while Present (Prag) loop - if Pragma_Name (Prag) = Name_Precondition then + if Pragma_Name_Mapped (Prag) = Name_Precondition then Prepend_To_Decls_Or_Save (Prag); end if; @@ -2265,7 +2263,7 @@ -- Note that non-matching pragmas are skipped if Nkind (Decl) = N_Pragma then - if Pragma_Name (Decl) = Name_Precondition then + if Pragma_Name_Mapped (Decl) = Name_Precondition then Prepend_To_Decls_Or_Save (Decl); end if; Index: einfo.adb =================================================================== --- einfo.adb (revision 244138) +++ einfo.adb (working copy) @@ -7419,7 +7419,7 @@ Ritem := First_Rep_Item (Id); while Present (Ritem) loop if Nkind (Ritem) = N_Pragma - and then Pragma_Name (Ritem) = Name_Attach_Handler + and then Pragma_Name_Mapped (Ritem) = Name_Attach_Handler then return True; else @@ -7480,7 +7480,7 @@ Ritem := First_Rep_Item (Id); while Present (Ritem) loop if Nkind (Ritem) = N_Pragma - and then Pragma_Name (Ritem) = Name_Interrupt_Handler + and then Pragma_Name_Mapped (Ritem) = Name_Interrupt_Handler then return True; else Index: errout.adb =================================================================== --- errout.adb (revision 244133) +++ errout.adb (working copy) @@ -2800,7 +2800,7 @@ -- identifiers, pragmas, and pragma argument associations. if Nkind (Node) = N_Pragma then - Nam := Pragma_Name (Node); + Nam := Pragma_Name_Mapped (Node); Loc := Sloc (Node); -- The other cases have Chars fields Index: exp_attr.adb =================================================================== --- exp_attr.adb (revision 244135) +++ exp_attr.adb (working copy) @@ -8100,7 +8100,7 @@ N := First_Rep_Item (Implementation_Base_Type (T)); while Present (N) loop if Nkind (N) = N_Pragma - and then Pragma_Name (N) = Name_Stream_Convert + and then Pragma_Name_Mapped (N) = Name_Stream_Convert then -- For tagged types this pragma is not inherited, so we -- must verify that it is defined for the given type and Index: exp_ch3.adb =================================================================== --- exp_ch3.adb (revision 244124) +++ exp_ch3.adb (working copy) @@ -2758,7 +2758,7 @@ -- Conversion for Priority expression if Nam = Name_Priority then - if Pragma_Name (Ritem) = Name_Priority + if Pragma_Name_Mapped (Ritem) = Name_Priority and then not GNAT_Mode then Exp := Convert_To (RTE (RE_Priority), Exp); Index: exp_ch6.adb =================================================================== --- exp_ch6.adb (revision 244139) +++ exp_ch6.adb (working copy) @@ -5618,7 +5618,7 @@ elsif Present (Next (N)) and then Nkind (Next (N)) = N_Pragma - and then Get_Pragma_Id (Pragma_Name (Next (N))) = Pragma_Import + and then Get_Pragma_Id (Next (N)) = Pragma_Import then -- In SPARK, subprogram declarations are also permitted in -- declarative parts when immediately followed by a corresponding Index: exp_ch7.adb =================================================================== --- exp_ch7.adb (revision 244124) +++ exp_ch7.adb (working copy) @@ -4358,8 +4358,7 @@ Create_Append (Checks, Make_Pragma (Ploc, - Pragma_Identifier => - Make_Identifier (Ploc, Name_Check), + Chars => Name_Check, Pragma_Argument_Associations => Assoc)); end if; @@ -4392,7 +4391,7 @@ Rep_Item := First_Rep_Item (T); while Present (Rep_Item) loop if Nkind (Rep_Item) = N_Pragma - and then Pragma_Name (Rep_Item) = Name_Invariant + and then Pragma_Name_Mapped (Rep_Item) = Name_Invariant then -- Stop the traversal of the rep item chain once a specific -- item is encountered. Index: exp_ch9.adb =================================================================== --- exp_ch9.adb (revision 244143) +++ exp_ch9.adb (working copy) @@ -1416,7 +1416,7 @@ Prag := Contract_Test_Cases (Items); while Present (Prag) loop - if Pragma_Name (Prag) = Name_Contract_Cases + if Pragma_Name_Mapped (Prag) = Name_Contract_Cases and then Is_Checked (Prag) then Has_Pragma := True; @@ -9142,7 +9142,7 @@ Ritem := First_Rep_Item (Prot_Typ); while Present (Ritem) loop if Nkind (Ritem) = N_Pragma - and then Pragma_Name (Ritem) = Name_Attach_Handler + and then Pragma_Name_Mapped (Ritem) = Name_Attach_Handler then Num_Attach_Handler := Num_Attach_Handler + 1; end if; @@ -11682,7 +11682,7 @@ N := First (Visible_Declarations (T)); while Present (N) loop if Nkind (N) = N_Pragma - and then Pragma_Name (N) = Name_Relative_Deadline + and then Pragma_Name_Mapped (N) = Name_Relative_Deadline then return N; end if; @@ -11693,7 +11693,7 @@ N := First (Private_Declarations (T)); while Present (N) loop if Nkind (N) = N_Pragma - and then Pragma_Name (N) = Name_Relative_Deadline + and then Pragma_Name_Mapped (N) = Name_Relative_Deadline then return N; end if; @@ -13706,7 +13706,7 @@ -- Get_Rep_Item returns either priority pragma. - if Pragma_Name (Prio_Clause) = Name_Priority then + if Pragma_Name_Mapped (Prio_Clause) = Name_Priority then Prio_Type := RTE (RE_Any_Priority); else Prio_Type := RTE (RE_Interrupt_Priority); @@ -13940,7 +13940,7 @@ while Present (Ritem) loop if Nkind (Ritem) = N_Pragma - and then Pragma_Name (Ritem) = Name_Attach_Handler + and then Pragma_Name_Mapped (Ritem) = Name_Attach_Handler then declare Handler : constant Node_Id := Index: exp_prag.adb =================================================================== --- exp_prag.adb (revision 244124) +++ exp_prag.adb (working copy) @@ -162,7 +162,7 @@ --------------------- procedure Expand_N_Pragma (N : Node_Id) is - Pname : constant Name_Id := Pragma_Name (N); + Pname : constant Name_Id := Pragma_Name_Mapped (N); begin -- Rewrite pragma ignored by Ignore_Pragma to null statement, so that @@ -174,53 +174,49 @@ 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. + case Get_Pragma_Id (Pname) is - if Is_Pragma_Name (Pname) then - case Get_Pragma_Id (Pname) is + -- Pragmas requiring special expander action - -- Pragmas requiring special expander action + when Pragma_Abort_Defer => + Expand_Pragma_Abort_Defer (N); - when Pragma_Abort_Defer => - Expand_Pragma_Abort_Defer (N); + when Pragma_Check => + Expand_Pragma_Check (N); - when Pragma_Check => - Expand_Pragma_Check (N); + when Pragma_Common_Object => + Expand_Pragma_Common_Object (N); - when Pragma_Common_Object => - Expand_Pragma_Common_Object (N); + when Pragma_Import => + Expand_Pragma_Import_Or_Interface (N); - when Pragma_Import => - Expand_Pragma_Import_Or_Interface (N); + when Pragma_Inspection_Point => + Expand_Pragma_Inspection_Point (N); - when Pragma_Inspection_Point => - Expand_Pragma_Inspection_Point (N); + when Pragma_Interface => + Expand_Pragma_Import_Or_Interface (N); - when Pragma_Interface => - Expand_Pragma_Import_Or_Interface (N); + when Pragma_Interrupt_Priority => + Expand_Pragma_Interrupt_Priority (N); - when Pragma_Interrupt_Priority => - Expand_Pragma_Interrupt_Priority (N); + when Pragma_Loop_Variant => + Expand_Pragma_Loop_Variant (N); - when Pragma_Loop_Variant => - Expand_Pragma_Loop_Variant (N); + when Pragma_Psect_Object => + Expand_Pragma_Psect_Object (N); - when Pragma_Psect_Object => - Expand_Pragma_Psect_Object (N); + when Pragma_Relative_Deadline => + Expand_Pragma_Relative_Deadline (N); - when Pragma_Relative_Deadline => - Expand_Pragma_Relative_Deadline (N); + when Pragma_Suppress_Initialization => + Expand_Pragma_Suppress_Initialization (N); - when Pragma_Suppress_Initialization => - Expand_Pragma_Suppress_Initialization (N); + -- All other pragmas need no expander action (includes + -- Unknown_Pragma). - -- All other pragmas need no expander action + when others => null; + end case; - when others => null; - end case; - end if; - end Expand_N_Pragma; ------------------------------- @@ -1292,7 +1288,7 @@ if Relaxed_RM_Semantics and then List_Length (Pragma_Argument_Associations (N)) = 2 - and then Chars (Pragma_Identifier (N)) = Name_Import + and then Pragma_Name_Mapped (N) = Name_Import and then Nkind (Arg2 (N)) = N_String_Literal then Def_Id := Entity (Arg1 (N)); Index: exp_util.adb =================================================================== --- exp_util.adb (revision 244131) +++ exp_util.adb (working copy) @@ -3901,7 +3901,7 @@ begin if Nkind (N) = N_Pragma - and then Get_Pragma_Id (Pragma_Name (N)) = Pragma_Annotate + and then Get_Pragma_Id (N) = Pragma_Annotate and then List_Length (Pragma_Argument_Associations (N)) = 2 then declare @@ -6856,7 +6856,7 @@ return Make_Pragma (Loc, - Pragma_Identifier => Make_Identifier (Loc, Name_Check), + Chars => Name_Check, Pragma_Argument_Associations => Arg_List); end Make_Predicate_Check; Index: freeze.adb =================================================================== --- freeze.adb (revision 244124) +++ freeze.adb (working copy) @@ -8464,7 +8464,7 @@ if Present (Decl) and then Nkind (Decl) = N_Pragma - and then Pragma_Name (Decl) = Name_Import + and then Pragma_Name_Mapped (Decl) = Name_Import then return; end if; Index: frontend.adb =================================================================== --- frontend.adb (revision 244124) +++ frontend.adb (working copy) @@ -492,7 +492,7 @@ Item := First (Context_Items (Cunit (Main_Unit))); while Present (Item) loop if Nkind (Item) = N_Pragma - and then Pragma_Name (Item) = Name_Initialize_Scalars + and then Pragma_Name_Mapped (Item) = Name_Initialize_Scalars then Initialize_Scalars := True; end if; Index: ghost.adb =================================================================== --- ghost.adb (revision 244129) +++ ghost.adb (working copy) @@ -992,7 +992,7 @@ while Present (Decl) loop if Nkind (Decl) = N_Pragma - and then Pragma_Name (Decl) = Name_Ghost + and then Pragma_Name_Mapped (Decl) = Name_Ghost then return Enables_Ghostness (First (Pragma_Argument_Associations (Decl))); Index: inline.adb =================================================================== --- inline.adb (revision 244124) +++ inline.adb (working copy) @@ -2541,7 +2541,7 @@ -- not be posting warnings on the inlined body so it is unneeded. elsif Nkind (N) = N_Pragma - and then Pragma_Name (N) = Name_Unreferenced + and then Pragma_Name_Mapped (N) = Name_Unreferenced then Rewrite (N, Make_Null_Statement (Sloc (N))); return OK; Index: lib-writ.adb =================================================================== --- lib-writ.adb (revision 244124) +++ lib-writ.adb (working copy) @@ -672,7 +672,7 @@ Write_Info_Initiate ('N'); Write_Info_Char (' '); - case Chars (Pragma_Identifier (N)) is + case Pragma_Name (N) is when Name_Annotate => C := 'A'; when Name_Comment => Index: par-ch2.adb =================================================================== --- par-ch2.adb (revision 244124) +++ par-ch2.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -279,12 +279,10 @@ -- Ada 2005 (AI-284): INTERFACE is a new reserved word but it is -- allowed as a pragma name. - if Ada_Version >= Ada_2005 - and then Token = Tok_Interface - then - Prag_Name := Name_Interface; - Ident_Node := Make_Identifier (Token_Ptr, Name_Interface); - Scan; -- past INTERFACE + if Is_Reserved_Keyword (Token) then + Prag_Name := Keyword_Name (Token); + Ident_Node := Make_Identifier (Token_Ptr, Prag_Name); + Scan; -- past the keyword else Ident_Node := P_Identifier; end if; @@ -490,8 +488,8 @@ Reserved_Words_OK : Boolean := False) is function P_Expression_Or_Reserved_Word return Node_Id; - -- Parse an expression or, if the token denotes one of the following - -- reserved words, construct an identifier with proper Chars field. + -- Parse an expression or, if the token is one of the following reserved + -- words, construct an identifier with proper Chars field. -- Access -- Delta -- Digits Index: scans.adb =================================================================== --- scans.adb (revision 244124) +++ scans.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -143,6 +143,29 @@ end Initialize_Ada_Keywords; + ------------------ + -- Keyword_Name -- + ------------------ + + function Keyword_Name (Token : Token_Type) return Name_Id is + Tok : String := Token'Img; + pragma Assert (Tok (1 .. 4) = "TOK_"); + Name : String renames Tok (5 .. Tok'Last); + begin + -- Convert to lower case. We don't want to add a dependence on a + -- general-purpose To_Lower routine, so we convert "by hand" here. + -- All keywords use 7-bit ASCII letters only, so this works. + + for J in Name'Range loop + pragma Assert (Name (J) in 'A' .. 'Z'); + Name (J) := + Character'Val (Character'Pos (Name (J)) + + (Character'Pos ('a') - Character'Pos ('A'))); + end loop; + + return Name_Find (Name); + end Keyword_Name; + ------------------------ -- Restore_Scan_State -- ------------------------ Index: scans.ads =================================================================== --- scans.ads (revision 244124) +++ scans.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -45,10 +45,6 @@ -- The class column in this table indicates the token classes which -- apply to the token, as defined by subsequent subtype declarations. - -- Note: Namet.Is_Keyword_Name depends on the fact that the first entry in - -- this type declaration is *not* for a reserved word. For details on why - -- there is this requirement, see Initialize_Ada_Keywords below. - type Token_Type is ( -- Token name Token type Class(es) @@ -228,6 +224,11 @@ -- No_Token is used for initializing Token values to indicate that -- no value has been set yet. + function Keyword_Name (Token : Token_Type) return Name_Id; + -- Given a token that is a reserved word, return the corresponding Name_Id + -- in lower case. E.g. Keyword_Name (Tok_Begin) = Name_Find ("begin"). + -- It is an error to pass any other kind of token. + -- Note: in the RM, operator symbol is a special case of string literal. -- We distinguish at the lexical level in this compiler, since there are -- many syntactic situations in which only an operator symbol is allowed. Index: sem_attr.adb =================================================================== --- sem_attr.adb (revision 244140) +++ sem_attr.adb (working copy) @@ -1306,7 +1306,7 @@ if Nkind (Prag) = N_Aspect_Specification then Prag_Nam := Chars (Identifier (Prag)); else - Prag_Nam := Pragma_Name (Prag); + Prag_Nam := Pragma_Name_Mapped (Prag); end if; if Prag_Nam = Name_Check then Index: sem_aux.adb =================================================================== --- sem_aux.adb (revision 244124) +++ sem_aux.adb (working copy) @@ -512,9 +512,10 @@ and then (Pragma_Name (N) = Nam or else (Nam = Name_Priority - and then Pragma_Name (N) = Name_Interrupt_Priority) + and then Pragma_Name_Mapped (N) = + Name_Interrupt_Priority) or else (Nam = Name_Interrupt_Priority - and then Pragma_Name (N) = Name_Priority)) + and then Pragma_Name_Mapped (N) = Name_Priority)) then if Check_Parents then return N; Index: sem_ch10.adb =================================================================== --- sem_ch10.adb (revision 244129) +++ sem_ch10.adb (working copy) @@ -1332,7 +1332,7 @@ Item := First (Context_Items (N)); while Present (Item) and then Nkind (Item) = N_Pragma - and then Pragma_Name (Item) in Configuration_Pragma_Names + and then Pragma_Name_Mapped (Item) in Configuration_Pragma_Names loop Analyze (Item); Next (Item); @@ -3384,7 +3384,7 @@ Item := First (Context_Items (N)); while Present (Item) and then Nkind (Item) = N_Pragma - and then Pragma_Name (Item) in Configuration_Pragma_Names + and then Pragma_Name_Mapped (Item) in Configuration_Pragma_Names loop Next (Item); end loop; @@ -4526,7 +4526,7 @@ Check_Declarations (Specification (Decl)); elsif Nkind (Decl) = N_Pragma - and then Pragma_Name (Decl) = Name_Import + and then Pragma_Name_Mapped (Decl) = Name_Import then Check_Pragma_Import (Decl); end if; @@ -4558,7 +4558,7 @@ Append_Elmt (Decl, Incomplete_Decls); elsif Nkind (Decl) = N_Pragma - and then Pragma_Name (Decl) = Name_Import + and then Pragma_Name_Mapped (Decl) = Name_Import then Check_Pragma_Import (Decl); end if; @@ -5826,7 +5826,7 @@ Decl := First (Decls); while Present (Decl) and then Nkind (Decl) = N_Pragma loop - if Pragma_Name (Decl) = Name_Abstract_State then + if Pragma_Name_Mapped (Decl) = Name_Abstract_State then Process_State (Get_Pragma_Arg (First (Pragma_Argument_Associations (Decl)))); Index: sem_ch13.adb =================================================================== --- sem_ch13.adb (revision 244126) +++ sem_ch13.adb (working copy) @@ -6868,7 +6868,7 @@ -- The only pragma of interest is Complete_Representation - if Pragma_Name (CC) = Name_Complete_Representation then + if Pragma_Name_Mapped (CC) = Name_Complete_Representation then CR_Pragma := CC; end if; @@ -8406,7 +8406,7 @@ Ritem := First_Rep_Item (Typ); while Present (Ritem) loop if Nkind (Ritem) = N_Pragma - and then Pragma_Name (Ritem) = Name_Predicate + and then Pragma_Name_Mapped (Ritem) = Name_Predicate then Add_Predicate (Ritem); @@ -8424,7 +8424,7 @@ begin if Nkind (Prag) = N_Pragma - and then Pragma_Name (Prag) = Name_Predicate + and then Pragma_Name_Mapped (Prag) = Name_Predicate then Add_Predicate (Prag); end if; @@ -12367,7 +12367,7 @@ if Is_Overloadable (T) and then Nkind (N) = N_Pragma then declare - Pname : constant Name_Id := Pragma_Name (N); + Pname : constant Name_Id := Pragma_Name_Mapped (N); begin if Nam_In (Pname, Name_Convention, Name_Import, Name_Export, Name_External, Name_Interface) @@ -13560,7 +13560,7 @@ procedure No_Independence is begin - if Pragma_Name (N) = Name_Independent then + if Pragma_Name_Mapped (N) = Name_Independent then Error_Msg_NE ("independence cannot be guaranteed for&", N, E); else Error_Msg_NE @@ -13691,7 +13691,7 @@ for J in Independence_Checks.First .. Independence_Checks.Last loop N := Independence_Checks.Table (J).N; E := Independence_Checks.Table (J).E; - IC := Pragma_Name (N) = Name_Independent_Components; + IC := Pragma_Name_Mapped (N) = Name_Independent_Components; -- Deal with component case Index: sem_ch6.adb =================================================================== --- sem_ch6.adb (revision 244140) +++ sem_ch6.adb (working copy) @@ -2692,7 +2692,7 @@ Analyze (Prag); Set_Has_Pragma_Inline (Subp); - if Pragma_Name (Prag) = Name_Inline_Always then + if Pragma_Name_Mapped (Prag) = Name_Inline_Always then Set_Is_Inlined (Subp); Set_Has_Pragma_Inline_Always (Subp); end if; @@ -6064,7 +6064,7 @@ begin if Nkind (Orig) = N_Pragma - and then Pragma_Name (Orig) = Name_Assert + and then Pragma_Name_Mapped (Orig) = Name_Assert and then not Error_Posted (Orig) then declare @@ -9301,7 +9301,7 @@ if Class_Present (Prag) and then not Split_PPC (Prag) then - if Pragma_Name (Prag) = Name_Precondition then + if Pragma_Name_Mapped (Prag) = Name_Precondition then Error_Msg_N ("info: & inherits `Pre''Class` aspect from " & "#?L?", E); Index: sem_ch9.adb =================================================================== --- sem_ch9.adb (revision 244124) +++ sem_ch9.adb (working copy) @@ -498,9 +498,10 @@ elsif Kind = N_Pragma then declare - Prag_Name : constant Name_Id := Pragma_Name (N); + Prag_Name : constant Name_Id := + Pragma_Name_Mapped (N); Prag_Id : constant Pragma_Id := - Get_Pragma_Id (Prag_Name); + Get_Pragma_Id (Prag_Name); begin if Prag_Id = Pragma_Export @@ -2148,7 +2149,7 @@ -- Pragma case else - Error_Msg_Name_1 := Pragma_Name (Prio_Item); + Error_Msg_Name_1 := Pragma_Name_Mapped (Prio_Item); Error_Msg_NE ("pragma% for & has no effect when Lock_Free given??", Prio_Item, Id); @@ -2188,7 +2189,7 @@ -- Pragma case elsif Nkind (Prio_Item) = N_Pragma - and then Pragma_Name (Prio_Item) = Name_Priority + and then Pragma_Name_Mapped (Prio_Item) = Name_Priority then Error_Msg_N ("pragma Interrupt_Priority is preferred in presence of " Index: sem_elab.adb =================================================================== --- sem_elab.adb (revision 244125) +++ sem_elab.adb (working copy) @@ -2099,7 +2099,7 @@ Par := Call; while Present (Par) loop if Nkind (Par) = N_Pragma then - Nam := Pragma_Name (Par); + Nam := Pragma_Name_Mapped (Par); -- Pragma Initial_Condition appears in its alternative from as -- Check (Initial_Condition, ...). @@ -2485,7 +2485,7 @@ -- Or, in the case of an initial condition, specifically by a -- Check pragma specifying an Initial_Condition check. - elsif Pragma_Name (O) = Name_Check + elsif Pragma_Name_Mapped (O) = Name_Check and then Chars (Expression (First (Pragma_Argument_Associations (O)))) = @@ -3716,7 +3716,7 @@ Item := First (Context_Items (CU)); while Present (Item) loop if Nkind (Item) = N_Pragma - and then Pragma_Name (Item) = Name_Elaborate_All + and then Pragma_Name_Mapped (Item) = Name_Elaborate_All then -- Return if some previous error on the pragma itself. The -- pragma may be unanalyzed, because of a previous error, or Index: sem_prag.adb =================================================================== --- sem_prag.adb (revision 244140) +++ sem_prag.adb (working copy) @@ -2006,7 +2006,7 @@ return; end if; - Error_Msg_Name_1 := Pragma_Name (N); + Error_Msg_Name_1 := Pragma_Name_Mapped (N); -- An external property pragma must apply to an effectively volatile -- object other than a formal subprogram parameter (SPARK RM 7.1.3(2)). @@ -5289,7 +5289,7 @@ -- previously given aspect specification or attribute definition -- clause for the same pragma. - P := Get_Rep_Item (E, Pragma_Name (N), Check_Parents => False); + P := Get_Rep_Item (E, Pragma_Name_Mapped (N), Check_Parents => False); if Present (P) then @@ -5322,7 +5322,7 @@ -- Here we have a definite duplicate - Error_Msg_Name_1 := Pragma_Name (N); + Error_Msg_Name_1 := Pragma_Name_Mapped (N); Error_Msg_Sloc := Sloc (P); -- For a single protected or a single task object, the error is @@ -6496,7 +6496,7 @@ if Is_Rewrite_Substitution (N) and then Nkind (Original_Node (N)) = N_Pragma then - Error_Msg_Name_1 := Pragma_Name (Original_Node (N)); + Error_Msg_Name_1 := Pragma_Name_Mapped (Original_Node (N)); end if; -- Case where pragma comes from an aspect specification @@ -7212,7 +7212,7 @@ if Nam_In (Pragma_Name (Decl), Name_Export, Name_Convention, - Pragma_Name (N)) + Pragma_Name_Mapped (N)) then exit; @@ -10381,7 +10381,7 @@ -- Deal with unrecognized pragma - Pname := Pragma_Name (N); + Pname := Pragma_Name_Mapped (N); if not Is_Pragma_Name (Pname) then if Warn_On_Unrecognized_Pragma then @@ -13800,7 +13800,7 @@ -- Skip prior pragmas, but check for duplicates if Nkind (Stmt) = N_Pragma then - if Pragma_Name (Stmt) = Pname then + if Pragma_Name_Mapped (Stmt) = Pname then Error_Msg_Name_1 := Pname; Error_Msg_Sloc := Sloc (Stmt); Error_Msg_N ("pragma % duplicates pragma declared#", N); @@ -15290,7 +15290,7 @@ -- Skip prior pragmas, but check for duplicates if Nkind (Stmt) = N_Pragma then - if Pragma_Name (Stmt) = Pname then + if Pragma_Name_Mapped (Stmt) = Pname then Error_Msg_Name_1 := Pname; Error_Msg_Sloc := Sloc (Stmt); Error_Msg_N ("pragma % duplicates pragma declared#", N); @@ -16564,7 +16564,7 @@ if Is_Imported (Def_Id) and then Present (First_Rep_Item (Def_Id)) and then Nkind (First_Rep_Item (Def_Id)) = N_Pragma - and then Pragma_Name (First_Rep_Item (Def_Id)) = + and then Pragma_Name_Mapped (First_Rep_Item (Def_Id)) = Name_Interface then null; @@ -17604,7 +17604,7 @@ Nod := Next (N); while Present (Nod) loop if Nkind (Nod) = N_Pragma - and then Pragma_Name (Nod) = Name_Main + and then Pragma_Name_Mapped (Nod) = Name_Main then Error_Msg_Name_1 := Pname; Error_Msg_N ("duplicate pragma% not permitted", Nod); @@ -17648,7 +17648,7 @@ Nod := Next (N); while Present (Nod) loop if Nkind (Nod) = N_Pragma - and then Pragma_Name (Nod) = Name_Main_Storage + and then Pragma_Name_Mapped (Nod) = Name_Main_Storage then Error_Msg_Name_1 := Pname; Error_Msg_N ("duplicate pragma% not permitted", Nod); @@ -19040,20 +19040,40 @@ -- pragma Rename_Pragma ( -- [New_Name =>] IDENTIFIER, - -- [Renames =>] pragma_IDENTIFIER); + -- [Renamed =>] pragma_IDENTIFIER); - -- ??? this is work in progress - pragma Warnings (Off); when Pragma_Rename_Pragma => Rename_Pragma : declare - GNAT_Pragma_Arg : constant Node_Id := Get_Pragma_Arg (Arg2); - Synonym : constant Node_Id := Get_Pragma_Arg (Arg1); - + New_Name : constant Node_Id := Get_Pragma_Arg (Arg1); + Old_Name : constant Node_Id := Get_Pragma_Arg (Arg2); begin GNAT_Pragma; + Check_Valid_Configuration_Pragma; Check_Arg_Count (2); Check_Optional_Identifier (Arg1, Name_New_Name); - Check_Optional_Identifier (Arg2, Name_Renames); + Check_Optional_Identifier (Arg2, Name_Renamed); + + if Nkind (New_Name) /= N_Identifier then + Error_Pragma_Arg ("identifier expected", Arg1); + end if; + + if Nkind (Old_Name) /= N_Identifier then + Error_Pragma_Arg ("identifier expected", Arg2); + end if; + + -- The New_Name arg should not be an existing pragma (but we allow + -- it; it's just a warning). The Old_Name arg must be an existing + -- pragma. + + if Is_Pragma_Name (Chars (New_Name)) then + Error_Pragma_Arg ("??pragma is already defined", Arg1); + end if; + + if not Is_Pragma_Name (Chars (Old_Name)) then + Error_Pragma_Arg ("existing pragma name expected", Arg1); + end if; + + Map_Pragma_Name (From => Chars (New_Name), To => Chars (Old_Name)); end Rename_Pragma; pragma Warnings (On); @@ -19694,7 +19714,7 @@ Import := Make_Pragma (Loc, - Chars => Name_Import, + Chars => Name_Import, Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Make_Identifier (Loc, Name_Intrinsic)), @@ -21357,7 +21377,7 @@ -- this also takes care of pragmas generated for aspects. if Nkind (Stmt) = N_Pragma then - if Pragma_Name (Stmt) = Pname then + if Pragma_Name_Mapped (Stmt) = Pname then Error_Msg_Name_1 := Pname; Error_Msg_Sloc := Sloc (Stmt); Error_Msg_N ("pragma% duplicates pragma declared#", N); @@ -22207,7 +22227,7 @@ if Present (Items) then Prag := Contract_Test_Cases (Items); while Present (Prag) loop - if Pragma_Name (Prag) = Name_Test_Case + if Pragma_Name_Mapped (Prag) = Name_Test_Case and then Prag /= N and then String_Equal (Name, Get_Name_From_CTC_Pragma (Prag)) @@ -22437,7 +22457,7 @@ Nod := Next (N); while Present (Nod) loop if Nkind (Nod) = N_Pragma - and then Pragma_Name (Nod) = Name_Time_Slice + and then Pragma_Name_Mapped (Nod) = Name_Time_Slice then Error_Msg_Name_1 := Pname; Error_Msg_N ("duplicate pragma% not permitted", Nod); @@ -26928,7 +26948,7 @@ -- Local variables Loc : constant Source_Ptr := Sloc (Prag); - Prag_Nam : constant Name_Id := Pragma_Name (Prag); + Prag_Nam : constant Name_Id := Pragma_Name_Mapped (Prag); Check_Prag : Node_Id; Msg_Arg : Node_Id; Nam : Name_Id; @@ -27964,7 +27984,9 @@ -- Skip prior pragmas, but check for duplicates if Nkind (Stmt) = N_Pragma then - if Do_Checks and then Pragma_Name (Stmt) = Pragma_Name (Prag) then + if Do_Checks + and then Pragma_Name_Mapped (Stmt) = Pragma_Name_Mapped (Prag) + then Duplication_Error (Prag => Prag, Prev => Stmt); @@ -28171,7 +28193,7 @@ Do_Checks : Boolean := False) return Node_Id is Context : constant Node_Id := Parent (Prag); - Prag_Nam : constant Name_Id := Pragma_Name (Prag); + Prag_Nam : constant Name_Id := Pragma_Name_Mapped (Prag); Stmt : Node_Id; begin @@ -28181,7 +28203,7 @@ -- Skip prior pragmas, but check for duplicates if Nkind (Stmt) = N_Pragma then - if Do_Checks and then Pragma_Name (Stmt) = Prag_Nam then + if Do_Checks and then Pragma_Name_Mapped (Stmt) = Prag_Nam then Duplication_Error (Prag => Prag, Prev => Stmt); @@ -28558,7 +28580,7 @@ begin pragma Assert (Nkind (N) = N_Pragma - and then Pragma_Name (N) = Name_SPARK_Mode + and then Pragma_Name_Mapped (N) = Name_SPARK_Mode and then Is_List_Member (N)); -- Pragma SPARK_Mode affects the elaboration of a package body when it @@ -28930,7 +28952,7 @@ function Is_Pragma_String_Literal (Par : Node_Id) return Boolean is Pragn : constant Node_Id := Parent (Par); Assoc : constant List_Id := Pragma_Argument_Associations (Pragn); - Pname : constant Name_Id := Pragma_Name (Pragn); + Pname : constant Name_Id := Pragma_Name_Mapped (Pragn); Argn : Natural; N : Node_Id; @@ -28992,7 +29014,7 @@ begin pragma Assert (Nkind (N) = N_Pragma - and then Pragma_Name (N) = Name_SPARK_Mode + and then Pragma_Name_Mapped (N) = Name_SPARK_Mode and then Is_List_Member (N)); -- For pragma SPARK_Mode to be private, it has to appear in the private Index: sem_res.adb =================================================================== --- sem_res.adb (revision 244140) +++ sem_res.adb (working copy) @@ -10018,7 +10018,7 @@ -- Special handling of Asssert pragma if Nkind (Orig) = N_Pragma - and then Pragma_Name (Orig) = Name_Assert + and then Pragma_Name_Mapped (Orig) = Name_Assert then declare Expr : constant Node_Id := @@ -10059,7 +10059,7 @@ -- Similar processing for Check pragma elsif Nkind (Orig) = N_Pragma - and then Pragma_Name (Orig) = Name_Check + and then Pragma_Name_Mapped (Orig) = Name_Check then -- Don't want to warn if original condition is explicit False Index: sem_util.adb =================================================================== --- sem_util.adb (revision 244129) +++ sem_util.adb (working copy) @@ -1319,9 +1319,7 @@ Stmt := Make_Pragma (Loc, - Pragma_Identifier => - Make_Identifier (Loc, Name_Check), - + Chars => Name_Check, Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => @@ -2025,7 +2023,7 @@ Par := Parent (Ref); while Present (Par) loop if Nkind (Par) = N_Pragma then - Prag_Nam := Pragma_Name (Par); + Prag_Nam := Pragma_Name_Mapped (Par); -- A concurrent constituent is allowed to appear in pragmas -- Initial_Condition and Initializes as this is part of the @@ -3417,12 +3415,12 @@ Check_Function_Result (Expr); if not Mentions_Post_State (Expr) then - if Pragma_Name (Prag) = Name_Contract_Cases then + if Pragma_Name_Mapped (Prag) = Name_Contract_Cases then Error_Msg_NE ("contract case does not check the outcome of calling " & "&?T?", Expr, Subp_Id); - elsif Pragma_Name (Prag) = Name_Refined_Post then + elsif Pragma_Name_Mapped (Prag) = Name_Refined_Post then Error_Msg_NE ("refined postcondition does not check the outcome of " & "calling &?T?", Prag, Subp_Id); @@ -3534,7 +3532,7 @@ Expr : constant Node_Id := Get_Pragma_Arg (First (Pragma_Argument_Associations (Prag))); - Nam : constant Name_Id := Pragma_Name (Prag); + Nam : constant Name_Id := Pragma_Name_Mapped (Prag); CCase : Node_Id; -- Start of processing for Check_Result_And_Post_State_In_Pragma @@ -3643,7 +3641,7 @@ Prag := Contract_Test_Cases (Items); while Present (Prag) loop - if Pragma_Name (Prag) = Name_Contract_Cases + if Pragma_Name_Mapped (Prag) = Name_Contract_Cases and then not Error_Posted (Prag) then Case_Prag := Prag; @@ -5172,7 +5170,7 @@ Arg : constant Node_Id := Get_Pragma_Arg (First (Pragma_Argument_Associations (Prag))); - Nam : constant Name_Id := Pragma_Name (Prag); + Nam : constant Name_Id := Pragma_Name_Mapped (Prag); -- Start of processing for Contains_Refined_State @@ -6984,7 +6982,7 @@ Decl := Next (Unit_Declaration_Node (Subp)); while Present (Decl) loop if Nkind (Decl) = N_Pragma - and then Pragma_Name (Decl) = Name_Extensions_Visible + and then Pragma_Name_Mapped (Decl) = Name_Extensions_Visible then Prag := Decl; exit; @@ -10993,7 +10991,7 @@ loop if No (P) then return False; - elsif Nkind (P) = N_Pragma and then Pragma_Name (P) = Nam then + elsif Nkind (P) = N_Pragma and then Pragma_Name_Mapped (P) = Nam then return True; else P := Parent (P); @@ -12359,7 +12357,7 @@ elsif Nkind (P) = N_Pragma and then - Get_Pragma_Id (Pragma_Name (P)) = Pragma_Predicate_Failure + Get_Pragma_Id (P) = Pragma_Predicate_Failure then return True; end if; @@ -14052,7 +14050,7 @@ Nam := Chars (Identifier (Item)); else pragma Assert (Nkind (Item) = N_Pragma); - Nam := Pragma_Name (Item); + Nam := Pragma_Name_Mapped (Item); end if; return Nam = Name_Abstract_State @@ -14871,7 +14869,7 @@ Nam := Chars (Identifier (Item)); else pragma Assert (Nkind (Item) = N_Pragma); - Nam := Pragma_Name (Item); + Nam := Pragma_Name_Mapped (Item); end if; return Nam = Name_Contract_Cases Index: sem_util.ads =================================================================== --- sem_util.ads (revision 244130) +++ sem_util.ads (working copy) @@ -958,7 +958,7 @@ function Get_Pragma_Id (N : Node_Id) return Pragma_Id; pragma Inline (Get_Pragma_Id); - -- Obtains the Pragma_Id from the Chars field of Pragma_Identifier (N) + -- Obtains the Pragma_Id from Pragma_Name (N) function Get_Qualified_Name (Id : Entity_Id; Index: sem_warn.adb =================================================================== --- sem_warn.adb (revision 244124) +++ sem_warn.adb (working copy) @@ -1887,7 +1887,8 @@ P := Parent (Nod); if Nkind (P) = N_Pragma - and then Pragma_Name (P) = Name_Test_Case + and then Pragma_Name_Mapped (P) = + Name_Test_Case and then Nod = Test_Case_Arg (P, Name_Ensures) then return True; Index: sinfo.adb =================================================================== --- sinfo.adb (revision 244141) +++ sinfo.adb (working copy) @@ -6822,9 +6822,28 @@ -- Map_Pragma_Name -- --------------------- + -- We don't want to introduce a dependence on some hash table package or + -- similar, so we use a simple array of Key => Value pairs, and do a linear + -- search. Linear search is plenty efficient, given that we don't expect + -- more than a couple of entries in the mapping. + + type Name_Pair is record + Key : Name_Id; + Value : Name_Id; + end record; + + type Pragma_Map_Index is range 1 .. 100; + Pragma_Map : array (Pragma_Map_Index) of Name_Pair; + Last_Pair : Pragma_Map_Index'Base range 0 .. Pragma_Map_Index'Last := 0; + procedure Map_Pragma_Name (From, To : Name_Id) is begin - null; -- not yet implemented + if Last_Pair = Pragma_Map'Last then + raise Too_Many_Pragma_Mappings; + end if; + + Last_Pair := Last_Pair + 1; + Pragma_Map (Last_Pair) := (Key => From, Value => To); end Map_Pragma_Name; ------------------------ @@ -6832,8 +6851,15 @@ ------------------------ function Pragma_Name_Mapped (N : Node_Id) return Name_Id is + Result : constant Name_Id := Pragma_Name (N); begin - return Pragma_Name (N); + for J in Pragma_Map'Range loop + if Result = Pragma_Map (J).Key then + return Pragma_Map (J).Value; + end if; + end loop; + + return Result; end Pragma_Name_Mapped; end Sinfo; Index: sinfo.ads =================================================================== --- sinfo.ads (revision 244141) +++ sinfo.ads (working copy) @@ -11012,10 +11012,16 @@ procedure Map_Pragma_Name (From, To : Name_Id); -- Used in the implementation of pragma Rename_Pragma. Maps pragma name - -- From to pragma name To, we From can be used as a synonym for To. + -- From to pragma name To, so From can be used as a synonym for To. + Too_Many_Pragma_Mappings : exception; + -- Raised if Map_Pragma_Name is called too many times. We expect that few + -- programs will use it at all, and those that do will use it approximately + -- once or twice. + function Pragma_Name_Mapped (N : Node_Id) return Name_Id; - -- ????Work in progress. + -- Same as Pragma_Name, except that if From has been mapped to To, and + -- Pragma_Name (N) = From, then this returns To. ----------------------------- -- Syntactic Parent Tables -- Index: snames.ads-tmpl =================================================================== --- snames.ads-tmpl (revision 244140) +++ snames.ads-tmpl (working copy) @@ -796,6 +796,7 @@ Name_Proof_In : constant Name_Id := N + $; Name_Reason : constant Name_Id := N + $; Name_Reference : constant Name_Id := N + $; + Name_Renamed : constant Name_Id := N + $; Name_Requires : constant Name_Id := N + $; Name_Restricted : constant Name_Id := N + $; Name_Result_Mechanism : constant Name_Id := N + $;