Commit 739e7bbf by Arnaud Charlet

[multiple changes]

2012-12-05  Thomas Quinot  <quinot@adacore.com>

	* err_vars.ads: Fix minor typo in comment.

2012-12-05  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_attr.adb (Analyze_Attribute): Do not analyze the attribute
	arguments when processing Loop_Entry. Rewrite the analysis of
	attribute Loop_Entry to handle an optional loop name.
	(Convert_To_Indexed_Component): New routine.
	(Eval_Attribute): Remove ??? comment and explain
	why Loop_Entry does not need to be evaluated.

From-SVN: r194189
parent 698ef65e
2012-12-05 Thomas Quinot <quinot@adacore.com>
* err_vars.ads: Fix minor typo in comment.
2012-12-05 Hristian Kirtchev <kirtchev@adacore.com>
* sem_attr.adb (Analyze_Attribute): Do not analyze the attribute
arguments when processing Loop_Entry. Rewrite the analysis of
attribute Loop_Entry to handle an optional loop name.
(Convert_To_Indexed_Component): New routine.
(Eval_Attribute): Remove ??? comment and explain
why Loop_Entry does not need to be evaluated.
2012-12-01 John David Anglin <dave.anglin@nrc-cnrc.gc.ca> 2012-12-01 John David Anglin <dave.anglin@nrc-cnrc.gc.ca>
PR ada/52110 PR ada/52110
......
...@@ -40,7 +40,7 @@ package Err_Vars is ...@@ -40,7 +40,7 @@ package Err_Vars is
-- Note on error counts (Serious_Errors_Detected, Total_Errors_Detected, -- Note on error counts (Serious_Errors_Detected, Total_Errors_Detected,
-- Warnings_Detected). These counts might more logically appear in this -- Warnings_Detected). These counts might more logically appear in this
-- unit, but we place them in atree.adb, because of licensing issues. We -- unit, but we place them in atree.ads, because of licensing issues. We
-- need to be able to access these counts from units that have the more -- need to be able to access these counts from units that have the more
-- general licensing conditions. -- general licensing conditions.
......
...@@ -875,7 +875,7 @@ package body Sem_Attr is ...@@ -875,7 +875,7 @@ package body Sem_Attr is
procedure Bad_Attribute_For_Predicate is procedure Bad_Attribute_For_Predicate is
begin begin
if Is_Scalar_Type (P_Type) if Is_Scalar_Type (P_Type)
and then Comes_From_Source (N) and then Comes_From_Source (N)
then then
Error_Msg_Name_1 := Aname; Error_Msg_Name_1 := Aname;
Bad_Predicated_Subtype_Use Bad_Predicated_Subtype_Use
...@@ -2120,6 +2120,20 @@ package body Sem_Attr is ...@@ -2120,6 +2120,20 @@ package body Sem_Attr is
E1 := Empty; E1 := Empty;
E2 := Empty; E2 := Empty;
-- Do not analyze the expressions of attribute Loop_Entry. Depending on
-- the number of arguments and/or the nature of the first argument, the
-- whole attribute reference may be rewritten into an indexed component.
-- In the case of two or more arguments, the expressions are analyzed
-- when the indexed component is analyzed, otherwise the sole argument
-- is preanalyzed to determine whether it is a loop name.
elsif Aname = Name_Loop_Entry then
E1 := First (Exprs);
if Present (E1) then
E2 := Next (E1);
end if;
else else
E1 := First (Exprs); E1 := First (Exprs);
Analyze (E1); Analyze (E1);
...@@ -3610,6 +3624,11 @@ package body Sem_Attr is ...@@ -3610,6 +3624,11 @@ package body Sem_Attr is
-- Inspect the prefix for any uses of entities declared within the -- Inspect the prefix for any uses of entities declared within the
-- related loop. Loop_Id denotes the loop identifier. -- related loop. Loop_Id denotes the loop identifier.
procedure Convert_To_Indexed_Component;
-- Transform the attribute reference into an indexed component where
-- the prefix is Prefix'Loop_Entry and the expressions are associated
-- with the indexed component.
-------------------------------- --------------------------------
-- Check_References_In_Prefix -- -- Check_References_In_Prefix --
-------------------------------- --------------------------------
...@@ -3682,6 +3701,25 @@ package body Sem_Attr is ...@@ -3682,6 +3701,25 @@ package body Sem_Attr is
Check_References (P); Check_References (P);
end Check_References_In_Prefix; end Check_References_In_Prefix;
----------------------------------
-- Convert_To_Indexed_Component --
----------------------------------
procedure Convert_To_Indexed_Component is
New_Loop_Entry : constant Node_Id := Relocate_Node (N);
begin
-- The new Loop_Entry loses its arguments. They will be converted
-- into the expressions of the indexed component.
Set_Expressions (New_Loop_Entry, No_List);
Rewrite (N,
Make_Indexed_Component (Loc,
Prefix => New_Loop_Entry,
Expressions => Exprs));
end Convert_To_Indexed_Component;
-- Local variables -- Local variables
Enclosing_Loop : Node_Id; Enclosing_Loop : Node_Id;
...@@ -3694,8 +3732,48 @@ package body Sem_Attr is ...@@ -3694,8 +3732,48 @@ package body Sem_Attr is
begin begin
S14_Attribute; S14_Attribute;
Check_E1;
Analyze (E1); -- The attribute reference appears as
-- Prefix'Loop_Entry (Expr1, Expr2, ... ExprN)
-- In this case, the loop name is omitted and the arguments are part
-- of an indexed component. Transform the whole attribute reference
-- to reflect this scenario.
if Present (E2) then
Convert_To_Indexed_Component;
Analyze (N);
return;
-- The attribute reference appears as
-- Prefix'Loop_Entry (Loop_Name)
-- or
-- Prefix'Loop_Entry (Expr1)
-- Depending on what Expr1 resolves to, either rewrite the reference
-- into an indexed component or continue with the analysis.
elsif Present (E1) then
-- Do not expand the argument as it may have side effects. Simply
-- preanalyze to determine whether it is a loop or something else.
Preanalyze_And_Resolve (E1);
if Is_Entity_Name (E1)
and then Present (Entity (E1))
and then Ekind (Entity (E1)) = E_Loop
then
Loop_Id := Entity (E1);
-- The argument is not a loop name
else
Convert_To_Indexed_Component;
Analyze (N);
return;
end if;
end if;
-- The prefix must denote an object -- The prefix must denote an object
...@@ -3711,20 +3789,6 @@ package body Sem_Attr is ...@@ -3711,20 +3789,6 @@ package body Sem_Attr is
Error_Attr_P ("prefix of attribute % cannot be limited"); Error_Attr_P ("prefix of attribute % cannot be limited");
end if; end if;
-- The sole argument of a Loop_Entry must be a loop name
if Is_Entity_Name (E1) then
Loop_Id := Entity (E1);
end if;
if No (Loop_Id)
or else Ekind (Loop_Id) /= E_Loop
or else not In_Open_Scopes (Loop_Id)
then
Error_Attr ("argument of % must be a valid loop name", E1);
return;
end if;
-- Climb the parent chain to verify the location of the attribute and -- Climb the parent chain to verify the location of the attribute and
-- find the enclosing loop. -- find the enclosing loop.
...@@ -3751,6 +3815,15 @@ package body Sem_Attr is ...@@ -3751,6 +3815,15 @@ package body Sem_Attr is
and then Present (Identifier (Stmt)) and then Present (Identifier (Stmt))
then then
Enclosing_Loop := Stmt; Enclosing_Loop := Stmt;
-- The original attribute reference may lack a loop name. Use
-- the name of the enclosing loop because it is the related
-- loop.
if No (Loop_Id) then
Loop_Id := Entity (Identifier (Enclosing_Loop));
end if;
exit; exit;
-- Prevent the search from going too far -- Prevent the search from going too far
...@@ -3790,7 +3863,7 @@ package body Sem_Attr is ...@@ -3790,7 +3863,7 @@ package body Sem_Attr is
else else
Error_Attr Error_Attr
("cannot appear in program unit or accept statement", N); ("attribute % cannot appear in body or accept statement", N);
exit; exit;
end if; end if;
end loop; end loop;
...@@ -7235,7 +7308,10 @@ package body Sem_Attr is ...@@ -7235,7 +7308,10 @@ package body Sem_Attr is
-- Loop_Entry -- -- Loop_Entry --
---------------- ----------------
-- This null processing requires an explanatory comment??? -- Loop_Entry acts as an alias of a constant initialized to the prefix
-- of the said attribute at the point of entry into the related loop. As
-- such, the attribute reference does not need to be evaluated because
-- the prefix is the one that is evaluted.
when Attribute_Loop_Entry => when Attribute_Loop_Entry =>
null; null;
......
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