[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

6 files changed, 158 insertions, 67 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b9e17f4..cede220 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,23 @@
+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.
+
 2010-10-11  Robert Dewar  <dewar@adacore.com>
 
 	* exp_ch6.adb, freeze.adb: Minor reformatting.
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index 0d0f0b3..a34caef 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -531,7 +531,8 @@ package body Debug is
    --       compiler has a bug -- these are the files that need to be included
    --       in a bug report.
 
-   --  d.o  documentation missing ???
+   --  d.o  Generate listing showing the IL instructions generated by the .NET
+   --       compiler for each subprogram.
 
    --  d.r  Forces the flag OK_To_Reorder_Components to be set in all record
    --       base types that have no discriminants.
diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index 174a8db..372c38b 100644
--- a/gcc/ada/gnatcmd.adb
+++ b/gcc/ada/gnatcmd.adb
@@ -1577,12 +1577,14 @@ begin
            Program_Name (Command_List (The_Command).Unixcmd.all, "gnat");
       end if;
 
-      --  For all tools other than gnatmake, allow shared library projects to
-      --  import projects that are not shared library projects.
-
-      if The_Command /= Make then
-         Opt.Unchecked_Shared_Lib_Imports := True;
-      end if;
+      --  For the tools where the GNAT driver processes the project files,
+      --  allow shared library projects to import projects that are not shared
+      --  library projects, to avoid adding a switch for these tools. For the
+      --  builder (gnatmake), if a shared library project imports a project
+      --  that is not a shared library project and the appropriate switch is
+      --  not specified, the invocation of gnatmake will fail.
+
+      Opt.Unchecked_Shared_Lib_Imports := True;
 
       --  Locate the executable for the command
 
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)
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 3e73151..7c8a2ea 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -5178,7 +5178,11 @@ package body Sem_Ch10 is
    --  If the unit is not generic, but contains a generic unit, it is loaded on
    --  demand, at the point of instantiation (see ch12).
 
-   procedure Load_Needed_Body (N : Node_Id; OK : out Boolean) is
+   procedure Load_Needed_Body
+     (N          : Node_Id;
+      OK         : out Boolean;
+      Do_Analyze : Boolean := True)
+   is
       Body_Name : Unit_Name_Type;
       Unum      : Unit_Number_Type;
 
@@ -5211,7 +5215,9 @@ package body Sem_Ch10 is
                Write_Eol;
             end if;
 
-            Semantics (Cunit (Unum));
+            if Do_Analyze then
+               Semantics (Cunit (Unum));
+            end if;
          end if;
 
          OK := True;
diff --git a/gcc/ada/sem_ch10.ads b/gcc/ada/sem_ch10.ads
index 9bf19ed..6eb7fab 100644
--- a/gcc/ada/sem_ch10.ads
+++ b/gcc/ada/sem_ch10.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -63,11 +63,16 @@ package Sem_Ch10 is
    --  rule imposes extra steps in order to install/remove the private_with
    --  clauses of an enclosing unit.
 
-   procedure Load_Needed_Body (N : Node_Id; OK : out Boolean);
-   --  Load and analyze the body of a context unit that is generic, or
-   --  that contains generic units or inlined units. The body becomes
-   --  part of the semantic dependency set of the unit that needs it.
-   --  The returned result in OK is True if the load is successful,
-   --  and False if the requested file cannot be found.
+   procedure Load_Needed_Body
+     (N          : Node_Id;
+      OK         : out Boolean;
+      Do_Analyze : Boolean := True);
+   --  Load and analyze the body of a context unit that is generic, or that
+   --  contains generic units or inlined units. The body becomes part of the
+   --  semantic dependency set of the unit that needs it. The returned result
+   --  in OK is True if the load is successful, and False if the requested file
+   --  cannot be found. If the flag Do_Analyze is false, the unit is loaded and
+   --  parsed only. This allows a selective analysis in some inlining cases
+   --  where a full analysis would lead so circularities in the back-end.
 
 end Sem_Ch10;