[multiple changes]
2013-04-25 Hristian Kirtchev <kirtchev@adacore.com> * einfo.adb (Set_Abstract_States): The attribute now applies to generic packages. * sem_ch4.adb (Referenced): Moved to sem_util. * sem_ch7.adb (Unit_Requires_Body): A [generic] package with a non-null abstract state needs a body. * sem_prag.adb (Analyze_Depends_In_Decl_Part): Update the calls to Collect_Subprogram_Inputs_Outputs. (Analyze_Global_Item): Verify the proper usage of an item with mode In_Out or Output relative to the enclosing context. (Analyze_Pragma): Abstract_State can now be applied to a generic package. Do not reset the Analyzed flag for pragmas Depends and Global as this is not needed. (Appears_In): Moved to library level. (Check_Mode_Restiction_In_Enclosing_Context): New routine. (Collect_Subprogram_Inputs_Outputs): Moved to library level. Add formal parameters Subp_Id, Subp_Inputs, Subp_Outputs and Global seen along with comments on usage. * sem_util.ads, sem_util.adb (Referenced): New routine. 2013-04-25 Hristian Kirtchev <kirtchev@adacore.com> * sem_ch6.adb (Expand_Contract_Cases): Generate detailed error messages only when switch -gnateE is in effect. 2013-04-25 Yannick Moy <moy@adacore.com> * sem_attr.adb (Analyze_Attribute): Do not issue an error for a possibly misplaced 'Result or 'Old attribute when analyzing the aspect. From-SVN: r198290
This commit is contained in:
Arnaud Charlet
parent
d1ec4768ad
commit
f40f731b98
@ -1,3 +1,35 @@
|
||||
2013-04-25 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* einfo.adb (Set_Abstract_States): The attribute now applies
|
||||
to generic packages.
|
||||
* sem_ch4.adb (Referenced): Moved to sem_util.
|
||||
* sem_ch7.adb (Unit_Requires_Body): A [generic] package with
|
||||
a non-null abstract state needs a body.
|
||||
* sem_prag.adb (Analyze_Depends_In_Decl_Part): Update the calls
|
||||
to Collect_Subprogram_Inputs_Outputs.
|
||||
(Analyze_Global_Item): Verify the proper usage of an item with mode
|
||||
In_Out or Output relative to the enclosing context.
|
||||
(Analyze_Pragma): Abstract_State can now be applied to a generic
|
||||
package. Do not reset the Analyzed flag for pragmas Depends and Global
|
||||
as this is not needed.
|
||||
(Appears_In): Moved to library level.
|
||||
(Check_Mode_Restiction_In_Enclosing_Context): New routine.
|
||||
(Collect_Subprogram_Inputs_Outputs): Moved to library level. Add
|
||||
formal parameters Subp_Id, Subp_Inputs, Subp_Outputs and Global
|
||||
seen along with comments on usage.
|
||||
* sem_util.ads, sem_util.adb (Referenced): New routine.
|
||||
|
||||
2013-04-25 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* sem_ch6.adb (Expand_Contract_Cases): Generate
|
||||
detailed error messages only when switch -gnateE is in effect.
|
||||
|
||||
2013-04-25 Yannick Moy <moy@adacore.com>
|
||||
|
||||
* sem_attr.adb (Analyze_Attribute): Do not issue
|
||||
an error for a possibly misplaced 'Result or 'Old attribute when
|
||||
analyzing the aspect.
|
||||
|
||||
2013-04-25 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_ch12.adb, sem_util.adb, sem_ch4.adb: Minor reformatting.
|
||||
|
||||
@ -3233,7 +3233,7 @@ package body Einfo is
|
||||
|
||||
procedure Set_Abstract_States (Id : E; V : L) is
|
||||
begin
|
||||
pragma Assert (Ekind (Id) = E_Package);
|
||||
pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package));
|
||||
Set_Elist25 (Id, V);
|
||||
end Set_Abstract_States;
|
||||
|
||||
|
||||
@ -4222,15 +4222,24 @@ package body Sem_Attr is
|
||||
-- Check in postcondition, Test_Case or Contract_Cases
|
||||
|
||||
Prag := N;
|
||||
while not Nkind_In (Prag, N_Pragma,
|
||||
N_Function_Specification,
|
||||
N_Procedure_Specification,
|
||||
N_Subprogram_Body)
|
||||
while Present (Prag)
|
||||
and then not Nkind_In (Prag, N_Pragma,
|
||||
N_Function_Specification,
|
||||
N_Procedure_Specification,
|
||||
N_Aspect_Specification,
|
||||
N_Subprogram_Body)
|
||||
loop
|
||||
Prag := Parent (Prag);
|
||||
end loop;
|
||||
|
||||
if Nkind (Prag) /= N_Pragma then
|
||||
-- In ASIS mode, the aspect itself is analyzed, in addition to the
|
||||
-- corresponding pragma. Do not issue errors when analyzing the
|
||||
-- aspect.
|
||||
|
||||
if Nkind (Prag) = N_Aspect_Specification then
|
||||
null;
|
||||
|
||||
elsif Nkind (Prag) /= N_Pragma then
|
||||
Error_Attr ("% attribute can only appear in postcondition", P);
|
||||
|
||||
elsif Get_Pragma_Id (Prag) = Pragma_Test_Case then
|
||||
@ -4241,7 +4250,7 @@ package body Sem_Attr is
|
||||
|
||||
begin
|
||||
Arg := N;
|
||||
while Arg /= Prag and Arg /= Arg_Ens loop
|
||||
while Arg /= Prag and then Arg /= Arg_Ens loop
|
||||
Arg := Parent (Arg);
|
||||
end loop;
|
||||
|
||||
@ -4258,7 +4267,7 @@ package body Sem_Attr is
|
||||
|
||||
begin
|
||||
Arg := N;
|
||||
while Arg /= Prag and Parent (Parent (Arg)) /= Aggr loop
|
||||
while Arg /= Prag and then Parent (Parent (Arg)) /= Aggr loop
|
||||
Arg := Parent (Arg);
|
||||
end loop;
|
||||
|
||||
@ -4628,14 +4637,23 @@ package body Sem_Attr is
|
||||
-- Check in postcondition, Test_Case or Contract_Cases of function
|
||||
|
||||
Prag := N;
|
||||
while not Nkind_In (Prag, N_Pragma,
|
||||
N_Function_Specification,
|
||||
N_Subprogram_Body)
|
||||
while Present (Prag)
|
||||
and then not Nkind_In (Prag, N_Pragma,
|
||||
N_Function_Specification,
|
||||
N_Aspect_Specification,
|
||||
N_Subprogram_Body)
|
||||
loop
|
||||
Prag := Parent (Prag);
|
||||
end loop;
|
||||
|
||||
if Nkind (Prag) /= N_Pragma then
|
||||
-- In ASIS mode, the aspect itself is analyzed, in addition to the
|
||||
-- corresponding pragma. Do not issue errors when analyzing the
|
||||
-- aspect.
|
||||
|
||||
if Nkind (Prag) = N_Aspect_Specification then
|
||||
null;
|
||||
|
||||
elsif Nkind (Prag) /= N_Pragma then
|
||||
Error_Attr
|
||||
("% attribute can only appear in postcondition of function",
|
||||
P);
|
||||
@ -4648,7 +4666,7 @@ package body Sem_Attr is
|
||||
|
||||
begin
|
||||
Arg := N;
|
||||
while Arg /= Prag and Arg /= Arg_Ens loop
|
||||
while Arg /= Prag and then Arg /= Arg_Ens loop
|
||||
Arg := Parent (Arg);
|
||||
end loop;
|
||||
|
||||
@ -4665,7 +4683,7 @@ package body Sem_Attr is
|
||||
|
||||
begin
|
||||
Arg := N;
|
||||
while Arg /= Prag and Parent (Parent (Arg)) /= Aggr loop
|
||||
while Arg /= Prag and then Parent (Parent (Arg)) /= Aggr loop
|
||||
Arg := Parent (Arg);
|
||||
end loop;
|
||||
|
||||
|
||||
@ -3510,10 +3510,6 @@ package body Sem_Ch4 is
|
||||
-- Determine whether if expression If_Expr lacks an else part or if it
|
||||
-- has one, it evaluates to True.
|
||||
|
||||
function Referenced (Id : Entity_Id; Expr : Node_Id) return Boolean;
|
||||
-- Determine whether entity Id is referenced within expression Expr
|
||||
-- This should be moved to sem_util ???
|
||||
|
||||
--------------------
|
||||
-- Is_Empty_Range --
|
||||
--------------------
|
||||
@ -3565,43 +3561,6 @@ package body Sem_Ch4 is
|
||||
and then Is_True (Expr_Value (Else_Expr)));
|
||||
end No_Else_Or_Trivial_True;
|
||||
|
||||
----------------
|
||||
-- Referenced --
|
||||
----------------
|
||||
|
||||
function Referenced (Id : Entity_Id; Expr : Node_Id) return Boolean is
|
||||
Seen : Boolean := False;
|
||||
|
||||
function Is_Reference (N : Node_Id) return Traverse_Result;
|
||||
-- Determine whether node N denotes a reference to Id. If this is the
|
||||
-- case, set global flag Seen to True and stop the traversal.
|
||||
|
||||
------------------
|
||||
-- Is_Reference --
|
||||
------------------
|
||||
|
||||
function Is_Reference (N : Node_Id) return Traverse_Result is
|
||||
begin
|
||||
if Is_Entity_Name (N)
|
||||
and then Present (Entity (N))
|
||||
and then Entity (N) = Id
|
||||
then
|
||||
Seen := True;
|
||||
return Abandon;
|
||||
else
|
||||
return OK;
|
||||
end if;
|
||||
end Is_Reference;
|
||||
|
||||
procedure Inspect_Expression is new Traverse_Proc (Is_Reference);
|
||||
|
||||
-- Start of processing for Referenced
|
||||
|
||||
begin
|
||||
Inspect_Expression (Expr);
|
||||
return Seen;
|
||||
end Referenced;
|
||||
|
||||
-- Local variables
|
||||
|
||||
Cond : constant Node_Id := Condition (N);
|
||||
|
||||
@ -11655,7 +11655,7 @@ package body Sem_Ch6 is
|
||||
|
||||
-- Check possible overlap between a case guard and "others"
|
||||
|
||||
if Multiple_PCs then
|
||||
if Multiple_PCs and then Exception_Extra_Info then
|
||||
Case_Guard_Error
|
||||
(Decls => Error_Decls,
|
||||
Flag => Others_Flag,
|
||||
@ -11695,7 +11695,7 @@ package body Sem_Ch6 is
|
||||
-- Check whether this case guard overlaps with another case
|
||||
-- guard.
|
||||
|
||||
if Multiple_PCs then
|
||||
if Multiple_PCs and then Exception_Extra_Info then
|
||||
Case_Guard_Error
|
||||
(Decls => Error_Decls,
|
||||
Flag => Flag,
|
||||
|
||||
@ -2615,6 +2615,16 @@ package body Sem_Ch7 is
|
||||
return True;
|
||||
end if;
|
||||
end;
|
||||
|
||||
-- A [generic] package that introduces at least one non-null abstract
|
||||
-- state requires completion. A null abstract state always appears as
|
||||
-- the sole element of the state list.
|
||||
|
||||
elsif Ekind_In (P, E_Generic_Package, E_Package)
|
||||
and then Present (Abstract_States (P))
|
||||
and then not Is_Null_State (Node (First_Elmt (Abstract_States (P))))
|
||||
then
|
||||
return True;
|
||||
end if;
|
||||
|
||||
-- Otherwise search entity chain for entity requiring completion
|
||||
|
||||
@ -181,6 +181,22 @@ package body Sem_Prag is
|
||||
-- to Uppercase or Lowercase, then a new string literal with appropriate
|
||||
-- casing is constructed.
|
||||
|
||||
function Appears_In (List : Elist_Id; Item_Id : Entity_Id) return Boolean;
|
||||
-- Subsidiary to the analysis of pragma Global and pragma Depends. Query
|
||||
-- whether a particular item appears in a mixed list of nodes and entities.
|
||||
-- It is assumed that all nodes in the list have entities.
|
||||
|
||||
procedure Collect_Subprogram_Inputs_Outputs
|
||||
(Subp_Id : Entity_Id;
|
||||
Subp_Inputs : in out Elist_Id;
|
||||
Subp_Outputs : in out Elist_Id;
|
||||
Global_Seen : out Boolean);
|
||||
-- Subsidiary to the analysis of pragma Global and pragma Depends. Gather
|
||||
-- all inputs and outputs of subprogram Subp_Id in lists Subp_Inputs and
|
||||
-- Subp_Outputs. If the case where the subprogram has no inputs and/or
|
||||
-- outputs, the corresponding returned list is No_Elist. Flag Global_Seen
|
||||
-- is set when the related subprogram has aspect/pragma Global.
|
||||
|
||||
function Find_Related_Subprogram
|
||||
(Prag : Node_Id;
|
||||
Check_Duplicates : Boolean := False) return Node_Id;
|
||||
@ -448,12 +464,6 @@ package body Sem_Prag is
|
||||
-- Verify the legality of a single dependency clause. Flag Is_Last
|
||||
-- denotes whether Clause is the last clause in the relation.
|
||||
|
||||
function Appears_In
|
||||
(List : Elist_Id;
|
||||
Item_Id : Entity_Id) return Boolean;
|
||||
-- Determine whether a particular item appears in a mixed list of nodes
|
||||
-- and entities.
|
||||
|
||||
procedure Check_Function_Return;
|
||||
-- Verify that Funtion'Result appears as one of the outputs
|
||||
|
||||
@ -476,10 +486,6 @@ package body Sem_Prag is
|
||||
-- Verify that all items from Subp_Items appear in Used_Items. Emit an
|
||||
-- error if this is not the case.
|
||||
|
||||
procedure Collect_Subprogram_Inputs_Outputs;
|
||||
-- Gather all inputs and outputs of the subprogram. These are the formal
|
||||
-- parameters and entities classified in pragma Global.
|
||||
|
||||
procedure Normalize_Clause (Clause : Node_Id);
|
||||
-- Remove a self-dependency "+" from the input list of a clause.
|
||||
-- Depending on the contents of the relation, either split the the
|
||||
@ -787,38 +793,6 @@ package body Sem_Prag is
|
||||
Analyze_Input_List (Inputs);
|
||||
end Analyze_Dependency_Clause;
|
||||
|
||||
----------------
|
||||
-- Appears_In --
|
||||
----------------
|
||||
|
||||
function Appears_In
|
||||
(List : Elist_Id;
|
||||
Item_Id : Entity_Id) return Boolean
|
||||
is
|
||||
Elmt : Elmt_Id;
|
||||
Id : Entity_Id;
|
||||
|
||||
begin
|
||||
if Present (List) then
|
||||
Elmt := First_Elmt (List);
|
||||
while Present (Elmt) loop
|
||||
if Nkind (Node (Elmt)) = N_Defining_Identifier then
|
||||
Id := Node (Elmt);
|
||||
else
|
||||
Id := Entity (Node (Elmt));
|
||||
end if;
|
||||
|
||||
if Id = Item_Id then
|
||||
return True;
|
||||
end if;
|
||||
|
||||
Next_Elmt (Elmt);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
return False;
|
||||
end Appears_In;
|
||||
|
||||
----------------------------
|
||||
-- Check_Function_Return --
|
||||
----------------------------
|
||||
@ -961,138 +935,6 @@ package body Sem_Prag is
|
||||
end loop;
|
||||
end Check_Usage;
|
||||
|
||||
---------------------------------------
|
||||
-- Collect_Subprogram_Inputs_Outputs --
|
||||
---------------------------------------
|
||||
|
||||
procedure Collect_Subprogram_Inputs_Outputs is
|
||||
procedure Collect_Global_List
|
||||
(List : Node_Id;
|
||||
Mode : Name_Id := Name_Input);
|
||||
-- Collect all relevant items from a global list
|
||||
|
||||
-------------------------
|
||||
-- Collect_Global_List --
|
||||
-------------------------
|
||||
|
||||
procedure Collect_Global_List
|
||||
(List : Node_Id;
|
||||
Mode : Name_Id := Name_Input)
|
||||
is
|
||||
procedure Collect_Global_Item
|
||||
(Item : Node_Id;
|
||||
Mode : Name_Id);
|
||||
-- Add an item to the proper subprogram input or output collection
|
||||
|
||||
-------------------------
|
||||
-- Collect_Global_Item --
|
||||
-------------------------
|
||||
|
||||
procedure Collect_Global_Item
|
||||
(Item : Node_Id;
|
||||
Mode : Name_Id)
|
||||
is
|
||||
begin
|
||||
if Nam_In (Mode, Name_In_Out, Name_Input) then
|
||||
Add_Item (Item, Subp_Inputs);
|
||||
end if;
|
||||
|
||||
if Nam_In (Mode, Name_In_Out, Name_Output) then
|
||||
Add_Item (Item, Subp_Outputs);
|
||||
end if;
|
||||
end Collect_Global_Item;
|
||||
|
||||
-- Local variables
|
||||
|
||||
Assoc : Node_Id;
|
||||
Item : Node_Id;
|
||||
|
||||
-- Start of processing for Collect_Global_List
|
||||
|
||||
begin
|
||||
-- Single global item declaration
|
||||
|
||||
if Nkind_In (List, N_Identifier, N_Selected_Component) then
|
||||
Collect_Global_Item (List, Mode);
|
||||
|
||||
-- Simple global list or moded global list declaration
|
||||
|
||||
else
|
||||
if Present (Expressions (List)) then
|
||||
Item := First (Expressions (List));
|
||||
while Present (Item) loop
|
||||
Collect_Global_Item (Item, Mode);
|
||||
|
||||
Next (Item);
|
||||
end loop;
|
||||
|
||||
else
|
||||
Assoc := First (Component_Associations (List));
|
||||
while Present (Assoc) loop
|
||||
Collect_Global_List
|
||||
(List => Expression (Assoc),
|
||||
Mode => Chars (First (Choices (Assoc))));
|
||||
|
||||
Next (Assoc);
|
||||
end loop;
|
||||
end if;
|
||||
end if;
|
||||
end Collect_Global_List;
|
||||
|
||||
-- Local variables
|
||||
|
||||
Formal : Entity_Id;
|
||||
Global : Node_Id;
|
||||
List : Node_Id;
|
||||
|
||||
-- Start of processing for Collect_Subprogram_Inputs_Outputs
|
||||
|
||||
begin
|
||||
-- Process all formal parameters
|
||||
|
||||
Formal := First_Formal (Subp_Id);
|
||||
while Present (Formal) loop
|
||||
if Ekind_In (Formal, E_In_Out_Parameter, E_In_Parameter) then
|
||||
Add_Item (Formal, Subp_Inputs);
|
||||
end if;
|
||||
|
||||
if Ekind_In (Formal, E_In_Out_Parameter, E_Out_Parameter) then
|
||||
Add_Item (Formal, Subp_Outputs);
|
||||
end if;
|
||||
|
||||
Next_Formal (Formal);
|
||||
end loop;
|
||||
|
||||
-- If the subprogram is subject to pragma Global, traverse all global
|
||||
-- lists and gather the relevant items.
|
||||
|
||||
Global := Find_Aspect (Subp_Id, Aspect_Global);
|
||||
if Present (Global) then
|
||||
Global_Seen := True;
|
||||
|
||||
-- Retrieve the pragma as it contains the analyzed lists
|
||||
|
||||
Global := Aspect_Rep_Item (Global);
|
||||
|
||||
-- The pragma may not have been analyzed because of the arbitrary
|
||||
-- declaration order of aspects. Make sure that it is analyzed for
|
||||
-- the purposes of item extraction.
|
||||
|
||||
if not Analyzed (Global) then
|
||||
Analyze_Global_In_Decl_Part (Global);
|
||||
end if;
|
||||
|
||||
List :=
|
||||
Expression (First (Pragma_Argument_Associations (Global)));
|
||||
|
||||
-- Nothing to be done for a null global list
|
||||
|
||||
if Nkind (List) /= N_Null then
|
||||
Collect_Global_List (List);
|
||||
end if;
|
||||
end if;
|
||||
end Collect_Subprogram_Inputs_Outputs;
|
||||
|
||||
----------------------
|
||||
-- Normalize_Clause --
|
||||
----------------------
|
||||
@ -1382,7 +1224,11 @@ package body Sem_Prag is
|
||||
-- subprogram may depend on. These items are obtained from the
|
||||
-- parameter profile or pragma Global (if available).
|
||||
|
||||
Collect_Subprogram_Inputs_Outputs;
|
||||
Collect_Subprogram_Inputs_Outputs
|
||||
(Subp_Id => Subp_Id,
|
||||
Subp_Inputs => Subp_Inputs,
|
||||
Subp_Outputs => Subp_Outputs,
|
||||
Global_Seen => Global_Seen);
|
||||
|
||||
-- Verify that every input or output of the subprogram appear in a
|
||||
-- dependency.
|
||||
@ -1402,7 +1248,11 @@ package body Sem_Prag is
|
||||
-- subprogram may depend on. These items are obtained from the
|
||||
-- parameter profile or pragma Global (if available).
|
||||
|
||||
Collect_Subprogram_Inputs_Outputs;
|
||||
Collect_Subprogram_Inputs_Outputs
|
||||
(Subp_Id => Subp_Id,
|
||||
Subp_Inputs => Subp_Inputs,
|
||||
Subp_Outputs => Subp_Outputs,
|
||||
Global_Seen => Global_Seen);
|
||||
|
||||
-- Ensure that the formal parameters are visible when analyzing all
|
||||
-- clauses. This falls out of the general rule of aspects pertaining
|
||||
@ -1505,6 +1355,14 @@ package body Sem_Prag is
|
||||
-- processing a global list. This routine verifies that Mode is not a
|
||||
-- duplicate mode and sets the flag Status.
|
||||
|
||||
procedure Check_Mode_Restiction_In_Enclosing_Context
|
||||
(Item : Node_Id;
|
||||
Item_Id : Entity_Id);
|
||||
-- Verify that an item of mode In_Out or Output does not appear as an
|
||||
-- input in the Global aspect of an enclosing subprogram. If this is
|
||||
-- the case, emit an error. Item and Item_Id are respectively the
|
||||
-- item and its entity.
|
||||
|
||||
procedure Check_Mode_Restriction_In_Function (Mode : Node_Id);
|
||||
-- Mode denotes either In_Out or Output. Depending on the kind of the
|
||||
-- related subprogram, emit an error if those two modes apply to a
|
||||
@ -1574,18 +1432,8 @@ package body Sem_Prag is
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- The same entity might be referenced through various way. Check
|
||||
-- the entity of the item rather than the item itself.
|
||||
|
||||
if Contains (Seen, Item_Id) then
|
||||
Error_Msg_N ("duplicate global item", Item);
|
||||
|
||||
-- Add the entity of the current item to the list of processed
|
||||
-- items.
|
||||
|
||||
else
|
||||
Add_Item (Item_Id, Seen);
|
||||
end if;
|
||||
-- At this point we know that the global item is one of the two
|
||||
-- valid choices. Perform mode- and usage-specific checks.
|
||||
|
||||
if Ekind (Item_Id) = E_Abstract_State
|
||||
and then Is_Volatile_State (Item_Id)
|
||||
@ -1611,6 +1459,26 @@ package body Sem_Prag is
|
||||
& "Volatile Output state", Item);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Verify that an output does not appear as an input in an
|
||||
-- enclosing subprogram.
|
||||
|
||||
if Nam_In (Global_Mode, Name_In_Out, Name_Output) then
|
||||
Check_Mode_Restiction_In_Enclosing_Context (Item, Item_Id);
|
||||
end if;
|
||||
|
||||
-- The same entity might be referenced through various way. Check
|
||||
-- the entity of the item rather than the item itself.
|
||||
|
||||
if Contains (Seen, Item_Id) then
|
||||
Error_Msg_N ("duplicate global item", Item);
|
||||
|
||||
-- Add the entity of the current item to the list of processed
|
||||
-- items.
|
||||
|
||||
else
|
||||
Add_Item (Item_Id, Seen);
|
||||
end if;
|
||||
end Analyze_Global_Item;
|
||||
|
||||
--------------------------
|
||||
@ -1629,6 +1497,53 @@ package body Sem_Prag is
|
||||
Status := True;
|
||||
end Check_Duplicate_Mode;
|
||||
|
||||
------------------------------------------------
|
||||
-- Check_Mode_Restiction_In_Enclosing_Context --
|
||||
------------------------------------------------
|
||||
|
||||
procedure Check_Mode_Restiction_In_Enclosing_Context
|
||||
(Item : Node_Id;
|
||||
Item_Id : Entity_Id)
|
||||
is
|
||||
Dummy : Boolean;
|
||||
Inputs : Elist_Id := No_Elist;
|
||||
Outputs : Elist_Id := No_Elist;
|
||||
Subp_Id : Entity_Id;
|
||||
|
||||
begin
|
||||
-- Traverse the scope stack looking for enclosing subprograms
|
||||
-- subject to aspect/pragma Global.
|
||||
|
||||
Subp_Id := Scope (Current_Scope);
|
||||
while Present (Subp_Id) and then Subp_Id /= Standard_Standard loop
|
||||
if Is_Subprogram (Subp_Id)
|
||||
and then Has_Aspect (Subp_Id, Aspect_Global)
|
||||
then
|
||||
Collect_Subprogram_Inputs_Outputs
|
||||
(Subp_Id => Subp_Id,
|
||||
Subp_Inputs => Inputs,
|
||||
Subp_Outputs => Outputs,
|
||||
Global_Seen => Dummy);
|
||||
|
||||
-- The item is classified as In_Out or Output but appears as
|
||||
-- an Input in an enclosing subprogram.
|
||||
|
||||
if Appears_In (Inputs, Item_Id)
|
||||
and then not Appears_In (Outputs, Item_Id)
|
||||
then
|
||||
Error_Msg_NE
|
||||
("global item & cannot have mode In_Out or Output",
|
||||
Item, Item_Id);
|
||||
Error_Msg_NE
|
||||
("\item already appears as input of subprogram &",
|
||||
Item, Subp_Id);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Subp_Id := Scope (Subp_Id);
|
||||
end loop;
|
||||
end Check_Mode_Restiction_In_Enclosing_Context;
|
||||
|
||||
----------------------------------------
|
||||
-- Check_Mode_Restriction_In_Function --
|
||||
----------------------------------------
|
||||
@ -8559,7 +8474,9 @@ package body Sem_Prag is
|
||||
Par := Unit (Par);
|
||||
end if;
|
||||
|
||||
if Nkind (Par) /= N_Package_Declaration then
|
||||
if not Nkind_In (Par, N_Generic_Package_Declaration,
|
||||
N_Package_Declaration)
|
||||
then
|
||||
Pragma_Misplaced;
|
||||
return;
|
||||
end if;
|
||||
@ -10660,11 +10577,6 @@ package body Sem_Prag is
|
||||
|
||||
Subp_Id := Defining_Unit_Name (Specification (Subp_Decl));
|
||||
|
||||
-- The pragma is analyzed at the end of the declarative part which
|
||||
-- contains the related subprogram. Reset the analyzed flag.
|
||||
|
||||
Set_Analyzed (N, False);
|
||||
|
||||
-- When the aspect/pragma appears on a subprogram body, perform
|
||||
-- the full analysis now.
|
||||
|
||||
@ -11906,11 +11818,6 @@ package body Sem_Prag is
|
||||
|
||||
Subp_Id := Defining_Unit_Name (Specification (Subp_Decl));
|
||||
|
||||
-- The pragma is analyzed at the end of the declarative part which
|
||||
-- contains the related subprogram. Reset the analyzed flag.
|
||||
|
||||
Set_Analyzed (N, False);
|
||||
|
||||
-- When the aspect/pragma appears on a subprogram body, perform
|
||||
-- the full analysis now.
|
||||
|
||||
@ -17894,6 +17801,35 @@ package body Sem_Prag is
|
||||
End_Scope;
|
||||
end Analyze_Test_Case_In_Decl_Part;
|
||||
|
||||
----------------
|
||||
-- Appears_In --
|
||||
----------------
|
||||
|
||||
function Appears_In (List : Elist_Id; Item_Id : Entity_Id) return Boolean is
|
||||
Elmt : Elmt_Id;
|
||||
Id : Entity_Id;
|
||||
|
||||
begin
|
||||
if Present (List) then
|
||||
Elmt := First_Elmt (List);
|
||||
while Present (Elmt) loop
|
||||
if Nkind (Node (Elmt)) = N_Defining_Identifier then
|
||||
Id := Node (Elmt);
|
||||
else
|
||||
Id := Entity (Node (Elmt));
|
||||
end if;
|
||||
|
||||
if Id = Item_Id then
|
||||
return True;
|
||||
end if;
|
||||
|
||||
Next_Elmt (Elmt);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
return False;
|
||||
end Appears_In;
|
||||
|
||||
----------------
|
||||
-- Check_Kind --
|
||||
----------------
|
||||
@ -18007,6 +17943,143 @@ package body Sem_Prag is
|
||||
end if;
|
||||
end Check_Applicable_Policy;
|
||||
|
||||
---------------------------------------
|
||||
-- Collect_Subprogram_Inputs_Outputs --
|
||||
---------------------------------------
|
||||
|
||||
procedure Collect_Subprogram_Inputs_Outputs
|
||||
(Subp_Id : Entity_Id;
|
||||
Subp_Inputs : in out Elist_Id;
|
||||
Subp_Outputs : in out Elist_Id;
|
||||
Global_Seen : out Boolean)
|
||||
is
|
||||
procedure Collect_Global_List
|
||||
(List : Node_Id;
|
||||
Mode : Name_Id := Name_Input);
|
||||
-- Collect all relevant items from a global list
|
||||
|
||||
-------------------------
|
||||
-- Collect_Global_List --
|
||||
-------------------------
|
||||
|
||||
procedure Collect_Global_List
|
||||
(List : Node_Id;
|
||||
Mode : Name_Id := Name_Input)
|
||||
is
|
||||
procedure Collect_Global_Item
|
||||
(Item : Node_Id;
|
||||
Mode : Name_Id);
|
||||
-- Add an item to the proper subprogram input or output collection
|
||||
|
||||
-------------------------
|
||||
-- Collect_Global_Item --
|
||||
-------------------------
|
||||
|
||||
procedure Collect_Global_Item
|
||||
(Item : Node_Id;
|
||||
Mode : Name_Id)
|
||||
is
|
||||
begin
|
||||
if Nam_In (Mode, Name_In_Out, Name_Input) then
|
||||
Add_Item (Item, Subp_Inputs);
|
||||
end if;
|
||||
|
||||
if Nam_In (Mode, Name_In_Out, Name_Output) then
|
||||
Add_Item (Item, Subp_Outputs);
|
||||
end if;
|
||||
end Collect_Global_Item;
|
||||
|
||||
-- Local variables
|
||||
|
||||
Assoc : Node_Id;
|
||||
Item : Node_Id;
|
||||
|
||||
-- Start of processing for Collect_Global_List
|
||||
|
||||
begin
|
||||
-- Single global item declaration
|
||||
|
||||
if Nkind_In (List, N_Identifier, N_Selected_Component) then
|
||||
Collect_Global_Item (List, Mode);
|
||||
|
||||
-- Simple global list or moded global list declaration
|
||||
|
||||
else
|
||||
if Present (Expressions (List)) then
|
||||
Item := First (Expressions (List));
|
||||
while Present (Item) loop
|
||||
Collect_Global_Item (Item, Mode);
|
||||
|
||||
Next (Item);
|
||||
end loop;
|
||||
|
||||
else
|
||||
Assoc := First (Component_Associations (List));
|
||||
while Present (Assoc) loop
|
||||
Collect_Global_List
|
||||
(List => Expression (Assoc),
|
||||
Mode => Chars (First (Choices (Assoc))));
|
||||
|
||||
Next (Assoc);
|
||||
end loop;
|
||||
end if;
|
||||
end if;
|
||||
end Collect_Global_List;
|
||||
|
||||
-- Local variables
|
||||
|
||||
Formal : Entity_Id;
|
||||
Global : Node_Id;
|
||||
List : Node_Id;
|
||||
|
||||
-- Start of processing for Collect_Subprogram_Inputs_Outputs
|
||||
|
||||
begin
|
||||
Global_Seen := False;
|
||||
|
||||
-- Process all formal parameters
|
||||
|
||||
Formal := First_Formal (Subp_Id);
|
||||
while Present (Formal) loop
|
||||
if Ekind_In (Formal, E_In_Out_Parameter, E_In_Parameter) then
|
||||
Add_Item (Formal, Subp_Inputs);
|
||||
end if;
|
||||
|
||||
if Ekind_In (Formal, E_In_Out_Parameter, E_Out_Parameter) then
|
||||
Add_Item (Formal, Subp_Outputs);
|
||||
end if;
|
||||
|
||||
Next_Formal (Formal);
|
||||
end loop;
|
||||
|
||||
-- If the subprogram is subject to pragma Global, traverse all global
|
||||
-- lists and gather the relevant items.
|
||||
|
||||
Global := Find_Aspect (Subp_Id, Aspect_Global);
|
||||
if Present (Global) then
|
||||
Global_Seen := True;
|
||||
|
||||
-- Retrieve the pragma as it contains the analyzed lists
|
||||
|
||||
Global := Aspect_Rep_Item (Global);
|
||||
List := Expression (First (Pragma_Argument_Associations (Global)));
|
||||
|
||||
-- The pragma may not have been analyzed because of the arbitrary
|
||||
-- declaration order of aspects. Make sure that it is analyzed for
|
||||
-- the purposes of item extraction.
|
||||
|
||||
if not Analyzed (List) then
|
||||
Analyze_Global_In_Decl_Part (Global);
|
||||
end if;
|
||||
|
||||
-- Nothing to be done for a null global list
|
||||
|
||||
if Nkind (List) /= N_Null then
|
||||
Collect_Global_List (List);
|
||||
end if;
|
||||
end if;
|
||||
end Collect_Subprogram_Inputs_Outputs;
|
||||
|
||||
---------------------------------
|
||||
-- Delay_Config_Pragma_Analyze --
|
||||
---------------------------------
|
||||
|
||||
@ -12964,6 +12964,40 @@ package body Sem_Util is
|
||||
Set_Sloc (Endl, Loc);
|
||||
end Process_End_Label;
|
||||
|
||||
----------------
|
||||
-- Referenced --
|
||||
----------------
|
||||
|
||||
function Referenced (Id : Entity_Id; Expr : Node_Id) return Boolean is
|
||||
Seen : Boolean := False;
|
||||
|
||||
function Is_Reference (N : Node_Id) return Traverse_Result;
|
||||
-- Determine whether node N denotes a reference to Id. If this is the
|
||||
-- case, set global flag Seen to True and stop the traversal.
|
||||
|
||||
function Is_Reference (N : Node_Id) return Traverse_Result is
|
||||
begin
|
||||
if Is_Entity_Name (N)
|
||||
and then Present (Entity (N))
|
||||
and then Entity (N) = Id
|
||||
then
|
||||
Seen := True;
|
||||
return Abandon;
|
||||
else
|
||||
return OK;
|
||||
end if;
|
||||
end Is_Reference;
|
||||
|
||||
procedure Inspect_Expression is new Traverse_Proc (Is_Reference);
|
||||
|
||||
-- Start of processing for Referenced
|
||||
|
||||
begin
|
||||
Inspect_Expression (Expr);
|
||||
|
||||
return Seen;
|
||||
end Referenced;
|
||||
|
||||
------------------------------------
|
||||
-- References_Generic_Formal_Type --
|
||||
------------------------------------
|
||||
|
||||
@ -1358,6 +1358,9 @@ package Sem_Util is
|
||||
-- parameter Ent gives the entity to which the End_Label refers,
|
||||
-- and to which cross-references are to be generated.
|
||||
|
||||
function Referenced (Id : Entity_Id; Expr : Node_Id) return Boolean;
|
||||
-- Determine whether entity Id is referenced within expression Expr
|
||||
|
||||
function References_Generic_Formal_Type (N : Node_Id) return Boolean;
|
||||
-- Returns True if the expression Expr contains any references to a
|
||||
-- generic type. This can only happen within a generic template.
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user