OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2015-10-16  Hristian Kirtchev  <kirtchev@adacore.com>

	* aspects.adb Add an entry for Constant_After_Elaboration in
	table Canonical_Aspect.
	* aspects.ads Add entries for Constant_After_Elaboration in
	tables Aspect_Argument, Aspect_Delay, Aspect_Id, Aspect_Names
	and Implementation_Defined_Aspect.
	* par-prag.adb Pragma Constant_After_Elaboration does not require
	special processing by the parser.
	* sem_ch13.adb Add an entry for Constant_After_Elaboration
	in table Sig_Flags.
	(Analyze_Aspect_Specifications):
	Add processing for aspect Constant_After_Elaboration.
	(Check_Aspect_At_Freeze_Point): Aspect Constant_After_Elaboration
	does not require special processing at freeze time.
	* sem_prag.adb (Analyze_Pragma): Add processing for pragma
	Constant_After_Elaboration. Use routine Find_Related_Context to
	retrieve the context of pragma Part_Of.
	(Duplication_Error): Update comment on usage.
	(Find_Related_Context): New routine.
	* sem_prag.ads Add an entry for Constant_After_Elaboration
	in table Aspect_Specifying_Pragma.
	(Analyze_Contract_Cases_In_Decl_Part): Update the comment on usage.
	* sem_util.adb (Add_Contract_Item): Add processing for pragma
	Constant_After_Elaboration.
	* sem_util.ads (Add_Contract_Item): Update the comment on usage.
	* snames.ads-tmpl Add new predefined name and aspect id for
	Constant_After_Elaboration.

2015-10-16  Vincent Celier  <celier@adacore.com>

	* prj-pp.adb (Pretty_Print.Print): Correctly display extending
	packages, instead of making them renamed packages.

From-SVN: r228911
This commit is contained in:
Arnaud Charlet 2015-10-16 15:52:44 +02:00
parent e1e307d941
commit 1df7c326c7
11 changed files with 365 additions and 178 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
gcc/ada/ChangeLog
View File

@ -1,3 +1,37 @@
2015-10-16 Hristian Kirtchev <kirtchev@adacore.com>
* aspects.adb Add an entry for Constant_After_Elaboration in
table Canonical_Aspect.
* aspects.ads Add entries for Constant_After_Elaboration in
tables Aspect_Argument, Aspect_Delay, Aspect_Id, Aspect_Names
and Implementation_Defined_Aspect.
* par-prag.adb Pragma Constant_After_Elaboration does not require
special processing by the parser.
* sem_ch13.adb Add an entry for Constant_After_Elaboration
in table Sig_Flags.
(Analyze_Aspect_Specifications):
Add processing for aspect Constant_After_Elaboration.
(Check_Aspect_At_Freeze_Point): Aspect Constant_After_Elaboration
does not require special processing at freeze time.
* sem_prag.adb (Analyze_Pragma): Add processing for pragma
Constant_After_Elaboration. Use routine Find_Related_Context to
retrieve the context of pragma Part_Of.
(Duplication_Error): Update comment on usage.
(Find_Related_Context): New routine.
* sem_prag.ads Add an entry for Constant_After_Elaboration
in table Aspect_Specifying_Pragma.
(Analyze_Contract_Cases_In_Decl_Part): Update the comment on usage.
* sem_util.adb (Add_Contract_Item): Add processing for pragma
Constant_After_Elaboration.
* sem_util.ads (Add_Contract_Item): Update the comment on usage.
* snames.ads-tmpl Add new predefined name and aspect id for
Constant_After_Elaboration.
2015-10-16 Vincent Celier <celier@adacore.com>
* prj-pp.adb (Pretty_Print.Print): Correctly display extending
packages, instead of making them renamed packages.
2015-10-16 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch12.adb (Analyze_Package_Instantiation):

1
gcc/ada/aspects.adb
View File

@ -505,6 +505,7 @@ package body Aspects is
Aspect_Attach_Handler => Aspect_Attach_Handler,
Aspect_Bit_Order => Aspect_Bit_Order,
Aspect_Component_Size => Aspect_Component_Size,
Aspect_Constant_After_Elaboration => Aspect_Constant_After_Elaboration,
Aspect_Constant_Indexing => Aspect_Constant_Indexing,
Aspect_Contract_Cases => Aspect_Contract_Cases,
Aspect_Convention => Aspect_Convention,

231
gcc/ada/aspects.ads
View File

@ -81,6 +81,7 @@ package Aspects is
Aspect_Attach_Handler,
Aspect_Bit_Order,
Aspect_Component_Size,
Aspect_Constant_After_Elaboration, -- GNAT
Aspect_Constant_Indexing,
Aspect_Contract_Cases, -- GNAT
Aspect_Convention,
@ -226,44 +227,45 @@ package Aspects is
-- The following array identifies all implementation defined aspects
Implementation_Defined_Aspect : constant array (Aspect_Id) of Boolean :=
(Aspect_Abstract_State => True,
Aspect_Annotate => True,
Aspect_Async_Readers => True,
Aspect_Async_Writers => True,
Aspect_Contract_Cases => True,
Aspect_Depends => True,
Aspect_Dimension => True,
Aspect_Dimension_System => True,
Aspect_Effective_Reads => True,
Aspect_Effective_Writes => True,
Aspect_Extensions_Visible => True,
Aspect_Favor_Top_Level => True,
Aspect_Ghost => True,
Aspect_Global => True,
Aspect_Inline_Always => True,
Aspect_Invariant => True,
Aspect_Lock_Free => True,
Aspect_Object_Size => True,
Aspect_Persistent_BSS => True,
Aspect_Predicate => True,
Aspect_Pure_Function => True,
Aspect_Remote_Access_Type => True,
Aspect_Scalar_Storage_Order => True,
Aspect_Shared => True,
Aspect_Simple_Storage_Pool => True,
Aspect_Simple_Storage_Pool_Type => True,
Aspect_Suppress_Debug_Info => True,
Aspect_Suppress_Initialization => True,
Aspect_Thread_Local_Storage => True,
Aspect_Test_Case => True,
Aspect_Universal_Aliasing => True,
Aspect_Universal_Data => True,
Aspect_Unmodified => True,
Aspect_Unreferenced => True,
Aspect_Unreferenced_Objects => True,
Aspect_Value_Size => True,
Aspect_Warnings => True,
others => False);
(Aspect_Abstract_State => True,
Aspect_Annotate => True,
Aspect_Async_Readers => True,
Aspect_Async_Writers => True,
Aspect_Constant_After_Elaboration => True,
Aspect_Contract_Cases => True,
Aspect_Depends => True,
Aspect_Dimension => True,
Aspect_Dimension_System => True,
Aspect_Effective_Reads => True,
Aspect_Effective_Writes => True,
Aspect_Extensions_Visible => True,
Aspect_Favor_Top_Level => True,
Aspect_Ghost => True,
Aspect_Global => True,
Aspect_Inline_Always => True,
Aspect_Invariant => True,
Aspect_Lock_Free => True,
Aspect_Object_Size => True,
Aspect_Persistent_BSS => True,
Aspect_Predicate => True,
Aspect_Pure_Function => True,
Aspect_Remote_Access_Type => True,
Aspect_Scalar_Storage_Order => True,
Aspect_Shared => True,
Aspect_Simple_Storage_Pool => True,
Aspect_Simple_Storage_Pool_Type => True,
Aspect_Suppress_Debug_Info => True,
Aspect_Suppress_Initialization => True,
Aspect_Thread_Local_Storage => True,
Aspect_Test_Case => True,
Aspect_Universal_Aliasing => True,
Aspect_Universal_Data => True,
Aspect_Unmodified => True,
Aspect_Unreferenced => True,
Aspect_Unreferenced_Objects => True,
Aspect_Value_Size => True,
Aspect_Warnings => True,
others => False);
-- The following array indicates aspects for which multiple occurrences of
-- the same aspect attached to the same declaration are allowed.
@ -305,82 +307,83 @@ package Aspects is
-- The following array indicates what argument type is required
Aspect_Argument : constant array (Aspect_Id) of Aspect_Expression :=
(No_Aspect => Optional_Expression,
Aspect_Abstract_State => Expression,
Aspect_Address => Expression,
Aspect_Alignment => Expression,
Aspect_Annotate => Expression,
Aspect_Attach_Handler => Expression,
Aspect_Bit_Order => Expression,
Aspect_Component_Size => Expression,
Aspect_Constant_Indexing => Name,
Aspect_Contract_Cases => Expression,
Aspect_Convention => Name,
Aspect_CPU => Expression,
Aspect_Default_Component_Value => Expression,
Aspect_Default_Initial_Condition => Optional_Expression,
Aspect_Default_Iterator => Name,
Aspect_Default_Storage_Pool => Expression,
Aspect_Default_Value => Expression,
Aspect_Depends => Expression,
Aspect_Dimension => Expression,
Aspect_Dimension_System => Expression,
Aspect_Dispatching_Domain => Expression,
Aspect_Dynamic_Predicate => Expression,
Aspect_Extensions_Visible => Optional_Expression,
Aspect_External_Name => Expression,
Aspect_External_Tag => Expression,
Aspect_Ghost => Optional_Expression,
Aspect_Global => Expression,
Aspect_Implicit_Dereference => Name,
Aspect_Initial_Condition => Expression,
Aspect_Initializes => Expression,
Aspect_Input => Name,
Aspect_Interrupt_Priority => Expression,
Aspect_Invariant => Expression,
Aspect_Iterable => Expression,
Aspect_Iterator_Element => Name,
Aspect_Link_Name => Expression,
Aspect_Linker_Section => Expression,
Aspect_Machine_Radix => Expression,
Aspect_Object_Size => Expression,
Aspect_Obsolescent => Optional_Expression,
Aspect_Output => Name,
Aspect_Part_Of => Expression,
Aspect_Post => Expression,
Aspect_Postcondition => Expression,
Aspect_Pre => Expression,
Aspect_Precondition => Expression,
Aspect_Predicate => Expression,
Aspect_Priority => Expression,
Aspect_Read => Name,
Aspect_Refined_Depends => Expression,
Aspect_Refined_Global => Expression,
Aspect_Refined_Post => Expression,
Aspect_Refined_State => Expression,
Aspect_Relative_Deadline => Expression,
Aspect_Scalar_Storage_Order => Expression,
Aspect_Simple_Storage_Pool => Name,
Aspect_Size => Expression,
Aspect_Small => Expression,
Aspect_SPARK_Mode => Optional_Name,
Aspect_Static_Predicate => Expression,
Aspect_Storage_Pool => Name,
Aspect_Storage_Size => Expression,
Aspect_Stream_Size => Expression,
Aspect_Suppress => Name,
Aspect_Synchronization => Name,
Aspect_Test_Case => Expression,
Aspect_Type_Invariant => Expression,
Aspect_Unimplemented => Optional_Expression,
Aspect_Unsuppress => Name,
Aspect_Value_Size => Expression,
Aspect_Variable_Indexing => Name,
Aspect_Warnings => Name,
Aspect_Write => Name,
(No_Aspect => Optional_Expression,
Aspect_Abstract_State => Expression,
Aspect_Address => Expression,
Aspect_Alignment => Expression,
Aspect_Annotate => Expression,
Aspect_Attach_Handler => Expression,
Aspect_Bit_Order => Expression,
Aspect_Component_Size => Expression,
Aspect_Constant_After_Elaboration => Optional_Expression,
Aspect_Constant_Indexing => Name,
Aspect_Contract_Cases => Expression,
Aspect_Convention => Name,
Aspect_CPU => Expression,
Aspect_Default_Component_Value => Expression,
Aspect_Default_Initial_Condition => Optional_Expression,
Aspect_Default_Iterator => Name,
Aspect_Default_Storage_Pool => Expression,
Aspect_Default_Value => Expression,
Aspect_Depends => Expression,
Aspect_Dimension => Expression,
Aspect_Dimension_System => Expression,
Aspect_Dispatching_Domain => Expression,
Aspect_Dynamic_Predicate => Expression,
Aspect_Extensions_Visible => Optional_Expression,
Aspect_External_Name => Expression,
Aspect_External_Tag => Expression,
Aspect_Ghost => Optional_Expression,
Aspect_Global => Expression,
Aspect_Implicit_Dereference => Name,
Aspect_Initial_Condition => Expression,
Aspect_Initializes => Expression,
Aspect_Input => Name,
Aspect_Interrupt_Priority => Expression,
Aspect_Invariant => Expression,
Aspect_Iterable => Expression,
Aspect_Iterator_Element => Name,
Aspect_Link_Name => Expression,
Aspect_Linker_Section => Expression,
Aspect_Machine_Radix => Expression,
Aspect_Object_Size => Expression,
Aspect_Obsolescent => Optional_Expression,
Aspect_Output => Name,
Aspect_Part_Of => Expression,
Aspect_Post => Expression,
Aspect_Postcondition => Expression,
Aspect_Pre => Expression,
Aspect_Precondition => Expression,
Aspect_Predicate => Expression,
Aspect_Priority => Expression,
Aspect_Read => Name,
Aspect_Refined_Depends => Expression,
Aspect_Refined_Global => Expression,
Aspect_Refined_Post => Expression,
Aspect_Refined_State => Expression,
Aspect_Relative_Deadline => Expression,
Aspect_Scalar_Storage_Order => Expression,
Aspect_Simple_Storage_Pool => Name,
Aspect_Size => Expression,
Aspect_Small => Expression,
Aspect_SPARK_Mode => Optional_Name,
Aspect_Static_Predicate => Expression,
Aspect_Storage_Pool => Name,
Aspect_Storage_Size => Expression,
Aspect_Stream_Size => Expression,
Aspect_Suppress => Name,
Aspect_Synchronization => Name,
Aspect_Test_Case => Expression,
Aspect_Type_Invariant => Expression,
Aspect_Unimplemented => Optional_Expression,
Aspect_Unsuppress => Name,
Aspect_Value_Size => Expression,
Aspect_Variable_Indexing => Name,
Aspect_Warnings => Name,
Aspect_Write => Name,
Boolean_Aspects => Optional_Expression,
Library_Unit_Aspects => Optional_Expression);
Boolean_Aspects => Optional_Expression,
Library_Unit_Aspects => Optional_Expression);
-----------------------------------------
-- Table Linking Names and Aspect_Id's --
@ -403,6 +406,7 @@ package Aspects is
Aspect_Attach_Handler => Name_Attach_Handler,
Aspect_Bit_Order => Name_Bit_Order,
Aspect_Component_Size => Name_Component_Size,
Aspect_Constant_After_Elaboration => Name_Constant_After_Elaboration,
Aspect_Constant_Indexing => Name_Constant_Indexing,
Aspect_Contract_Cases => Name_Contract_Cases,
Aspect_Convention => Name_Convention,
@ -700,6 +704,7 @@ package Aspects is
Aspect_Annotate => Never_Delay,
Aspect_Async_Readers => Never_Delay,
Aspect_Async_Writers => Never_Delay,
Aspect_Constant_After_Elaboration => Never_Delay,
Aspect_Contract_Cases => Never_Delay,
Aspect_Convention => Never_Delay,
Aspect_Default_Initial_Condition => Never_Delay,

1
gcc/ada/par-prag.adb
View File

@ -1304,6 +1304,7 @@ begin
Pragma_Check_Policy |
Pragma_Compile_Time_Error |
Pragma_Compile_Time_Warning |
Pragma_Constant_After_Elaboration |
Pragma_Contract_Cases |
Pragma_Convention_Identifier |
Pragma_CPP_Class |

17
gcc/ada/prj-pp.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2014, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2015, 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- --
@ -522,7 +522,13 @@ package body Prj.PP is
if Project_Of_Renamed_Package_Of (Node, In_Tree) /=
Empty_Node
then
Write_String (" renames ", Indent);
if First_Declarative_Item_Of (Node, In_Tree) = Empty_Node
then
Write_String (" renames ", Indent);
else
Write_String (" extends ", Indent);
end if;
Output_Name
(Name_Of
(Project_Of_Renamed_Package_Of (Node, In_Tree),
@ -530,6 +536,13 @@ package body Prj.PP is
Indent);
Write_String (".", Indent);
Output_Name (Name_Of (Node, In_Tree), Indent);
end if;
if Project_Of_Renamed_Package_Of (Node, In_Tree) /=
Empty_Node
and then
First_Declarative_Item_Of (Node, In_Tree) = Empty_Node
then
Write_String (";", Indent);
Write_End_Of_Line_Comment (Node);
Print (First_Comment_After_End (Node, In_Tree), Indent);

69
gcc/ada/sem_ch13.adb
View File

@ -2263,6 +2263,22 @@ package body Sem_Ch13 is
goto Continue;
end Abstract_State;
-- Aspect Constant_After_Elaboration is never delayed because
-- it is equivalent to a source pragma which appears after the
-- related object declaration.
when Aspect_Constant_After_Elaboration =>
Make_Aitem_Pragma
(Pragma_Argument_Associations => New_List (
Make_Pragma_Argument_Association (Loc,
Expression => Relocate_Node (Expr))),
Pragma_Name =>
Name_Constant_After_Elaboration);
Decorate (Aspect, Aitem);
Insert_Pragma (Aitem);
goto Continue;
-- Aspect Default_Internal_Condition is never delayed because
-- it is equivalent to a source pragma which appears after the
-- related private type. To deal with forward references, the
@ -9246,32 +9262,33 @@ package body Sem_Ch13 is
-- Here is the list of aspects that don't require delay analysis
when Aspect_Abstract_State |
Aspect_Annotate |
Aspect_Contract_Cases |
Aspect_Default_Initial_Condition |
Aspect_Depends |
Aspect_Dimension |
Aspect_Dimension_System |
Aspect_Extensions_Visible |
Aspect_Ghost |
Aspect_Global |
Aspect_Implicit_Dereference |
Aspect_Initial_Condition |
Aspect_Initializes |
Aspect_Obsolescent |
Aspect_Part_Of |
Aspect_Post |
Aspect_Postcondition |
Aspect_Pre |
Aspect_Precondition |
Aspect_Refined_Depends |
Aspect_Refined_Global |
Aspect_Refined_Post |
Aspect_Refined_State |
Aspect_SPARK_Mode |
Aspect_Test_Case |
Aspect_Unimplemented =>
when Aspect_Abstract_State |
Aspect_Annotate |
Aspect_Constant_After_Elaboration |
Aspect_Contract_Cases |
Aspect_Default_Initial_Condition |
Aspect_Depends |
Aspect_Dimension |
Aspect_Dimension_System |
Aspect_Extensions_Visible |
Aspect_Ghost |
Aspect_Global |
Aspect_Implicit_Dereference |
Aspect_Initial_Condition |
Aspect_Initializes |
Aspect_Obsolescent |
Aspect_Part_Of |
Aspect_Post |
Aspect_Postcondition |
Aspect_Pre |
Aspect_Precondition |
Aspect_Refined_Depends |
Aspect_Refined_Global |
Aspect_Refined_Post |
Aspect_Refined_State |
Aspect_SPARK_Mode |
Aspect_Test_Case |
Aspect_Unimplemented =>
raise Program_Error;
end case;

182
gcc/ada/sem_prag.adb
View File

@ -200,9 +200,17 @@ package body Sem_Prag is
-- context denoted by Context. If this is the case, emit an error.
procedure Duplication_Error (Prag : Node_Id; Prev : Node_Id);
-- Subsidiary to routines Find_Related_Package_Or_Body and
-- Find_Related_Subprogram_Or_Body. Emit an error on pragma Prag that
-- duplicates previous pragma Prev.
-- Subsidiary to all Find_Related_xxx routines. Emit an error on pragma
-- Prag that duplicates previous pragma Prev.
function Find_Related_Context
(Prag : Node_Id;
Do_Checks : Boolean := False) return Node_Id;
-- Subsidiaty to the analysis of pragmas Constant_After_Elaboration and
-- Part_Of. Find the first source declaration or statement found while
-- traversing the previous node chain starting from pragma Prag. If flag
-- Do_Checks is set, the routine reports duplicate pragmas. The routine
-- returns Empty when reaching the start of the node chain.
function Get_Base_Subprogram (Def_Id : Entity_Id) return Entity_Id;
-- If Def_Id refers to a renamed subprogram, then the base subprogram (the
@ -12134,6 +12142,88 @@ package body Sem_Prag is
end if;
end Component_AlignmentP;
--------------------------------
-- Constant_After_Elaboration --
--------------------------------
-- pragma Constant_After_Elaboration [ (boolean_EXPRESSION) ];
when Pragma_Constant_After_Elaboration => Constant_After_Elaboration :
declare
Expr : Node_Id;
Obj_Decl : Node_Id;
Obj_Id : Entity_Id;
begin
GNAT_Pragma;
Check_No_Identifiers;
Check_At_Most_N_Arguments (1);
Obj_Decl := Find_Related_Context (N, Do_Checks => True);
-- Object declaration
if Nkind (Obj_Decl) = N_Object_Declaration then
null;
-- Otherwise the pragma is associated with an illegal construct
else
Pragma_Misplaced;
return;
end if;
Obj_Id := Defining_Entity (Obj_Decl);
-- A pragma that applies to a Ghost entity becomes Ghost for the
-- purposes of legality checks and removal of ignored Ghost code.
Mark_Pragma_As_Ghost (N, Obj_Id);
-- The object declaration must be a library-level variable with
-- an initialization expression. The expression must depend on
-- a variable, parameter, or another constant_after_elaboration,
-- but the compiler cannot detect this property, as this requires
-- full flow analysis (SPARK RM 3.3.1).
if Ekind (Obj_Id) = E_Variable then
if not Is_Library_Level_Entity (Obj_Id) then
Error_Pragma
("pragma % must apply to a library level variable");
return;
elsif not Has_Init_Expression (Obj_Decl) then
Error_Pragma
("pragma % must apply to a variable with initialization "
& "expression");
end if;
-- Otherwise the pragma applies to a constant, which is illegal
else
Error_Pragma ("pragma % must apply to a variable declaration");
return;
end if;
-- Analyze the Boolean expression (if any)
if Present (Arg1) then
Expr := Get_Pragma_Arg (Arg1);
Analyze_And_Resolve (Expr, Standard_Boolean);
if not Is_OK_Static_Expression (Expr) then
Error_Pragma_Arg
("expression of pragma % must be static", Expr);
return;
end if;
end if;
-- Chain the pragma on the contract for completeness
Add_Contract_Item (N, Obj_Id);
end Constant_After_Elaboration;
--------------------
-- Contract_Cases --
--------------------
@ -17394,45 +17484,24 @@ package body Sem_Prag is
Check_No_Identifiers;
Check_Arg_Count (1);
-- Ensure the proper placement of the pragma. Part_Of must appear
-- on an object declaration or a package instantiation.
Stmt := Find_Related_Context (N, Do_Checks => True);
Stmt := Prev (N);
while Present (Stmt) loop
-- Object declaration
-- Skip prior pragmas, but check for duplicates
if Nkind (Stmt) = N_Object_Declaration then
null;
if Nkind (Stmt) = N_Pragma then
if Pragma_Name (Stmt) = Pname then
Error_Msg_Name_1 := Pname;
Error_Msg_Sloc := Sloc (Stmt);
Error_Msg_N ("pragma% duplicates pragma declared#", N);
end if;
-- Package instantiation
-- Skip internally generated code
elsif Nkind (Stmt) = N_Package_Instantiation then
null;
elsif not Comes_From_Source (Stmt) then
null;
-- Otherwise the pragma is associated with an illegal construct
-- The pragma applies to an object declaration (possibly a
-- variable) or a package instantiation. Stop the traversal
-- and continue the analysis.
elsif Nkind_In (Stmt, N_Object_Declaration,
N_Package_Instantiation)
then
exit;
-- The pragma does not apply to a legal construct, issue an
-- error and stop the analysis.
else
Pragma_Misplaced;
return;
end if;
Stmt := Prev (Stmt);
end loop;
else
Pragma_Misplaced;
return;
end if;
-- Extract the entity of the related object declaration or package
-- instantiation. In the case of the instantiation, use the entity
@ -25680,6 +25749,46 @@ package body Sem_Prag is
end if;
end Duplication_Error;
--------------------------
-- Find_Related_Context --
--------------------------
function Find_Related_Context
(Prag : Node_Id;
Do_Checks : Boolean := False) return Node_Id
is
Stmt : Node_Id;
begin
Stmt := Prev (Prag);
while Present (Stmt) loop
-- 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
Duplication_Error
(Prag => Prag,
Prev => Stmt);
end if;
-- Skip internally generated code
elsif not Comes_From_Source (Stmt) then
null;
-- Return the current source construct
else
return Stmt;
end if;
Prev (Stmt);
end loop;
return Empty;
end Find_Related_Context;
----------------------------------
-- Find_Related_Package_Or_Body --
----------------------------------
@ -26223,6 +26332,7 @@ package body Sem_Prag is
Pragma_Complete_Representation => 0,
Pragma_Complex_Representation => 0,
Pragma_Component_Alignment => 0,
Pragma_Constant_After_Elaboration => 0,
Pragma_Contract_Cases => -1,
Pragma_Controlled => 0,
Pragma_Convention => 0,

3
gcc/ada/sem_prag.ads
View File

@ -45,6 +45,7 @@ package Sem_Prag is
Pragma_Atomic => True,
Pragma_Atomic_Components => True,
Pragma_Attach_Handler => True,
Pragma_Constant_After_Elaboration => True,
Pragma_Contract_Cases => True,
Pragma_Convention => True,
Pragma_CPU => True,
@ -171,7 +172,7 @@ package Sem_Prag is
-- Analyze procedure for pragma reference node N
procedure Analyze_Contract_Cases_In_Decl_Part (N : Node_Id);
-- Perform full analysis and expansion of delayed pragma Contract_Cases
-- Perform full analysis of delayed pragma Contract_Cases
procedure Analyze_Depends_In_Decl_Part (N : Node_Id);
-- Perform full analysis of delayed pragma Depends. This routine is also

2
gcc/ada/sem_util.adb
View File

@ -424,6 +424,7 @@ package body Sem_Util is
-- Contract items related to variables. Applicable pragmas are:
-- Async_Readers
-- Async_Writers
-- Constant_After_Elaboration
-- Effective_Reads
-- Effective_Writes
-- Part_Of
@ -431,6 +432,7 @@ package body Sem_Util is
elsif Ekind (Id) = E_Variable then
if Nam_In (Prag_Nam, Name_Async_Readers,
Name_Async_Writers,
Name_Constant_After_Elaboration,
Name_Effective_Reads,
Name_Effective_Writes,
Name_Part_Of)

1
gcc/ada/sem_util.ads
View File

@ -56,6 +56,7 @@ package Sem_Util is
-- Abstract_State
-- Async_Readers
-- Async_Writers
-- Constant_After_Elaboration
-- Contract_Cases
-- Depends
-- Effective_Reads

2
gcc/ada/snames.ads-tmpl
View File

@ -468,6 +468,7 @@ package Snames is
Name_Common_Object : constant Name_Id := N + $; -- GNAT
Name_Complete_Representation : constant Name_Id := N + $; -- GNAT
Name_Complex_Representation : constant Name_Id := N + $; -- GNAT
Name_Constant_After_Elaboration : constant Name_Id := N + $; -- GNAT
Name_Contract_Cases : constant Name_Id := N + $; -- GNAT
Name_Controlled : constant Name_Id := N + $;
Name_Convention : constant Name_Id := N + $;
@ -1813,6 +1814,7 @@ package Snames is
Pragma_Common_Object,
Pragma_Complete_Representation,
Pragma_Complex_Representation,
Pragma_Constant_After_Elaboration,
Pragma_Contract_Cases,
Pragma_Controlled,
Pragma_Convention,