[multiple changes]

2010-06-14  Robert Dewar  <dewar@adacore.com>

	* sem_res.adb: Minor reformatting

2010-06-14  Ed Schonberg  <schonberg@adacore.com>

	* sem.adb: New version of unit traversal.

	* sem_elab.adb (Check_Internal_Call): Do not place a call appearing
	within a generic unit in the table of delayed calls.

From-SVN: r160718

4 files changed, 186 insertions, 111 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index af9bbd1..85fd581 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,16 @@
 2010-06-14  Robert Dewar  <dewar@adacore.com>
 
+	* sem_res.adb: Minor reformatting
+
+2010-06-14  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem.adb: New version of unit traversal.
+
+	* sem_elab.adb (Check_Internal_Call): Do not place a call appearing
+	within a generic unit in the table of delayed calls.
+
+2010-06-14  Robert Dewar  <dewar@adacore.com>
+
 	* gnatcmd.adb, sem_util.adb, exp_ch3.adb: Minor reformatting
 
 2010-06-14  Ed Schonberg  <schonberg@adacore.com>
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index caa73a0..2dd4c3a 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -1517,6 +1517,9 @@ package body Sem is
    procedure Walk_Library_Items is
       type Unit_Number_Set is array (Main_Unit .. Last_Unit) of Boolean;
       pragma Pack (Unit_Number_Set);
+
+      Main_CU : constant Node_Id := Cunit (Main_Unit);
+
       Seen, Done : Unit_Number_Set := (others => False);
       --  Seen (X) is True after we have seen unit X in the walk. This is used
       --  to prevent processing the same unit more than once. Done (X) is True
@@ -1537,6 +1540,17 @@ package body Sem is
       --  this unit. If it's an instance body, do the spec first. If it is
       --  an instance spec, do the body last.
 
+      procedure Do_Withed_Unit (Withed_Unit : Node_Id);
+      --  Apply Do_Unit_And_Dependents to a unit in a context clause.
+
+      procedure Process_Bodies_In_Context (Comp : Node_Id);
+      --  The main unit and its spec may depend on bodies that contain generics
+      --  that are instantiated in them. Iterate through the corresponding
+      --  contexts before processing main (spec/body) itself, to process bodies
+      --  that may be present, together with their  context. The spec of main
+      --  is processed wherever it appears in the list of units, while the body
+      --  is processed as the last unit in the list.
+
       ---------------
       -- Do_Action --
       ---------------
@@ -1565,8 +1579,8 @@ package body Sem is
 
             when N_Package_Body  =>
 
-               --  Package bodies are processed immediately after the
-               --  corresponding spec.
+               --  Package bodies are processed separately if the main
+               --  unit depends on them.
 
                null;
 
@@ -1622,6 +1636,7 @@ package body Sem is
                               (Unit (Withed_Unit),
                                  N_Generic_Package_Declaration,
                                  N_Package_Body,
+                                 N_Package_Renaming_Declaration,
                                  N_Subprogram_Body)
                      then
                         Write_Unit_Name
@@ -1647,12 +1662,14 @@ package body Sem is
                   Write_Unit_Info (Unit_Num, Item, Withs => True);
                end if;
 
-               --  Main unit should come last (except in the case where we
+               --  Main unit should come last, except in the case where we
                --  skipped System_Aux_Id, in which case we missed the things it
-               --  depends on).
+               --  depends on, and in the case of parent bodies if present.
 
                pragma Assert
-                 (not Done (Main_Unit) or else Present (System_Aux_Id));
+                 (not Done (Main_Unit)
+                  or else Present (System_Aux_Id)
+                  or else Nkind (Item) = N_Package_Body);
 
                --  We shouldn't do the same thing twice
 
@@ -1677,6 +1694,15 @@ package body Sem is
          Action (Item);
       end Do_Action;
 
+      --------------------
+      -- Do_Withed_Unit --
+      --------------------
+
+      procedure Do_Withed_Unit (Withed_Unit : Node_Id) is
+      begin
+         Do_Unit_And_Dependents (Withed_Unit, Unit (Withed_Unit));
+      end Do_Withed_Unit;
+
       ----------------------------
       -- Do_Unit_And_Dependents --
       ----------------------------
@@ -1685,26 +1711,6 @@ package body Sem is
          Unit_Num : constant Unit_Number_Type :=
                       Get_Cunit_Unit_Number (CU);
 
-         procedure Do_Withed_Unit (Withed_Unit : Node_Id);
-         --  Pass the buck to Do_Unit_And_Dependents
-
-         --------------------
-         -- Do_Withed_Unit --
-         --------------------
-
-         procedure Do_Withed_Unit (Withed_Unit : Node_Id) is
-            Save_Do_Main : constant Boolean := Do_Main;
-
-         begin
-            --  Do not process the main unit if coming from a with_clause,
-            --  as would happen with a parent body that has a child spec
-            --  in its context.
-
-            Do_Main := False;
-            Do_Unit_And_Dependents (Withed_Unit, Unit (Withed_Unit));
-            Do_Main := Save_Do_Main;
-         end Do_Withed_Unit;
-
          procedure Do_Withed_Units is new Walk_Withs (Do_Withed_Unit);
 
       --  Start of processing for Do_Unit_And_Dependents
@@ -1716,103 +1722,111 @@ package body Sem is
 
             Do_Withed_Units (CU, Include_Limited => False);
 
-            --  Process the unit if it is a spec. If it is the main unit,
-            --  process it only if we have done all other units.
+            --  Process the unit if it is a spec or the the main unit, if
+            --  it has no previous spec or we have done all other units.
 
             if not Nkind_In (Item, N_Package_Body, N_Subprogram_Body)
               or else Acts_As_Spec (CU)
             then
-               if CU = Cunit (Main_Unit) and then not Do_Main then
+
+               if CU = Cunit (Main_Unit)
+                   and then not Do_Main
+               then
                   Seen (Unit_Num) := False;
 
                else
                   Seen (Unit_Num) := True;
+
+                  if CU = Library_Unit (Main_CU) then
+                     Process_Bodies_In_Context (CU);
+                  end if;
+
                   Do_Action (CU, Item);
                   Done (Unit_Num) := True;
                end if;
             end if;
          end if;
+      end Do_Unit_And_Dependents;
 
-         --  Process bodies. The spec, if present, has been processed already.
-         --  A body appears if it is the main, or the body of a spec that is
-         --  in the context of the main unit, and that is instantiated, or else
-         --  contains a generic that is instantiated, or a subprogram that is
-         --  or a subprogram that is inlined in the main unit.
-
-         --  We exclude bodies that may appear in a circular dependency list,
-         --  where spec A depends on spec B and body of B depends on spec A.
-         --  This is not an elaboration issue, but body B must be excluded
-         --  from the processing.
+      -------------------------------
+      -- Process_Bodies_In_Context --
+      -------------------------------
 
-         declare
-            Body_Unit :  Node_Id := Empty;
-            Body_Num  : Unit_Number_Type;
+      procedure Process_Bodies_In_Context (Comp : Node_Id) is
+         Body_CU : Node_Id;
+         Body_U  : Unit_Number_Type;
+         Clause  : Node_Id;
+         Spec    : Node_Id;
 
-            function Circular_Dependence (B : Node_Id) return Boolean;
-            --  Check whether this body depends on a spec that is pending,
-            --  that is to say has been seen but not processed yet.
+         procedure Do_Withed_Units is new Walk_Withs (Do_Withed_Unit);
 
-            -------------------------
-            -- Circular_Dependence --
-            -------------------------
+         function Depends_On_Main (CU : Node_Id) return Boolean;
+         --  The body of a unit that is withed by the spec of the main
+         --  unit may in turn have a with_clause on that spec. In that
+         --  case do not traverse the body, to prevent loops.
 
-            function Circular_Dependence (B : Node_Id) return Boolean is
-               Item : Node_Id;
-               UN   : Unit_Number_Type;
+         ---------------------
+         -- Depends_On_Main --
+         ---------------------
 
-            begin
-               Item := First (Context_Items (B));
-               while Present (Item) loop
-                  if Nkind (Item) = N_With_Clause then
-                     UN := Get_Cunit_Unit_Number (Library_Unit (Item));
+         function Depends_On_Main (CU : Node_Id) return Boolean is
+            CL : Node_Id;
 
-                     if Seen (UN)
-                       and then not Done (UN)
-                     then
-                        return True;
-                     end if;
-                  end if;
+         begin
+            CL := First (Context_Items (CU));
 
-                  Next (Item);
-               end loop;
+            --  Problem does not arise with main subprograms.
 
+            if Nkind (Unit (Main_CU)) /= N_Package_Body then
                return False;
-            end Circular_Dependence;
+            end if;
 
-         begin
-            if Nkind (Item) = N_Package_Declaration then
-               Body_Unit := Library_Unit (CU);
+            while Present (CL) loop
+               if Nkind (CL) = N_With_Clause
+                 and then Library_Unit (CL) = Library_Unit (Main_CU)
+               then
+                  return True;
+               end if;
 
-            elsif Nkind_In (Item, N_Package_Body, N_Subprogram_Body) then
-               Body_Unit := CU;
-            end if;
+               Next (CL);
+            end loop;
 
-            if Present (Body_Unit)
+            return False;
+         end Depends_On_Main;
 
-              --  Since specs and bodies are not done at the same time,
-              --  guard against listing a body more than once. Bodies are
-              --  only processed when the main unit is being processed,
-              --  after all other units in the list. The DEC extension
-              --  to System is excluded because of circularities.
+      --  Start of processing for Process_Bodies_In_Context
 
-              and then not Seen (Get_Cunit_Unit_Number (Body_Unit))
-              and then
-                (No (System_Aux_Id)
-                   or else Unit_Num /= Get_Source_Unit (System_Aux_Id))
-              and then not Circular_Dependence (Body_Unit)
-              and then Do_Main
-            then
-               Body_Num := Get_Cunit_Unit_Number (Body_Unit);
-               Seen (Body_Num) := True;
-               Do_Action (Body_Unit, Unit (Body_Unit));
-               Done (Body_Num) := True;
+      begin
+         Clause := First (Context_Items (Comp));
+         while Present (Clause) loop
+            if Nkind (Clause) = N_With_Clause then
+               Spec := Library_Unit (Clause);
+               Body_CU := Library_Unit (Spec);
+
+               if Present (Body_CU)
+                 and then Body_CU /= Cunit (Main_Unit)
+                 and then Nkind (Unit (Body_CU)) /= N_Subprogram_Body
+               then
+                  Body_U := Get_Cunit_Unit_Number (Body_CU);
+
+                  if not Seen (Body_U)
+                    and then not Depends_On_Main (Body_CU)
+                  then
+                     Seen (Body_U) := True;
+                     Do_Withed_Units (Body_CU, Include_Limited => False);
+                     Do_Action (Body_CU, Unit (Body_CU));
+                     Done (Body_U) := True;
+                  end if;
+               end if;
             end if;
-         end;
-      end Do_Unit_And_Dependents;
+
+            Next (Clause);
+         end loop;
+      end Process_Bodies_In_Context;
 
       --  Local Declarations
 
-      Cur : Elmt_Id;
+      Cur     : Elmt_Id;
 
    --  Start of processing for Walk_Library_Items
 
@@ -1848,7 +1862,7 @@ package body Sem is
          end;
       end loop;
 
-      --  Now traverse compilation units in order
+      --  Now traverse compilation units (specs) in order
 
       Cur := First_Elmt (Comp_Unit_List);
       while Present (Cur) loop
@@ -1861,15 +1875,37 @@ package body Sem is
 
             case Nkind (N) is
 
-               --  If it's a body, ignore it. Bodies appear in the list only
-               --  because of inlining/instantiations, and they are processed
-               --  immediately after the corresponding specs. The main unit is
-               --  processed separately after all other units.
+               --  If it is a subprogram body, process it if it has no
+               --  separate spec.
+
+               --  If it's a package body, ignore it, unless it is a body
+               --  created for an instance that is the main unit. In the
+               --  case of subprograms, the body is the wrapper package. In
+               --  case of a package, the original file carries the body,
+               --  and the spec appears as a later entry in the units list.
+
+               --  Otherwise Bodies appear in the list only because of
+               --  inlining/instantiations, and they are processed only
+               --  if relevant to the main unit. The main unit itself
+               --  is processed separately after all other specs.
 
-               when N_Package_Body | N_Subprogram_Body =>
-                  null;
+               when N_Subprogram_Body =>
+                  if Acts_As_Spec (N) then
+                     Do_Unit_And_Dependents (CU, N);
+                  end if;
+
+               when N_Package_Body =>
+                  if CU = Main_CU
+                    and then Nkind (Original_Node (Unit (Main_CU))) in
+                                                  N_Generic_Instantiation
+                    and then Present (Library_Unit (Main_CU))
+                  then
+                     Do_Unit_And_Dependents
+                       (Library_Unit (Main_CU),
+                        Unit (Library_Unit (Main_CU)));
+                  end if;
 
-               --  It's a spec, so just do it
+               --  It's a spec, process it, and the units it depends on.
 
                when others =>
                   Do_Unit_And_Dependents (CU, N);
@@ -1879,26 +1915,48 @@ package body Sem is
          Next_Elmt (Cur);
       end loop;
 
+      --  Now process package bodies on which main depends, followed by
+      --  bodies of parents, if present, and finally main itself.
+
       if not Done (Main_Unit) then
          Do_Main := True;
 
          declare
-            Main_CU : constant Node_Id := Cunit (Main_Unit);
+            Parent_CU : Node_Id;
+            Body_CU   : Node_Id;
+            Body_U    : Unit_Number_Type;
+            Child     : Entity_Id;
 
          begin
-            --  If the main unit is an instantiation, the body appears before
-            --  the instance spec, which is added later to the unit list. Do
-            --  the spec if present, body will follow.
+            Process_Bodies_In_Context (Main_CU);
+
+            --  If the main unit is a child unit, parent bodies may be present
+            --  because they export instances or inlined subprograms. Check for
+            --  presence of these, which are not present in context clauses.
+
+            if Is_Child_Unit (Cunit_Entity (Main_Unit)) then
+               Child := Cunit_Entity (Main_Unit);
+
+               while Is_Child_Unit (Child) loop
+                  Parent_CU :=
+                    Cunit (Get_Cunit_Entity_Unit_Number (Scope (Child)));
+                  Body_CU := Library_Unit (Parent_CU);
+
+                  if Present (Body_CU)
+                    and then not Seen (Get_Cunit_Unit_Number (Body_CU))
+                  then
+                     Body_U := Get_Cunit_Unit_Number (Body_CU);
+                     Seen (Body_U) := True;
+                     Do_Action (Body_CU, Unit (Body_CU));
+                     Done (Body_U) := True;
+                  end if;
 
-            if Nkind (Original_Node (Unit (Main_CU)))
-                 in N_Generic_Instantiation
-              and then Present (Library_Unit (Main_CU))
-            then
-               Do_Unit_And_Dependents
-                 (Library_Unit (Main_CU), Unit (Library_Unit (Main_CU)));
-            else
-               Do_Unit_And_Dependents (Main_CU, Unit (Main_CU));
+                  Child := Scope (Child);
+               end loop;
             end if;
+
+            Do_Action (Main_CU, Unit (Main_CU));
+            Done (Main_Unit) := True;
          end;
       end if;
 
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index 1e278a6..c0d9115 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -1891,6 +1891,11 @@ package body Sem_Elab is
 
       elsif In_Task_Activation then
          return;
+
+         --  Nothing to do if call is within a generic unit.
+
+      elsif Inside_A_Generic then
+         return;
       end if;
 
       --  Delay this call if we are still delaying calls
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 4dbd22a..9a0a0ac 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -1753,13 +1753,14 @@ package body Sem_Res is
          then
             Error_Msg_NE ("ambiguous call to&", Arg, Name (Arg));
 
+            --  Could use comments on what is going on here ???
+
             Get_First_Interp (Name (Arg), I, It);
             while Present (It.Nam) loop
                Error_Msg_Sloc := Sloc (It.Nam);
 
                if Nkind (Parent (It.Nam)) = N_Full_Type_Declaration then
                   Error_Msg_N ("interpretation (inherited) #!", Arg);
-
                else
                   Error_Msg_N ("interpretation #!", Arg);
                end if;