[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:
parent
9ca67d3f24
commit
ffa168bc98
|
@ -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>
|
2017-01-06 Ed Schonberg <schonberg@adacore.com>
|
||||||
|
|
||||||
* exp_ch6.adb (Expand_Protected_Subprogram_Call): Add guard to
|
* exp_ch6.adb (Expand_Protected_Subprogram_Call): Add guard to
|
||||||
|
|
|
@ -2484,8 +2484,7 @@ package Einfo is
|
||||||
-- test for the need to replace references in Exp_Ch2.
|
-- test for the need to replace references in Exp_Ch2.
|
||||||
|
|
||||||
-- Is_Entry_Wrapper (Flag297)
|
-- Is_Entry_Wrapper (Flag297)
|
||||||
-- Defined on wrappers that are created for entries that have pre-
|
-- Defined on wrappers created for entries that have precondition aspects
|
||||||
-- condition aspects.
|
|
||||||
|
|
||||||
-- Is_Enumeration_Type (synthesized)
|
-- Is_Enumeration_Type (synthesized)
|
||||||
-- Defined in all entities, true for enumeration types and subtypes
|
-- Defined in all entities, true for enumeration types and subtypes
|
||||||
|
|
|
@ -1450,6 +1450,7 @@ begin
|
||||||
Pragma_Restricted_Run_Time |
|
Pragma_Restricted_Run_Time |
|
||||||
Pragma_Rational |
|
Pragma_Rational |
|
||||||
Pragma_Ravenscar |
|
Pragma_Ravenscar |
|
||||||
|
Pragma_Rename_Pragma |
|
||||||
Pragma_Reviewable |
|
Pragma_Reviewable |
|
||||||
Pragma_Share_Generic |
|
Pragma_Share_Generic |
|
||||||
Pragma_Shared |
|
Pragma_Shared |
|
||||||
|
|
|
@ -3843,22 +3843,24 @@ package body Sem_Attr is
|
||||||
-- The prefix denotes an object
|
-- The prefix denotes an object
|
||||||
|
|
||||||
if Is_Object_Reference (P) then
|
if Is_Object_Reference (P) then
|
||||||
Analyze_And_Resolve (P);
|
|
||||||
Check_Object_Reference (P);
|
Check_Object_Reference (P);
|
||||||
|
|
||||||
-- Check the prefix is a type to avoid an error message stating the
|
-- The prefix denotes a type
|
||||||
-- prefix must exclusively denote one
|
|
||||||
|
|
||||||
elsif Is_Entity_Name (P) and then Is_Type (Entity (P)) then
|
elsif Is_Entity_Name (P) and then Is_Type (Entity (P)) then
|
||||||
|
|
||||||
Check_Type;
|
Check_Type;
|
||||||
Check_Not_Incomplete_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
|
if Is_Class_Wide_Type (Etype (P)) then
|
||||||
Error_Attr_P
|
Error_Attr_P
|
||||||
("prefix of % attribute cannot denote a class-wide type");
|
("prefix of % attribute cannot denote a class-wide type");
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- The prefix does not denote an object or a type
|
-- The prefix denotes an illegal construct
|
||||||
|
|
||||||
else
|
else
|
||||||
Error_Attr_P
|
Error_Attr_P
|
||||||
|
|
|
@ -3643,7 +3643,7 @@ package body Sem_Ch6 is
|
||||||
(Body_Id, Body_Id, 'b', Set_Ref => False, Force => True);
|
(Body_Id, Body_Id, 'b', Set_Ref => False, Force => True);
|
||||||
|
|
||||||
-- If the body is an entry wrapper created for an entry with
|
-- 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
|
-- enclosing synchronized object, because it may mention other
|
||||||
-- operations of the type.
|
-- operations of the type.
|
||||||
|
|
||||||
|
@ -4018,7 +4018,7 @@ package body Sem_Ch6 is
|
||||||
End_Scope;
|
End_Scope;
|
||||||
|
|
||||||
-- If we are compiling an entry wrapper, remove the enclosing
|
-- 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
|
if Is_Entry_Wrapper (Body_Id) then
|
||||||
End_Scope;
|
End_Scope;
|
||||||
|
|
|
@ -7704,8 +7704,7 @@ package body Sem_Prag is
|
||||||
|
|
||||||
Rewrite (N,
|
Rewrite (N,
|
||||||
Make_Pragma (Loc,
|
Make_Pragma (Loc,
|
||||||
Pragma_Identifier =>
|
Chars => Nam,
|
||||||
Make_Identifier (Loc, Nam),
|
|
||||||
Pragma_Argument_Associations => New_List (
|
Pragma_Argument_Associations => New_List (
|
||||||
Make_Pragma_Argument_Association (Loc,
|
Make_Pragma_Argument_Association (Loc,
|
||||||
Expression =>
|
Expression =>
|
||||||
|
@ -16565,8 +16564,8 @@ package body Sem_Prag is
|
||||||
if Is_Imported (Def_Id)
|
if Is_Imported (Def_Id)
|
||||||
and then Present (First_Rep_Item (Def_Id))
|
and then Present (First_Rep_Item (Def_Id))
|
||||||
and then Nkind (First_Rep_Item (Def_Id)) = N_Pragma
|
and then Nkind (First_Rep_Item (Def_Id)) = N_Pragma
|
||||||
and then
|
and then Pragma_Name (First_Rep_Item (Def_Id)) =
|
||||||
Pragma_Name (First_Rep_Item (Def_Id)) = Name_Interface
|
Name_Interface
|
||||||
then
|
then
|
||||||
null;
|
null;
|
||||||
else
|
else
|
||||||
|
@ -19035,6 +19034,29 @@ package body Sem_Prag is
|
||||||
end if;
|
end if;
|
||||||
end Persistent_BSS;
|
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 --
|
-- Polling --
|
||||||
-------------
|
-------------
|
||||||
|
@ -19672,7 +19694,7 @@ package body Sem_Prag is
|
||||||
|
|
||||||
Import :=
|
Import :=
|
||||||
Make_Pragma (Loc,
|
Make_Pragma (Loc,
|
||||||
Pragma_Identifier => Make_Identifier (Loc, Name_Import),
|
Chars => Name_Import,
|
||||||
Pragma_Argument_Associations => New_List (
|
Pragma_Argument_Associations => New_List (
|
||||||
Make_Pragma_Argument_Association (Loc,
|
Make_Pragma_Argument_Association (Loc,
|
||||||
Expression => Make_Identifier (Loc, Name_Intrinsic)),
|
Expression => Make_Identifier (Loc, Name_Intrinsic)),
|
||||||
|
@ -28766,6 +28788,7 @@ package body Sem_Prag is
|
||||||
Pragma_Refined_Post => -1,
|
Pragma_Refined_Post => -1,
|
||||||
Pragma_Refined_State => -1,
|
Pragma_Refined_State => -1,
|
||||||
Pragma_Relative_Deadline => 0,
|
Pragma_Relative_Deadline => 0,
|
||||||
|
Pragma_Rename_Pragma => 0,
|
||||||
Pragma_Remote_Access_Type => -1,
|
Pragma_Remote_Access_Type => -1,
|
||||||
Pragma_Remote_Call_Interface => -1,
|
Pragma_Remote_Call_Interface => -1,
|
||||||
Pragma_Remote_Types => -1,
|
Pragma_Remote_Types => -1,
|
||||||
|
|
|
@ -6287,8 +6287,8 @@ package body Sem_Res is
|
||||||
|
|
||||||
-- A protected function cannot be called within the definition of the
|
-- A protected function cannot be called within the definition of the
|
||||||
-- enclosing protected type, unless it is part of a pre/postcondition
|
-- enclosing protected type, unless it is part of a pre/postcondition
|
||||||
-- on another protected operation. This may appear in the entry
|
-- on another protected operation. This may appear in the entry wrapper
|
||||||
-- wrapper created for an entry with preconditions.
|
-- created for an entry with preconditions.
|
||||||
|
|
||||||
if Is_Protected_Type (Scope (Nam))
|
if Is_Protected_Type (Scope (Nam))
|
||||||
and then In_Open_Scopes (Scope (Nam))
|
and then In_Open_Scopes (Scope (Nam))
|
||||||
|
|
|
@ -6818,4 +6818,13 @@ package body Sinfo is
|
||||||
return Chars (Pragma_Identifier (N));
|
return Chars (Pragma_Identifier (N));
|
||||||
end Pragma_Name;
|
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;
|
end Sinfo;
|
||||||
|
|
|
@ -11010,6 +11010,9 @@ package Sinfo is
|
||||||
pragma Inline (Pragma_Name);
|
pragma Inline (Pragma_Name);
|
||||||
-- Convenient function to obtain Chars field of Pragma_Identifier
|
-- 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 --
|
-- Syntactic Parent Tables --
|
||||||
-----------------------------
|
-----------------------------
|
||||||
|
|
|
@ -331,7 +331,7 @@ package body Snames is
|
||||||
|
|
||||||
function Is_Configuration_Pragma_Name (N : Name_Id) return Boolean is
|
function Is_Configuration_Pragma_Name (N : Name_Id) return Boolean is
|
||||||
begin
|
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_Default_Scalar_Storage_Order
|
||||||
or else N = Name_Fast_Math;
|
or else N = Name_Fast_Math;
|
||||||
end Is_Configuration_Pragma_Name;
|
end Is_Configuration_Pragma_Name;
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- S p e c --
|
-- 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 --
|
-- 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- --
|
-- 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_Queuing_Policy : constant Name_Id := N + $;
|
||||||
Name_Rational : constant Name_Id := N + $; -- GNAT
|
Name_Rational : constant Name_Id := N + $; -- GNAT
|
||||||
Name_Ravenscar : 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_Restricted_Run_Time : constant Name_Id := N + $; -- GNAT
|
||||||
Name_Restrictions : constant Name_Id := N + $;
|
Name_Restrictions : constant Name_Id := N + $;
|
||||||
Name_Restriction_Warnings : constant Name_Id := N + $; -- GNAT
|
Name_Restriction_Warnings : constant Name_Id := N + $; -- GNAT
|
||||||
|
@ -765,6 +766,7 @@ package Snames is
|
||||||
Name_Modified_GPL : constant Name_Id := N + $;
|
Name_Modified_GPL : constant Name_Id := N + $;
|
||||||
Name_Name : constant Name_Id := N + $;
|
Name_Name : constant Name_Id := N + $;
|
||||||
Name_NCA : 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 : constant Name_Id := N + $;
|
||||||
Name_No_Access_Parameter_Allocators : constant Name_Id := N + $;
|
Name_No_Access_Parameter_Allocators : constant Name_Id := N + $;
|
||||||
Name_No_Coextensions : constant Name_Id := N + $;
|
Name_No_Coextensions : constant Name_Id := N + $;
|
||||||
|
@ -1808,6 +1810,7 @@ package Snames is
|
||||||
Pragma_Queuing_Policy,
|
Pragma_Queuing_Policy,
|
||||||
Pragma_Rational,
|
Pragma_Rational,
|
||||||
Pragma_Ravenscar,
|
Pragma_Ravenscar,
|
||||||
|
Pragma_Rename_Pragma,
|
||||||
Pragma_Restricted_Run_Time,
|
Pragma_Restricted_Run_Time,
|
||||||
Pragma_Restrictions,
|
Pragma_Restrictions,
|
||||||
Pragma_Restriction_Warnings,
|
Pragma_Restriction_Warnings,
|
||||||
|
|
Loading…
Reference in New Issue