[multiple changes]

2017-01-06  Gary Dismukes  <dismukes@adacore.com>

	* einfo.ads, sem_res.adb, sem_attr.adb, sem_ch6.adb: Minor
	reformatting and typo fixes.

2017-01-06  Bob Duff  <duff@adacore.com>

	* 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.

From-SVN: r244140
This commit is contained in:
Arnaud Charlet 2017-01-06 12:25:31 +01:00
parent 9ca67d3f24
commit ffa168bc98
11 changed files with 73 additions and 18 deletions

View File

@ -1,3 +1,18 @@
2017-01-06 Gary Dismukes <dismukes@adacore.com>
* einfo.ads, sem_res.adb, sem_attr.adb, sem_ch6.adb: Minor
reformatting and typo fixes.
2017-01-06 Bob Duff <duff@adacore.com>
* 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 <schonberg@adacore.com>
* exp_ch6.adb (Expand_Protected_Subprogram_Call): Add guard to

View File

@ -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

View File

@ -1450,6 +1450,7 @@ begin
Pragma_Restricted_Run_Time |
Pragma_Rational |
Pragma_Ravenscar |
Pragma_Rename_Pragma |
Pragma_Reviewable |
Pragma_Share_Generic |
Pragma_Shared |

View File

@ -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

View File

@ -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;

View File

@ -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,

View File

@ -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))

View File

@ -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;

View File

@ -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 --
-----------------------------

View File

@ -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;

View File

@ -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,