diff options
| author | Bob Duff <duff@adacore.com> | 2017-01-06 11:56:16 +0000 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2017-01-06 12:56:16 +0100 |
| commit | 533e3abc48268dd8eee0c63ddcf133e7a14b370d (patch) | |
| tree | e8e7f4a54bb69880fbcb93c3100b1f285bc23820 | |
| parent | a62e6287d91309dd07957739d5a000fc0b0073c9 (diff) | |
| download | gcc-533e3abc48268dd8eee0c63ddcf133e7a14b370d.zip gcc-533e3abc48268dd8eee0c63ddcf133e7a14b370d.tar.gz gcc-533e3abc48268dd8eee0c63ddcf133e7a14b370d.tar.bz2 | |
snames.ads-tmpl (Renamed): New name for the pragma argument.
2017-01-06 Bob Duff <duff@adacore.com>
* 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.
From-SVN: r244144
35 files changed, 253 insertions, 165 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index bd64c76..4232d36 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2017-01-06 Bob Duff <duff@adacore.com> + + * 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. + 2017-01-06 Hristian Kirtchev <kirtchev@adacore.com> * exp_ch9.adb: Minor reformatting. diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 61e1ad4..f9cb0ba 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -2412,8 +2412,7 @@ package body Checks is 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, diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb index cd74cfcd..7ed7e41 100644 --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -115,16 +115,14 @@ package body Contracts is -- 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 @@ package body Contracts is 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 @@ package body Contracts is 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 @@ package body Contracts is 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 @@ package body Contracts is 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 @@ package body Contracts is 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 @@ package body Contracts is -- 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 @@ package body Contracts is 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 @@ package body Contracts is 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 @@ package body Contracts is 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 @@ package body Contracts is 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 @@ package body Contracts is -- 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; diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index f2023c0..0e66f42 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -7419,7 +7419,7 @@ package body Einfo is 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 @@ package body Einfo is 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 diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 49aa2a7..f655452 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -2800,7 +2800,7 @@ package body Errout is -- 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 diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 57905df..894a3f5 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -8100,7 +8100,7 @@ package body Exp_Attr is 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 diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 6f7ae0a..81eaf8c 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -2758,7 +2758,7 @@ package body Exp_Ch3 is -- 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); diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 3f201bb..85c381f 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -5618,7 +5618,7 @@ package body Exp_Ch6 is 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 diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 031c497..ac188b4 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -4358,8 +4358,7 @@ package body Exp_Ch7 is 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 @@ package body Exp_Ch7 is 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. diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 7fba7bf..7eb38b5e 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -1416,7 +1416,7 @@ package body Exp_Ch9 is 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 @@ package body Exp_Ch9 is 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 @@ package body Exp_Ch9 is 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 @@ package body Exp_Ch9 is 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 @@ package body Exp_Ch9 is -- 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 @@ package body Exp_Ch9 is 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 := diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index 62de26b..30284ae 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -162,7 +162,7 @@ package body Exp_Prag is --------------------- 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,52 +174,48 @@ package body Exp_Prag is 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; - end if; + when others => null; + end case; end Expand_N_Pragma; @@ -1292,7 +1288,7 @@ package body Exp_Prag is 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)); diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index c6e26d4..31eaf6e 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -3901,7 +3901,7 @@ package body Exp_Util is 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 @@ package body Exp_Util is return Make_Pragma (Loc, - Pragma_Identifier => Make_Identifier (Loc, Name_Check), + Chars => Name_Check, Pragma_Argument_Associations => Arg_List); end Make_Predicate_Check; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 96ae4e4..44b306d 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -8464,7 +8464,7 @@ package body Freeze is 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; diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index ff5418a..1f06614 100644 --- a/gcc/ada/frontend.adb +++ b/gcc/ada/frontend.adb @@ -492,7 +492,7 @@ begin 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; diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb index 26ea406..fd0d34e 100644 --- a/gcc/ada/ghost.adb +++ b/gcc/ada/ghost.adb @@ -992,7 +992,7 @@ package body Ghost is 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))); diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 1be03ae..4ecd11a 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -2541,7 +2541,7 @@ package body Inline is -- 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; diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index 0cd615f..ae6dbf7 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -672,7 +672,7 @@ package body Lib.Writ is 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 => diff --git a/gcc/ada/par-ch2.adb b/gcc/ada/par-ch2.adb index 06f74cd..fd8b963 100644 --- a/gcc/ada/par-ch2.adb +++ b/gcc/ada/par-ch2.adb @@ -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 @@ package body Ch2 is -- 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 @@ package body Ch2 is 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 diff --git a/gcc/ada/scans.adb b/gcc/ada/scans.adb index 121ab11..461a378 100644 --- a/gcc/ada/scans.adb +++ b/gcc/ada/scans.adb @@ -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 @@ package body Scans is 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 -- ------------------------ diff --git a/gcc/ada/scans.ads b/gcc/ada/scans.ads index 682bb6c..afbdf96 100644 --- a/gcc/ada/scans.ads +++ b/gcc/ada/scans.ads @@ -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 @@ package Scans is -- 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 @@ package Scans is -- 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. diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index a1e64e4..393ebe9 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -1306,7 +1306,7 @@ package body Sem_Attr is 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 diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index c700245..326cd07 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -512,9 +512,10 @@ package body Sem_Aux is 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; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index e0baf7b..9cd1489 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -1332,7 +1332,7 @@ package body Sem_Ch10 is 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 @@ package body Sem_Ch10 is 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 @@ package body Sem_Ch10 is 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 @@ package body Sem_Ch10 is 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 @@ package body Sem_Ch10 is 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)))); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 2627288..1685ff3 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -6868,7 +6868,7 @@ package body Sem_Ch13 is -- 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 @@ package body Sem_Ch13 is 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 @@ package body Sem_Ch13 is 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 @@ package body Sem_Ch13 is 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 @@ package body Sem_Ch13 is 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 @@ package body Sem_Ch13 is 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 diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 3ce683e..014c2d4 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -2692,7 +2692,7 @@ package body Sem_Ch6 is 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 @@ package body Sem_Ch6 is 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 @@ package body Sem_Ch6 is 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); diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index 7ccf38b..1c01f3e 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -498,9 +498,10 @@ package body Sem_Ch9 is 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 @@ package body Sem_Ch9 is -- 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 @@ package body Sem_Ch9 is -- 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 " diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 7fa4845..e623262 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -2099,7 +2099,7 @@ package body Sem_Elab is 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 @@ package body Sem_Elab is -- 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 @@ package body Sem_Elab is 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 diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index a7c1ca4..a5ae0d0 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -2006,7 +2006,7 @@ package body Sem_Prag is 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 @@ package body Sem_Prag is -- 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 @@ package body Sem_Prag is -- 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 @@ package body Sem_Prag is 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 @@ package body Sem_Prag is if Nam_In (Pragma_Name (Decl), Name_Export, Name_Convention, - Pragma_Name (N)) + Pragma_Name_Mapped (N)) then exit; @@ -10381,7 +10381,7 @@ package body Sem_Prag is -- 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 @@ package body Sem_Prag is -- 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 @@ package body Sem_Prag is -- 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 @@ package body Sem_Prag is 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 @@ package body Sem_Prag is 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 @@ package body Sem_Prag is 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 @@ package body Sem_Prag is -- pragma Rename_Pragma ( -- [New_Name =>] IDENTIFIER, - -- [Renames =>] pragma_IDENTIFIER); - - -- ??? this is work in progress + -- [Renamed =>] pragma_IDENTIFIER); 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 @@ package body Sem_Prag is 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 @@ package body Sem_Prag is -- 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 @@ package body Sem_Prag is 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 @@ package body Sem_Prag is 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 @@ package body Sem_Prag is -- 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 @@ package body Sem_Prag is -- 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 @@ package body Sem_Prag is 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 @@ package body Sem_Prag is -- 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 @@ package body Sem_Prag is 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 @@ package body Sem_Prag is 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 @@ package body Sem_Prag is 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 diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index c8ca67c..692a00a 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -10018,7 +10018,7 @@ package body Sem_Res is -- 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 @@ package body Sem_Res is -- 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 diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index cd75585..64cbbea 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -1319,9 +1319,7 @@ package body Sem_Util is 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 @@ package body Sem_Util is 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 @@ package body Sem_Util is 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 @@ package body Sem_Util is 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 @@ package body Sem_Util is 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 @@ package body Sem_Util is 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 @@ package body Sem_Util is 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 @@ package body Sem_Util is 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 @@ package body Sem_Util is 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 @@ package body Sem_Util is 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 @@ package body Sem_Util is 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 diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 92503fe..0e95bdd 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -958,7 +958,7 @@ package Sem_Util is 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; diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index d905095..f722ada 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -1887,7 +1887,8 @@ package body Sem_Warn is 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; diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 30960b4..4059f21 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -6822,9 +6822,28 @@ package body Sinfo is -- 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 @@ package body Sinfo is ------------------------ 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; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 4a01505..1aec086 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -11012,10 +11012,16 @@ package Sinfo is 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 -- diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 0d12b6a..a45b895 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -796,6 +796,7 @@ package Snames is 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 + $; |