[multiple changes]

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

	* sem_warn.adb (Check_Infinite_Loop_Warning.Test_Ref): Add defence
	against missing parent.

2009-04-07  Thomas Quinot  <quinot@adacore.com>

	* xoscons.adb: Minor reformatting

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

	* rtsfind.ads: Remove obsolete string concatenation entries

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

	* exp_ch4.adb (Expand_Concatenate): Redo handling of bounds

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

	* sem_ch10.adb (Check_Body_Required): Handle properly imported
	subprograms.

2009-04-07  Gary Dismukes  <dismukes@adacore.com>

	* exp_ch13.adb (Expand_N_Attribute_Definition_Clause, case
	Attribute_Address): When Init_Or_Norm_Scalars is True and the object
	is of a scalar or string type then suppress the setting of the
	expression to Empty.

	* freeze.adb (Warn_Overlay): Also emit the warnings about default
	initialization for the cases of scalar and string objects when
	Init_Or_Norm_Scalars is True.

From-SVN: r145694

gcc/ada/ChangeLog

+2009-04-07  Robert Dewar  <dewar@adacore.com>
+
+	* sem_warn.adb (Check_Infinite_Loop_Warning.Test_Ref): Add defence
+	against missing parent.
+
+2009-04-07  Thomas Quinot  <quinot@adacore.com>
+
+	* xoscons.adb: Minor reformatting
+
+2009-04-07  Robert Dewar  <dewar@adacore.com>
+
+	* rtsfind.ads: Remove obsolete string concatenation entries
+
+2009-04-07  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch4.adb (Expand_Concatenate): Redo handling of bounds
+
+2009-04-07  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch10.adb (Check_Body_Required): Handle properly imported
+	subprograms.
+
+2009-04-07  Gary Dismukes  <dismukes@adacore.com>
+
+	* exp_ch13.adb (Expand_N_Attribute_Definition_Clause, case
+	Attribute_Address): When Init_Or_Norm_Scalars is True and the object
+	is of a scalar or string type then suppress the setting of the
+	expression to Empty.
+
+	* freeze.adb (Warn_Overlay): Also emit the warnings about default
+	initialization for the cases of scalar and string objects when
+	Init_Or_Norm_Scalars is True.
+
 2009-04-07  Bob Duff  <duff@adacore.com>
 
 	* s-secsta.ads, g-pehage.ads, s-fileio.ads: Minor comment fixes

gcc/ada/exp_ch13.adb

@@ -34,6 +34,7 @@ with Exp_Util; use Exp_Util;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
+with Opt;      use Opt;
 with Rtsfind;  use Rtsfind;
 with Sem;      use Sem;
 with Sem_Ch7;  use Sem_Ch7;
@@ -91,6 +92,14 @@ package body Exp_Ch13 is
             --  call to the init proc, and must be respected. Note that for
             --  packed types we do not build equivalent aggregates.
 
+            --  Also, if Init_Or_Norm_Scalars applies, then we need to retain
+            --  any default initialization for objects of scalar types and
+            --  types with scalar components. Normally a composite type will
+            --  have an init_proc in the presence of Init_Or_Norm_Scalars,
+            --  so when that flag is set we have just have to do a test for
+            --  scalar and string types (the predefined string types such as
+            --  String and Wide_String don't have an init_proc).
+
             declare
                Decl : constant Node_Id := Declaration_Node (Ent);
                Typ  : constant Entity_Id := Etype (Ent);
@@ -106,6 +115,13 @@ package body Exp_Ch13 is
                       Present (Static_Initialization (Base_Init_Proc (Typ)))
                   then
                      null;
+
+                  elsif Init_Or_Norm_Scalars
+                    and then
+                      (Is_Scalar_Type (Typ) or else Is_String_Type (Typ))
+                  then
+                     null;
+
                   else
                      Set_Expression (Decl, Empty);
                   end if;

gcc/ada/freeze.adb

@@ -5509,13 +5509,19 @@ package body Freeze is
       end if;
 
       --  We only give the warning for non-imported entities of a type for
-      --  which a non-null base init proc is defined (or for access types which
-      --  have implicit null initialization).
+      --  which a non-null base init proc is defined, or for objects of access
+      --  types with implicit null initialization, or when Initialize_Scalars
+      --  applies and the type is scalar or a string type (the latter being
+      --  tested for because predefined String types are initialized by inline
+      --  code rather than by an init_proc).
 
       if Present (Expr)
-        and then (Has_Non_Null_Base_Init_Proc (Typ)
-                    or else Is_Access_Type (Typ))
         and then not Is_Imported (Ent)
+        and then (Has_Non_Null_Base_Init_Proc (Typ)
+                    or else Is_Access_Type (Typ)
+                    or else (Init_Or_Norm_Scalars
+                              and then (Is_Scalar_Type (Typ)
+                                         or else Is_String_Type (Typ))))
       then
          if Nkind (Expr) = N_Attribute_Reference
            and then Is_Entity_Name (Prefix (Expr))

gcc/ada/rtsfind.ads

@@ -322,10 +322,6 @@ package Rtsfind is
       System_Storage_Elements,
       System_Storage_Pools,
       System_Stream_Attributes,
-      System_String_Ops,
-      System_String_Ops_Concat_3,
-      System_String_Ops_Concat_4,
-      System_String_Ops_Concat_5,
       System_Task_Info,
       System_Tasking,
       System_Threads,
@@ -1320,17 +1316,6 @@ package Rtsfind is
      RE_W_WC,                            -- System.Stream_Attributes
      RE_W_WWC,                           -- System.Stream_Attributes
 
-     RE_Str_Concat,                      -- System.String_Ops
-     RE_Str_Concat_CC,                   -- System.String_Ops
-     RE_Str_Concat_CS,                   -- System.String_Ops
-     RE_Str_Concat_SC,                   -- System.String_Ops
-
-     RE_Str_Concat_3,                    -- System.String_Ops_Concat_3
-
-     RE_Str_Concat_4,                    -- System.String_Ops_Concat_4
-
-     RE_Str_Concat_5,                    -- System.String_Ops_Concat_5
-
      RE_String_Input,                    -- System.Strings.Stream_Ops
      RE_String_Input_Blk_IO,             -- System.Strings.Stream_Ops
      RE_String_Output,                   -- System.Strings.Stream_Ops
@@ -2474,17 +2459,6 @@ package Rtsfind is
      RE_W_WC                             => System_Stream_Attributes,
      RE_W_WWC                            => System_Stream_Attributes,
 
-     RE_Str_Concat                       => System_String_Ops,
-     RE_Str_Concat_CC                    => System_String_Ops,
-     RE_Str_Concat_CS                    => System_String_Ops,
-     RE_Str_Concat_SC                    => System_String_Ops,
-
-     RE_Str_Concat_3                     => System_String_Ops_Concat_3,
-
-     RE_Str_Concat_4                     => System_String_Ops_Concat_4,
-
-     RE_Str_Concat_5                     => System_String_Ops_Concat_5,
-
      RE_String_Input                     => System_Strings_Stream_Ops,
      RE_String_Input_Blk_IO              => System_Strings_Stream_Ops,
      RE_String_Output                    => System_Strings_Stream_Ops,

gcc/ada/sem_ch10.adb

@@ -3905,9 +3905,6 @@ package body Sem_Ch10 is
       -- Check_Body_Required --
       -------------------------
 
-      --  ??? misses pragma Import on subprograms
-      --  ??? misses pragma Import on renamed subprograms
-
       procedure Check_Body_Required is
          PA : constant List_Id :=
                 Pragmas_After (Aux_Decls_Node (Parent (P_Unit)));
@@ -3923,6 +3920,97 @@ package body Sem_Ch10 is
             Decl             : Node_Id;
             Incomplete_Decls : constant Elist_Id := New_Elmt_List;
 
+            Subp_List        : constant Elist_Id := New_Elmt_List;
+
+            procedure Check_Pragma_Import (P : Node_Id);
+            --  If a pragma import applies to a previous subprogram, the
+            --  enclosing unit may not need a body. The processing is
+            --  syntactic and does not require a declaration to be analyzed,
+            --  The code below also handles pragma import when applied to
+            --  a subprogram that renames another. In this case the pragma
+            --  applies to the renamed entity
+            --  Chains of multiple renames are not handled by the code below.
+            --  It is probably impossible to handle all cases without proper
+            --  name resolution. In such cases the algorithm is conservative
+            --  and will indicate that a body is needed???
+
+            -------------------------
+            -- Check_Pragma_Import --
+            -------------------------
+
+            procedure Check_Pragma_Import (P : Node_Id) is
+               Arg      : Node_Id;
+               Prev_Id  : Elmt_Id;
+               Subp_Id  : Elmt_Id;
+               Imported : Node_Id;
+
+               procedure Remove_Homonyms (E : Node_Id);
+               --  Make one pass over list of subprograms, Called again if
+               --  subprogram is a renaming. E is known to be an identifier.
+
+               ---------------------
+               -- Remove_Homonyms --
+               ---------------------
+
+               procedure Remove_Homonyms (E : Entity_Id) is
+                  R : Entity_Id := Empty;
+                  --  Name of renamed entity, if any.
+
+               begin
+                  Subp_Id := First_Elmt (Subp_List);
+
+                  while Present (Subp_Id) loop
+                     if Chars (Node (Subp_Id)) = Chars (E) then
+                        if Nkind (Parent (Parent (Node (Subp_Id))))
+                          /=  N_Subprogram_Renaming_Declaration
+                        then
+                           Prev_Id := Subp_Id;
+                           Next_Elmt (Subp_Id);
+                           Remove_Elmt (Subp_List, Prev_Id);
+                        else
+                           R := Name (Parent (Parent (Node (Subp_Id))));
+                           exit;
+                        end if;
+                     else
+                        Next_Elmt (Subp_Id);
+                     end if;
+                  end loop;
+
+                  if Present (R) then
+                     if Nkind (R) = N_Identifier then
+                        Remove_Homonyms (R);
+
+                     elsif Nkind (R) = N_Selected_Component then
+                        Remove_Homonyms (Selector_Name (R));
+
+                     else
+                        --  renaming of attribute
+
+                        null;
+                     end if;
+                  end if;
+               end Remove_Homonyms;
+
+               --  Start of processing for Check_Pragma_Import
+
+            begin
+
+               --  Find name of entity in Import pragma. We have not analyzed
+               --  the construct, so we must guard against syntax errors.
+
+               Arg := Next (First (Pragma_Argument_Associations (P)));
+
+               if No (Arg)
+                 or else Nkind (Expression (Arg)) /= N_Identifier
+               then
+                  return;
+               else
+                  Imported := Expression (Arg);
+               end if;
+
+               Remove_Homonyms (Imported);
+            end Check_Pragma_Import;
+
          begin
             --  Search for Elaborate Body pragma
 
@@ -3942,15 +4030,15 @@ package body Sem_Ch10 is
 
             while Present (Decl) loop
 
-               --  Subprogram that comes from source means body required
-               --  This is where a test for Import is missing ???
+               --  Subprogram that comes from source means body may be needed.
+               --  Save for subsequent examination of import pragmas.
 
                if Comes_From_Source (Decl)
                  and then (Nkind_In (Decl, N_Subprogram_Declaration,
+                                           N_Subprogram_Renaming_Declaration,
                                            N_Generic_Subprogram_Declaration))
                then
-                  Set_Body_Required (Library_Unit (N));
-                  return;
+                  Append_Elmt (Defining_Entity (Decl), Subp_List);
 
                --  Package declaration of generic package declaration. We need
                --  to recursively examine nested declarations.
@@ -3959,6 +4047,11 @@ package body Sem_Ch10 is
                                      N_Generic_Package_Declaration)
                then
                   Check_Declarations (Specification (Decl));
+
+               elsif Nkind (Decl) = N_Pragma
+                 and then Pragma_Name (Decl) = Name_Import
+               then
+                  Check_Pragma_Import (Decl);
                end if;
 
                Next (Decl);
@@ -3972,9 +4065,10 @@ package body Sem_Ch10 is
             while Present (Decl) loop
                if Comes_From_Source (Decl)
                  and then (Nkind_In (Decl, N_Subprogram_Declaration,
+                                           N_Subprogram_Renaming_Declaration,
                                            N_Generic_Subprogram_Declaration))
                then
-                  Set_Body_Required (Library_Unit (N));
+                  Append_Elmt (Defining_Entity (Decl), Subp_List);
 
                elsif Nkind_In (Decl, N_Package_Declaration,
                                      N_Generic_Package_Declaration)
@@ -3985,6 +4079,11 @@ package body Sem_Ch10 is
 
                elsif Nkind (Decl) = N_Incomplete_Type_Declaration then
                   Append_Elmt (Decl, Incomplete_Decls);
+
+               elsif Nkind (Decl) = N_Pragma
+                 and then Pragma_Name (Decl) = Name_Import
+               then
+                  Check_Pragma_Import (Decl);
                end if;
 
                Next (Decl);
@@ -4022,6 +4121,29 @@ package body Sem_Ch10 is
                   Next_Elmt (Inc);
                end loop;
             end;
+
+            --  Finally, check whether there are subprograms that still
+            --  require a body.
+
+            if not Is_Empty_Elmt_List (Subp_List) then
+               declare
+                  Subp_Id : Elmt_Id;
+
+               begin
+                  Subp_Id := First_Elmt (Subp_List);
+
+                  while Present (Subp_Id) loop
+                     if Nkind (Parent (Parent (Node (Subp_Id))))
+                        /= N_Subprogram_Renaming_Declaration
+                     then
+                        Set_Body_Required (Library_Unit (N));
+                        return;
+                     end if;
+
+                     Next_Elmt (Subp_Id);
+                  end loop;
+               end;
+            end if;
          end Check_Declarations;
 
       --  Start of processing for Check_Body_Required

gcc/ada/sem_warn.adb

@@ -490,7 +490,13 @@ package body Sem_Warn is
                   P := Parent (P);
                   exit when P = Loop_Statement;
 
-                  if Nkind (P) = N_Procedure_Call_Statement then
+                  --  Abandon if at procedure call, or something strange is
+                  --  going on (perhaps a node with no parent that should
+                  --  have one but does not?) As always, for a warning we
+                  --  prefer to just abandon the warning than get into the
+                  --  business of complaining about the tree structure here!
+
+                  if No (P) or else Nkind (P) = N_Procedure_Call_Statement then
                      return Abandon;
                   end if;
                end loop;