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>
* g-comlin.adb: Minor typo fix.
......
gcc/ada/exp_ch13.adb
......@@ -157,6 +157,46 @@ package body Exp_Ch13 is
(Exp, Make_Integer_Literal (Loc, Expr_Value (Exp)));
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 --
------------------
......
gcc/ada/sem_ch13.adb
......@@ -3526,13 +3526,23 @@ package body Sem_Ch13 is
-- expander. The easiest general way to handle this is to create a
-- copy of the attribute definition clause for this object.
else
elsif Is_Entity_Name (Renamed_Object (Ent)) then
Insert_Action (N,
Make_Attribute_Definition_Clause (Loc,
Name =>
New_Occurrence_Of (Entity (Renamed_Object (Ent)), Loc),
Chars => Chars (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;
-- If no underlying entity, use entity itself, applies to some
......
gcc/ada/sem_prag.adb
......@@ -21201,12 +21201,6 @@ package body Sem_Prag is
Depends : Node_Id;
-- 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;
-- The clauses of pragma Refined_Depends
......@@ -21216,6 +21210,27 @@ package body Sem_Prag is
procedure Check_Dependency_Clause (Dep_Clause : Node_Id);
-- 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;
-- Emit an error for each extra clause the appears in Refined_Depends
......@@ -21224,38 +21239,249 @@ package body Sem_Prag is
-----------------------------
procedure Check_Dependency_Clause (Dep_Clause : Node_Id) is
function Inputs_Match
(Ref_Clause : Node_Id;
Do_Checks : Boolean) return Boolean;
-- Determine whether the inputs of clause Dep_Clause match those of
-- clause Ref_Clause. If flag Do_Checks is set, the routine reports
-- missed or extra input items.
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;
------------------
-- Inputs_Match --
------------------
Has_Constituent : Boolean := False;
-- Flag set when the refinement output list contains at least one
-- constituent of the state denoted by Dep_Id.
function Inputs_Match
(Ref_Clause : Node_Id;
Do_Checks : Boolean) return Boolean
is
Ref_Inputs : List_Id;
-- The input list of the refinement clause
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;
-- 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;
-- Determine whether input Dep_Input matches one of the inputs of
-- clause Ref_Clause.
begin
-- The analysis of pragma Depends should produce normalized clauses
-- 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;
-- Emit errors for all extra inputs that appear in Ref_Clause
pragma Assert (No (Next (Dep_Output)));
-----------------------
-- Is_Matching_Input --
-----------------------
-- 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
-- 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);
-- Emit a matching error if flag Do_Checks is set
-- Emit a matching error if flag Post_Errors is set
-----------------
-- Match_Error --
......@@ -21263,7 +21489,7 @@ package body Sem_Prag is
procedure Match_Error (Msg : String; N : Node_Id) is
begin
if Do_Checks then
if Post_Errors then
Error_Msg_N (Msg, N);
end if;
end Match_Error;
......@@ -21276,18 +21502,18 @@ package body Sem_Prag is
Ref_Input : Node_Id;
Has_Constituent : Boolean := False;
-- Flag set when the refinement input list contains at least
-- one constituent of the state denoted by Dep_Id.
-- Flag set when the refinement input list contains at least one
-- constituent of the state denoted by Dep_Id.
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.
Has_Refined_State : Boolean := False;
-- Flag set when the dependency input is a state with visible
-- refinement.
-- Flag set when the dependency input is a state with visible non-
-- null refinement.
-- Start of processing for Is_Matching_Input
-- Start of processing for Input_Match
begin
-- Match a null input with another null input
......@@ -21303,33 +21529,33 @@ package body Sem_Prag is
else
Match_Error
("null input cannot be matched in corresponding "
& "refinement clause", Dep_Input);
("null input cannot be matched in corresponding refinement "
& "clause", Dep_Input);
end if;
-- Remaining cases are formal parameters, variables, and states
else
-- Handle abstract views of states and variables generated
-- for limited with clauses.
-- Handle abstract views of states and variables generated for
-- limited with clauses.
Dep_Id := Available_View (Entity_Of (Dep_Input));
-- Inspect all inputs of the refinement clause and attempt
-- to match against the inputs of the dependence clause.
-- Inspect all inputs of the refinement clause and attempt to
-- match against the inputs of the dependence clause.
Ref_Input := First (Ref_Inputs);
while Present (Ref_Input) loop
-- Store the next input now because a match will remove
-- it from the list.
-- Store the next input now because a match will remove it from
-- the list.
Next_Ref_Input := Next (Ref_Input);
if Ekind (Dep_Id) = E_Abstract_State then
-- A state with a null refinement matches either a
-- null input list or nothing at all (no input):
-- A state with a null refinement matches either a null
-- input list or nothing at all (no input):
-- Refined_State => (State => null)
......@@ -21346,8 +21572,7 @@ package body Sem_Prag is
if Has_Null_Refinement (Dep_Id) then
Has_Null_State := True;
-- Remove the matching null from the pool of
-- candidates.
-- Remove the matching null from the pool of candidates
if Nkind (Ref_Input) = N_Null then
Remove (Ref_Input);
......@@ -21355,8 +21580,8 @@ package body Sem_Prag is
return True;
-- The state has a non-null refinement in which case
-- remove all the matching constituents of the state:
-- The state has a non-null refinement in which case remove
-- all the matching constituents of the state:
-- Refined_State => (State => (C1, C2))
-- Depends => (<output> => State)
......@@ -21365,16 +21590,33 @@ package body Sem_Prag is
elsif Has_Non_Null_Refinement (Dep_Id) then
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
if Is_Entity_Name (Ref_Input) then
elsif Is_Entity_Name (Ref_Input) then
Ref_Id := Entity_Of (Ref_Input);
-- The input of the refinement clause is a valid
-- constituent of the state. Remove the input
-- from the pool of candidates. Note that the
-- search continues because the state may be
-- represented by multiple constituents.
-- constituent of the state. Remove the input from the
-- pool of candidates. Note that the search continues
-- because the state may be represented by multiple
-- constituents.
if Ekind_In (Ref_Id, E_Abstract_State,
E_Variable)
......@@ -21386,8 +21628,8 @@ package body Sem_Prag is
end if;
end if;
-- The abstract view of a state matches its
-- corresponding non-abstract view:
-- The abstract view of a state matches its corresponding
-- non-abstract view:
-- Depends => (<output> => Lim_Pack.State)
-- Refined_Depends => (<output> => State)
......@@ -21399,9 +21641,8 @@ package body Sem_Prag is
return True;
end if;
-- Formal parameters and variables are matched on
-- entities. If this is the case, remove the input from
-- the candidate list.
-- Formal parameters and variables are matched on entities. If
-- this is the case, remove the input from the candidate list.
elsif Is_Entity_Name (Ref_Input)
and then Entity_Of (Ref_Input) = Dep_Id
......@@ -21413,8 +21654,8 @@ package body Sem_Prag is
Ref_Input := Next_Ref_Input;
end loop;
-- When a state with a null refinement appears as the last
-- input, it matches nothing:
-- When a state with a null refinement appears as the last input,
-- it matches nothing:
-- Refined_State => (State => null)
-- Depends => (<output> => (Input, State))
......@@ -21428,8 +21669,8 @@ package body Sem_Prag is
end if;
end if;
-- A state with visible refinement was matched against one or
-- more of its constituents.
-- A state with visible refinement was matched against one or more of
-- its constituents.
if Has_Constituent then
return True;
......@@ -21439,23 +21680,38 @@ package body Sem_Prag is
elsif Has_Null_State then
return True;
-- The input of a dependence clause does not have a matching
-- input in the refinement clause, emit an error.
-- The input of a dependence clause does not have a matching input in
-- the refinement clause, emit an error.
else
Match_Error
("input cannot be matched in corresponding refinement "
& "clause", Dep_Input);
("input cannot be matched in corresponding refinement clause",
Dep_Input);
if Has_Refined_State then
Match_Error
("\check the use of constituents in dependence "
& "refinement", Dep_Input);
("\check the use of constituents in dependence refinement",
Dep_Input);
end if;
return False;
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 --
......@@ -21465,12 +21721,11 @@ package body Sem_Prag is
Input : Node_Id;
begin
if Present (Ref_Inputs) and then Do_Checks then
if Present (Ref_Inputs) and then Post_Errors then
Input := First (Ref_Inputs);
while Present (Input) loop
Error_Msg_N
("unmatched or extra input in refinement clause",
Input);
("unmatched or extra input in refinement clause", Input);
Next (Input);
end loop;
......@@ -21524,7 +21779,11 @@ package body Sem_Prag is
if Nkind (Dep_Inputs) = N_Aggregate then
Dep_Input := First (Expressions (Dep_Inputs));
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;
end if;
......@@ -21536,242 +21795,90 @@ package body Sem_Prag is
-- Solitary input
else
Result := Is_Matching_Input (Dep_Inputs);
Result :=
Input_Match
(Dep_Input => Dep_Inputs,
Ref_Inputs => Ref_Inputs,
Post_Errors => Post_Errors);
end if;
-- List all inputs that appear as extras
Report_Extra_Inputs;
return Result;
end Inputs_Match;
-- Local variables
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.
-------------------------
-- Is_Self_Referential --
-------------------------
Has_Refined_State : Boolean := False;
-- Flag set when the output of clause Dep_Clause is a state with
-- visible refinement.
function Is_Self_Referential (Item_Id : Entity_Id) return Boolean is
function Denotes_Item (N : Node_Id) return Boolean;
-- 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
-- The analysis of pragma Depends should produce normalized clauses
-- with exactly one output. This is important because output items
-- are unique in the whole dependence relation and can be used as
-- keys.
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;
return
Is_Entity_Name (N)
and then Present (Entity (N))
and then Entity (N) = Item_Id;
end Denotes_Item;
-- When a state with null refinement matches a null
-- output, compare their inputs.
-- Local variables
if Nkind (Ref_Output) = N_Null then
Matching_Clause := Ref_Clause;
end if;
Clauses : constant Node_Id :=
Get_Pragma_Arg
(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
-- match is based on constituents and inputs. A state with
-- multiple output constituents may match multiple clauses:
begin
Clause := First (Component_Associations (Clauses));
while Present (Clause) loop
-- Refined_State => (State => (C1, C2))
-- Depends => (State => <input>)
-- Refined_Depends => ((C1, C2) => <input>)
-- Due to normalization, a dependence clause has exactly one
-- output even if the original clause had multiple outputs.
-- When normalized, the above becomes:
Output := First (Choices (Clause));
-- Refined_Depends => (C1 => <input>,
-- C2 => <input>)
-- Detect the following scenario:
--
-- Item_Id => [(...,] Item_Id [, ...)]
elsif Has_Non_Null_Refinement (Dep_Id) then
Has_Refined_State := True;
if Denotes_Item (Output) then
Input := Expression (Clause);
if Is_Entity_Name (Ref_Output) then
Ref_Id := Entity_Of (Ref_Output);
-- Multiple inputs appear as an aggregate
-- 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 Nkind (Input) = N_Aggregate then
Input := First (Expressions (Input));
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
(Ref_Clause, Do_Checks => False)
then
Has_Constituent := True;
Remove (Ref_Clause);
end if;
if Denotes_Item (Input) then
return True;
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;
Next (Input);
-- Formal parameters and variables match if their inputs match
-- Solitary input
elsif Is_Entity_Name (Ref_Output)
and then Entity_Of (Ref_Output) = Dep_Id
then
Matching_Clause := Ref_Clause;
exit;
elsif Denotes_Item (Input) then
return True;
end if;
end if;
Ref_Clause := Next_Ref_Clause;
Next (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 (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;
return False;
end Is_Self_Referential;
--------------------------
-- Report_Extra_Clauses --
......@@ -21804,18 +21911,11 @@ package body Sem_Prag is
-- Local variables
Body_Decl : constant Node_Id := Parent (N);
Body_Id : constant Entity_Id := Defining_Entity (Body_Decl);
Errors : constant Nat := Serious_Errors_Detected;
Clause : Node_Id;
Deps : 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
begin
......@@ -21859,28 +21959,6 @@ package body Sem_Prag is
Refs := Get_Pragma_Arg (First (Pragma_Argument_Associations (N)));
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
Refinements := No_List;
......
gcc/ada/sinfo.ads
......@@ -7359,7 +7359,11 @@ package Sinfo is
-- 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
-- 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
-- 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