[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

3 files changed, 109 insertions, 20 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 57077d0..4aafa83 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,16 @@
+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>
 
 	PR ada/52110
diff --git a/gcc/ada/err_vars.ads b/gcc/ada/err_vars.ads
index 6afa4e3..64d68e0 100644
--- a/gcc/ada/err_vars.ads
+++ b/gcc/ada/err_vars.ads
@@ -40,7 +40,7 @@ package Err_Vars is
 
    --  Note on error counts (Serious_Errors_Detected, Total_Errors_Detected,
    --  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
    --  general licensing conditions.
 
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 7ed94b4..cfb0983 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -875,7 +875,7 @@ package body Sem_Attr is
       procedure Bad_Attribute_For_Predicate is
       begin
          if Is_Scalar_Type (P_Type)
-           and then  Comes_From_Source (N)
+           and then Comes_From_Source (N)
          then
             Error_Msg_Name_1 := Aname;
             Bad_Predicated_Subtype_Use
@@ -2120,6 +2120,20 @@ package body Sem_Attr is
          E1 := 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
          E1 := First (Exprs);
          Analyze (E1);
@@ -3610,6 +3624,11 @@ package body Sem_Attr is
          --  Inspect the prefix for any uses of entities declared within the
          --  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 --
          --------------------------------
@@ -3682,6 +3701,25 @@ package body Sem_Attr is
             Check_References (P);
          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
 
          Enclosing_Loop    : Node_Id;
@@ -3694,8 +3732,48 @@ package body Sem_Attr is
 
       begin
          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
 
@@ -3711,20 +3789,6 @@ package body Sem_Attr is
             Error_Attr_P ("prefix of attribute % cannot be limited");
          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
          --  find the enclosing loop.
 
@@ -3751,6 +3815,15 @@ package body Sem_Attr is
               and then Present (Identifier (Stmt))
             then
                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;
 
             --  Prevent the search from going too far
@@ -3790,7 +3863,7 @@ package body Sem_Attr is
 
             else
                Error_Attr
-                 ("cannot appear in program unit or accept statement", N);
+                 ("attribute % cannot appear in body or accept statement", N);
                exit;
             end if;
          end loop;
@@ -7235,7 +7308,10 @@ package body Sem_Attr is
       -- 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 =>
          null;