[multiple changes]

2011-08-04  Eric Botcazou  <ebotcazou@adacore.com>

	* bindgen.adb (Gen_Finalize_Library_Ada): Factor out code to generate
	the header of the finalization routine.
	If the unit has no finalizer but is a body whose spec has one, then
	generate the decrement of the elaboration entity only.
	If the unit has a finalizer and is a spec, then do not generate the
	decrement of the elaboration entity.
	(Gen_Finalize_Library_C): Likewise.

2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch7.adb (Alignment_Of): New subsidiary routine.
	(Bounds_Size_Expression): Removed.
	(Double_Alignment_Of): New subsidiary routine.
	(Make_Finalize_Address_Stmts): New local variable Index_Typ. Account
	for a hole in the dope vector of unconstrained arrays due to different
	index and element alignments.

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

	* sem_res.adb (Resolve_Allocator): diagnose task allocator that will
	raise program_error because body has not been seen yet.

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

	* sem_ch10.adb (Analyze_With_Clause): Protect against child unit with
	an unresolved name.

2011-08-04  Vincent Celier  <celier@adacore.com>

	* makeutl.adb (Do_Complete): Check absolute paths in canonical forms

2011-08-04  Yannick Moy  <moy@adacore.com>

	* alfa.adb, alfa.ads (Unique_Defining_Entity): move function from here
	* sem_util.adb, sem_util.ads (Unique_Defining_Entity): ...to here

2011-08-04  Thomas Quinot  <quinot@adacore.com>

	* sem_ch12.adb (Analyze_Package_Instantiation): Do not omit body for
	instantiation in RCI.

2011-08-04  Emmanuel Briot  <briot@adacore.com>

	* make.adb: Share more code with gprbuild

From-SVN: r177361

gcc/ada/ChangeLog

+2011-08-04  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* bindgen.adb (Gen_Finalize_Library_Ada): Factor out code to generate
+	the header of the finalization routine.
+	If the unit has no finalizer but is a body whose spec has one, then
+	generate the decrement of the elaboration entity only.
+	If the unit has a finalizer and is a spec, then do not generate the
+	decrement of the elaboration entity.
+	(Gen_Finalize_Library_C): Likewise.
+
+2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch7.adb (Alignment_Of): New subsidiary routine.
+	(Bounds_Size_Expression): Removed.
+	(Double_Alignment_Of): New subsidiary routine.
+	(Make_Finalize_Address_Stmts): New local variable Index_Typ. Account
+	for a hole in the dope vector of unconstrained arrays due to different
+	index and element alignments.
+
+2011-08-04  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_res.adb (Resolve_Allocator): diagnose task allocator that will
+	raise program_error because body has not been seen yet.
+
+2011-08-04  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch10.adb (Analyze_With_Clause): Protect against child unit with
+	an unresolved name.
+
+2011-08-04  Vincent Celier  <celier@adacore.com>
+
+	* makeutl.adb (Do_Complete): Check absolute paths in canonical forms
+
+2011-08-04  Yannick Moy  <moy@adacore.com>
+
+	* alfa.adb, alfa.ads (Unique_Defining_Entity): move function from here
+	* sem_util.adb, sem_util.ads (Unique_Defining_Entity): ...to here
+
+2011-08-04  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_ch12.adb (Analyze_Package_Instantiation): Do not omit body for
+	instantiation in RCI.
+
+2011-08-04  Emmanuel Briot  <briot@adacore.com>
+
+	* make.adb: Share more code with gprbuild
+
 2011-08-04  Emmanuel Briot  <briot@adacore.com>
 
 	* projects.texi: Added documentation for the IDE'Gnat project file

gcc/ada/alfa.adb

@@ -23,11 +23,8 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Atree;    use Atree;
 with Output;   use Output;
 with Put_ALFA;
-with Sem_Util; use Sem_Util;
-with Sinfo;    use Sinfo;
 
 package body ALFA is
 
@@ -203,26 +200,4 @@ package body ALFA is
       Debug_Put_ALFA;
    end palfa;
 
-   ----------------------------
-   -- Unique_Defining_Entity --
-   ----------------------------
-
-   function Unique_Defining_Entity (N : Node_Id) return Entity_Id is
-   begin
-      case Nkind (N) is
-         when N_Package_Body =>
-            return Corresponding_Spec (N);
-
-         when N_Subprogram_Body =>
-            if Acts_As_Spec (N) then
-               return Defining_Entity (N);
-            else
-               return Corresponding_Spec (N);
-            end if;
-
-         when others =>
-            return Defining_Entity (N);
-      end case;
-   end Unique_Defining_Entity;
-
 end ALFA;

gcc/ada/alfa.ads

@@ -319,10 +319,6 @@ package ALFA is
    procedure Initialize_ALFA_Tables;
    --  Reset tables for a new compilation
 
-   function Unique_Defining_Entity (N : Node_Id) return Entity_Id;
-   --  Return the entity which represents declaration N, so that matching
-   --  declaration and body have the same entity.
-
    procedure dalfa;
    --  Debug routine to dump internal ALFA tables. This is a raw format dump
    --  showing exactly what the tables contain.

gcc/ada/bindgen.adb

@@ -1662,38 +1662,84 @@ package body Bindgen is
       Uspec : Unit_Record;
       Unum  : Unit_Id;
 
+      procedure Gen_Header;
+      --  Generate the header of the finalization routine
+
+      procedure Gen_Header is
+      begin
+         WBI ("   procedure finalize_library is");
+
+         --  The following flag is used to check for library-level
+         --  exceptions raised during finalization. The symbol comes
+         --  from System.Soft_Links. VM targets use regular Ada to
+         --  reference the entity.
+
+         if VM_Target = No_VM then
+            WBI ("      LE_Set : Boolean;");
+
+            Set_String ("      pragma Import (Ada, LE_Set, ");
+            Set_String ("""__gnat_library_exception_set"");");
+            Write_Statement_Buffer;
+         end if;
+
+         WBI ("   begin");
+      end Gen_Header;
+
    begin
       for E in reverse Elab_Order.First .. Elab_Order.Last loop
          Unum := Elab_Order.Table (E);
          U    := Units.Table (Unum);
 
+         --  Dealing with package bodies is a little complicated. In such
+         --  cases we must retrieve the package spec since it contains the
+         --  spec of the body finalizer.
+
+         if U.Utype = Is_Body then
+            Unum  := Unum + 1;
+            Uspec := Units.Table (Unum);
+         else
+            Uspec := U;
+         end if;
+
+         Get_Name_String (Uspec.Uname);
+
          --  We are only interested in non-generic packages
 
-         if U.Unit_Kind = 'p'
-           and then U.Has_Finalizer
-           and then not U.Is_Generic
-           and then not U.SAL_Interface
-           and then not U.No_Elab
-         then
-            if not Lib_Final_Built then
-               Lib_Final_Built := True;
+         if U.Unit_Kind /= 'p' or else U.Is_Generic then
+            null;
 
-               WBI ("   procedure finalize_library is");
+         --  That aren't an interface to a stand alone library
 
-               --  The following flag is used to check for library-level
-               --  exceptions raised during finalization. The symbol comes
-               --  from System.Soft_Links. VM targets use regular Ada to
-               --  reference the entity.
+         elsif U.SAL_Interface then
+            null;
 
-               if VM_Target = No_VM then
-                  WBI ("      LE_Set : Boolean;");
+         --  Case of no finalization
 
-                  Set_String ("      pragma Import (Ada, LE_Set, ");
-                  Set_String ("""__gnat_library_exception_set"");");
-                  Write_Statement_Buffer;
+         elsif not U.Has_Finalizer then
+
+            --  The only case in which we have to do something is if this
+            --  is a body, with a separate spec, where the separate spec
+            --  has a finalizer. In that case, this is where we decrement
+            --  the elaboration entity.
+
+            if U.Utype = Is_Body and then Uspec.Has_Finalizer then
+               if not Lib_Final_Built then
+                  Gen_Header;
+                  Lib_Final_Built := True;
                end if;
 
-               WBI ("   begin");
+               Set_String ("      E");
+               Set_Unit_Number (Unum);
+               Set_String (" := E");
+               Set_Unit_Number (Unum);
+               Set_String (" - 1;");
+               Write_Statement_Buffer;
+            end if;
+
+         else
+            if not Lib_Final_Built then
+               Gen_Header;
+               Lib_Final_Built := True;
             end if;
 
             --  Generate:
@@ -1732,19 +1778,6 @@ package body Bindgen is
             Set_Int (Count);
             Set_String (", """);
 
-            --  Dealing with package bodies is a little complicated. In such
-            --  cases we must retrieve the package spec since it contains the
-            --  spec of the body finalizer.
-
-            if U.Utype = Is_Body then
-               Unum  := Unum + 1;
-               Uspec := Units.Table (Unum);
-            else
-               Uspec := U;
-            end if;
-
-            Get_Name_String (Uspec.Uname);
-
             --  Perform name construction
 
             --  .NET   xx.yy_pkg.xx__yy__finalize
@@ -1798,13 +1831,19 @@ package body Bindgen is
             --       F<Count>;
             --    end;
 
+            --  The uname_E decrement is skipped if this is a separate spec,
+            --  since it will be done when we process the body.
+
             WBI ("      begin");
-            Set_String ("         E");
-            Set_Unit_Number (Unum);
-            Set_String (" := E");
-            Set_Unit_Number (Unum);
-            Set_String (" - 1;");
-            Write_Statement_Buffer;
+
+            if U.Utype /= Is_Spec then
+               Set_String ("         E");
+               Set_Unit_Number (Unum);
+               Set_String (" := E");
+               Set_Unit_Number (Unum);
+               Set_String (" - 1;");
+               Write_Statement_Buffer;
+            end if;
 
             if Interface_Library_Unit or not Bind_Main_Program then
                Set_String ("         if E");
@@ -1884,37 +1923,68 @@ package body Bindgen is
       Uspec : Unit_Record;
       Unum  : Unit_Id;
 
+      procedure Gen_Header;
+      --  Generate the header of the finalization routine
+
+      procedure Gen_Header is
+      begin
+         WBI ("static void finalize_library(void) {");
+      end Gen_Header;
+
    begin
       for E in reverse Elab_Order.First .. Elab_Order.Last loop
          Unum := Elab_Order.Table (E);
          U    := Units.Table (Unum);
 
+         --  Dealing with package bodies is a little complicated. In such
+         --  cases we must retrieve the package spec since it contains the
+         --  spec of the body finalizer.
+
+         if U.Utype = Is_Body then
+            Unum  := Unum + 1;
+            Uspec := Units.Table (Unum);
+         else
+            Uspec := U;
+         end if;
+
+         Get_Name_String (Uspec.Uname);
+
          --  We are only interested in non-generic packages
 
-         if U.Unit_Kind = 'p'
-           and then U.Has_Finalizer
-           and then not U.Is_Generic
-           and then not U.SAL_Interface
-           and then not U.No_Elab
-         then
-            if not Lib_Final_Built then
-               Lib_Final_Built := True;
+         if U.Unit_Kind /= 'p' or else U.Is_Generic then
+            null;
 
-               WBI ("static void finalize_library(void) {");
-            end if;
+         --  That aren't an interface to a stand alone library
 
-            --  Dealing with package bodies is a little complicated. In such
-            --  cases we must retrieve the package spec since it contains the
-            --  spec of the body finalizer.
+         elsif U.SAL_Interface then
+            null;
 
-            if U.Utype = Is_Body then
-               Unum  := Unum + 1;
-               Uspec := Units.Table (Unum);
-            else
-               Uspec := U;
+         --  Case of no finalization
+
+         elsif not U.Has_Finalizer then
+
+            --  The only case in which we have to do something is if this
+            --  is a body, with a separate spec, where the separate spec
+            --  has a finalizer. In that case, this is where we decrement
+            --  the elaboration entity.
+
+            if U.Utype = Is_Body and then Uspec.Has_Finalizer then
+               if not Lib_Final_Built then
+                  Gen_Header;
+                  Lib_Final_Built := True;
+               end if;
+
+               Set_String ("   ");
+               Set_Unit_Name;
+               Set_String ("_E--;");
+               Write_Statement_Buffer;
             end if;
 
-            Get_Name_String (Uspec.Uname);
+         else
+            if not Lib_Final_Built then
+               Gen_Header;
+               Lib_Final_Built := True;
+            end if;
 
             --  If binding a library or if there is a non-Ada main subprogram
             --  then we generate:
@@ -1928,10 +1998,15 @@ package body Bindgen is
             --    uname_E--;
             --    uname__finalize_[spec|body] ();
 
-            Set_String ("   ");
-            Set_Unit_Name;
-            Set_String ("_E--;");
-            Write_Statement_Buffer;
+            --  The uname_E decrement is skipped if this is a separate spec,
+            --  since it will be done when we process the body.
+
+            if U.Utype /= Is_Spec then
+               Set_String ("   ");
+               Set_Unit_Name;
+               Set_String ("_E--;");
+               Write_Statement_Buffer;
+            end if;
 
             if Interface_Library_Unit or not Bind_Main_Program then
                Set_String ("   if (");

gcc/ada/exp_ch7.adb

@@ -6865,6 +6865,42 @@ package body Exp_Ch7 is
       Desg_Typ : Entity_Id;
       Obj_Expr : Node_Id;
 
+      function Alignment_Of (Some_Typ : Entity_Id) return Node_Id;
+      --  Subsidiary routine, generate the following attribute reference:
+      --
+      --    Some_Typ'Alignment
+
+      function Double_Alignment_Of (Some_Typ : Entity_Id) return Node_Id;
+      --  Subsidiary routine, generate the following expression:
+      --
+      --    2 * Some_Typ'Alignment
+
+      ------------------
+      -- Alignment_Of --
+      ------------------
+
+      function Alignment_Of (Some_Typ : Entity_Id) return Node_Id is
+      begin
+         return
+           Make_Attribute_Reference (Loc,
+             Prefix         => New_Reference_To (Some_Typ, Loc),
+             Attribute_Name => Name_Alignment);
+      end Alignment_Of;
+
+      -------------------------
+      -- Double_Alignment_Of --
+      -------------------------
+
+      function Double_Alignment_Of (Some_Typ : Entity_Id) return Node_Id is
+      begin
+         return
+           Make_Op_Multiply (Loc,
+             Left_Opnd  => Make_Integer_Literal (Loc, 2),
+             Right_Opnd => Alignment_Of (Some_Typ));
+      end Double_Alignment_Of;
+
+   --  Start of processing for Make_Finalize_Address_Stmts
+
    begin
       if Is_Array_Type (Typ) then
          if Is_Constrained (First_Subtype (Typ)) then
@@ -6931,7 +6967,7 @@ package body Exp_Ch7 is
 
       --  Unconstrained arrays require special processing in order to retrieve
       --  the elements. To achieve this, we have to skip the dope vector which
-      --  lays infront of the elements and then use a thin pointer to perform
+      --  lays in front of the elements and then use a thin pointer to perform
       --  the address-to-access conversion.
 
       if Is_Array_Type (Typ)
@@ -6942,30 +6978,7 @@ package body Exp_Ch7 is
             Dope_Id   : Entity_Id;
             For_First : Boolean := True;
             Index     : Node_Id;
-
-            function Bounds_Size_Expression (Typ : Entity_Id) return Node_Id;
-            --  Given the type of an array index, create the following
-            --  expression:
-            --
-            --    2 * Esize (Typ) / Storage_Unit
-
-            ----------------------------
-            -- Bounds_Size_Expression --
-            ----------------------------
-
-            function Bounds_Size_Expression (Typ : Entity_Id) return Node_Id is
-            begin
-               return
-                 Make_Op_Multiply (Loc,
-                   Left_Opnd  => Make_Integer_Literal (Loc, 2),
-                   Right_Opnd =>
-                     Make_Op_Divide (Loc,
-                       Left_Opnd  => Make_Integer_Literal (Loc, Esize (Typ)),
-                       Right_Opnd =>
-                         Make_Integer_Literal (Loc, System_Storage_Unit)));
-            end Bounds_Size_Expression;
-
-         --  Start of processing for arrays
+            Index_Typ : Entity_Id;
 
          begin
             --  Ensure that Ptr_Typ a thin pointer, generate:
@@ -6980,32 +6993,56 @@ package body Exp_Ch7 is
                   Make_Integer_Literal (Loc, System_Address_Size)));
 
             --  For unconstrained arrays, create the expression which computes
-            --  the size of the dope vector. Note that in the end, all values
-            --  will be constant folded.
+            --  the size of the dope vector.
 
             Index := First_Index (Typ);
             while Present (Index) loop
+               Index_Typ := Etype (Index);
 
-               --  Generate:
-               --    2 * Esize (Index_Typ) / Storage_Unit
+               --  Each bound has two values and a potential hole added to
+               --  compensate for alignment differences.
 
                if For_First then
                   For_First := False;
-                  Dope_Expr := Bounds_Size_Expression (Etype (Index));
 
-               --  Generate:
-               --    Dope_Expr + 2 * Esize (Index_Typ) / Storage_Unit
+                  --  Generate:
+                  --    2 * Index_Typ'Alignment
+
+                  Dope_Expr := Double_Alignment_Of (Index_Typ);
 
                else
+                  --  Generate:
+                  --    Dope_Expr + 2 * Index_Typ'Alignment
+
                   Dope_Expr :=
                     Make_Op_Add (Loc,
                       Left_Opnd  => Dope_Expr,
-                      Right_Opnd => Bounds_Size_Expression (Etype (Index)));
+                      Right_Opnd => Double_Alignment_Of (Index_Typ));
                end if;
 
                Next_Index (Index);
             end loop;
 
+            --  Round the cumulative alignment to the next higher multiple of
+            --  the array alignment. Generate:
+
+            --    ((Dope_Expr + Typ'Alignment - 1) / Typ'Alignment)
+            --        * Typ'Alignment
+
+            Dope_Expr :=
+              Make_Op_Multiply (Loc,
+                Left_Opnd  =>
+                  Make_Op_Divide (Loc,
+                    Left_Opnd  =>
+                      Make_Op_Add (Loc,
+                        Left_Opnd  => Dope_Expr,
+                        Right_Opnd =>
+                          Make_Op_Subtract (Loc,
+                            Left_Opnd  => Alignment_Of (Typ),
+                            Right_Opnd => Make_Integer_Literal (Loc, 1))),
+                    Right_Opnd => Alignment_Of (Typ)),
+                Right_Opnd => Alignment_Of (Typ));
+
             --  Generate:
             --    Dnn : Storage_Offset := Dope_Expr;
 

gcc/ada/makeutl.adb

@@ -1347,7 +1347,7 @@ package body Makeutl is
             then
                --  Traverse in reverse order, since in the case of multi-unit
                --  files we will be adding extra files at the end, and there's
-               --  no need to process them in tun.
+               --  no need to process them in turn.
 
                for J in reverse Names.First .. Names.Last loop
                   declare
@@ -1457,7 +1457,7 @@ package body Makeutl is
 
                         else
                            if Is_Absolute then
-                              if File_Name_Type (Source.Path.Display_Name) /=
+                              if File_Name_Type (Source.Path.Name) /=
                                 File.File
                               then
                                  Debug_Output

gcc/ada/sem_ch10.adb

@@ -2602,8 +2602,16 @@ package body Sem_Ch10 is
             Par_Name := Entity (Pref);
          end if;
 
-         Set_Entity_With_Style_Check (Pref, Par_Name);
-         Generate_Reference (Par_Name, Pref);
+         --  Guard against missing or misspelled child units.
+
+         if Present (Par_Name) then
+            Set_Entity_With_Style_Check (Pref, Par_Name);
+            Generate_Reference (Par_Name, Pref);
+
+         else
+            Set_Name (N, Make_Null (Sloc (N)));
+            return;
+         end if;
       end if;
 
       --  If the withed unit is System, and a system extension pragma is

gcc/ada/sem_ch12.adb

@@ -3379,18 +3379,18 @@ package body Sem_Ch12 is
             end if;
          end;
 
-         --  If we are generating calling stubs, we never need a body for an
-         --  instantiation from source in the visible part, because in that
-         --  case we'll be generating stubs for any subprogram in the instance.
-         --  However normal processing occurs for instantiations in generated
-         --  code or in the private part, since in those cases we do not
-         --  generate stubs.
-
-         if Distribution_Stub_Mode = Generate_Caller_Stub_Body
-              and then Comes_From_Source (N)
-         then
-            Needs_Body := False;
-         end if;
+         --  Note that we generate the instance body even when generating
+         --  calling stubs for an RCI unit: it may be required e.g. if it
+         --  provides stream attributes for some type used in the profile of a
+         --  remote subprogram. If the instantiation is within the visible part
+         --  of the RCI, then calling stubs for any relevant subprogram will
+         --  be inserted immediately after the subprogram declaration, and
+         --  will take precedence over the subsequent (original) body. (The
+         --  stub and original body will be complete homographs, but this is
+         --  permitted in an instance).
+
+         --  Could we do better and remove the original subprogram body in that
+         --  case???
 
          if Needs_Body then
 

gcc/ada/sem_res.adb

@@ -4342,6 +4342,21 @@ package body Sem_Res is
             Set_Is_Static_Coextension  (N, False);
          end if;
       end if;
+
+      --  Report a simple error:  if the designated object is a local task,
+      --  its body has not been seen yet, and its activation will fail
+      --  an elaboration check.
+
+      if Is_Task_Type (Designated_Type (Typ))
+        and then Scope (Base_Type (Designated_Type (Typ))) = Current_Scope
+        and then Is_Compilation_Unit (Current_Scope)
+        and then Ekind (Current_Scope) = E_Package
+        and then not In_Package_Body (Current_Scope)
+      then
+         Error_Msg_N
+           ("cannot activate task before body seen?", N);
+         Error_Msg_N ("\Program_Error will be raised at run time", N);
+      end if;
    end Resolve_Allocator;
 
    ---------------------------

gcc/ada/sem_util.adb

@@ -12179,6 +12179,28 @@ package body Sem_Util is
       return Scope_Depth (Enclosing_Dynamic_Scope (Btyp));
    end Type_Access_Level;
 
+   ----------------------------
+   -- Unique_Defining_Entity --
+   ----------------------------
+
+   function Unique_Defining_Entity (N : Node_Id) return Entity_Id is
+   begin
+      case Nkind (N) is
+         when N_Package_Body =>
+            return Corresponding_Spec (N);
+
+         when N_Subprogram_Body =>
+            if Acts_As_Spec (N) then
+               return Defining_Entity (N);
+            else
+               return Corresponding_Spec (N);
+            end if;
+
+         when others =>
+            return Defining_Entity (N);
+      end case;
+   end Unique_Defining_Entity;
+
    --------------------------
    -- Unit_Declaration_Node --
    --------------------------

gcc/ada/sem_util.ads

@@ -1368,6 +1368,10 @@ package Sem_Util is
    function Type_Access_Level (Typ : Entity_Id) return Uint;
    --  Return the accessibility level of Typ
 
+   function Unique_Defining_Entity (N : Node_Id) return Entity_Id;
+   --  Return the entity which represents declaration N, so that matching
+   --  declaration and body have the same entity.
+
    function Unit_Declaration_Node (Unit_Id : Entity_Id) return Node_Id;
    --  Unit_Id is the simple name of a program unit, this function returns the
    --  corresponding xxx_Declaration node for the entity. Also applies to the