[multiple changes]

2010-10-11  Javier Miranda  <miranda@adacore.com>

	* debug.adb: Update comment.

2010-10-11  Vincent Celier  <celier@adacore.com>

	* gnatcmd.adb (GNATCmd): Set Opt.Unchecked_Shared_Lib_Imports to True
	unconditionally as for "gnat make" the projects are not processed in
	the GNAT driver.

2010-10-11  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch10.ads, sem_ch10.adb (Load_Needed_Body): Add parameter to
	suppress semantic analysis of the body when inlining, prior to
	verifying that the body does not have a with_clause on a descendant
	unit.
	* inline.adb (Analyze_Inlined_Bodies): Do not inline a body if it has a
	with_clause on a descendant. 
	(Scope_In_Main_Unit): Simplify.

From-SVN: r165298

1 files changed, 108 insertions, 51 deletions

diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index 1379a9e..f7e2b30 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -138,8 +138,7 @@ package body Inline is
    -----------------------
 
    function Scope_In_Main_Unit (Scop : Entity_Id) return Boolean;
-   --  Return True if Scop is in the main unit or its spec, or in a
-   --  parent of the main unit if it is a child unit.
+   --  Return True if Scop is in the main unit or its spec
 
    procedure Add_Call (Called : Entity_Id; Caller : Entity_Id := Empty);
    --  Make two entries in Inlined table, for an inlined subprogram being
@@ -338,7 +337,6 @@ package body Inline is
 
             elsif not Is_Inlined (Pack)
               and then not Has_Completion (E)
-              and then not Scope_In_Main_Unit (Pack)
             then
                Set_Is_Inlined (Pack);
                Inlined_Bodies.Increment_Last;
@@ -354,6 +352,7 @@ package body Inline is
 
    procedure Add_Inlined_Subprogram (Index : Subp_Index) is
       E    : constant Entity_Id := Inlined.Table (Index).Name;
+      Pack : constant Entity_Id := Cunit_Entity (Get_Code_Unit (E));
       Succ : Succ_Index;
       Subp : Subp_Index;
 
@@ -473,10 +472,12 @@ package body Inline is
    --  Start of processing for Add_Inlined_Subprogram
 
    begin
-      --  Insert the current subprogram in the list of inlined subprograms,
-      --  if it can actually be inlined by the back-end.
+      --  Insert the current subprogram in the list of inlined subprograms, if
+      --  it can actually be inlined by the back-end, and if its unit is known
+      --  to be inlined, or is an instance whose body will be analyzed anyway.
 
-      if not Scope_In_Main_Unit (E)
+      if (Is_Inlined (Pack) or else Is_Generic_Instance (Pack))
+        and then not Scope_In_Main_Unit (E)
         and then Is_Inlined (E)
         and then not Is_Nested (E)
         and then not Has_Initialized_Type (E)
@@ -625,6 +626,53 @@ package body Inline is
       Pack      : Entity_Id;
       S         : Succ_Index;
 
+      function Is_Ancestor
+        (U_Name : Entity_Id;
+         Nam    : Node_Id) return Boolean;
+      --  Determine whether the unit whose body is loaded is an ancestor of
+      --  a unit mentioned in a with_clause of that body. The body is not
+      --  analyzed yet, so the check is purely lexical: the name of the with
+      --  clause is a selected component, and names of ancestors must match.
+
+      -----------------
+      -- Is_Ancestor --
+      -----------------
+
+      function Is_Ancestor
+        (U_Name : Entity_Id;
+         Nam    : Node_Id) return Boolean
+      is
+         Pref : Node_Id;
+
+      begin
+         if Nkind (Nam) /= N_Selected_Component then
+            return False;
+
+         else
+            Pref := Prefix (Nam);
+            if Nkind (Pref) = N_Identifier then
+
+               --  Par is an ancestor of Par.Child.
+
+               return Chars (Pref) = Chars (U_Name);
+
+            elsif Nkind (Pref) = N_Selected_Component
+              and then Chars (Selector_Name (Pref)) = Chars (U_Name)
+            then
+               --  Par.Child is an ancestor of Par.Child.Grand.
+
+               return True;   --  should check that ancestor match
+
+            else
+               --  A is an ancestor of A.B.C if it is an ancestor of A.B
+
+               return Is_Ancestor (U_Name, Pref);
+            end if;
+         end if;
+      end Is_Ancestor;
+
+   --  Start of processing for  Analyze_Inlined_Bodies
+
    begin
       Analyzing_Inlined_Bodies := False;
 
@@ -650,8 +698,8 @@ package body Inline is
                Comp_Unit := Parent (Comp_Unit);
             end loop;
 
-            --  Load the body, unless it the main unit, or is an instance
-            --  whose body has already been analyzed.
+            --  Load the body, unless it the main unit, or is an instance whose
+            --  body has already been analyzed.
 
             if Present (Comp_Unit)
               and then Comp_Unit /= Cunit (Main_Unit)
@@ -667,7 +715,8 @@ package body Inline is
 
                begin
                   if not Is_Loaded (Bname) then
-                     Load_Needed_Body (Comp_Unit, OK);
+                     Style_Check := False;
+                     Load_Needed_Body (Comp_Unit, OK, Do_Analyze => False);
 
                      if not OK then
 
@@ -681,6 +730,42 @@ package body Inline is
                         Error_Msg_File_1 :=
                           Get_File_Name (Bname, Subunit => False);
                         Error_Msg_N ("\but file{ was not found!?", Comp_Unit);
+
+                     else
+                        --  If the package to be inlined is an ancestor unit of
+                        --  the main unit, and it has a semantic dependence on
+                        --  it, the inlining cannot take place to prevent an
+                        --  elaboration circularity. The desired body is not
+                        --  analyzed yet, to prevent the completion of Taft
+                        --  amendment types that would lead to elaboration
+                        --  circularities in gigi.
+
+                        declare
+                           U_Id      : constant Entity_Id :=
+                                         Defining_Entity (Unit (Comp_Unit));
+                           Body_Unit : constant Node_Id :=
+                                         Library_Unit (Comp_Unit);
+                           Item      : Node_Id;
+
+                        begin
+                           Item := First (Context_Items (Body_Unit));
+                           while Present (Item) loop
+                              if Nkind (Item) = N_With_Clause
+                                and then Is_Ancestor (U_Id, Name (Item))
+                              then
+                                 Set_Is_Inlined (U_Id, False);
+                                 exit;
+                              end if;
+
+                              Next (Item);
+                           end loop;
+
+                           --  If no suspicious with_clauses, analyze the body.
+
+                           if Is_Inlined (U_Id) then
+                              Semantics (Body_Unit);
+                           end if;
+                        end;
                      end if;
                   end if;
                end;
@@ -697,14 +782,14 @@ package body Inline is
 
          Instantiate_Bodies;
 
-         --  The list of inlined subprograms is an overestimate, because
-         --  it includes inlined functions called from functions that are
-         --  compiled as part of an inlined package, but are not themselves
-         --  called. An accurate computation of just those subprograms that
-         --  are needed requires that we perform a transitive closure over
-         --  the call graph, starting from calls in the main program. Here
-         --  we do one step of the inverse transitive closure, and reset
-         --  the Is_Called flag on subprograms all of whose callers are not.
+         --  The list of inlined subprograms is an overestimate, because it
+         --  includes inlined functions called from functions that are compiled
+         --  as part of an inlined package, but are not themselves called. An
+         --  accurate computation of just those subprograms that are needed
+         --  requires that we perform a transitive closure over the call graph,
+         --  starting from calls in the main program. Here we do one step of
+         --  the inverse transitive closure, and reset the Is_Called flag on
+         --  subprograms all of whose callers are not.
 
          for Index in Inlined.First .. Inlined.Last loop
             S := Inlined.Table (Index).First_Succ;
@@ -1124,42 +1209,14 @@ package body Inline is
    ------------------------
 
    function Scope_In_Main_Unit (Scop : Entity_Id) return Boolean is
-      Comp : Node_Id;
-      S    : Entity_Id;
-      Ent  : Entity_Id := Cunit_Entity (Main_Unit);
+      Comp : constant Node_Id := Cunit (Get_Code_Unit (Scop));
 
    begin
-      --  The scope may be within the main unit, or it may be an ancestor
-      --  of the main unit, if the main unit is a child unit. In both cases
-      --  it makes no sense to process the body before the main unit. In
-      --  the second case, this may lead to circularities if a parent body
-      --  depends on a child spec, and we are analyzing the child.
-
-      S := Scop;
-      while Scope (S) /= Standard_Standard
-        and then not Is_Child_Unit (S)
-      loop
-         S := Scope (S);
-      end loop;
-
-      Comp := Parent (S);
-      while Present (Comp)
-        and then Nkind (Comp) /= N_Compilation_Unit
-      loop
-         Comp := Parent (Comp);
-      end loop;
-
-      if Is_Child_Unit (Ent) then
-         while Present (Ent)
-           and then Is_Child_Unit (Ent)
-         loop
-            if Scope (Ent) = S then
-               return True;
-            end if;
-
-            Ent := Scope (Ent);
-         end loop;
-      end if;
+      --  Check whether the scope of the subprogram to inline is within the
+      --  main unit or within its spec. In either case there are no additional
+      --  bodies to process. If the subprogram appears in a parent of the
+      --  current unit, the check on whether inlining is possible is done in
+      --  Analyze_Inlined_Bodies.
 
       return
         Comp = Cunit (Main_Unit)