[multiple changes]
2013-10-14 Hristian Kirtchev <kirtchev@adacore.com> * aspects.adb: Add an entry in table Canonical_Aspect for Initial_Condition. * aspects.ads: Add entries in tables Aspect_Id, Aspect_Argument, Aspect_Names and Aspect_Delay for Initial_Condition. * einfo.adb (Get_Pragma): Include pragma Initial_Condition to categorization pragmas. * einfo.ads (Get_Pragma): Update comment on usage. * exp_ch7.adb (Expand_N_Package_Body): Add a runtime check to verify the assertion introduced by pragma Initial_Condition. (Expand_N_Package_Declaration): Add a runtime check to verify the assertion introduced by pragma Initial_Condition. (Expand_Pragma_Initial_Condition): New routine. * par-prag: Include pragma Initial_Condition to the list of pragmas that do not require special processing by the parser. * sem_ch3.adb (Analyze_Declarations): Analyze pragma Initial_Condition at the end of the visible declarations. * sem_ch13.adb (Analyze_Aspect_Specifications): Add processing for aspect Initial_Condition. (Check_Aspect_At_Freeze_Point): Aspect Initial_Condition does not need inspection at freezing. * sem_prag.adb (Analyze_Initial_Condition_In_Decl_Part): New routine. (Analyze_Pragma): Update all calls to Check_Declaration_Order. Add processing for pragma Initial_Condition. Initial_Condition is now a valid assertion kind. Add an entry in table Sig_Flags for Initial_Condition. (Check_Declaration_Order): Reimplemented to handle arbitrary pragmas. (Is_Valid_Assertion_Kind): Add an entry for Initial_Condition. * sem_pag.ads (Analyze_Initial_Condition_In_Decl_Part): New routine. * sem_util.adb (Add_Contract_Item): Pragma Initial_Condition can now be associated with a package spec. * sem_util.ads (Add_Contract_Item): Update comment on usage. * sinfo.ads: Update the documentation of node N_Contract * snames.ads-tmpl: Add new predefined name Initial_Condition. Add new pragma id for Initial_Condition. 2013-10-14 Thomas Quinot <quinot@adacore.com> * exp_pakd.adb: Minor reformatting. From-SVN: r203551
This commit is contained in:
parent
1e7bc06555
commit
9b2451e5b3
|
@ -1,3 +1,48 @@
|
||||||
|
2013-10-14 Hristian Kirtchev <kirtchev@adacore.com>
|
||||||
|
|
||||||
|
* aspects.adb: Add an entry in table Canonical_Aspect for
|
||||||
|
Initial_Condition.
|
||||||
|
* aspects.ads: Add entries in tables Aspect_Id, Aspect_Argument,
|
||||||
|
Aspect_Names and Aspect_Delay for Initial_Condition.
|
||||||
|
* einfo.adb (Get_Pragma): Include pragma Initial_Condition to
|
||||||
|
categorization pragmas.
|
||||||
|
* einfo.ads (Get_Pragma): Update comment on usage.
|
||||||
|
* exp_ch7.adb (Expand_N_Package_Body): Add a runtime check to
|
||||||
|
verify the assertion introduced by pragma Initial_Condition.
|
||||||
|
(Expand_N_Package_Declaration): Add a runtime check to
|
||||||
|
verify the assertion introduced by pragma Initial_Condition.
|
||||||
|
(Expand_Pragma_Initial_Condition): New routine.
|
||||||
|
* par-prag: Include pragma Initial_Condition to the list of
|
||||||
|
pragmas that do not require special processing by the parser.
|
||||||
|
* sem_ch3.adb (Analyze_Declarations): Analyze pragma
|
||||||
|
Initial_Condition at the end of the visible declarations.
|
||||||
|
* sem_ch13.adb (Analyze_Aspect_Specifications): Add processing
|
||||||
|
for aspect Initial_Condition.
|
||||||
|
(Check_Aspect_At_Freeze_Point):
|
||||||
|
Aspect Initial_Condition does not need inspection at freezing.
|
||||||
|
* sem_prag.adb (Analyze_Initial_Condition_In_Decl_Part):
|
||||||
|
New routine.
|
||||||
|
(Analyze_Pragma): Update all calls
|
||||||
|
to Check_Declaration_Order. Add processing for pragma
|
||||||
|
Initial_Condition. Initial_Condition is now a valid assertion
|
||||||
|
kind. Add an entry in table Sig_Flags for Initial_Condition.
|
||||||
|
(Check_Declaration_Order): Reimplemented to handle arbitrary
|
||||||
|
pragmas.
|
||||||
|
(Is_Valid_Assertion_Kind): Add an entry for
|
||||||
|
Initial_Condition.
|
||||||
|
* sem_pag.ads (Analyze_Initial_Condition_In_Decl_Part):
|
||||||
|
New routine.
|
||||||
|
* sem_util.adb (Add_Contract_Item): Pragma Initial_Condition
|
||||||
|
can now be associated with a package spec.
|
||||||
|
* sem_util.ads (Add_Contract_Item): Update comment on usage.
|
||||||
|
* sinfo.ads: Update the documentation of node N_Contract
|
||||||
|
* snames.ads-tmpl: Add new predefined name Initial_Condition. Add
|
||||||
|
new pragma id for Initial_Condition.
|
||||||
|
|
||||||
|
2013-10-14 Thomas Quinot <quinot@adacore.com>
|
||||||
|
|
||||||
|
* exp_pakd.adb: Minor reformatting.
|
||||||
|
|
||||||
2013-10-14 Robert Dewar <dewar@adacore.com>
|
2013-10-14 Robert Dewar <dewar@adacore.com>
|
||||||
|
|
||||||
* exp_prag.adb: Minor reformatting.
|
* exp_prag.adb: Minor reformatting.
|
||||||
|
|
|
@ -440,6 +440,7 @@ package body Aspects is
|
||||||
Aspect_Independent_Components => Aspect_Independent_Components,
|
Aspect_Independent_Components => Aspect_Independent_Components,
|
||||||
Aspect_Inline => Aspect_Inline,
|
Aspect_Inline => Aspect_Inline,
|
||||||
Aspect_Inline_Always => Aspect_Inline,
|
Aspect_Inline_Always => Aspect_Inline,
|
||||||
|
Aspect_Initial_Condition => Aspect_Initial_Condition,
|
||||||
Aspect_Initializes => Aspect_Initializes,
|
Aspect_Initializes => Aspect_Initializes,
|
||||||
Aspect_Input => Aspect_Input,
|
Aspect_Input => Aspect_Input,
|
||||||
Aspect_Interrupt_Handler => Aspect_Interrupt_Handler,
|
Aspect_Interrupt_Handler => Aspect_Interrupt_Handler,
|
||||||
|
|
|
@ -96,6 +96,7 @@ package Aspects is
|
||||||
Aspect_External_Tag,
|
Aspect_External_Tag,
|
||||||
Aspect_Global, -- GNAT
|
Aspect_Global, -- GNAT
|
||||||
Aspect_Implicit_Dereference,
|
Aspect_Implicit_Dereference,
|
||||||
|
Aspect_Initial_Condition, -- GNAT
|
||||||
Aspect_Initializes, -- GNAT
|
Aspect_Initializes, -- GNAT
|
||||||
Aspect_Input,
|
Aspect_Input,
|
||||||
Aspect_Interrupt_Priority,
|
Aspect_Interrupt_Priority,
|
||||||
|
@ -310,6 +311,7 @@ package Aspects is
|
||||||
Aspect_External_Tag => Expression,
|
Aspect_External_Tag => Expression,
|
||||||
Aspect_Global => Expression,
|
Aspect_Global => Expression,
|
||||||
Aspect_Implicit_Dereference => Name,
|
Aspect_Implicit_Dereference => Name,
|
||||||
|
Aspect_Initial_Condition => Expression,
|
||||||
Aspect_Initializes => Expression,
|
Aspect_Initializes => Expression,
|
||||||
Aspect_Input => Name,
|
Aspect_Input => Name,
|
||||||
Aspect_Interrupt_Priority => Expression,
|
Aspect_Interrupt_Priority => Expression,
|
||||||
|
@ -400,6 +402,7 @@ package Aspects is
|
||||||
Aspect_Independent_Components => Name_Independent_Components,
|
Aspect_Independent_Components => Name_Independent_Components,
|
||||||
Aspect_Inline => Name_Inline,
|
Aspect_Inline => Name_Inline,
|
||||||
Aspect_Inline_Always => Name_Inline_Always,
|
Aspect_Inline_Always => Name_Inline_Always,
|
||||||
|
Aspect_Initial_Condition => Name_Initial_Condition,
|
||||||
Aspect_Initializes => Name_Initializes,
|
Aspect_Initializes => Name_Initializes,
|
||||||
Aspect_Input => Name_Input,
|
Aspect_Input => Name_Input,
|
||||||
Aspect_Interrupt_Handler => Name_Interrupt_Handler,
|
Aspect_Interrupt_Handler => Name_Interrupt_Handler,
|
||||||
|
@ -600,6 +603,7 @@ package Aspects is
|
||||||
Aspect_Independent_Components => Always_Delay,
|
Aspect_Independent_Components => Always_Delay,
|
||||||
Aspect_Inline => Always_Delay,
|
Aspect_Inline => Always_Delay,
|
||||||
Aspect_Inline_Always => Always_Delay,
|
Aspect_Inline_Always => Always_Delay,
|
||||||
|
Aspect_Initial_Condition => Always_Delay,
|
||||||
Aspect_Initializes => Always_Delay,
|
Aspect_Initializes => Always_Delay,
|
||||||
Aspect_Input => Always_Delay,
|
Aspect_Input => Always_Delay,
|
||||||
Aspect_Interrupt_Handler => Always_Delay,
|
Aspect_Interrupt_Handler => Always_Delay,
|
||||||
|
|
|
@ -6300,18 +6300,19 @@ package body Einfo is
|
||||||
|
|
||||||
function Get_Pragma (E : Entity_Id; Id : Pragma_Id) return Node_Id is
|
function Get_Pragma (E : Entity_Id; Id : Pragma_Id) return Node_Id is
|
||||||
Is_CDG : constant Boolean :=
|
Is_CDG : constant Boolean :=
|
||||||
Id = Pragma_Abstract_State or else
|
Id = Pragma_Abstract_State or else
|
||||||
Id = Pragma_Depends or else
|
Id = Pragma_Depends or else
|
||||||
Id = Pragma_Global or else
|
Id = Pragma_Global or else
|
||||||
Id = Pragma_Initializes or else
|
Id = Pragma_Initial_Condition or else
|
||||||
Id = Pragma_Refined_Depends or else
|
Id = Pragma_Initializes or else
|
||||||
Id = Pragma_Refined_Global or else
|
Id = Pragma_Refined_Depends or else
|
||||||
|
Id = Pragma_Refined_Global or else
|
||||||
Id = Pragma_Refined_State;
|
Id = Pragma_Refined_State;
|
||||||
Is_CTC : constant Boolean :=
|
Is_CTC : constant Boolean :=
|
||||||
Id = Pragma_Contract_Cases or else
|
Id = Pragma_Contract_Cases or else
|
||||||
Id = Pragma_Test_Case;
|
Id = Pragma_Test_Case;
|
||||||
Is_PPC : constant Boolean :=
|
Is_PPC : constant Boolean :=
|
||||||
Id = Pragma_Precondition or else
|
Id = Pragma_Precondition or else
|
||||||
Id = Pragma_Postcondition;
|
Id = Pragma_Postcondition;
|
||||||
|
|
||||||
In_Contract : constant Boolean := Is_CDG or Is_CTC or Is_PPC;
|
In_Contract : constant Boolean := Is_CDG or Is_CTC or Is_PPC;
|
||||||
|
|
|
@ -7442,6 +7442,8 @@ package Einfo is
|
||||||
-- Contract_Cases
|
-- Contract_Cases
|
||||||
-- Depends
|
-- Depends
|
||||||
-- Global
|
-- Global
|
||||||
|
-- Initial_Condition
|
||||||
|
-- Initializes
|
||||||
-- Precondition
|
-- Precondition
|
||||||
-- Postcondition
|
-- Postcondition
|
||||||
-- Refined_Depends
|
-- Refined_Depends
|
||||||
|
|
|
@ -368,6 +368,11 @@ package body Exp_Ch7 is
|
||||||
-- Given an arbitrary entity, traverse the scope chain looking for the
|
-- Given an arbitrary entity, traverse the scope chain looking for the
|
||||||
-- first enclosing function. Return Empty if no function was found.
|
-- first enclosing function. Return Empty if no function was found.
|
||||||
|
|
||||||
|
procedure Expand_Pragma_Initial_Condition (N : Node_Id);
|
||||||
|
-- Subsidiary to the expansion of package specs and bodies. Generate a
|
||||||
|
-- runtime check needed to verify the assumption introduced by pragma
|
||||||
|
-- Initial_Condition. N denotes the package spec or body.
|
||||||
|
|
||||||
function Make_Call
|
function Make_Call
|
||||||
(Loc : Source_Ptr;
|
(Loc : Source_Ptr;
|
||||||
Proc_Id : Entity_Id;
|
Proc_Id : Entity_Id;
|
||||||
|
@ -3959,6 +3964,15 @@ package body Exp_Ch7 is
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Build_Task_Activation_Call (N);
|
Build_Task_Activation_Call (N);
|
||||||
|
|
||||||
|
-- When the package is subject to pragma Initial_Condition, the
|
||||||
|
-- assertion expression must be verified at the end of the body
|
||||||
|
-- statements.
|
||||||
|
|
||||||
|
if Present (Get_Pragma (Spec_Ent, Pragma_Initial_Condition)) then
|
||||||
|
Expand_Pragma_Initial_Condition (N);
|
||||||
|
end if;
|
||||||
|
|
||||||
Pop_Scope;
|
Pop_Scope;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
@ -4053,10 +4067,9 @@ package body Exp_Ch7 is
|
||||||
if No_Body then
|
if No_Body then
|
||||||
Push_Scope (Id);
|
Push_Scope (Id);
|
||||||
|
|
||||||
|
-- Generate RACW subprogram bodies
|
||||||
|
|
||||||
if Has_RACW (Id) then
|
if Has_RACW (Id) then
|
||||||
|
|
||||||
-- Generate RACW subprogram bodies
|
|
||||||
|
|
||||||
Decls := Private_Declarations (Spec);
|
Decls := Private_Declarations (Spec);
|
||||||
|
|
||||||
if No (Decls) then
|
if No (Decls) then
|
||||||
|
@ -4072,13 +4085,21 @@ package body Exp_Ch7 is
|
||||||
Analyze_List (Decls);
|
Analyze_List (Decls);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
-- Generate task activation call as last step of elaboration
|
||||||
|
|
||||||
if Present (Activation_Chain_Entity (N)) then
|
if Present (Activation_Chain_Entity (N)) then
|
||||||
|
|
||||||
-- Generate task activation call as last step of elaboration
|
|
||||||
|
|
||||||
Build_Task_Activation_Call (N);
|
Build_Task_Activation_Call (N);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
-- When the package is subject to pragma Initial_Condition and lacks
|
||||||
|
-- a body, the assertion expression must be verified at the end of
|
||||||
|
-- the visible declarations. Otherwise the check is performed at the
|
||||||
|
-- end of the body statements (see Expand_N_Package_Body).
|
||||||
|
|
||||||
|
if Present (Get_Pragma (Id, Pragma_Initial_Condition)) then
|
||||||
|
Expand_Pragma_Initial_Condition (N);
|
||||||
|
end if;
|
||||||
|
|
||||||
Pop_Scope;
|
Pop_Scope;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
@ -4114,6 +4135,88 @@ package body Exp_Ch7 is
|
||||||
end if;
|
end if;
|
||||||
end Expand_N_Package_Declaration;
|
end Expand_N_Package_Declaration;
|
||||||
|
|
||||||
|
-------------------------------------
|
||||||
|
-- Expand_Pragma_Initial_Condition --
|
||||||
|
-------------------------------------
|
||||||
|
|
||||||
|
procedure Expand_Pragma_Initial_Condition (N : Node_Id) is
|
||||||
|
Loc : constant Source_Ptr := Sloc (N);
|
||||||
|
Check : Node_Id;
|
||||||
|
Expr : Node_Id;
|
||||||
|
Init_Cond : Node_Id;
|
||||||
|
List : List_Id;
|
||||||
|
Pack_Id : Entity_Id;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if Nkind (N) = N_Package_Body then
|
||||||
|
Pack_Id := Corresponding_Spec (N);
|
||||||
|
|
||||||
|
if Present (Handled_Statement_Sequence (N)) then
|
||||||
|
List := Statements (Handled_Statement_Sequence (N));
|
||||||
|
|
||||||
|
-- The package body lacks statements, create an empty list
|
||||||
|
|
||||||
|
else
|
||||||
|
List := New_List;
|
||||||
|
|
||||||
|
Set_Handled_Statement_Sequence (N,
|
||||||
|
Make_Handled_Sequence_Of_Statements (Loc, Statements => List));
|
||||||
|
end if;
|
||||||
|
|
||||||
|
elsif Nkind (N) = N_Package_Declaration then
|
||||||
|
Pack_Id := Defining_Entity (N);
|
||||||
|
|
||||||
|
if Present (Visible_Declarations (Specification (N))) then
|
||||||
|
List := Visible_Declarations (Specification (N));
|
||||||
|
|
||||||
|
-- The package lacks visible declarations, create an empty list
|
||||||
|
|
||||||
|
else
|
||||||
|
List := New_List;
|
||||||
|
|
||||||
|
Set_Visible_Declarations (Specification (N), List);
|
||||||
|
end if;
|
||||||
|
|
||||||
|
-- This routine should not be used on anything other than packages
|
||||||
|
|
||||||
|
else
|
||||||
|
raise Program_Error;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
Init_Cond := Get_Pragma (Pack_Id, Pragma_Initial_Condition);
|
||||||
|
|
||||||
|
-- The caller should check whether the package is subject to pragma
|
||||||
|
-- Initial_Condition.
|
||||||
|
|
||||||
|
pragma Assert (Present (Init_Cond));
|
||||||
|
|
||||||
|
Expr :=
|
||||||
|
Get_Pragma_Arg (First (Pragma_Argument_Associations (Init_Cond)));
|
||||||
|
|
||||||
|
-- The assertion expression was found to be illegal, do not generate the
|
||||||
|
-- runtime check as it will repeat the illegality.
|
||||||
|
|
||||||
|
if Error_Posted (Init_Cond) or else Error_Posted (Expr) then
|
||||||
|
return;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
-- Generate:
|
||||||
|
-- pragma Check (Initial_Condition, <Expr>);
|
||||||
|
|
||||||
|
Check :=
|
||||||
|
Make_Pragma (Loc,
|
||||||
|
Chars => Name_Check,
|
||||||
|
Pragma_Argument_Associations => New_List (
|
||||||
|
Make_Pragma_Argument_Association (Loc,
|
||||||
|
Expression => Make_Identifier (Loc, Name_Initial_Condition)),
|
||||||
|
|
||||||
|
Make_Pragma_Argument_Association (Loc,
|
||||||
|
Expression => New_Copy_Tree (Expr))));
|
||||||
|
|
||||||
|
Append_To (List, Check);
|
||||||
|
Analyze (Check);
|
||||||
|
end Expand_Pragma_Initial_Condition;
|
||||||
|
|
||||||
-----------------------------
|
-----------------------------
|
||||||
-- Find_Node_To_Be_Wrapped --
|
-- Find_Node_To_Be_Wrapped --
|
||||||
-----------------------------
|
-----------------------------
|
||||||
|
|
|
@ -1326,8 +1326,8 @@ package body Exp_Pakd is
|
||||||
-- The expression for the shift value that is required
|
-- The expression for the shift value that is required
|
||||||
|
|
||||||
Shift_Used : Boolean := False;
|
Shift_Used : Boolean := False;
|
||||||
-- Set True if Shift has been used in the generated code at least
|
-- Set True if Shift has been used in the generated code at least once,
|
||||||
-- once, so that it must be duplicated if used again
|
-- so that it must be duplicated if used again.
|
||||||
|
|
||||||
New_Lhs : Node_Id;
|
New_Lhs : Node_Id;
|
||||||
New_Rhs : Node_Id;
|
New_Rhs : Node_Id;
|
||||||
|
|
|
@ -1185,6 +1185,7 @@ begin
|
||||||
Pragma_Import_Valued_Procedure |
|
Pragma_Import_Valued_Procedure |
|
||||||
Pragma_Independent |
|
Pragma_Independent |
|
||||||
Pragma_Independent_Components |
|
Pragma_Independent_Components |
|
||||||
|
Pragma_Initial_Condition |
|
||||||
Pragma_Initialize_Scalars |
|
Pragma_Initialize_Scalars |
|
||||||
Pragma_Initializes |
|
Pragma_Initializes |
|
||||||
Pragma_Inline |
|
Pragma_Inline |
|
||||||
|
|
|
@ -2053,6 +2053,45 @@ package body Sem_Ch13 is
|
||||||
Insert_Delayed_Pragma (Aitem);
|
Insert_Delayed_Pragma (Aitem);
|
||||||
goto Continue;
|
goto Continue;
|
||||||
|
|
||||||
|
-- Initial_Condition
|
||||||
|
|
||||||
|
-- Aspect Initial_Condition covers the visible declarations of
|
||||||
|
-- a package and all hidden states through functions. As such,
|
||||||
|
-- it must be evaluated at the end of the said declarations.
|
||||||
|
|
||||||
|
when Aspect_Initial_Condition => Initial_Condition : declare
|
||||||
|
Decls : List_Id;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if Nkind_In (N, N_Generic_Package_Declaration,
|
||||||
|
N_Package_Declaration)
|
||||||
|
then
|
||||||
|
Decls := Visible_Declarations (Specification (N));
|
||||||
|
|
||||||
|
Make_Aitem_Pragma
|
||||||
|
(Pragma_Argument_Associations => New_List (
|
||||||
|
Make_Pragma_Argument_Association (Loc,
|
||||||
|
Expression => Relocate_Node (Expr))),
|
||||||
|
Pragma_Name =>
|
||||||
|
Name_Initial_Condition);
|
||||||
|
Decorate_Delayed_Aspect_And_Pragma (Aspect, Aitem);
|
||||||
|
|
||||||
|
if No (Decls) then
|
||||||
|
Decls := New_List;
|
||||||
|
Set_Visible_Declarations (N, Decls);
|
||||||
|
end if;
|
||||||
|
|
||||||
|
Prepend_To (Decls, Aitem);
|
||||||
|
|
||||||
|
else
|
||||||
|
Error_Msg_NE
|
||||||
|
("aspect & must apply to a package declaration",
|
||||||
|
Aspect, Id);
|
||||||
|
end if;
|
||||||
|
|
||||||
|
goto Continue;
|
||||||
|
end Initial_Condition;
|
||||||
|
|
||||||
-- Initializes
|
-- Initializes
|
||||||
|
|
||||||
-- Aspect Initializes coverts the visible declarations of a
|
-- Aspect Initializes coverts the visible declarations of a
|
||||||
|
@ -7849,6 +7888,7 @@ package body Sem_Ch13 is
|
||||||
Aspect_Dimension |
|
Aspect_Dimension |
|
||||||
Aspect_Dimension_System |
|
Aspect_Dimension_System |
|
||||||
Aspect_Implicit_Dereference |
|
Aspect_Implicit_Dereference |
|
||||||
|
Aspect_Initial_Condition |
|
||||||
Aspect_Initializes |
|
Aspect_Initializes |
|
||||||
Aspect_Post |
|
Aspect_Post |
|
||||||
Aspect_Postcondition |
|
Aspect_Postcondition |
|
||||||
|
|
|
@ -2224,9 +2224,9 @@ package body Sem_Ch3 is
|
||||||
if Present (L) then
|
if Present (L) then
|
||||||
Context := Parent (L);
|
Context := Parent (L);
|
||||||
|
|
||||||
-- Analyze aspect/pragma Initializes of a package at the end of the
|
-- Analyze pragmas Initializes and Initial_Condition of a package at
|
||||||
-- visible declarations as the aspect/pragma has visibility over the
|
-- the end of the visible declarations as the pragmas have visibility
|
||||||
-- said region.
|
-- over the said region.
|
||||||
|
|
||||||
if Nkind (Context) = N_Package_Specification
|
if Nkind (Context) = N_Package_Specification
|
||||||
and then L = Visible_Declarations (Context)
|
and then L = Visible_Declarations (Context)
|
||||||
|
@ -2238,6 +2238,12 @@ package body Sem_Ch3 is
|
||||||
Analyze_Initializes_In_Decl_Part (Prag);
|
Analyze_Initializes_In_Decl_Part (Prag);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
Prag := Get_Pragma (Spec_Id, Pragma_Initial_Condition);
|
||||||
|
|
||||||
|
if Present (Prag) then
|
||||||
|
Analyze_Initial_Condition_In_Decl_Part (Prag);
|
||||||
|
end if;
|
||||||
|
|
||||||
-- Analyze the state refinements within a package body now, after
|
-- Analyze the state refinements within a package body now, after
|
||||||
-- all hidden states have been encountered and freely visible.
|
-- all hidden states have been encountered and freely visible.
|
||||||
-- Refinements must be processed before pragmas Refined_Depends and
|
-- Refinements must be processed before pragmas Refined_Depends and
|
||||||
|
|
|
@ -911,9 +911,9 @@ package body Sem_Prag is
|
||||||
-- as input. OUT parameters are valid inputs only when their type
|
-- as input. OUT parameters are valid inputs only when their type
|
||||||
-- is unconstrained or tagged as their discriminants, array bouns
|
-- is unconstrained or tagged as their discriminants, array bouns
|
||||||
-- or tags can be read. In general, states and variables are
|
-- or tags can be read. In general, states and variables are
|
||||||
-- considered to have mode IN OUT unless they are moded by pragma
|
-- considered to have mode IN OUT unless they are classified by
|
||||||
-- [Refined_]Global. In that case, the item must appear in an
|
-- pragma [Refined_]Global. In that case, the item must appear in
|
||||||
-- input global list.
|
-- an input global list.
|
||||||
|
|
||||||
if (Ekind (Item_Id) = E_Out_Parameter
|
if (Ekind (Item_Id) = E_Out_Parameter
|
||||||
and then not Is_Unconstrained_Or_Tagged_Item (Item_Id))
|
and then not Is_Unconstrained_Or_Tagged_Item (Item_Id))
|
||||||
|
@ -1964,6 +1964,194 @@ package body Sem_Prag is
|
||||||
end if;
|
end if;
|
||||||
end Analyze_Global_In_Decl_Part;
|
end Analyze_Global_In_Decl_Part;
|
||||||
|
|
||||||
|
--------------------------------------------
|
||||||
|
-- Analyze_Initial_Condition_In_Decl_Part --
|
||||||
|
--------------------------------------------
|
||||||
|
|
||||||
|
procedure Analyze_Initial_Condition_In_Decl_Part (N : Node_Id) is
|
||||||
|
Pack_Id : constant Entity_Id := Defining_Entity (Parent (Parent (N)));
|
||||||
|
Prag_Init : constant Node_Id :=
|
||||||
|
Get_Pragma (Pack_Id, Pragma_Initializes);
|
||||||
|
-- The related pragma Initializes
|
||||||
|
|
||||||
|
Vars : Elist_Id := No_Elist;
|
||||||
|
-- A list of all variables declared in pragma Initializes
|
||||||
|
|
||||||
|
procedure Collect_Variables;
|
||||||
|
-- Inspect the initialization list of pragma Initializes and collect the
|
||||||
|
-- entities of all variables declared within the related package.
|
||||||
|
|
||||||
|
function Match_Variable (N : Node_Id) return Traverse_Result;
|
||||||
|
-- Determine whether arbitrary node N denotes a variable declared in the
|
||||||
|
-- visible declarations of the related package.
|
||||||
|
|
||||||
|
procedure Report_Unused_Variables;
|
||||||
|
-- Emit errors for all variables found in list Vars
|
||||||
|
|
||||||
|
-----------------------
|
||||||
|
-- Collect_Variables --
|
||||||
|
-----------------------
|
||||||
|
|
||||||
|
procedure Collect_Variables is
|
||||||
|
procedure Collect_Variable (Item : Node_Id);
|
||||||
|
-- Determine whether Item denotes a variable that appears in the
|
||||||
|
-- related package and if it does, add it to list Vars.
|
||||||
|
|
||||||
|
----------------------
|
||||||
|
-- Collect_Variable --
|
||||||
|
----------------------
|
||||||
|
|
||||||
|
procedure Collect_Variable (Item : Node_Id) is
|
||||||
|
Item_Id : Entity_Id;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if Is_Entity_Name (Item) and then Present (Entity (Item)) then
|
||||||
|
Item_Id := Entity (Item);
|
||||||
|
|
||||||
|
-- The item is a variable declared in the related package
|
||||||
|
|
||||||
|
if Ekind (Item_Id) = E_Variable
|
||||||
|
and then Scope (Item_Id) = Pack_Id
|
||||||
|
then
|
||||||
|
Add_Item (Item_Id, Vars);
|
||||||
|
end if;
|
||||||
|
end if;
|
||||||
|
end Collect_Variable;
|
||||||
|
|
||||||
|
-- Local variables
|
||||||
|
|
||||||
|
Inits : constant Node_Id :=
|
||||||
|
Get_Pragma_Arg
|
||||||
|
(First (Pragma_Argument_Associations (Prag_Init)));
|
||||||
|
Init : Node_Id;
|
||||||
|
|
||||||
|
-- Start of processing for Collect_Variables
|
||||||
|
|
||||||
|
begin
|
||||||
|
-- Multiple initialization items appear as an aggregate
|
||||||
|
|
||||||
|
if Nkind (Inits) = N_Aggregate
|
||||||
|
and then Present (Expressions (Inits))
|
||||||
|
then
|
||||||
|
Init := First (Expressions (Inits));
|
||||||
|
while Present (Init) loop
|
||||||
|
Collect_Variable (Init);
|
||||||
|
|
||||||
|
Next (Init);
|
||||||
|
end loop;
|
||||||
|
|
||||||
|
-- Single initialization item
|
||||||
|
|
||||||
|
else
|
||||||
|
Collect_Variable (Inits);
|
||||||
|
end if;
|
||||||
|
end Collect_Variables;
|
||||||
|
|
||||||
|
--------------------
|
||||||
|
-- Match_Variable --
|
||||||
|
--------------------
|
||||||
|
|
||||||
|
function Match_Variable (N : Node_Id) return Traverse_Result is
|
||||||
|
Var_Id : Entity_Id;
|
||||||
|
|
||||||
|
begin
|
||||||
|
-- Find a variable declared within the related package and try to
|
||||||
|
-- remove it from the list of collected variables found in pragma
|
||||||
|
-- Initializes.
|
||||||
|
|
||||||
|
if Is_Entity_Name (N)
|
||||||
|
and then Present (Entity (N))
|
||||||
|
then
|
||||||
|
Var_Id := Entity (N);
|
||||||
|
|
||||||
|
if Ekind (Var_Id) = E_Variable
|
||||||
|
and then Scope (Var_Id) = Pack_Id
|
||||||
|
then
|
||||||
|
Remove (Vars, Var_Id);
|
||||||
|
end if;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
return OK;
|
||||||
|
end Match_Variable;
|
||||||
|
|
||||||
|
procedure Match_Variables is new Traverse_Proc (Match_Variable);
|
||||||
|
|
||||||
|
-----------------------------
|
||||||
|
-- Report_Unused_Variables --
|
||||||
|
-----------------------------
|
||||||
|
|
||||||
|
procedure Report_Unused_Variables is
|
||||||
|
Posted : Boolean := False;
|
||||||
|
Var_Elmt : Elmt_Id;
|
||||||
|
Var_Id : Entity_Id;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if Present (Vars) then
|
||||||
|
Var_Elmt := First_Elmt (Vars);
|
||||||
|
while Present (Var_Elmt) loop
|
||||||
|
Var_Id := Node (Var_Elmt);
|
||||||
|
|
||||||
|
if not Posted then
|
||||||
|
Posted := True;
|
||||||
|
Error_Msg_Name_1 := Name_Initial_Condition;
|
||||||
|
Error_Msg_N
|
||||||
|
("expression of % must mention the following variables",
|
||||||
|
N);
|
||||||
|
end if;
|
||||||
|
|
||||||
|
Error_Msg_Sloc := Sloc (Var_Id);
|
||||||
|
Error_Msg_NE ("\ & declared #", N, Var_Id);
|
||||||
|
|
||||||
|
Next_Elmt (Var_Elmt);
|
||||||
|
end loop;
|
||||||
|
end if;
|
||||||
|
end Report_Unused_Variables;
|
||||||
|
|
||||||
|
Expr : constant Node_Id :=
|
||||||
|
Get_Pragma_Arg (First (Pragma_Argument_Associations (N)));
|
||||||
|
Errors : constant Nat := Serious_Errors_Detected;
|
||||||
|
|
||||||
|
-- Start of processing for Analyze_Initial_Condition_In_Decl_Part
|
||||||
|
|
||||||
|
begin
|
||||||
|
Set_Analyzed (N);
|
||||||
|
|
||||||
|
-- Pragma Initial_Condition depends on the names enumerated in pragma
|
||||||
|
-- Initializes. Without those, the analysis cannot take place.
|
||||||
|
|
||||||
|
if No (Prag_Init) then
|
||||||
|
Error_Msg_Name_1 := Name_Initial_Condition;
|
||||||
|
Error_Msg_Name_2 := Name_Initializes;
|
||||||
|
|
||||||
|
Error_Msg_N ("% requires the presence of aspect or pragma %", N);
|
||||||
|
return;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
-- The expression is preanalyzed because it has not been moved to its
|
||||||
|
-- final place yet. A direct analysis may generate sife effects and this
|
||||||
|
-- is not desired at this point.
|
||||||
|
|
||||||
|
Preanalyze_And_Resolve (Expr, Standard_Boolean);
|
||||||
|
|
||||||
|
-- Perform variable matching only when the expression is legal
|
||||||
|
|
||||||
|
if Serious_Errors_Detected = Errors then
|
||||||
|
Collect_Variables;
|
||||||
|
|
||||||
|
-- Verify that all variables mentioned in pragma Initializes are used
|
||||||
|
-- in the expression of pragma Initial_Condition.
|
||||||
|
|
||||||
|
Match_Variables (Expr);
|
||||||
|
end if;
|
||||||
|
|
||||||
|
-- Emit errors for all variables that should participate in the
|
||||||
|
-- expression of pragma Initial_Condition.
|
||||||
|
|
||||||
|
if Serious_Errors_Detected = Errors then
|
||||||
|
Report_Unused_Variables;
|
||||||
|
end if;
|
||||||
|
end Analyze_Initial_Condition_In_Decl_Part;
|
||||||
|
|
||||||
--------------------------------------
|
--------------------------------------
|
||||||
-- Analyze_Initializes_In_Decl_Part --
|
-- Analyze_Initializes_In_Decl_Part --
|
||||||
--------------------------------------
|
--------------------------------------
|
||||||
|
@ -2451,10 +2639,10 @@ package body Sem_Prag is
|
||||||
-- UU_Typ is the related Unchecked_Union type. Flag In_Variant_Part
|
-- UU_Typ is the related Unchecked_Union type. Flag In_Variant_Part
|
||||||
-- should be set when Comp comes from a record variant.
|
-- should be set when Comp comes from a record variant.
|
||||||
|
|
||||||
procedure Check_Declaration_Order (States : Node_Id; Inits : Node_Id);
|
procedure Check_Declaration_Order (First : Node_Id; Second : Node_Id);
|
||||||
-- Subsidiary routine to the analysis of pragmas Abstract_State and
|
-- Subsidiary routine to the analysis of pragmas Abstract_State,
|
||||||
-- Initializes. Determine whether pragma Abstract_State denoted by
|
-- Initial_Condition and Initializes. Determine whether pragma First
|
||||||
-- States is defined earlier than pragma Initializes denoted by Inits.
|
-- appears before pragma Second. If this is not the case, emit an error.
|
||||||
|
|
||||||
procedure Check_Duplicate_Pragma (E : Entity_Id);
|
procedure Check_Duplicate_Pragma (E : Entity_Id);
|
||||||
-- Check if a rep item of the same name as the current pragma is already
|
-- Check if a rep item of the same name as the current pragma is already
|
||||||
|
@ -3433,7 +3621,7 @@ package body Sem_Prag is
|
||||||
-- Check_Declaration_Order --
|
-- Check_Declaration_Order --
|
||||||
-----------------------------
|
-----------------------------
|
||||||
|
|
||||||
procedure Check_Declaration_Order (States : Node_Id; Inits : Node_Id) is
|
procedure Check_Declaration_Order (First : Node_Id; Second : Node_Id) is
|
||||||
procedure Check_Aspect_Specification_Order;
|
procedure Check_Aspect_Specification_Order;
|
||||||
-- Inspect the aspect specifications of the context to determine the
|
-- Inspect the aspect specifications of the context to determine the
|
||||||
-- proper order.
|
-- proper order.
|
||||||
|
@ -3443,33 +3631,34 @@ package body Sem_Prag is
|
||||||
--------------------------------------
|
--------------------------------------
|
||||||
|
|
||||||
procedure Check_Aspect_Specification_Order is
|
procedure Check_Aspect_Specification_Order is
|
||||||
Asp_I : constant Node_Id := Corresponding_Aspect (Inits);
|
Asp_First : constant Node_Id := Corresponding_Aspect (First);
|
||||||
Asp_S : constant Node_Id := Corresponding_Aspect (States);
|
Asp_Second : constant Node_Id := Corresponding_Aspect (Second);
|
||||||
Asp : Node_Id;
|
Asp : Node_Id;
|
||||||
|
|
||||||
States_Seen : Boolean := False;
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
-- Both aspects must be part of the same aspect specification list
|
-- Both aspects must be part of the same aspect specification list
|
||||||
|
|
||||||
pragma Assert (List_Containing (Asp_I) = List_Containing (Asp_S));
|
pragma Assert
|
||||||
|
(List_Containing (Asp_First) = List_Containing (Asp_Second));
|
||||||
|
|
||||||
Asp := First (List_Containing (Asp_I));
|
-- Try to reach Second starting from First in a left to right
|
||||||
|
-- traversal of the aspect specifications.
|
||||||
|
|
||||||
|
Asp := Next (Asp_First);
|
||||||
while Present (Asp) loop
|
while Present (Asp) loop
|
||||||
if Get_Aspect_Id (Asp) = Aspect_Abstract_State then
|
|
||||||
States_Seen := True;
|
|
||||||
|
|
||||||
elsif Get_Aspect_Id (Asp) = Aspect_Initializes then
|
-- The order is ok, First is followed by Second
|
||||||
if not States_Seen then
|
|
||||||
Error_Msg_N
|
|
||||||
("aspect % must come before aspect %", States);
|
|
||||||
end if;
|
|
||||||
|
|
||||||
exit;
|
if Asp = Asp_Second then
|
||||||
|
return;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Next (Asp);
|
Next (Asp);
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
|
-- If we get here, then the aspects are out of order
|
||||||
|
|
||||||
|
Error_Msg_N ("aspect % cannot come after aspect %", First);
|
||||||
end Check_Aspect_Specification_Order;
|
end Check_Aspect_Specification_Order;
|
||||||
|
|
||||||
-- Local variables
|
-- Local variables
|
||||||
|
@ -3481,44 +3670,41 @@ package body Sem_Prag is
|
||||||
begin
|
begin
|
||||||
-- Cannot check the order if one of the pragmas is missing
|
-- Cannot check the order if one of the pragmas is missing
|
||||||
|
|
||||||
if No (States) or else No (Inits) then
|
if No (First) or else No (Second) then
|
||||||
return;
|
return;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Set up the error names in case the order is incorrect
|
-- Set up the error names in case the order is incorrect
|
||||||
|
|
||||||
Error_Msg_Name_1 := Name_Abstract_State;
|
Error_Msg_Name_1 := Pragma_Name (First);
|
||||||
Error_Msg_Name_2 := Name_Initializes;
|
Error_Msg_Name_2 := Pragma_Name (Second);
|
||||||
|
|
||||||
if From_Aspect_Specification (States) then
|
if From_Aspect_Specification (First) then
|
||||||
|
|
||||||
-- Both pragmas are actually aspects, check their declaration
|
-- Both pragmas are actually aspects, check their declaration
|
||||||
-- order in the associated aspect specification list. Otherwise
|
-- order in the associated aspect specification list. Otherwise
|
||||||
-- States is an aspect and Inits a source pragma.
|
-- First is an aspect and Second a source pragma.
|
||||||
|
|
||||||
if From_Aspect_Specification (Inits) then
|
if From_Aspect_Specification (Second) then
|
||||||
Check_Aspect_Specification_Order;
|
Check_Aspect_Specification_Order;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Abstract_States is a source pragma
|
-- Abstract_States is a source pragma
|
||||||
|
|
||||||
else
|
else
|
||||||
if From_Aspect_Specification (Inits) then
|
if From_Aspect_Specification (Second) then
|
||||||
Error_Msg_N ("pragma % cannot come after aspect %", States);
|
Error_Msg_N ("pragma % cannot come after aspect %", First);
|
||||||
|
|
||||||
-- Both pragmas are source constructs. Try to reach States from
|
-- Both pragmas are source constructs. Try to reach First from
|
||||||
-- Inits by traversing the declarations backwards.
|
-- Second by traversing the declarations backwards.
|
||||||
|
|
||||||
else
|
else
|
||||||
Stmt := Prev (Inits);
|
Stmt := Prev (Second);
|
||||||
while Present (Stmt) loop
|
while Present (Stmt) loop
|
||||||
|
|
||||||
-- The order is ok, Abstract_States is first followed by
|
-- The order is ok, First is followed by Second
|
||||||
-- Initializes.
|
|
||||||
|
|
||||||
if Nkind (Stmt) = N_Pragma
|
if Stmt = First then
|
||||||
and then Pragma_Name (Stmt) = Name_Abstract_State
|
|
||||||
then
|
|
||||||
return;
|
return;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
@ -3527,7 +3713,7 @@ package body Sem_Prag is
|
||||||
|
|
||||||
-- If we get here, then the pragmas are out of order
|
-- If we get here, then the pragmas are out of order
|
||||||
|
|
||||||
Error_Msg_N ("pragma % cannot come after pragma %", States);
|
Error_Msg_N ("pragma % cannot come after pragma %", First);
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
end Check_Declaration_Order;
|
end Check_Declaration_Order;
|
||||||
|
@ -9318,8 +9504,8 @@ package body Sem_Prag is
|
||||||
-- Initializes.
|
-- Initializes.
|
||||||
|
|
||||||
Check_Declaration_Order
|
Check_Declaration_Order
|
||||||
(States => N,
|
(First => N,
|
||||||
Inits => Get_Pragma (Pack_Id, Pragma_Initializes));
|
Second => Get_Pragma (Pack_Id, Pragma_Initializes));
|
||||||
|
|
||||||
State := Expression (Arg1);
|
State := Expression (Arg1);
|
||||||
|
|
||||||
|
@ -9732,6 +9918,7 @@ package body Sem_Prag is
|
||||||
-- Assume |
|
-- Assume |
|
||||||
-- Contract_Cases |
|
-- Contract_Cases |
|
||||||
-- Debug |
|
-- Debug |
|
||||||
|
-- Initial_Condition |
|
||||||
-- Loop_Invariant |
|
-- Loop_Invariant |
|
||||||
-- Loop_Variant |
|
-- Loop_Variant |
|
||||||
-- Postcondition |
|
-- Postcondition |
|
||||||
|
@ -13380,6 +13567,80 @@ package body Sem_Prag is
|
||||||
end if;
|
end if;
|
||||||
end Independent_Components;
|
end Independent_Components;
|
||||||
|
|
||||||
|
-----------------------
|
||||||
|
-- Initial_Condition --
|
||||||
|
-----------------------
|
||||||
|
|
||||||
|
-- pragma Initial_Condition (boolean_EXPRESSION);
|
||||||
|
|
||||||
|
when Pragma_Initial_Condition => Initial_Condition : declare
|
||||||
|
Context : constant Node_Id := Parent (Parent (N));
|
||||||
|
Pack_Id : Entity_Id;
|
||||||
|
Stmt : Node_Id;
|
||||||
|
|
||||||
|
begin
|
||||||
|
GNAT_Pragma;
|
||||||
|
S14_Pragma;
|
||||||
|
Check_Arg_Count (1);
|
||||||
|
|
||||||
|
-- Ensure the proper placement of the pragma. Initial_Condition
|
||||||
|
-- must be associated with a package declaration.
|
||||||
|
|
||||||
|
if not Nkind_In (Context, N_Generic_Package_Declaration,
|
||||||
|
N_Package_Declaration)
|
||||||
|
then
|
||||||
|
Pragma_Misplaced;
|
||||||
|
return;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
Stmt := Prev (N);
|
||||||
|
while Present (Stmt) loop
|
||||||
|
|
||||||
|
-- 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 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;
|
||||||
|
|
||||||
|
-- The pragma must be analyzed at the end of the visible
|
||||||
|
-- declarations of the related package. Save the pragma for later
|
||||||
|
-- (see Analyze_Initial_Condition_In_Decl_Part) by adding it to
|
||||||
|
-- the contract of the package.
|
||||||
|
|
||||||
|
Pack_Id := Defining_Entity (Context);
|
||||||
|
Add_Contract_Item (N, Pack_Id);
|
||||||
|
|
||||||
|
-- Verify the declaration order of pragma Initial_Condition with
|
||||||
|
-- respect to pragmas Abstract_State and Initializes.
|
||||||
|
|
||||||
|
Check_Declaration_Order
|
||||||
|
(First => Get_Pragma (Pack_Id, Pragma_Abstract_State),
|
||||||
|
Second => N);
|
||||||
|
|
||||||
|
Check_Declaration_Order
|
||||||
|
(First => Get_Pragma (Pack_Id, Pragma_Initializes),
|
||||||
|
Second => N);
|
||||||
|
end Initial_Condition;
|
||||||
|
|
||||||
------------------------
|
------------------------
|
||||||
-- Initialize_Scalars --
|
-- Initialize_Scalars --
|
||||||
------------------------
|
------------------------
|
||||||
|
@ -13461,8 +13722,8 @@ package body Sem_Prag is
|
||||||
elsif not Comes_From_Source (Stmt) then
|
elsif not Comes_From_Source (Stmt) then
|
||||||
null;
|
null;
|
||||||
|
|
||||||
-- The pragma does not apply to a legal construct, issue an
|
-- The pragma does not apply to a legal construct, issue an
|
||||||
-- error and stop the analysis.
|
-- error and stop the analysis.
|
||||||
|
|
||||||
else
|
else
|
||||||
Pragma_Misplaced;
|
Pragma_Misplaced;
|
||||||
|
@ -13484,8 +13745,8 @@ package body Sem_Prag is
|
||||||
-- Initializes.
|
-- Initializes.
|
||||||
|
|
||||||
Check_Declaration_Order
|
Check_Declaration_Order
|
||||||
(States => Get_Pragma (Pack_Id, Pragma_Abstract_State),
|
(First => Get_Pragma (Pack_Id, Pragma_Abstract_State),
|
||||||
Inits => N);
|
Second => N);
|
||||||
end Initializes;
|
end Initializes;
|
||||||
|
|
||||||
------------
|
------------
|
||||||
|
@ -16979,8 +17240,8 @@ package body Sem_Prag is
|
||||||
elsif not Comes_From_Source (Stmt) then
|
elsif not Comes_From_Source (Stmt) then
|
||||||
null;
|
null;
|
||||||
|
|
||||||
-- The pragma does not apply to a legal construct, issue an
|
-- The pragma does not apply to a legal construct, issue an
|
||||||
-- error and stop the analysis.
|
-- error and stop the analysis.
|
||||||
|
|
||||||
else
|
else
|
||||||
Pragma_Misplaced;
|
Pragma_Misplaced;
|
||||||
|
@ -22429,6 +22690,7 @@ package body Sem_Prag is
|
||||||
Pragma_Import_Valued_Procedure => 0,
|
Pragma_Import_Valued_Procedure => 0,
|
||||||
Pragma_Independent => 0,
|
Pragma_Independent => 0,
|
||||||
Pragma_Independent_Components => 0,
|
Pragma_Independent_Components => 0,
|
||||||
|
Pragma_Initial_Condition => -1,
|
||||||
Pragma_Initialize_Scalars => -1,
|
Pragma_Initialize_Scalars => -1,
|
||||||
Pragma_Initializes => -1,
|
Pragma_Initializes => -1,
|
||||||
Pragma_Inline => 0,
|
Pragma_Inline => 0,
|
||||||
|
@ -22822,6 +23084,7 @@ package body Sem_Prag is
|
||||||
Name_Assume |
|
Name_Assume |
|
||||||
Name_Contract_Cases |
|
Name_Contract_Cases |
|
||||||
Name_Debug |
|
Name_Debug |
|
||||||
|
Name_Initial_Condition |
|
||||||
Name_Invariant |
|
Name_Invariant |
|
||||||
Name_uInvariant |
|
Name_uInvariant |
|
||||||
Name_Loop_Invariant |
|
Name_Loop_Invariant |
|
||||||
|
|
|
@ -64,6 +64,9 @@ package Sem_Prag is
|
||||||
-- Perform full analysis of delayed pragma Global. This routine is also
|
-- Perform full analysis of delayed pragma Global. This routine is also
|
||||||
-- capable of performing basic analysis of pragma Refind_Global.
|
-- capable of performing basic analysis of pragma Refind_Global.
|
||||||
|
|
||||||
|
procedure Analyze_Initial_Condition_In_Decl_Part (N : Node_Id);
|
||||||
|
-- Perform full analysis of delayed pragma Initial_Condition
|
||||||
|
|
||||||
procedure Analyze_Initializes_In_Decl_Part (N : Node_Id);
|
procedure Analyze_Initializes_In_Decl_Part (N : Node_Id);
|
||||||
-- Perform full analysis of delayed pragma Initializes
|
-- Perform full analysis of delayed pragma Initializes
|
||||||
|
|
||||||
|
|
|
@ -229,10 +229,14 @@ package body Sem_Util is
|
||||||
-- Contract items related to [generic] packages. The applicable pragmas
|
-- Contract items related to [generic] packages. The applicable pragmas
|
||||||
-- are:
|
-- are:
|
||||||
-- Abstract_States
|
-- Abstract_States
|
||||||
|
-- Initial_Condition
|
||||||
-- Initializes
|
-- Initializes
|
||||||
|
|
||||||
if Ekind_In (Id, E_Generic_Package, E_Package) then
|
if Ekind_In (Id, E_Generic_Package, E_Package) then
|
||||||
if Nam_In (Nam, Name_Abstract_State, Name_Initializes) then
|
if Nam_In (Nam, Name_Abstract_State,
|
||||||
|
Name_Initial_Condition,
|
||||||
|
Name_Initializes)
|
||||||
|
then
|
||||||
Set_Next_Pragma (Prag, Classifications (Items));
|
Set_Next_Pragma (Prag, Classifications (Items));
|
||||||
Set_Classifications (Items, Prag);
|
Set_Classifications (Items, Prag);
|
||||||
|
|
||||||
|
|
|
@ -50,6 +50,7 @@ package Sem_Util is
|
||||||
-- Contract_Cases
|
-- Contract_Cases
|
||||||
-- Depends
|
-- Depends
|
||||||
-- Global
|
-- Global
|
||||||
|
-- Initial_Condition
|
||||||
-- Initializes
|
-- Initializes
|
||||||
-- Postcondition
|
-- Postcondition
|
||||||
-- Precondition
|
-- Precondition
|
||||||
|
|
|
@ -7198,6 +7198,7 @@ package Sinfo is
|
||||||
-- Abstract_States
|
-- Abstract_States
|
||||||
-- Depends
|
-- Depends
|
||||||
-- Global
|
-- Global
|
||||||
|
-- Initial_Condition
|
||||||
-- Initializes
|
-- Initializes
|
||||||
-- Refined_Depends
|
-- Refined_Depends
|
||||||
-- Refined_Global
|
-- Refined_Global
|
||||||
|
|
|
@ -509,6 +509,7 @@ package Snames is
|
||||||
Name_Import_Valued_Procedure : constant Name_Id := N + $; -- GNAT
|
Name_Import_Valued_Procedure : constant Name_Id := N + $; -- GNAT
|
||||||
Name_Independent : constant Name_Id := N + $; -- Ada 12
|
Name_Independent : constant Name_Id := N + $; -- Ada 12
|
||||||
Name_Independent_Components : constant Name_Id := N + $; -- Ada 12
|
Name_Independent_Components : constant Name_Id := N + $; -- Ada 12
|
||||||
|
Name_Initial_Condition : constant Name_Id := N + $; -- GNAT
|
||||||
Name_Initializes : constant Name_Id := N + $; -- GNAT
|
Name_Initializes : constant Name_Id := N + $; -- GNAT
|
||||||
Name_Inline : constant Name_Id := N + $;
|
Name_Inline : constant Name_Id := N + $;
|
||||||
Name_Inline_Always : constant Name_Id := N + $; -- GNAT
|
Name_Inline_Always : constant Name_Id := N + $; -- GNAT
|
||||||
|
@ -1829,6 +1830,7 @@ package Snames is
|
||||||
Pragma_Import_Valued_Procedure,
|
Pragma_Import_Valued_Procedure,
|
||||||
Pragma_Independent,
|
Pragma_Independent,
|
||||||
Pragma_Independent_Components,
|
Pragma_Independent_Components,
|
||||||
|
Pragma_Initial_Condition,
|
||||||
Pragma_Initializes,
|
Pragma_Initializes,
|
||||||
Pragma_Inline,
|
Pragma_Inline,
|
||||||
Pragma_Inline_Always,
|
Pragma_Inline_Always,
|
||||||
|
|
Loading…
Reference in New Issue