[multiple changes]

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

From-SVN: r145729

4 files changed, 105 insertions, 38 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 940337e..0231903 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,15 @@
+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
+
 2009-04-08  Tristan Gingold  <gingold@adacore.com>
 
 	* sem_prag.adb: Restrict pragma Thread_Local_Storage to library level
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index 83b5095..0d93463 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -269,8 +269,10 @@ package Errout is
 
    --      Normally warning messages issued in other than the main unit are
    --      suppressed. If the message ends with !! then this suppression is
-   --      avoided. This is currently only used by the Compile_Time_Warning
-   --      pragma to ensure the message for a with'ed unit is output.
+   --      avoided. This is currently used by the Compile_Time_Warning pragma
+   --      to ensure the message for a with'ed unit is output, and for warnings
+   --      on ineffective back-end inlining, which is detected in units that
+   --      contain subprograms to be inlined in the main program.
 
    --    Insertion character ? (Question: warning message)
    --      The character ? appearing anywhere in a message makes the message
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index b01203d..190baa6 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -2154,7 +2154,7 @@ package body Exp_Ch4 is
       --  for all computed bounds (which may be out of range of Istyp in the
       --  case of null ranges).
 
-      Intyp : Entity_Id;
+      Artyp : Entity_Id;
       --  This is the type we use to do arithmetic to compute the bounds and
       --  lengths of operands. The choice of this type is a little subtle and
       --  is discussed in a separate section at the start of the body code.
@@ -2204,14 +2204,14 @@ package body Exp_Ch4 is
       --  Set to an entity of type Natural that contains the length of an
       --  operand whose length is not known at compile time. Entries in this
       --  array are set only if the corresponding entry in Is_Fixed_Length
-      --  is False. The entity is of type Intyp.
+      --  is False. The entity is of type Artyp.
 
       Aggr_Length : array (0 .. N) of Node_Id;
       --  The J'th entry in an expression node that represents the total length
       --  of operands 1 through J. It is either an integer literal node, or a
       --  reference to a constant entity with the right value, so it is fine
       --  to just do a Copy_Node to get an appropriate copy. The extra zero'th
-      --  entry always is set to zero. The length is of type Intyp.
+      --  entry always is set to zero. The length is of type Artyp.
 
       Low_Bound : Node_Id;
       --  A tree node representing the low bound of the result (of type Ityp).
@@ -2230,21 +2230,21 @@ package body Exp_Ch4 is
       Result : Node_Id;
       --  Result of the concatenation (of type Ityp)
 
-      function To_Intyp (X : Node_Id) return Node_Id;
+      function To_Artyp (X : Node_Id) return Node_Id;
       --  Given a node of type Ityp, returns the corresponding value of type
-      --  Intyp. For non-enumeration types, this is the identity. For enum
+      --  Artyp. For non-enumeration types, this is the identity. For enum
       --  types, the Pos of the value is returned.
 
       function To_Ityp (X : Node_Id) return Node_Id;
       --  The inverse function (uses Val in the case of enumeration types)
 
       --------------
-      -- To_Intyp --
+      -- To_Artyp --
       --------------
 
-      function To_Intyp (X : Node_Id) return Node_Id is
+      function To_Artyp (X : Node_Id) return Node_Id is
       begin
-         if Ityp = Base_Type (Intyp) then
+         if Ityp = Base_Type (Artyp) then
             return X;
 
          elsif Is_Enumeration_Type (Ityp) then
@@ -2255,9 +2255,9 @@ package body Exp_Ch4 is
                 Expressions    => New_List (X));
 
          else
-            return Convert_To (Intyp, X);
+            return Convert_To (Artyp, X);
          end if;
-      end To_Intyp;
+      end To_Artyp;
 
       -------------
       -- To_Ityp --
@@ -2287,15 +2287,13 @@ package body Exp_Ch4 is
             --  we analyzed and resolved the expression.
 
             Set_Parent (X, Cnode);
-            Analyze_And_Resolve (X);
+            Analyze_And_Resolve (X, Artyp);
 
             if Compile_Time_Compare
-                 (X, Type_High_Bound (Istyp),
-                  Assume_Valid => False) = GT
+                 (X, Type_High_Bound (Istyp), Assume_Valid => False) = GT
               or else
                Compile_Time_Compare
-                 (X, Type_High_Bound (Ityp),
-                  Assume_Valid => False) = GT
+                 (X, Type_High_Bound (Ityp), Assume_Valid => False) = GT
             then
                Apply_Compile_Time_Constraint_Error
                  (N      => Cnode,
@@ -2304,7 +2302,7 @@ package body Exp_Ch4 is
                raise Concatenation_Error;
 
             else
-               if Ityp = Base_Type (Intyp) then
+               if Ityp = Base_Type (Artyp) then
                   return X;
                else
                   return Convert_To (Ityp, X);
@@ -2343,7 +2341,7 @@ package body Exp_Ch4 is
       --  arithmetic with POS values, not representation values).
 
       if Is_Enumeration_Type (Ityp) then
-         Intyp := Standard_Integer;
+         Artyp := Standard_Integer;
 
       --  For modular types, we use a 32-bit modular type for types whose size
       --  is in the range 1-31 bits. For 32-bit unsigned types, we use the
@@ -2351,22 +2349,22 @@ package body Exp_Ch4 is
 
       elsif Is_Modular_Integer_Type (Ityp) then
          if RM_Size (Ityp) < RM_Size (Standard_Unsigned) then
-            Intyp := Standard_Unsigned;
+            Artyp := Standard_Unsigned;
          elsif RM_Size (Ityp) = RM_Size (Standard_Unsigned) then
-            Intyp := Ityp;
+            Artyp := Ityp;
          else
-            Intyp := RTE (RE_Long_Long_Unsigned);
+            Artyp := RTE (RE_Long_Long_Unsigned);
          end if;
 
       --  Similar treatment for signed types
 
       else
          if RM_Size (Ityp) < RM_Size (Standard_Integer) then
-            Intyp := Standard_Integer;
+            Artyp := Standard_Integer;
          elsif RM_Size (Ityp) = RM_Size (Standard_Integer) then
-            Intyp := Ityp;
+            Artyp := Ityp;
          else
-            Intyp := Standard_Long_Long_Integer;
+            Artyp := Standard_Long_Long_Integer;
          end if;
       end if;
 
@@ -2543,7 +2541,7 @@ package body Exp_Ch4 is
                    Constant_Present    => True,
 
                    Object_Definition   =>
-                     New_Occurrence_Of (Intyp, Loc),
+                     New_Occurrence_Of (Artyp, Loc),
 
                    Expression          =>
                      Make_Attribute_Reference (Loc,
@@ -2600,7 +2598,7 @@ package body Exp_Ch4 is
                 Constant_Present    => True,
 
                 Object_Definition   =>
-                  New_Occurrence_Of (Intyp, Loc),
+                  New_Occurrence_Of (Artyp, Loc),
 
                 Expression          =>
                   Make_Op_Add (Loc,
@@ -2729,7 +2727,7 @@ package body Exp_Ch4 is
       High_Bound :=
         To_Ityp (
           Make_Op_Add (Loc,
-            Left_Opnd  => To_Intyp (New_Copy (Low_Bound)),
+            Left_Opnd  => To_Artyp (New_Copy (Low_Bound)),
             Right_Opnd =>
               Make_Op_Subtract (Loc,
                 Left_Opnd  => New_Copy (Aggr_Length (NN)),
@@ -2777,12 +2775,12 @@ package body Exp_Ch4 is
          declare
             Lo : constant Node_Id :=
                    Make_Op_Add (Loc,
-                     Left_Opnd  => To_Intyp (New_Copy (Low_Bound)),
+                     Left_Opnd  => To_Artyp (New_Copy (Low_Bound)),
                      Right_Opnd => Aggr_Length (J - 1));
 
             Hi : constant Node_Id :=
                    Make_Op_Add (Loc,
-                     Left_Opnd  => To_Intyp (New_Copy (Low_Bound)),
+                     Left_Opnd  => To_Artyp (New_Copy (Low_Bound)),
                      Right_Opnd =>
                        Make_Op_Subtract (Loc,
                          Left_Opnd  => Aggr_Length (J),
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index 296ff6b..7cda5d5 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;