Skip to content

R
riscv-gcc-1
Commit 81bd8c90 by Arnaud Charlet
Options

[multiple changes] 

2014-02-04  Robert Dewar  <dewar@adacore.com>

	* sinfo.ads: Further comments on N_Expression_With_Actions node.

2014-02-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Refined_Depends_In_Decl_Part): Remove global
	variables Out_Items and Ref_Global. Remove local constant
	Body_Id along with dummy variables D1, D2, D3, D4, D5, D6, D7
	and D8. Remove the useless collection of global items as this
	was a leftover from an earlier version of the routine. Move
	several routines out to avoid deep nesting and indentation.
	(Inputs_Match): Add formal parameter Dep_Clause. Rename formal
	parameter Do_Checks to Post_Errors. Update the comment on usage.
	(Is_Matching_Input): Renamed to Input_Match. Add formal parameters
	Ref_Inputs and Do_Checks. Rename formal parameter Do_Checks
	to Post_Errors. Update the comment on usage. Account for the
	case where a self referential state may have a null input_list.
	(Is_Self_Referential): New routine.

2014-02-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Analyze_Attribute_Definition_Clause): If the
	entity renames an expression, as in the case of an object of
	an unconstrained type initialized by a function call, defer the
	rewriting of the expression to the expander.
	* exp_ch13.adb (Expand_N_Attribute_Definition_Clause, case
	'Alignment): If the entity renames an expression, introduce
	temporary to capture value, and rewrite original declaration to
	use temporary.

From-SVN: r207467
parent ebdaa81b
Showing with 477 additions and 314 deletions
gcc/ada/ChangeLog
2014-02-04 Robert Dewar <dewar@adacore.com>
* sinfo.ads: Further comments on N_Expression_With_Actions node.
2014-02-04 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_Refined_Depends_In_Decl_Part): Remove global
variables Out_Items and Ref_Global. Remove local constant
Body_Id along with dummy variables D1, D2, D3, D4, D5, D6, D7
and D8. Remove the useless collection of global items as this
was a leftover from an earlier version of the routine. Move
several routines out to avoid deep nesting and indentation.
(Inputs_Match): Add formal parameter Dep_Clause. Rename formal
parameter Do_Checks to Post_Errors. Update the comment on usage.
(Is_Matching_Input): Renamed to Input_Match. Add formal parameters
Ref_Inputs and Do_Checks. Rename formal parameter Do_Checks
to Post_Errors. Update the comment on usage. Account for the
case where a self referential state may have a null input_list.
(Is_Self_Referential): New routine.
2014-02-04 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb (Analyze_Attribute_Definition_Clause): If the
entity renames an expression, as in the case of an object of
an unconstrained type initialized by a function call, defer the
rewriting of the expression to the expander.
* exp_ch13.adb (Expand_N_Attribute_Definition_Clause, case
'Alignment): If the entity renames an expression, introduce
temporary to capture value, and rewrite original declaration to
use temporary.
2014-02-04 Gary Dismukes <dismukes@adacore.com> 2014-02-04 Gary Dismukes <dismukes@adacore.com>
* g-comlin.adb: Minor typo fix. * g-comlin.adb: Minor typo fix.
......
gcc/ada/exp_ch13.adb
...@@ -157,6 +157,46 @@ package body Exp_Ch13 is ...@@ -157,6 +157,46 @@ package body Exp_Ch13 is
(Exp, Make_Integer_Literal (Loc, Expr_Value (Exp))); (Exp, Make_Integer_Literal (Loc, Expr_Value (Exp)));
end if; end if;
-- A complex case arises if the alignment clause applies to an
-- unconstrained object initialized with a function call. The
-- result of the call is placed on the secondary stack, and the
-- declaration is rewritten as a renaming of a dereference, which
-- fails expansion. We must introduce a temporary and assign its
-- value to the existing entity.
if Nkind (Parent (Ent)) = N_Object_Renaming_Declaration
and then not Is_Entity_Name (Renamed_Object (Ent))
then
declare
Loc : constant Source_Ptr := Sloc (N);
Decl : constant Node_Id := Parent (Ent);
Temp : constant Entity_Id := Make_Temporary (Loc, 'T');
New_Decl : Node_Id;
begin
-- Replace entity with temporary and renalyze
Set_Defining_Identifier (Decl, Temp);
Set_Analyzed (Decl, False);
Analyze (Decl);
-- Introduce new declaration for entity but do not reanalyze
-- because entity is already in scope. Type and expression
-- are already resolved.
New_Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Ent,
Object_Definition =>
New_Occurrence_Of (Etype (Ent), Loc),
Expression => New_Occurrence_Of (Temp, Loc));
Set_Renamed_Object (Ent, Empty);
Insert_After (Decl, New_Decl);
Set_Analyzed (Decl);
end;
end if;
------------------ ------------------
-- Storage_Size -- -- Storage_Size --
------------------ ------------------
......
gcc/ada/sem_ch13.adb
...@@ -3526,13 +3526,23 @@ package body Sem_Ch13 is ...@@ -3526,13 +3526,23 @@ package body Sem_Ch13 is
-- expander. The easiest general way to handle this is to create a -- expander. The easiest general way to handle this is to create a
-- copy of the attribute definition clause for this object. -- copy of the attribute definition clause for this object.
else elsif Is_Entity_Name (Renamed_Object (Ent)) then
Insert_Action (N, Insert_Action (N,
Make_Attribute_Definition_Clause (Loc, Make_Attribute_Definition_Clause (Loc,
Name => Name =>
New_Occurrence_Of (Entity (Renamed_Object (Ent)), Loc), New_Occurrence_Of (Entity (Renamed_Object (Ent)), Loc),
Chars => Chars (N), Chars => Chars (N),
Expression => Duplicate_Subexpr (Expression (N)))); Expression => Duplicate_Subexpr (Expression (N))));
-- If the renamed object is not an entity, it must be a dereference
-- of an unconstrained function call, and we must introduce a new
-- declaration to capture the expression. This is needed in the case
-- of 'Alignment, where the original declaration must be rewritten.
else
pragma Assert
(Nkind (Renamed_Object (Ent)) = N_Explicit_Dereference);
null;
end if; end if;
-- If no underlying entity, use entity itself, applies to some -- If no underlying entity, use entity itself, applies to some
......
gcc/ada/sem_prag.adb
...@@ -21201,12 +21201,6 @@ package body Sem_Prag is ...@@ -21201,12 +21201,6 @@ package body Sem_Prag is
Depends : Node_Id; Depends : Node_Id;
-- The corresponding Depends pragma along with its clauses -- The corresponding Depends pragma along with its clauses
Out_Items : Elist_Id := No_Elist;
-- All output items as defined in pragma Refined_Global (if any)
Ref_Global : Node_Id := Empty;
-- The corresponding Refined_Global pragma (if any)
Refinements : List_Id := No_List; Refinements : List_Id := No_List;
-- The clauses of pragma Refined_Depends -- The clauses of pragma Refined_Depends
...@@ -21216,6 +21210,27 @@ package body Sem_Prag is ...@@ -21216,6 +21210,27 @@ package body Sem_Prag is
procedure Check_Dependency_Clause (Dep_Clause : Node_Id); procedure Check_Dependency_Clause (Dep_Clause : Node_Id);
-- Verify the legality of a single clause -- Verify the legality of a single clause
function Input_Match
(Dep_Input : Node_Id;
Ref_Inputs : List_Id;
Post_Errors : Boolean) return Boolean;
-- Determine whether input Dep_Input matches one of inputs found in list
-- Ref_Inputs. If flag Post_Errors is set, the routine reports missed or
-- extra input items.
function Inputs_Match
(Dep_Clause : Node_Id;
Ref_Clause : Node_Id;
Post_Errors : Boolean) return Boolean;
-- Determine whether the inputs of Depends clause Dep_Clause match those
-- of refinement clause Ref_Clause. If flag Post_Errors is set, then the
-- routine reports missed or extra input items.
function Is_Self_Referential (Item_Id : Entity_Id) return Boolean;
-- Determine whether a formal parameter, variable or state denoted by
-- Item_Id appears both as input and an output in a single clause of
-- pragma Depends.
procedure Report_Extra_Clauses; procedure Report_Extra_Clauses;
-- Emit an error for each extra clause the appears in Refined_Depends -- Emit an error for each extra clause the appears in Refined_Depends
...@@ -21224,38 +21239,249 @@ package body Sem_Prag is ...@@ -21224,38 +21239,249 @@ package body Sem_Prag is
----------------------------- -----------------------------
procedure Check_Dependency_Clause (Dep_Clause : Node_Id) is procedure Check_Dependency_Clause (Dep_Clause : Node_Id) is
function Inputs_Match Dep_Output : constant Node_Id := First (Choices (Dep_Clause));
(Ref_Clause : Node_Id; Dep_Id : Entity_Id;
Do_Checks : Boolean) return Boolean; Matching_Clause : Node_Id := Empty;
-- Determine whether the inputs of clause Dep_Clause match those of Next_Ref_Clause : Node_Id;
-- clause Ref_Clause. If flag Do_Checks is set, the routine reports Ref_Clause : Node_Id;
-- missed or extra input items. Ref_Id : Entity_Id;
Ref_Output : Node_Id;
------------------ Has_Constituent : Boolean := False;
-- Inputs_Match -- -- Flag set when the refinement output list contains at least one
------------------ -- constituent of the state denoted by Dep_Id.
function Inputs_Match Has_Null_State : Boolean := False;
(Ref_Clause : Node_Id; -- Flag set when the output of clause Dep_Clause is a state with a
Do_Checks : Boolean) return Boolean -- null refinement.
is
Ref_Inputs : List_Id; Has_Refined_State : Boolean := False;
-- The input list of the refinement clause -- Flag set when the output of clause Dep_Clause is a state with
-- visible refinement.
function Is_Matching_Input (Dep_Input : Node_Id) return Boolean; begin
-- Determine whether input Dep_Input matches one of the inputs of -- The analysis of pragma Depends should produce normalized clauses
-- clause Ref_Clause. -- with exactly one output. This is important because output items
-- are unique in the whole dependence relation and can be used as
-- keys.
procedure Report_Extra_Inputs; pragma Assert (No (Next (Dep_Output)));
-- Emit errors for all extra inputs that appear in Ref_Clause
----------------------- -- Inspect all clauses of Refined_Depends and attempt to match the
-- Is_Matching_Input -- -- output of Dep_Clause against an output from the refinement clauses
----------------------- -- set.
Ref_Clause := First (Refinements);
while Present (Ref_Clause) loop
Matching_Clause := Empty;
-- Store the next clause now because a match will trim the list of
-- refinement clauses and this side effect should not be visible
-- in pragma Refined_Depends.
Next_Ref_Clause := Next (Ref_Clause);
-- The analysis of pragma Refined_Depends should produce
-- normalized clauses with exactly one output.
Ref_Output := First (Choices (Ref_Clause));
pragma Assert (No (Next (Ref_Output)));
-- Two null output lists match if their inputs match
if Nkind (Dep_Output) = N_Null
and then Nkind (Ref_Output) = N_Null
then
Matching_Clause := Ref_Clause;
exit;
-- Two function 'Result attributes match if their inputs match.
-- Note that there is no need to compare the two prefixes because
-- the attributes cannot denote anything but the related function.
elsif Is_Attribute_Result (Dep_Output)
and then Is_Attribute_Result (Ref_Output)
then
Matching_Clause := Ref_Clause;
exit;
-- The remaining cases are formal parameters, variables and states
elsif Is_Entity_Name (Dep_Output) then
-- Handle abstract views of states and variables generated for
-- limited with clauses.
Dep_Id := Available_View (Entity_Of (Dep_Output));
if Ekind (Dep_Id) = E_Abstract_State then
-- A state with a null refinement matches either a null
-- output list or nothing at all (no clause):
-- Refined_State => (State => null)
-- No clause
-- Depends => (State => null)
-- Refined_Depends => null -- OK
-- Null output list
-- Depends => (State => <input>)
-- Refined_Depends => (null => <input>) -- OK
if Has_Null_Refinement (Dep_Id) then
Has_Null_State := True;
-- When a state with null refinement matches a null
-- output, compare their inputs.
if Nkind (Ref_Output) = N_Null then
Matching_Clause := Ref_Clause;
end if;
exit;
-- The state has a non-null refinement in which case the
-- match is based on constituents and inputs. A state with
-- multiple output constituents may match multiple clauses:
-- Refined_State => (State => (C1, C2))
-- Depends => (State => <input>)
-- Refined_Depends => ((C1, C2) => <input>)
-- When normalized, the above becomes:
-- Refined_Depends => (C1 => <input>,
-- C2 => <input>)
function Is_Matching_Input (Dep_Input : Node_Id) return Boolean is elsif Has_Non_Null_Refinement (Dep_Id) then
Has_Refined_State := True;
if Is_Entity_Name (Ref_Output) then
Ref_Id := Entity_Of (Ref_Output);
-- The output of the refinement clause is a valid
-- constituent of the state. Remove the clause from
-- the pool of candidates if both input lists match.
-- Note that the search continues because one clause
-- may have been normalized into multiple clauses as
-- per the example above.
if Ekind_In (Ref_Id, E_Abstract_State, E_Variable)
and then Present (Encapsulating_State (Ref_Id))
and then Encapsulating_State (Ref_Id) = Dep_Id
and then Inputs_Match
(Dep_Clause => Dep_Clause,
Ref_Clause => Ref_Clause,
Post_Errors => False)
then
Has_Constituent := True;
Remove (Ref_Clause);
end if;
end if;
-- The abstract view of a state matches is corresponding
-- non-abstract view:
-- Depends => (Lim_Pack.State => <input>)
-- Refined_Depends => (State => <input>)
elsif Is_Entity_Name (Ref_Output)
and then Entity_Of (Ref_Output) = Dep_Id
then
Matching_Clause := Ref_Clause;
exit;
end if;
-- Formal parameters and variables match if their inputs match
elsif Is_Entity_Name (Ref_Output)
and then Entity_Of (Ref_Output) = Dep_Id
then
Matching_Clause := Ref_Clause;
exit;
end if;
end if;
Ref_Clause := Next_Ref_Clause;
end loop;
-- Handle the case where pragma Depends contains one or more clauses
-- that only mention states with null refinements. In that case the
-- corresponding pragma Refined_Depends may have a null relation.
-- Refined_State => (State => null)
-- Depends => (State => null)
-- Refined_Depends => null -- OK
-- Another instance of the same scenario occurs when the list of
-- refinements has been depleted while processing previous clauses.
if Is_Entity_Name (Dep_Output)
and then (No (Refinements) or else Is_Empty_List (Refinements))
then
Dep_Id := Entity_Of (Dep_Output);
if Ekind (Dep_Id) = E_Abstract_State
and then Has_Null_Refinement (Dep_Id)
then
Has_Null_State := True;
end if;
end if;
-- The above search produced a match based on unique output. Ensure
-- that the inputs match as well and if they do, remove the clause
-- from the pool of candidates.
if Present (Matching_Clause) then
if Inputs_Match
(Ref_Clause => Ref_Clause,
Dep_Clause => Matching_Clause,
Post_Errors => True)
then
Remove (Matching_Clause);
end if;
-- A state with a visible refinement was matched against one or
-- more clauses containing appropriate constituents.
elsif Has_Constituent then
null;
-- A state with a null refinement did not warrant a clause
elsif Has_Null_State then
null;
-- The dependence relation of pragma Refined_Depends does not contain
-- a matching clause, emit an error.
else
Error_Msg_NE
("dependence clause of subprogram & has no matching refinement "
& "in body", Ref_Clause, Spec_Id);
if Has_Refined_State then
Error_Msg_N
("\check the use of constituents in dependence refinement",
Ref_Clause);
end if;
end if;
end Check_Dependency_Clause;
-----------------
-- Input_Match --
-----------------
function Input_Match
(Dep_Input : Node_Id;
Ref_Inputs : List_Id;
Post_Errors : Boolean) return Boolean
is
procedure Match_Error (Msg : String; N : Node_Id); procedure Match_Error (Msg : String; N : Node_Id);
-- Emit a matching error if flag Do_Checks is set -- Emit a matching error if flag Post_Errors is set
----------------- -----------------
-- Match_Error -- -- Match_Error --
...@@ -21263,7 +21489,7 @@ package body Sem_Prag is ...@@ -21263,7 +21489,7 @@ package body Sem_Prag is
procedure Match_Error (Msg : String; N : Node_Id) is procedure Match_Error (Msg : String; N : Node_Id) is
begin begin
if Do_Checks then if Post_Errors then
Error_Msg_N (Msg, N); Error_Msg_N (Msg, N);
end if; end if;
end Match_Error; end Match_Error;
...@@ -21276,18 +21502,18 @@ package body Sem_Prag is ...@@ -21276,18 +21502,18 @@ package body Sem_Prag is
Ref_Input : Node_Id; Ref_Input : Node_Id;
Has_Constituent : Boolean := False; Has_Constituent : Boolean := False;
-- Flag set when the refinement input list contains at least -- Flag set when the refinement input list contains at least one
-- one constituent of the state denoted by Dep_Id. -- constituent of the state denoted by Dep_Id.
Has_Null_State : Boolean := False; Has_Null_State : Boolean := False;
-- Flag set when the dependency input is a state with a null -- Flag set when the dependency input is a state with a visible null
-- refinement. -- refinement.
Has_Refined_State : Boolean := False; Has_Refined_State : Boolean := False;
-- Flag set when the dependency input is a state with visible -- Flag set when the dependency input is a state with visible non-
-- refinement. -- null refinement.
-- Start of processing for Is_Matching_Input -- Start of processing for Input_Match
begin begin
-- Match a null input with another null input -- Match a null input with another null input
...@@ -21303,33 +21529,33 @@ package body Sem_Prag is ...@@ -21303,33 +21529,33 @@ package body Sem_Prag is
else else
Match_Error Match_Error
("null input cannot be matched in corresponding " ("null input cannot be matched in corresponding refinement "
& "refinement clause", Dep_Input); & "clause", Dep_Input);
end if; end if;
-- Remaining cases are formal parameters, variables, and states -- Remaining cases are formal parameters, variables, and states
else else
-- Handle abstract views of states and variables generated -- Handle abstract views of states and variables generated for
-- for limited with clauses. -- limited with clauses.
Dep_Id := Available_View (Entity_Of (Dep_Input)); Dep_Id := Available_View (Entity_Of (Dep_Input));
-- Inspect all inputs of the refinement clause and attempt -- Inspect all inputs of the refinement clause and attempt to
-- to match against the inputs of the dependence clause. -- match against the inputs of the dependence clause.
Ref_Input := First (Ref_Inputs); Ref_Input := First (Ref_Inputs);
while Present (Ref_Input) loop while Present (Ref_Input) loop
-- Store the next input now because a match will remove -- Store the next input now because a match will remove it from
-- it from the list. -- the list.
Next_Ref_Input := Next (Ref_Input); Next_Ref_Input := Next (Ref_Input);
if Ekind (Dep_Id) = E_Abstract_State then if Ekind (Dep_Id) = E_Abstract_State then
-- A state with a null refinement matches either a -- A state with a null refinement matches either a null
-- null input list or nothing at all (no input): -- input list or nothing at all (no input):
-- Refined_State => (State => null) -- Refined_State => (State => null)
...@@ -21346,8 +21572,7 @@ package body Sem_Prag is ...@@ -21346,8 +21572,7 @@ package body Sem_Prag is
if Has_Null_Refinement (Dep_Id) then if Has_Null_Refinement (Dep_Id) then
Has_Null_State := True; Has_Null_State := True;
-- Remove the matching null from the pool of -- Remove the matching null from the pool of candidates
-- candidates.
if Nkind (Ref_Input) = N_Null then if Nkind (Ref_Input) = N_Null then
Remove (Ref_Input); Remove (Ref_Input);
...@@ -21355,8 +21580,8 @@ package body Sem_Prag is ...@@ -21355,8 +21580,8 @@ package body Sem_Prag is
return True; return True;
-- The state has a non-null refinement in which case -- The state has a non-null refinement in which case remove
-- remove all the matching constituents of the state: -- all the matching constituents of the state:
-- Refined_State => (State => (C1, C2)) -- Refined_State => (State => (C1, C2))
-- Depends => (<output> => State) -- Depends => (<output> => State)
...@@ -21365,16 +21590,33 @@ package body Sem_Prag is ...@@ -21365,16 +21590,33 @@ package body Sem_Prag is
elsif Has_Non_Null_Refinement (Dep_Id) then elsif Has_Non_Null_Refinement (Dep_Id) then
Has_Refined_State := True; Has_Refined_State := True;
-- A state with a visible non-null refinement may have a
-- null input_list only when it is self referential.
-- Refined_State => (State => (C1, C2))
-- Depends => (State => State)
-- Refined_Depends => (C2 => null) -- OK
if Nkind (Ref_Input) = N_Null
and then Is_Self_Referential (Dep_Id)
then
-- Remove the null from the pool of candidates. Note
-- that the search continues because the state may be
-- represented by multiple constituents.
Has_Constituent := True;
Remove (Ref_Input);
-- Ref_Input is an entity name -- Ref_Input is an entity name
if Is_Entity_Name (Ref_Input) then elsif Is_Entity_Name (Ref_Input) then
Ref_Id := Entity_Of (Ref_Input); Ref_Id := Entity_Of (Ref_Input);
-- The input of the refinement clause is a valid -- The input of the refinement clause is a valid
-- constituent of the state. Remove the input -- constituent of the state. Remove the input from the
-- from the pool of candidates. Note that the -- pool of candidates. Note that the search continues
-- search continues because the state may be -- because the state may be represented by multiple
-- represented by multiple constituents. -- constituents.
if Ekind_In (Ref_Id, E_Abstract_State, if Ekind_In (Ref_Id, E_Abstract_State,
E_Variable) E_Variable)
...@@ -21386,8 +21628,8 @@ package body Sem_Prag is ...@@ -21386,8 +21628,8 @@ package body Sem_Prag is
end if; end if;
end if; end if;
-- The abstract view of a state matches its -- The abstract view of a state matches its corresponding
-- corresponding non-abstract view: -- non-abstract view:
-- Depends => (<output> => Lim_Pack.State) -- Depends => (<output> => Lim_Pack.State)
-- Refined_Depends => (<output> => State) -- Refined_Depends => (<output> => State)
...@@ -21399,9 +21641,8 @@ package body Sem_Prag is ...@@ -21399,9 +21641,8 @@ package body Sem_Prag is
return True; return True;
end if; end if;
-- Formal parameters and variables are matched on -- Formal parameters and variables are matched on entities. If
-- entities. If this is the case, remove the input from -- this is the case, remove the input from the candidate list.
-- the candidate list.
elsif Is_Entity_Name (Ref_Input) elsif Is_Entity_Name (Ref_Input)
and then Entity_Of (Ref_Input) = Dep_Id and then Entity_Of (Ref_Input) = Dep_Id
...@@ -21413,8 +21654,8 @@ package body Sem_Prag is ...@@ -21413,8 +21654,8 @@ package body Sem_Prag is
Ref_Input := Next_Ref_Input; Ref_Input := Next_Ref_Input;
end loop; end loop;
-- When a state with a null refinement appears as the last -- When a state with a null refinement appears as the last input,
-- input, it matches nothing: -- it matches nothing:
-- Refined_State => (State => null) -- Refined_State => (State => null)
-- Depends => (<output> => (Input, State)) -- Depends => (<output> => (Input, State))
...@@ -21428,8 +21669,8 @@ package body Sem_Prag is ...@@ -21428,8 +21669,8 @@ package body Sem_Prag is
end if; end if;
end if; end if;
-- A state with visible refinement was matched against one or -- A state with visible refinement was matched against one or more of
-- more of its constituents. -- its constituents.
if Has_Constituent then if Has_Constituent then
return True; return True;
...@@ -21439,23 +21680,38 @@ package body Sem_Prag is ...@@ -21439,23 +21680,38 @@ package body Sem_Prag is
elsif Has_Null_State then elsif Has_Null_State then
return True; return True;
-- The input of a dependence clause does not have a matching -- The input of a dependence clause does not have a matching input in
-- input in the refinement clause, emit an error. -- the refinement clause, emit an error.
else else
Match_Error Match_Error
("input cannot be matched in corresponding refinement " ("input cannot be matched in corresponding refinement clause",
& "clause", Dep_Input); Dep_Input);
if Has_Refined_State then if Has_Refined_State then
Match_Error Match_Error
("\check the use of constituents in dependence " ("\check the use of constituents in dependence refinement",
& "refinement", Dep_Input); Dep_Input);
end if; end if;
return False; return False;
end if; end if;
end Is_Matching_Input; end Input_Match;
------------------
-- Inputs_Match --
------------------
function Inputs_Match
(Dep_Clause : Node_Id;
Ref_Clause : Node_Id;
Post_Errors : Boolean) return Boolean
is
Ref_Inputs : List_Id;
-- The input list of the refinement clause
procedure Report_Extra_Inputs;
-- Emit errors for all extra inputs that appear in Ref_Inputs
------------------------- -------------------------
-- Report_Extra_Inputs -- -- Report_Extra_Inputs --
...@@ -21465,12 +21721,11 @@ package body Sem_Prag is ...@@ -21465,12 +21721,11 @@ package body Sem_Prag is
Input : Node_Id; Input : Node_Id;
begin begin
if Present (Ref_Inputs) and then Do_Checks then if Present (Ref_Inputs) and then Post_Errors then
Input := First (Ref_Inputs); Input := First (Ref_Inputs);
while Present (Input) loop while Present (Input) loop
Error_Msg_N Error_Msg_N
("unmatched or extra input in refinement clause", ("unmatched or extra input in refinement clause", Input);
Input);
Next (Input); Next (Input);
end loop; end loop;
...@@ -21524,7 +21779,11 @@ package body Sem_Prag is ...@@ -21524,7 +21779,11 @@ package body Sem_Prag is
if Nkind (Dep_Inputs) = N_Aggregate then if Nkind (Dep_Inputs) = N_Aggregate then
Dep_Input := First (Expressions (Dep_Inputs)); Dep_Input := First (Expressions (Dep_Inputs));
while Present (Dep_Input) loop while Present (Dep_Input) loop
if not Is_Matching_Input (Dep_Input) then if not Input_Match
(Dep_Input => Dep_Input,
Ref_Inputs => Ref_Inputs,
Post_Errors => Post_Errors)
then
Result := False; Result := False;
end if; end if;
...@@ -21536,242 +21795,90 @@ package body Sem_Prag is ...@@ -21536,242 +21795,90 @@ package body Sem_Prag is
-- Solitary input -- Solitary input
else else
Result := Is_Matching_Input (Dep_Inputs); Result :=
Input_Match
(Dep_Input => Dep_Inputs,
Ref_Inputs => Ref_Inputs,
Post_Errors => Post_Errors);
end if; end if;
-- List all inputs that appear as extras
Report_Extra_Inputs; Report_Extra_Inputs;
return Result; return Result;
end Inputs_Match; end Inputs_Match;
-- Local variables -------------------------
-- Is_Self_Referential --
Dep_Output : constant Node_Id := First (Choices (Dep_Clause)); -------------------------
Dep_Id : Entity_Id;
Matching_Clause : Node_Id := Empty;
Next_Ref_Clause : Node_Id;
Ref_Clause : Node_Id;
Ref_Id : Entity_Id;
Ref_Output : Node_Id;
Has_Constituent : Boolean := False;
-- Flag set when the refinement output list contains at least one
-- constituent of the state denoted by Dep_Id.
Has_Null_State : Boolean := False;
-- Flag set when the output of clause Dep_Clause is a state with a
-- null refinement.
Has_Refined_State : Boolean := False; function Is_Self_Referential (Item_Id : Entity_Id) return Boolean is
-- Flag set when the output of clause Dep_Clause is a state with function Denotes_Item (N : Node_Id) return Boolean;
-- visible refinement. -- Determine whether an arbitrary node N denotes item Item_Id
-- Start of processing for Check_Dependency_Clause ------------------
-- Denotes_Item --
------------------
function Denotes_Item (N : Node_Id) return Boolean is
begin begin
-- The analysis of pragma Depends should produce normalized clauses return
-- with exactly one output. This is important because output items Is_Entity_Name (N)
-- are unique in the whole dependence relation and can be used as and then Present (Entity (N))
-- keys. and then Entity (N) = Item_Id;
end Denotes_Item;
pragma Assert (No (Next (Dep_Output)));
-- Inspect all clauses of Refined_Depends and attempt to match the
-- output of Dep_Clause against an output from the refinement clauses
-- set.
Ref_Clause := First (Refinements);
while Present (Ref_Clause) loop
Matching_Clause := Empty;
-- Store the next clause now because a match will trim the list of
-- refinement clauses and this side effect should not be visible
-- in pragma Refined_Depends.
Next_Ref_Clause := Next (Ref_Clause);
-- The analysis of pragma Refined_Depends should produce
-- normalized clauses with exactly one output.
Ref_Output := First (Choices (Ref_Clause));
pragma Assert (No (Next (Ref_Output)));
-- Two null output lists match if their inputs match
if Nkind (Dep_Output) = N_Null
and then Nkind (Ref_Output) = N_Null
then
Matching_Clause := Ref_Clause;
exit;
-- Two function 'Result attributes match if their inputs match.
-- Note that there is no need to compare the two prefixes because
-- the attributes cannot denote anything but the related function.
elsif Is_Attribute_Result (Dep_Output)
and then Is_Attribute_Result (Ref_Output)
then
Matching_Clause := Ref_Clause;
exit;
-- The remaining cases are formal parameters, variables and states
elsif Is_Entity_Name (Dep_Output) then
-- Handle abstract views of states and variables generated for
-- limited with clauses.
Dep_Id := Available_View (Entity_Of (Dep_Output));
if Ekind (Dep_Id) = E_Abstract_State then
-- A state with a null refinement matches either a null
-- output list or nothing at all (no clause):
-- Refined_State => (State => null)
-- No clause
-- Depends => (State => null)
-- Refined_Depends => null -- OK
-- Null output list
-- Depends => (State => <input>)
-- Refined_Depends => (null => <input>) -- OK
if Has_Null_Refinement (Dep_Id) then
Has_Null_State := True;
-- When a state with null refinement matches a null -- Local variables
-- output, compare their inputs.
if Nkind (Ref_Output) = N_Null then Clauses : constant Node_Id :=
Matching_Clause := Ref_Clause; Get_Pragma_Arg
end if; (First (Pragma_Argument_Associations (Depends)));
Clause : Node_Id;
Input : Node_Id;
Output : Node_Id;
exit; -- Start of processing for Is_Self_Referential
-- The state has a non-null refinement in which case the begin
-- match is based on constituents and inputs. A state with Clause := First (Component_Associations (Clauses));
-- multiple output constituents may match multiple clauses: while Present (Clause) loop
-- Refined_State => (State => (C1, C2)) -- Due to normalization, a dependence clause has exactly one
-- Depends => (State => <input>) -- output even if the original clause had multiple outputs.
-- Refined_Depends => ((C1, C2) => <input>)
-- When normalized, the above becomes: Output := First (Choices (Clause));
-- Refined_Depends => (C1 => <input>, -- Detect the following scenario:
-- C2 => <input>) --
-- Item_Id => [(...,] Item_Id [, ...)]
elsif Has_Non_Null_Refinement (Dep_Id) then if Denotes_Item (Output) then
Has_Refined_State := True; Input := Expression (Clause);
if Is_Entity_Name (Ref_Output) then -- Multiple inputs appear as an aggregate
Ref_Id := Entity_Of (Ref_Output);
-- The output of the refinement clause is a valid if Nkind (Input) = N_Aggregate then
-- constituent of the state. Remove the clause from Input := First (Expressions (Input));
-- the pool of candidates if both input lists match.
-- Note that the search continues because one clause
-- may have been normalized into multiple clauses as
-- per the example above.
if Ekind_In (Ref_Id, E_Abstract_State, E_Variable) if Denotes_Item (Input) then
and then Present (Encapsulating_State (Ref_Id)) return True;
and then Encapsulating_State (Ref_Id) = Dep_Id
and then Inputs_Match
(Ref_Clause, Do_Checks => False)
then
Has_Constituent := True;
Remove (Ref_Clause);
end if;
end if; end if;
-- The abstract view of a state matches is corresponding Next (Input);
-- non-abstract view:
-- Depends => (Lim_Pack.State => <input>)
-- Refined_Depends => (State => <input>)
elsif Is_Entity_Name (Ref_Output)
and then Entity_Of (Ref_Output) = Dep_Id
then
Matching_Clause := Ref_Clause;
exit;
end if;
-- Formal parameters and variables match if their inputs match -- Solitary input
elsif Is_Entity_Name (Ref_Output) elsif Denotes_Item (Input) then
and then Entity_Of (Ref_Output) = Dep_Id return True;
then
Matching_Clause := Ref_Clause;
exit;
end if; end if;
end if; end if;
Ref_Clause := Next_Ref_Clause; Next (Clause);
end loop; end loop;
-- Handle the case where pragma Depends contains one or more clauses return False;
-- that only mention states with null refinements. In that case the end Is_Self_Referential;
-- corresponding pragma Refined_Depends may have a null relation.
-- Refined_State => (State => null)
-- Depends => (State => null)
-- Refined_Depends => null -- OK
-- Another instance of the same scenario occurs when the list of
-- refinements has been depleted while processing previous clauses.
if Is_Entity_Name (Dep_Output)
and then (No (Refinements) or else Is_Empty_List (Refinements))
then
Dep_Id := Entity_Of (Dep_Output);
if Ekind (Dep_Id) = E_Abstract_State
and then Has_Null_Refinement (Dep_Id)
then
Has_Null_State := True;
end if;
end if;
-- The above search produced a match based on unique output. Ensure
-- that the inputs match as well and if they do, remove the clause
-- from the pool of candidates.
if Present (Matching_Clause) then
if Inputs_Match (Matching_Clause, Do_Checks => True) then
Remove (Matching_Clause);
end if;
-- A state with a visible refinement was matched against one or
-- more clauses containing appropriate constituents.
elsif Has_Constituent then
null;
-- A state with a null refinement did not warrant a clause
elsif Has_Null_State then
null;
-- The dependence relation of pragma Refined_Depends does not contain
-- a matching clause, emit an error.
else
Error_Msg_NE
("dependence clause of subprogram & has no matching refinement "
& "in body", Ref_Clause, Spec_Id);
if Has_Refined_State then
Error_Msg_N
("\check the use of constituents in dependence refinement",
Ref_Clause);
end if;
end if;
end Check_Dependency_Clause;
-------------------------- --------------------------
-- Report_Extra_Clauses -- -- Report_Extra_Clauses --
...@@ -21804,18 +21911,11 @@ package body Sem_Prag is ...@@ -21804,18 +21911,11 @@ package body Sem_Prag is
-- Local variables -- Local variables
Body_Decl : constant Node_Id := Parent (N); Body_Decl : constant Node_Id := Parent (N);
Body_Id : constant Entity_Id := Defining_Entity (Body_Decl);
Errors : constant Nat := Serious_Errors_Detected; Errors : constant Nat := Serious_Errors_Detected;
Clause : Node_Id; Clause : Node_Id;
Deps : Node_Id; Deps : Node_Id;
Refs : Node_Id; Refs : Node_Id;
-- The following are dummy variables that capture unused output of
-- routine Collect_Global_Items.
D1, D2, D3 : Elist_Id := No_Elist;
D4, D5, D6, D7, D8 : Boolean;
-- Start of processing for Analyze_Refined_Depends_In_Decl_Part -- Start of processing for Analyze_Refined_Depends_In_Decl_Part
begin begin
...@@ -21859,28 +21959,6 @@ package body Sem_Prag is ...@@ -21859,28 +21959,6 @@ package body Sem_Prag is
Refs := Get_Pragma_Arg (First (Pragma_Argument_Associations (N))); Refs := Get_Pragma_Arg (First (Pragma_Argument_Associations (N)));
if Serious_Errors_Detected = Errors then if Serious_Errors_Detected = Errors then
-- The related subprogram may be subject to pragma Refined_Global. If
-- this is the case, gather all output items. These are needed when
-- verifying the use of constituents that apply to output states with
-- visible refinement.
Ref_Global := Get_Pragma (Body_Id, Pragma_Refined_Global);
if Present (Ref_Global) then
Collect_Global_Items
(Prag => Ref_Global,
In_Items => D1,
In_Out_Items => D2,
Out_Items => Out_Items,
Proof_In_Items => D3,
Has_In_State => D4,
Has_In_Out_State => D5,
Has_Out_State => D6,
Has_Proof_In_State => D7,
Has_Null_State => D8);
end if;
if Nkind (Refs) = N_Null then if Nkind (Refs) = N_Null then
Refinements := No_List; Refinements := No_List;
......
gcc/ada/sinfo.ads
...@@ -7359,7 +7359,11 @@ package Sinfo is ...@@ -7359,7 +7359,11 @@ package Sinfo is
-- the actions list is always non-null, since there is no point in this -- the actions list is always non-null, since there is no point in this
-- node if the actions are Empty. During semantic analysis there are -- node if the actions are Empty. During semantic analysis there are
-- cases where it is convenient to temporarily generate an empty actions -- cases where it is convenient to temporarily generate an empty actions
-- list, but the Expander removes such cases. -- list. This arises in cases where we create such an empty actions
-- list, and it may or may not end up being a place where additional
-- actions are inserted. The expander removes such empty cases after
-- the expression of the node is fully analyzed and expanded, at which
-- point it is safe to remove it, since no more actions can be inserted.
-- Note: Expression may be a Null_Statement, in which case the -- Note: Expression may be a Null_Statement, in which case the
-- N_Expression_With_Actions has type Standard_Void_Type. However some -- N_Expression_With_Actions has type Standard_Void_Type. However some
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment