2009-04-08 Ed Schonberg <schonberg@adacore.com>

	* inline.adb (Back_End_Cannot_Inline): Do not mark a body as inlineable
	by the back-end if it contains a call to a subprogram without a
	previous spec that is declared in the same unit.

	* errout.ads: Update comments on uses of dirs

2009-04-08  Robert Dewar  <dewar@adacore.com>

	* exp_ch4.adb (Expand_Concatenate): Make sure nodes are properly typed



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@145729 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 63 insertions, 8 deletions

diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index 296ff6b1df5..7cda5d5a153 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -371,7 +371,13 @@ package body Inline is
       --    inlined under ZCX because the numeric suffix generated by gigi
       --    will be different in the body and the place of the inlined call.
       --
-      --  This procedure must be carefully coordinated with the back end
+      --  If the body to be inlined contains calls to subprograms declared
+      --  in the same body that have no previous spec, the back-end cannot
+      --  inline either because the bodies to be inlined are processed before
+      --  the rest of the enclosing package body, and gigi will then find
+      --  references to entities that have not been elaborated yet.
+      --
+      --  This procedure must be carefully coordinated with the back end.
 
       ----------------------------
       -- Back_End_Cannot_Inline --
@@ -381,6 +387,40 @@ package body Inline is
          Decl     : constant Node_Id := Unit_Declaration_Node (Subp);
          Body_Ent : Entity_Id;
          Ent      : Entity_Id;
+         Bad_Call : Node_Id;
+
+         function Process (N : Node_Id) return Traverse_Result;
+         --  Look for calls to subprograms with no previous spec, declared
+         --  in the same enclosiong package body.
+
+         -------------
+         -- Process --
+         -------------
+
+         function Process (N : Node_Id) return Traverse_Result is
+         begin
+            if Nkind (N) = N_Procedure_Call_Statement
+              or else Nkind (N) = N_Function_Call
+            then
+               if Is_Entity_Name (Name (N))
+                 and then
+                    Nkind (Unit_Declaration_Node (Entity (Name (N))))
+                      = N_Subprogram_Body
+                 and then In_Same_Extended_Unit (Subp, Entity (Name (N)))
+               then
+                  Bad_Call := N;
+                  return Abandon;
+               else
+                  return OK;
+               end if;
+            else
+               return OK;
+            end if;
+         end Process;
+
+         function Has_Exposed_Call is new Traverse_Func (Process);
+
+      --  Start of processing for Back_End_Cannot_Inline
 
       begin
          if Nkind (Decl) = N_Subprogram_Declaration
@@ -400,13 +440,12 @@ package body Inline is
          if Present
           (Exception_Handlers
             (Handled_Statement_Sequence
-                 (Unit_Declaration_Node (Corresponding_Body (Decl)))))
+              (Unit_Declaration_Node (Corresponding_Body (Decl)))))
          then
             return True;
          end if;
 
          Ent := First_Entity (Body_Ent);
-
          while Present (Ent) loop
             if Is_Subprogram (Ent)
               and then Is_Generic_Instance (Ent)
@@ -416,7 +455,20 @@ package body Inline is
 
             Next_Entity (Ent);
          end loop;
-         return False;
+
+         if Has_Exposed_Call
+              (Unit_Declaration_Node (Corresponding_Body (Decl))) = Abandon
+         then
+            if Ineffective_Inline_Warnings then
+               Error_Msg_N
+                 ("?call to subprogram with no separate spec"
+                  & " prevents inlining!!", Bad_Call);
+            end if;
+
+            return True;
+         else
+            return False;
+         end if;
       end Back_End_Cannot_Inline;
 
    --  Start of processing for Add_Inlined_Subprogram
@@ -445,8 +497,8 @@ package body Inline is
       end if;
 
       Inlined.Table (Index).Listed := True;
-      Succ := Inlined.Table (Index).First_Succ;
 
+      Succ := Inlined.Table (Index).First_Succ;
       while Succ /= No_Succ loop
          Subp := Successors.Table (Succ).Subp;
          Inlined.Table (Subp).Count := Inlined.Table (Subp).Count - 1;
@@ -614,14 +666,17 @@ package body Inline is
                      Load_Needed_Body (Comp_Unit, OK);
 
                      if not OK then
+
+                        --  Warn that a body was not available for inlining
+                        --  by the back-end.
+
                         Error_Msg_Unit_1 := Bname;
                         Error_Msg_N
-                          ("one or more inlined subprograms accessed in $!",
+                          ("one or more inlined subprograms accessed in $!?",
                            Comp_Unit);
                         Error_Msg_File_1 :=
                           Get_File_Name (Bname, Subunit => False);
-                        Error_Msg_N ("\but file{ was not found!", Comp_Unit);
-                        raise Unrecoverable_Error;
+                        Error_Msg_N ("\but file{ was not found!?", Comp_Unit);
                      end if;
                   end if;
                end;