[multiple changes]

2013-04-24  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch7.adb (Swap_Private_Dependents): New internal routine
	to Install_Private_Declarations, to make the installation of
	private dependents recursive in the presence of child units.
	* sem_ch3.adb (Build_Discriminated_Subtype): Initialize properly
	the Private_Dependents of a private subtype.

2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_attr.adb (Expand_Loop_Entry_Attribute): Update the
	retrieval of the block declarations.
	* par-ch4.adb (P_Name): Let the name parsing machinery create
	a sequence of nested indexed components for attribute Loop_Entry.
	* sem_attr.adb (Analyze_Attribute): Add local constant
	Context. Reimplement part of the analysis of attribute Loop_Entry.
	(Convert_To_Indexed_Component): Removed.
	* sem_ch4.adb (Analyze_Indexed_Component_Form): Do not analyze
	an indexed component after it has been rewritten into attribute
	Loop_Entry.

From-SVN: r198240

7 files changed, 172 insertions, 118 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 34a91d1..345f9d2 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,24 @@
+2013-04-24  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch7.adb (Swap_Private_Dependents): New internal routine
+	to Install_Private_Declarations, to make the installation of
+	private dependents recursive in the presence of child units.
+	* sem_ch3.adb (Build_Discriminated_Subtype): Initialize properly
+	the Private_Dependents of a private subtype.
+
+2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_attr.adb (Expand_Loop_Entry_Attribute): Update the
+	retrieval of the block declarations.
+	* par-ch4.adb (P_Name): Let the name parsing machinery create
+	a sequence of nested indexed components for attribute Loop_Entry.
+	* sem_attr.adb (Analyze_Attribute): Add local constant
+	Context. Reimplement part of the analysis of attribute Loop_Entry.
+	(Convert_To_Indexed_Component): Removed.
+	* sem_ch4.adb (Analyze_Indexed_Component_Form): Do not analyze
+	an indexed component after it has been rewritten into attribute
+	Loop_Entry.
+
 2013-04-24  Yannick Moy  <moy@adacore.com>
 
 	* snames.ads-tmpl: Minor change to list
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index c206218..f904707 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -782,7 +782,15 @@ package body Exp_Attr is
       --  'Loop_Entry attribute. Retrieve the declarative list of the block.
 
       if Has_Loop_Entry_Attributes (Loop_Id) then
-         Decls  := Declarations (Parent (Parent (Loop_Stmt)));
+         if Nkind (Loop_Stmt) = N_Block_Statement then
+            Decls := Declarations (Loop_Stmt);
+         else
+            --  What is going on here??? comments/assertions needed to explain
+            --  the assumption being made about the tree???
+
+            Decls := Declarations (Parent (Parent (Loop_Stmt)));
+         end if;
+
          Result := Empty;
 
       --  Transform the loop into a conditional block
diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index f0cfa35..e1e634a 100644
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -698,25 +698,16 @@ package body Ch4 is
 
          if Token = Tok_Arrow then
             Error_Msg
-              ("expect identifier in parameter association",
-                Sloc (Expr_Node));
+              ("expect identifier in parameter association", Sloc (Expr_Node));
             Scan;  -- past arrow
 
          elsif not Comma_Present then
             T_Right_Paren;
 
-            --  Do not convert Prefix'Loop_Entry (Expr1, ..., ExprN) into an
-            --  indexed component now. Let the analysis determine whether the
-            --  attribute is legal and perform the transformation if needed.
-
-            if Attr_Name = Name_Loop_Entry then
-               Set_Expressions (Name_Node, Arg_List);
-            else
-               Prefix_Node := Name_Node;
-               Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node));
-               Set_Prefix (Name_Node, Prefix_Node);
-               Set_Expressions (Name_Node, Arg_List);
-            end if;
+            Prefix_Node := Name_Node;
+            Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node));
+            Set_Prefix (Name_Node, Prefix_Node);
+            Set_Expressions (Name_Node, Arg_List);
 
             goto Scan_Name_Extension;
          end if;
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index fc1ace2..30509dc 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -2136,20 +2136,6 @@ 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);
@@ -3641,11 +3627,6 @@ 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 --
          --------------------------------
@@ -3712,27 +3693,9 @@ 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
 
+         Context           : constant Node_Id := Parent (N);
          Enclosing_Loop    : Node_Id;
          In_Loop_Assertion : Boolean   := False;
          Loop_Id           : Entity_Id := Empty;
@@ -3742,47 +3705,77 @@ package body Sem_Attr is
       --  Start of processing for Loop_Entry
 
       begin
-         S14_Attribute;
+         --  Attribute 'Loop_Entry may appear in several flavors:
 
-         --  The attribute reference appears as
-         --    Prefix'Loop_Entry (Expr1, Expr2, ... ExprN)
+         --    * Prefix'Loop_Entry - in this form, the attribute applies to the
+         --        nearest enclosing loop.
 
-         --  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.
+         --    * Prefix'Loop_Entry (Expr) - depending on what Expr denotes, the
+         --        attribute may be related to a loop denoted by label Expr or
+         --        the prefix may denote an array object and Expr may act as an
+         --        indexed component.
 
-         if Present (E2) then
-            Convert_To_Indexed_Component;
-            Analyze (N);
-            return;
+         --    * Prefix'Loop_Entry (Expr1, ..., ExprN) - the attribute applies
+         --        to the nearest enclosing loop, all expressions are part of
+         --        an indexed component.
 
-         --  The attribute reference appears as
-         --    Prefix'Loop_Entry (Loop_Name)
-         --      or
-         --    Prefix'Loop_Entry (Expr1)
+         --    * Prefix'Loop_Entry (Expr) (...) (...) - depending on what Expr
+         --        denotes, the attribute may be related to a loop denoted by
+         --        label Expr or the prefix may denote a multidimensional array
+         --        array object and Expr along with the rest of the expressions
+         --        may act as indexed components.
 
-         --  Depending on what Expr1 resolves to, either rewrite the reference
-         --  into an indexed component or continue with the analysis.
+         --  Regardless of variations, the attribute reference does not have an
+         --  expression list. Instead, all available expressions are stored as
+         --  indexed components.
 
-         elsif Present (E1) then
+         S14_Attribute;
 
-            --  Do not expand the argument as it may have side effects. Simply
-            --  preanalyze to determine whether it is a loop or something else.
+         --  When the attribute is part of an indexed component, find the first
+         --  expression as it will determine the semantics of 'Loop_Entry.
 
-            Preanalyze_And_Resolve (E1);
+         if Nkind (Context) = N_Indexed_Component then
+            E1 := First (Expressions (Context));
+            E2 := Next (E1);
 
-            if Is_Entity_Name (E1)
-              and then Present (Entity (E1))
-              and then Ekind (Entity (E1)) = E_Loop
-            then
-               Loop_Id := Entity (E1);
+            --  The attribute reference appears in the following form:
+
+            --    Prefix'Loop_Entry (Exp1, Expr2, ..., ExprN) [(...)]
+
+            --  In this case, the loop name is omitted and no rewriting is
+            --  required.
+
+            if Present (E2) then
+               null;
+
+            --  The form of the attribute is:
+
+            --    Prefix'Loop_Entry (Expr) [(...)]
 
-            --  The argument is not a loop name
+            --  If Expr denotes a loop entry, the whole attribute and indexed
+            --  component will have to be rewritten to reflect this relation.
 
             else
-               Convert_To_Indexed_Component;
-               Analyze (N);
-               return;
+               pragma Assert (Present (E1));
+
+               --  Do not expand the expression as it may have side effects.
+               --  Simply preanalyze to determine whether it is a loop name 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);
+
+                  --  Transform the attribute and enclosing indexed component
+
+                  Set_Expressions (N, Expressions (Context));
+                  Rewrite   (Context, N);
+                  Set_Etype (Context, P_Type);
+               end if;
             end if;
          end if;
 
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index af2cc23..8e874af 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -8659,6 +8659,10 @@ package body Sem_Ch3 is
          Set_Known_To_Have_Preelab_Init
            (Def_Id, Known_To_Have_Preelab_Init (T));
 
+         --  private subtypes may have private dependents.
+
+         Set_Private_Dependents (Def_Id, New_Elmt_List);
+
       elsif Is_Class_Wide_Type (T) then
          Set_Ekind (Def_Id, E_Class_Wide_Subtype);
 
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index e78ce33..ae69805 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -2388,12 +2388,20 @@ package body Sem_Ch4 is
 
       Analyze (P);
 
+      --  If P is an explicit dereference whose prefix is of a remote access-
+      --  to-subprogram type, then N has already been rewritten as a subprogram
+      --  call and analyzed.
+
       if Nkind (N) in N_Subprogram_Call then
+         return;
 
-         --  If P is an explicit dereference whose prefix is of a
-         --  remote access-to-subprogram type, then N has already
-         --  been rewritten as a subprogram call and analyzed.
+      --  When the prefix is attribute 'Loop_Entry and the sole expression of
+      --  the indexed component denotes a loop name, the indexed form is turned
+      --  into an attribute reference.
 
+      elsif Nkind (N) = N_Attribute_Reference
+        and then Attribute_Name (N) = Name_Loop_Entry
+      then
          return;
       end if;
 
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index f8e2799..c21874d 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -1812,9 +1812,63 @@ package body Sem_Ch7 is
 
    procedure Install_Private_Declarations (P : Entity_Id) is
       Id        : Entity_Id;
-      Priv_Elmt : Elmt_Id;
-      Priv      : Entity_Id;
       Full      : Entity_Id;
+      Priv_Deps : Elist_Id;
+
+      procedure Swap_Private_Dependents (Priv_Deps : Elist_Id);
+      --  When the full view of a private type is made available, we do the
+      --  same for its private dependents under proper visibility conditions.
+      --  When compiling a grand-chid unit this needs to be done recursively.
+
+      procedure Swap_Private_Dependents (Priv_Deps : Elist_Id) is
+         Deps      : Elist_Id;
+         Priv      : Entity_Id;
+         Priv_Elmt : Elmt_Id;
+         Is_Priv   : Boolean;
+
+      begin
+         Priv_Elmt := First_Elmt (Priv_Deps);
+
+         while Present (Priv_Elmt) loop
+            Priv := Node (Priv_Elmt);
+
+            --  Before the exchange, verify that the presence of the
+            --  Full_View field. It will be empty if the entity has already
+            --  been installed due to a previous call.
+
+            if Present (Full_View (Priv))
+              and then Is_Visible_Dependent (Priv)
+            then
+               if Is_Private_Type (Priv) then
+                  Deps := Private_Dependents (Priv);
+                  Is_Priv := True;
+               else
+                  Is_Priv := False;
+               end if;
+
+               --  For each subtype that is swapped, we also swap the
+               --  reference to it in Private_Dependents, to allow access
+               --  to it when we swap them out in End_Package_Scope.
+
+               Replace_Elmt (Priv_Elmt, Full_View (Priv));
+               Exchange_Declarations (Priv);
+               Set_Is_Immediately_Visible
+                 (Priv, In_Open_Scopes (Scope (Priv)));
+               Set_Is_Potentially_Use_Visible
+                 (Priv, Is_Potentially_Use_Visible (Node (Priv_Elmt)));
+
+               --  Within a child unit, recurse.
+
+               if Is_Priv
+                 and then Is_Child_Unit (Cunit_Entity (Current_Sem_Unit))
+               then
+                  Swap_Private_Dependents (Deps);
+               end if;
+            end if;
+
+            Next_Elmt (Priv_Elmt);
+         end loop;
+      end Swap_Private_Dependents;
 
    begin
       --  First exchange declarations for private types, so that the full
@@ -1869,36 +1923,10 @@ package body Sem_Ch7 is
                end if;
             end if;
 
-            Priv_Elmt := First_Elmt (Private_Dependents (Id));
-
+            Priv_Deps := Private_Dependents (Id);
             Exchange_Declarations (Id);
             Set_Is_Immediately_Visible (Id);
-
-            while Present (Priv_Elmt) loop
-               Priv := Node (Priv_Elmt);
-
-               --  Before the exchange, verify that the presence of the
-               --  Full_View field. It will be empty if the entity has already
-               --  been installed due to a previous call.
-
-               if Present (Full_View (Priv))
-                 and then Is_Visible_Dependent (Priv)
-               then
-
-                  --  For each subtype that is swapped, we also swap the
-                  --  reference to it in Private_Dependents, to allow access
-                  --  to it when we swap them out in End_Package_Scope.
-
-                  Replace_Elmt (Priv_Elmt, Full_View (Priv));
-                  Exchange_Declarations (Priv);
-                  Set_Is_Immediately_Visible
-                    (Priv, In_Open_Scopes (Scope (Priv)));
-                  Set_Is_Potentially_Use_Visible
-                    (Priv, Is_Potentially_Use_Visible (Node (Priv_Elmt)));
-               end if;
-
-               Next_Elmt (Priv_Elmt);
-            end loop;
+            Swap_Private_Dependents (Priv_Deps);
          end if;
 
          Next_Entity (Id);
@@ -2035,12 +2063,13 @@ package body Sem_Ch7 is
       if Ada_Version < Ada_2012 then
          Enter_Name (Id);
 
-      --  Ada 2012 (AI05-0162): Enter the name in the current scope handling
-      --  private type that completes an incomplete type.
+      --  Ada 2012 (AI05-0162): Enter the name in the current scope. Note that
+      --  there may be an incomplete previous view.
 
       else
          declare
             Prev : Entity_Id;
+
          begin
             Prev := Find_Type_Name (N);
             pragma Assert (Prev = Id
@@ -2093,7 +2122,7 @@ package body Sem_Ch7 is
 
          --  Create a class-wide type with the same attributes
 
-         Make_Class_Wide_Type     (Id);
+         Make_Class_Wide_Type (Id);
 
       elsif Abstract_Present (Def) then
          Error_Msg_N ("only a tagged type can be abstract", N);