Aspect_Attach_Handler,
Aspect_Bit_Order,
Aspect_Component_Size,
+ Aspect_Constant_After_Elaboration, -- GNAT
Aspect_Constant_Indexing,
Aspect_Contract_Cases, -- GNAT
Aspect_Convention,
-- 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.
-- 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 --
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,
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,
-- 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
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 --
--------------------
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
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 --
----------------------------------
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,
projects / gcc.git / commitdiff