From d0849c231459927b58d3683d25780269314e579e Mon Sep 17 00:00:00 2001 From: charlet Date: Fri, 16 Oct 2015 13:52:44 +0000 Subject: [PATCH] 2015-10-16 Hristian Kirtchev * 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 * prj-pp.adb (Pretty_Print.Print): Correctly display extending packages, instead of making them renamed packages. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@228911 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 34 +++++++ gcc/ada/aspects.adb | 1 + gcc/ada/aspects.ads | 233 +++++++++++++++++++++++++----------------------- gcc/ada/par-prag.adb | 1 + gcc/ada/prj-pp.adb | 17 +++- gcc/ada/sem_ch13.adb | 69 ++++++++------ gcc/ada/sem_prag.adb | 182 +++++++++++++++++++++++++++++-------- gcc/ada/sem_prag.ads | 3 +- gcc/ada/sem_util.adb | 2 + gcc/ada/sem_util.ads | 1 + gcc/ada/snames.ads-tmpl | 2 + 11 files changed, 366 insertions(+), 179 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 751cbf7..c3d425d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,39 @@ 2015-10-16 Hristian Kirtchev + * 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 + + * prj-pp.adb (Pretty_Print.Print): Correctly display extending + packages, instead of making them renamed packages. + +2015-10-16 Hristian Kirtchev + * sem_ch12.adb (Analyze_Package_Instantiation): Treat a missing SPARK_Mode annotation as having mode "Off". (Analyze_Subprogram_Instantiation): Treat a missing SPARK_Mode diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index bf01f77..b945a8b 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -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, diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index e215622..2d71394 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -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, - - Boolean_Aspects => Optional_Expression, - Library_Unit_Aspects => Optional_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_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); ----------------------------------------- -- 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, diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 645c8f0..bcb8add 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -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 | diff --git a/gcc/ada/prj-pp.adb b/gcc/ada/prj-pp.adb index 9ccd935..2b05eaa 100644 --- a/gcc/ada/prj-pp.adb +++ b/gcc/ada/prj-pp.adb @@ -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); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 40d4d35..c1c7132 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 94eac81..b2e0f11 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -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_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; - - -- Skip internally generated code - - elsif not Comes_From_Source (Stmt) then - null; - - -- The pragma applies to an object declaration (possibly a - -- variable) or a package instantiation. Stop the traversal - -- and continue the analysis. + if Nkind (Stmt) = N_Object_Declaration then + null; - elsif Nkind_In (Stmt, N_Object_Declaration, - N_Package_Instantiation) - then - exit; + -- Package instantiation - -- The pragma does not apply to a legal construct, issue an - -- error and stop the analysis. + elsif Nkind (Stmt) = N_Package_Instantiation then + null; - else - Pragma_Misplaced; - return; - end if; + -- Otherwise the pragma is associated with an illegal construct - 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, diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads index 52f6935..72881a0 100644 --- a/gcc/ada/sem_prag.ads +++ b/gcc/ada/sem_prag.ads @@ -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 diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 2fa6253..d182229 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -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) diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 238a0fa..7826576 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -56,6 +56,7 @@ package Sem_Util is -- Abstract_State -- Async_Readers -- Async_Writers + -- Constant_After_Elaboration -- Contract_Cases -- Depends -- Effective_Reads diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index de46bdb..9484311 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -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, -- 2.7.4