diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5419627eafa..e465f9fc622 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2017-01-06 Gary Dismukes + + * einfo.ads, sem_res.adb, sem_attr.adb, sem_ch6.adb: Minor + reformatting and typo fixes. + +2017-01-06 Bob Duff + + * snames.ads-tmpl: New names for pragma renaming. + * snames.adb-tmpl (Is_Configuration_Pragma_Name): Minor cleanup. + * par-prag.adb: Add new pragma name to case statement. + * sem_prag.adb (Rename_Pragma): Initial cut at semantic analysis + of the pragma. + * sinfo.ads, sinfo.adb (Pragma_Name_Mapped): Preparation work, + Dummy implementation of Pragma_Name_Mapped. + 2017-01-06 Ed Schonberg * exp_ch6.adb (Expand_Protected_Subprogram_Call): Add guard to diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index b1c817f7484..f42c3876991 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2484,8 +2484,7 @@ package Einfo is -- test for the need to replace references in Exp_Ch2. -- Is_Entry_Wrapper (Flag297) --- Defined on wrappers that are created for entries that have pre- --- condition aspects. +-- Defined on wrappers created for entries that have precondition aspects -- Is_Enumeration_Type (synthesized) -- Defined in all entities, true for enumeration types and subtypes diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 16a9c44ccad..ff939f6848d 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -1450,6 +1450,7 @@ begin Pragma_Restricted_Run_Time | Pragma_Rational | Pragma_Ravenscar | + Pragma_Rename_Pragma | Pragma_Reviewable | Pragma_Share_Generic | Pragma_Shared | diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 91d740a17ec..a1e64e4311b 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -3843,22 +3843,24 @@ package body Sem_Attr is -- The prefix denotes an object if Is_Object_Reference (P) then - Analyze_And_Resolve (P); Check_Object_Reference (P); - -- Check the prefix is a type to avoid an error message stating the - -- prefix must exclusively denote one + -- The prefix denotes a type elsif Is_Entity_Name (P) and then Is_Type (Entity (P)) then - Check_Type; Check_Not_Incomplete_Type; + + -- Attribute 'Finalization_Size is not defined for class-wide + -- types because it is not possible to know statically whether + -- a definite type will have controlled components or not. + if Is_Class_Wide_Type (Etype (P)) then Error_Attr_P ("prefix of % attribute cannot denote a class-wide type"); end if; - -- The prefix does not denote an object or a type + -- The prefix denotes an illegal construct else Error_Attr_P diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 21790c35f79..3ce683e22a6 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -3643,7 +3643,7 @@ package body Sem_Ch6 is (Body_Id, Body_Id, 'b', Set_Ref => False, Force => True); -- If the body is an entry wrapper created for an entry with - -- preconditions, it must compiled in the context of the + -- preconditions, it must be compiled in the context of the -- enclosing synchronized object, because it may mention other -- operations of the type. @@ -4018,7 +4018,7 @@ package body Sem_Ch6 is End_Scope; -- If we are compiling an entry wrapper, remove the enclosing - -- syncrhonized object from the stack. + -- synchronized object from the stack. if Is_Entry_Wrapper (Body_Id) then End_Scope; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index c90b45db8c2..a7c1ca45754 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -7704,8 +7704,7 @@ package body Sem_Prag is Rewrite (N, Make_Pragma (Loc, - Pragma_Identifier => - Make_Identifier (Loc, Nam), + Chars => Nam, Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => @@ -16565,8 +16564,8 @@ 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)) = Name_Interface + and then Pragma_Name (First_Rep_Item (Def_Id)) = + Name_Interface then null; else @@ -19035,6 +19034,29 @@ package body Sem_Prag is end if; end Persistent_BSS; + -------------------- + -- Rename_Pragma -- + -------------------- + + -- pragma Rename_Pragma ( + -- [New_Name =>] IDENTIFIER, + -- [Renames =>] 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); + + begin + GNAT_Pragma; + Check_Arg_Count (2); + Check_Optional_Identifier (Arg1, Name_New_Name); + Check_Optional_Identifier (Arg2, Name_Renames); + end Rename_Pragma; + pragma Warnings (On); + ------------- -- Polling -- ------------- @@ -19672,7 +19694,7 @@ package body Sem_Prag is Import := Make_Pragma (Loc, - Pragma_Identifier => Make_Identifier (Loc, Name_Import), + Chars => Name_Import, Pragma_Argument_Associations => New_List ( Make_Pragma_Argument_Association (Loc, Expression => Make_Identifier (Loc, Name_Intrinsic)), @@ -28766,6 +28788,7 @@ package body Sem_Prag is Pragma_Refined_Post => -1, Pragma_Refined_State => -1, Pragma_Relative_Deadline => 0, + Pragma_Rename_Pragma => 0, Pragma_Remote_Access_Type => -1, Pragma_Remote_Call_Interface => -1, Pragma_Remote_Types => -1, diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 74dc0e19433..c8ca67cb609 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -6287,8 +6287,8 @@ package body Sem_Res is -- A protected function cannot be called within the definition of the -- enclosing protected type, unless it is part of a pre/postcondition - -- on another protected operation. This may appear in the entry - -- wrapper created for an entry with preconditions. + -- on another protected operation. This may appear in the entry wrapper + -- created for an entry with preconditions. if Is_Protected_Type (Scope (Nam)) and then In_Open_Scopes (Scope (Nam)) diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 9738101d86c..c4e97a6d5e6 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -6818,4 +6818,13 @@ package body Sinfo is return Chars (Pragma_Identifier (N)); end Pragma_Name; + ------------------------ + -- Pragma_Name_Mapped -- + ------------------------ + + function Pragma_Name_Mapped (N : Node_Id) return Name_Id is + begin + return Pragma_Name (N); + end Pragma_Name_Mapped; + end Sinfo; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 75e0846526c..79b56a12ae2 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -11010,6 +11010,9 @@ package Sinfo is pragma Inline (Pragma_Name); -- Convenient function to obtain Chars field of Pragma_Identifier + function Pragma_Name_Mapped (N : Node_Id) return Name_Id; + -- ????Work in progress. + ----------------------------- -- Syntactic Parent Tables -- ----------------------------- diff --git a/gcc/ada/snames.adb-tmpl b/gcc/ada/snames.adb-tmpl index 6b6c598bf83..fe239983110 100644 --- a/gcc/ada/snames.adb-tmpl +++ b/gcc/ada/snames.adb-tmpl @@ -331,7 +331,7 @@ package body Snames is function Is_Configuration_Pragma_Name (N : Name_Id) return Boolean is begin - return N in First_Pragma_Name .. Last_Configuration_Pragma_Name + return N in Configuration_Pragma_Names or else N = Name_Default_Scalar_Storage_Order or else N = Name_Fast_Math; end Is_Configuration_Pragma_Name; diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index d33b97a34fd..0d12b6a92dd 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- 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- -- @@ -450,6 +450,7 @@ package Snames is Name_Queuing_Policy : constant Name_Id := N + $; Name_Rational : constant Name_Id := N + $; -- GNAT Name_Ravenscar : constant Name_Id := N + $; -- GNAT + Name_Rename_Pragma : constant Name_Id := N + $; -- GNAT Name_Restricted_Run_Time : constant Name_Id := N + $; -- GNAT Name_Restrictions : constant Name_Id := N + $; Name_Restriction_Warnings : constant Name_Id := N + $; -- GNAT @@ -765,6 +766,7 @@ package Snames is Name_Modified_GPL : constant Name_Id := N + $; Name_Name : constant Name_Id := N + $; Name_NCA : constant Name_Id := N + $; + Name_New_Name : constant Name_Id := N + $; Name_No : constant Name_Id := N + $; Name_No_Access_Parameter_Allocators : constant Name_Id := N + $; Name_No_Coextensions : constant Name_Id := N + $; @@ -1808,6 +1810,7 @@ package Snames is Pragma_Queuing_Policy, Pragma_Rational, Pragma_Ravenscar, + Pragma_Rename_Pragma, Pragma_Restricted_Run_Time, Pragma_Restrictions, Pragma_Restriction_Warnings,