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

	* rtsfind.ads, exp_dist.adb (RE_Allocate_Buffer): Runtime entry
	removed, not used anymore.
	(Exp_Dist.PolyORB_Support.Helpers.Assign_Opaque_From_Any):
	New subprogram, implements copy of an Any value into a limited object.
	(Exp_Dist.PolyORB_Support.Build_General_Calling_Stubs,
	Exp_Dist.PolyORB_Support.Build_Subprogram_Receiving_Stubs,
	Exp_Dist.PolyORB_Support.Helpers.Build_From_Any_Function): For the case
	of parameters of a limited type, use the above new subprogram.

2009-07-13  Emmanuel Briot  <briot@adacore.com>

	* prj-nmsc.adb, prj-proc.adb, mlib.adb (Add_Source): new parameter
	Location.
	(Copy_ALI_Files): Avoid calls to read when pointing outside of the
 	allocated space.
	(Error_Report): Remove global variable, replaced by parameters.



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

6 files changed, 289 insertions, 204 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7fe051269f9..0e8ea163800 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,24 @@
 2009-07-13  Thomas Quinot  <quinot@adacore.com>
 
+	* rtsfind.ads, exp_dist.adb (RE_Allocate_Buffer): Runtime entry
+	removed, not used anymore.
+	(Exp_Dist.PolyORB_Support.Helpers.Assign_Opaque_From_Any):
+	New subprogram, implements copy of an Any value into a limited object.
+	(Exp_Dist.PolyORB_Support.Build_General_Calling_Stubs,
+	Exp_Dist.PolyORB_Support.Build_Subprogram_Receiving_Stubs,
+	Exp_Dist.PolyORB_Support.Helpers.Build_From_Any_Function): For the case
+	of parameters of a limited type, use the above new subprogram.
+
+2009-07-13  Emmanuel Briot  <briot@adacore.com>
+
+	* prj-nmsc.adb, prj-proc.adb, mlib.adb (Add_Source): new parameter
+	Location.
+	(Copy_ALI_Files): Avoid calls to read when pointing outside of the
+ 	allocated space.
+	(Error_Report): Remove global variable, replaced by parameters.
+
+2009-07-13  Thomas Quinot  <quinot@adacore.com>
+
 	* g-socthi-vxworks.adb (C_Sendto): VxWorks does not support the
 	standard sendto(2) interface for connected sockets (passing a null
 	destination address). Use send(2) instead for that case.
diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb
index 744c0d4bc7f..fa4327a5e19 100644
--- a/gcc/ada/exp_dist.adb
+++ b/gcc/ada/exp_dist.adb
@@ -863,6 +863,21 @@ package body Exp_Dist is
          --  for entity E (a distributed object type or operation): one
          --  containing the name of E, the second containing its repository id.
 
+         procedure Assign_Opaque_From_Any
+           (Loc    : Source_Ptr;
+            Stms   : List_Id;
+            Typ    : Entity_Id;
+            N      : Node_Id;
+            Target : Entity_Id);
+         --  For a Target object of type Typ, which has opaque representation
+         --  as a sequence of octets determined by stream attributes (which
+         --  includes all limited types), append code to Stmts performing the
+         --  equivalent of:
+         --    Target := Typ'From_Any (N)
+
+         --  or, if Target is Empty:
+         --    return Typ'From_Any (N)
+
       end Helpers;
 
    end PolyORB_Support;
@@ -7403,17 +7418,25 @@ package body Exp_Dist is
                   if Out_Present (Current_Parameter)
                     and then not Is_Controlling_Formal
                   then
-                     Append_To (After_Statements,
-                       Make_Assignment_Statement (Loc,
-                         Name =>
-                           New_Occurrence_Of (
-                             Defining_Identifier (Current_Parameter), Loc),
-                           Expression =>
-                             PolyORB_Support.Helpers.Build_From_Any_Call
-                               (Etype (Parameter_Type (Current_Parameter)),
-                                New_Occurrence_Of (Any, Loc),
-                                Decls)));
-
+                     if Is_Limited_Type (Etyp) then
+                        Helpers.Assign_Opaque_From_Any (Loc,
+                           Stms   => After_Statements,
+                           Typ    => Etyp,
+                           N      => New_Occurrence_Of (Any, Loc),
+                           Target =>
+                             Defining_Identifier (Current_Parameter));
+                     else
+                        Append_To (After_Statements,
+                          Make_Assignment_Statement (Loc,
+                            Name =>
+                              New_Occurrence_Of (
+                                Defining_Identifier (Current_Parameter), Loc),
+                              Expression =>
+                                PolyORB_Support.Helpers.Build_From_Any_Call
+                                  (Etyp,
+                                   New_Occurrence_Of (Any, Loc),
+                                   Decls)));
+                     end if;
                   end if;
                end;
             end if;
@@ -7931,24 +7954,32 @@ package body Exp_Dist is
                   --  the object declaration and the variable is set using
                   --  'Input instead of 'Read.
 
-                  Expr :=
-                    PolyORB_Support.Helpers.Build_From_Any_Call
-                      (Etyp, New_Occurrence_Of (Any, Loc), Decls);
-
-                  if Constrained then
-                     Append_To (Statements,
-                       Make_Assignment_Statement (Loc,
-                         Name       => New_Occurrence_Of (Object, Loc),
-                         Expression => Expr));
-                     Expr := Empty;
+                  if Constrained and then Is_Limited_Type (Etyp) then
+                     Helpers.Assign_Opaque_From_Any (Loc,
+                        Stms   => Statements,
+                        Typ    => Etyp,
+                        N      => New_Occurrence_Of (Any, Loc),
+                        Target => Object);
 
                   else
-                     --  Expr will be used to initialize (and constrain) the
-                     --  parameter when it is declared.
+                     Expr := Helpers.Build_From_Any_Call
+                               (Etyp, New_Occurrence_Of (Any, Loc), Decls);
+
+                     if Constrained then
+                        Append_To (Statements,
+                          Make_Assignment_Statement (Loc,
+                            Name       => New_Occurrence_Of (Object, Loc),
+                            Expression => Expr));
+                        Expr := Empty;
+
+                     else
+                        --  Expr will be used to initialize (and constrain) the
+                        --  parameter when it is declared.
+                        null;
+                     end if;
 
                      null;
                   end if;
-
                end if;
 
                Need_Extra_Constrained :=
@@ -8364,6 +8395,120 @@ package body Exp_Dist is
             end if;
          end Append_Record_Traversal;
 
+         -----------------------------
+         -- Assign_Opaque_From_Any --
+         -----------------------------
+
+         procedure Assign_Opaque_From_Any
+           (Loc    : Source_Ptr;
+            Stms   : List_Id;
+            Typ    : Entity_Id;
+            N      : Node_Id;
+            Target : Entity_Id)
+         is
+            Strm : constant Entity_Id :=
+                     Make_Defining_Identifier (Loc,
+                       Chars => New_Internal_Name ('S'));
+            Expr : Node_Id;
+
+            Read_Call_List : List_Id;
+            --  List on which to place the 'Read attribute reference
+
+         begin
+            --  Strm : Buffer_Stream_Type;
+
+            Append_To (Stms,
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Strm,
+                Aliased_Present     => True,
+                Object_Definition   =>
+                  New_Occurrence_Of (RTE (RE_Buffer_Stream_Type), Loc)));
+
+            --  Any_To_BS (Strm, A);
+
+            Append_To (Stms,
+              Make_Procedure_Call_Statement (Loc,
+                Name => New_Occurrence_Of (RTE (RE_Any_To_BS), Loc),
+                Parameter_Associations => New_List (
+                  N,
+                  New_Occurrence_Of (Strm, Loc))));
+
+            if Transmit_As_Unconstrained (Typ) then
+               Expr :=
+                 Make_Attribute_Reference (Loc,
+                   Prefix         => New_Occurrence_Of (Typ, Loc),
+                   Attribute_Name => Name_Input,
+                   Expressions    => New_List (
+                 Make_Attribute_Reference (Loc,
+                   Prefix         => New_Occurrence_Of (Strm, Loc),
+                   Attribute_Name => Name_Access)));
+
+               if Present (Target) then
+                  --  Target := Typ'Input (Strm'Access)
+
+                  Append_To (Stms,
+                    Make_Assignment_Statement (Loc,
+                      Name       => New_Occurrence_Of (Target, Loc),
+                      Expression => Expr));
+
+               else
+                  --  return Typ'Input (Strm'Access);
+
+                  Append_To (Stms,
+                    Make_Simple_Return_Statement (Loc,
+                      Expression => Expr));
+               end if;
+
+            else
+               if Present (Target) then
+                  Read_Call_List := Stms;
+                  Expr := New_Occurrence_Of (Target, Loc);
+
+               else
+                  declare
+                     Temp : constant Entity_Id :=
+                              Make_Defining_Identifier
+                                (Loc, New_Internal_Name ('R'));
+                  begin
+                     Read_Call_List := New_List;
+                     Expr := New_Occurrence_Of (Temp, Loc);
+
+                     Append_To (Stms, Make_Block_Statement (Loc,
+                       Declarations               => New_List (
+                         Make_Object_Declaration (Loc,
+                           Defining_Identifier =>
+                             Temp,
+                           Object_Definition   =>
+                             New_Occurrence_Of (Typ, Loc))),
+
+                       Handled_Statement_Sequence =>
+                         Make_Handled_Sequence_Of_Statements (Loc,
+                           Statements => Read_Call_List)));
+                  end;
+               end if;
+
+               --  Typ'Read (Strm'Access, [Target|Temp])
+
+               Append_To (Read_Call_List,
+                 Make_Attribute_Reference (Loc,
+                   Prefix         => New_Occurrence_Of (Typ, Loc),
+                   Attribute_Name => Name_Read,
+                   Expressions    => New_List (
+                     Make_Attribute_Reference (Loc,
+                       Prefix         => New_Occurrence_Of (Strm, Loc),
+                       Attribute_Name => Name_Access),
+                     Expr)));
+
+               if No (Target) then
+                  --  return Temp
+
+                  Append_To (Read_Call_List,
+                    Make_Simple_Return_Statement (Loc,
+                       Expression => New_Copy (Expr)));
+               end if;
+            end if;
+         end Assign_Opaque_From_Any;
+
          -------------------------
          -- Build_From_Any_Call --
          -------------------------
@@ -8632,11 +8777,13 @@ package body Exp_Dist is
                         Rec     : Entity_Id;
                         Field   : Node_Id)
                      is
+                        Ctyp : Entity_Id;
                      begin
                         if Nkind (Field) = N_Defining_Identifier then
-
                            --  A regular component
 
+                           Ctyp := Etype (Field);
+
                            Append_To (Stmts,
                              Make_Assignment_Statement (Loc,
                                Name => Make_Selected_Component (Loc,
@@ -8646,11 +8793,11 @@ package body Exp_Dist is
                                    New_Occurrence_Of (Field, Loc)),
 
                                Expression =>
-                                 Build_From_Any_Call (Etype (Field),
+                                 Build_From_Any_Call (Ctyp,
                                    Build_Get_Aggregate_Element (Loc,
                                      Any => Any,
                                      TC  => Build_TypeCode_Call (Loc,
-                                              Etype (Field), Decls),
+                                              Ctyp, Decls),
                                      Idx => Make_Integer_Literal (Loc,
                                               Counter)),
                                    Decls)));
@@ -9102,124 +9249,11 @@ package body Exp_Dist is
             end if;
 
             if Use_Opaque_Representation then
-
-               --  Default: type is represented as an opaque sequence of bytes
-
-               declare
-                  Strm : constant Entity_Id :=
-                           Make_Defining_Identifier (Loc,
-                             Chars => New_Internal_Name ('S'));
-                  Res  : constant Entity_Id :=
-                           Make_Defining_Identifier (Loc,
-                             Chars => New_Internal_Name ('R'));
-
-               begin
-                  --  Strm : Buffer_Stream_Type;
-
-                  Append_To (Decls,
-                    Make_Object_Declaration (Loc,
-                      Defining_Identifier => Strm,
-                      Aliased_Present     => True,
-                      Object_Definition   =>
-                        New_Occurrence_Of (RTE (RE_Buffer_Stream_Type), Loc)));
-
-                  --  Allocate_Buffer (Strm);
-
-                  Append_To (Stms,
-                    Make_Procedure_Call_Statement (Loc,
-                      Name =>
-                        New_Occurrence_Of (RTE (RE_Allocate_Buffer), Loc),
-                      Parameter_Associations => New_List (
-                        New_Occurrence_Of (Strm, Loc))));
-
-                  --  Any_To_BS (Strm, A);
-
-                  Append_To (Stms,
-                    Make_Procedure_Call_Statement (Loc,
-                      Name => New_Occurrence_Of (RTE (RE_Any_To_BS), Loc),
-                      Parameter_Associations => New_List (
-                        New_Occurrence_Of (Any_Parameter, Loc),
-                        New_Occurrence_Of (Strm, Loc))));
-
-                  if Transmit_As_Unconstrained (Typ) then
-
-                     --  declare
-                     --     Res : constant T := T'Input (Strm);
-                     --  begin
-                     --     Release_Buffer (Strm);
-                     --     return Res;
-                     --  end;
-
-                     Append_To (Stms, Make_Block_Statement (Loc,
-                       Declarations               => New_List (
-                         Make_Object_Declaration (Loc,
-                           Defining_Identifier => Res,
-                           Constant_Present    => True,
-                           Object_Definition   => New_Occurrence_Of (Typ, Loc),
-                           Expression          =>
-                             Make_Attribute_Reference (Loc,
-                               Prefix         => New_Occurrence_Of (Typ, Loc),
-                               Attribute_Name => Name_Input,
-                               Expressions    => New_List (
-                                 Make_Attribute_Reference (Loc,
-                                   Prefix         =>
-                                     New_Occurrence_Of (Strm, Loc),
-                                   Attribute_Name => Name_Access))))),
-
-                       Handled_Statement_Sequence =>
-                         Make_Handled_Sequence_Of_Statements (Loc,
-                           Statements => New_List (
-                             Make_Procedure_Call_Statement (Loc,
-                               Name                   =>
-                                 New_Occurrence_Of
-                                   (RTE (RE_Release_Buffer), Loc),
-                               Parameter_Associations =>
-                                 New_List (New_Occurrence_Of (Strm, Loc))),
-
-                             Make_Simple_Return_Statement (Loc,
-                               Expression => New_Occurrence_Of (Res, Loc))))));
-
-                  else
-                     --  declare
-                     --     Res : T;
-                     --  begin
-                     --     T'Read (Strm, Res);
-                     --     Release_Buffer (Strm);
-                     --     return Res;
-                     --  end;
-
-                     Append_To (Stms, Make_Block_Statement (Loc,
-                       Declarations               => New_List (
-                         Make_Object_Declaration (Loc,
-                           Defining_Identifier => Res,
-                           Constant_Present    => False,
-                           Object_Definition   =>
-                             New_Occurrence_Of (Typ, Loc))),
-
-                       Handled_Statement_Sequence =>
-                         Make_Handled_Sequence_Of_Statements (Loc,
-                           Statements => New_List (
-                             Make_Attribute_Reference (Loc,
-                               Prefix         => New_Occurrence_Of (Typ, Loc),
-                               Attribute_Name => Name_Read,
-                               Expressions    => New_List (
-                                 Make_Attribute_Reference (Loc,
-                                   Prefix         =>
-                                     New_Occurrence_Of (Strm, Loc),
-                                   Attribute_Name => Name_Access),
-                                 New_Occurrence_Of (Res, Loc))),
-
-                             Make_Procedure_Call_Statement (Loc,
-                               Name                   =>
-                                 New_Occurrence_Of
-                                   (RTE (RE_Release_Buffer), Loc),
-                               Parameter_Associations =>
-                                 New_List (New_Occurrence_Of (Strm, Loc))),
-
-                             Make_Simple_Return_Statement (Loc,
-                               Expression => New_Occurrence_Of (Res, Loc))))));
-                  end if;
-               end;
+               Assign_Opaque_From_Any (Loc,
+                  Stms   => Stms,
+                  Typ    => Typ,
+                  N      => New_Occurrence_Of (Any_Parameter, Loc),
+                  Target => Empty);
             end if;
 
             Decl :=
@@ -10001,16 +10035,6 @@ package body Exp_Dist is
                         New_Occurrence_Of (RTE (RE_Buffer_Stream_Type), Loc)));
 
                   --  Generate:
-                  --    Allocate_Buffer (Strm);
-
-                  Append_To (Stms,
-                    Make_Procedure_Call_Statement (Loc,
-                      Name =>
-                        New_Occurrence_Of (RTE (RE_Allocate_Buffer), Loc),
-                      Parameter_Associations => New_List (
-                        New_Occurrence_Of (Strm, Loc))));
-
-                  --  Generate:
                   --    T'Output (Strm'Access, E);
 
                   Append_To (Stms,
diff --git a/gcc/ada/mlib.adb b/gcc/ada/mlib.adb
index 5d029dbf387..61fa0d7ada8 100644
--- a/gcc/ada/mlib.adb
+++ b/gcc/ada/mlib.adb
@@ -202,16 +202,21 @@ package body MLib is
                      if FD /= Invalid_FD then
                         Len := Integer (File_Length (FD));
 
+                        --  ??? Why "+3" here
+
                         S := new String (1 .. Len + 3);
 
                         --  Read the file. Note that the loop is not necessary
                         --  since the whole file is read at once except on VMS.
 
-                        Curr := 1;
-                        Actual_Len := Len;
+                        Curr := S'First;
 
-                        while Actual_Len /= 0 loop
+                        while Curr <= Len loop
                            Actual_Len := Read (FD, S (Curr)'Address, Len);
+
+                           --  Exit if we could not read for some reason
+                           exit when Actual_Len = 0;
+
                            Curr := Curr + Actual_Len;
                         end loop;
 
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 53bd367f149..6fd7b7e6f59 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -166,12 +166,15 @@ package body Prj.Nmsc is
       Path                : Path_Information := No_Path_Information;
       Alternate_Languages : Language_List := null;
       Unit                : Name_Id   := No_Name;
-      Index               : Int       := 0);
+      Index               : Int       := 0;
+      Location            : Source_Ptr := No_Location);
    --  Add a new source to the different lists: list of all sources in the
    --  project tree, list of source of a project and list of sources of a
    --  language.
    --
    --  If Path is specified, the file is also added to Source_Paths_HT.
+   --
+   --  Location is used for error messages
 
    function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type;
    --  Same as Osint.Canonical_Case_File_Name but applies to Name_Id.
@@ -534,7 +537,8 @@ package body Prj.Nmsc is
       Path                : Path_Information := No_Path_Information;
       Alternate_Languages : Language_List := null;
       Unit                : Name_Id   := No_Name;
-      Index               : Int       := 0)
+      Index               : Int       := 0;
+      Location            : Source_Ptr := No_Location)
    is
       Config    : constant Language_Config := Lang_Id.Config;
       UData     : Unit_Index;
@@ -547,7 +551,6 @@ package body Prj.Nmsc is
       --  Check if the same file name or unit is used in the prj tree
 
       Add_Src := True;
-      Source  := Files_Htable.Get (Data.File_To_Source, File_Name);
 
       if Unit /= No_Name then
          Prev_Unit := Units_Htable.Get (Data.Tree.Units_HT, Unit);
@@ -561,8 +564,12 @@ package body Prj.Nmsc is
          Add_Src := False;
          Source := Prev_Unit.File_Names (Kind);
 
-      elsif Source /= No_Source then
-         if Source.Index = Index then
+      else
+         Source  := Files_Htable.Get (Data.File_To_Source, File_Name);
+
+         if Source /= No_Source
+           and then Source.Index = Index
+         then
             Add_Src := False;
          end if;
       end if;
@@ -583,7 +590,7 @@ package body Prj.Nmsc is
                   Error_Msg_File_1 := File_Name;
                   Error_Msg
                     (Project, "duplicate source file name {",
-                     No_Location, Data);
+                     Location, Data);
                   Add_Src := False;
                end if;
 
@@ -597,7 +604,7 @@ package body Prj.Nmsc is
                elsif Source.Path.Name /= Path.Name then
                   Error_Msg_Name_1 := Unit;
                   Error_Msg
-                    (Project, "duplicate unit %%", No_Location, Data);
+                    (Project, "duplicate unit %%", Location, Data);
                   Add_Src := False;
                end if;
             end if;
@@ -615,29 +622,34 @@ package body Prj.Nmsc is
          elsif Prev_Unit /= No_Unit_Index
            and then not Source.Locally_Removed
          then
+            --  Path is set if this is a source we found on the disk, in which
+            --  case we can provide more explicit error message. Path is unset
+            --  when the source is added from one of the naming exceptions in
+            --  the project
+
             if Path /= No_Path_Information then
                Error_Msg_Name_1 := Unit;
                Error_Msg
                  (Project,
                   "unit %% cannot belong to several projects",
-                  No_Location, Data);
+                  Location, Data);
 
                Error_Msg_Name_1 := Project.Name;
                Error_Msg_Name_2 := Name_Id (Path.Name);
                Error_Msg
-                 (Project, "\  project %%, %%", No_Location, Data);
+                 (Project, "\  project %%, %%", Location, Data);
 
                Error_Msg_Name_1 := Source.Project.Name;
                Error_Msg_Name_2 := Name_Id (Source.Path.Display_Name);
                Error_Msg
-                 (Project, "\  project %%, %%", No_Location, Data);
+                 (Project, "\  project %%, %%", Location, Data);
 
             else
                Error_Msg_Name_1 := Unit;
                Error_Msg_Name_2 := Source.Project.Name;
                Error_Msg
                  (Project, "unit %% already belongs to project %%",
-                  No_Location, Data);
+                  Location, Data);
             end if;
 
             Add_Src := False;
@@ -650,7 +662,7 @@ package body Prj.Nmsc is
             Error_Msg_File_2 := File_Name_Type (Source.Project.Name);
             Error_Msg
               (Project,
-               "{ is already a source of project {", No_Location, Data);
+               "{ is already a source of project {", Location, Data);
 
             --  Add the file anyway, to avoid further warnings like "language
             --  unknown"
@@ -912,6 +924,7 @@ package body Prj.Nmsc is
                      end loop Source_Loop;
 
                      if Source = No_Source then
+
                         Report_No_Sources
                           (Project,
                            Get_Name_String (Language.Display_Name),
@@ -2907,6 +2920,7 @@ package body Prj.Nmsc is
                   Display_File => File_Name_Type (Element.Value.Value),
                   Unit         => Unit,
                   Index        => Index,
+                  Location     => Element.Value.Location,
                   Naming_Exception => True);
             end if;
 
@@ -4915,6 +4929,15 @@ package body Prj.Nmsc is
    --  Start of processing for Error_Msg
 
    begin
+      --  Display the error message in the traces so that it appears in the
+      --  correct location in the traces (otherwise error messages are only
+      --  displayed at the end and it is difficult to see when they were
+      --  triggered)
+
+      if Current_Verbosity = High then
+         Write_Line ("ERROR: " & Msg);
+      end if;
+
       --  If location of error is unknown, use the location of the project
 
       if Real_Location = No_Location then
@@ -6582,9 +6605,7 @@ package body Prj.Nmsc is
          Data            => Data,
          For_All_Sources => Sources.Default and then Source_List_File.Default);
 
-      --  Check if all exceptions have been found. For Ada, it is an error if
-      --  an exception is not found. For other language, the source is simply
-      --  removed.
+      --  Check if all exceptions have been found.
 
       declare
          Source : Source_Id;
@@ -6601,9 +6622,11 @@ package body Prj.Nmsc is
             then
                if Source.Unit /= No_Unit_Index then
 
-                  --  ??? Current limitation of gprbuild will display this
-                  --  error message for multi-unit source files, because not
-                  --  all instances of the file have had their path fully set.
+                  --  For multi-unit source files, source_id gets duplicated
+                  --  once for every unit. Only the first source_id got its
+                  --  full path set. So if it isn't set for that first one,
+                  --  the file wasn't found. Otherwise we need to update for
+                  --  units after the first one.
 
                   if Source.Index = 0
                     or else Source.Index = 1
@@ -6613,12 +6636,10 @@ package body Prj.Nmsc is
                      Error_Msg
                        (Project.Project,
                         "source file %% for unit %% not found",
-                        No_Location, Data);
+                        No_Location,
+                        Data);
 
                   else
-                     --  Set the full path information since we know it
-                     --  anyway
-
                      Source.Path := Files_Htable.Get
                        (Data.File_To_Source, Source.File).Path;
 
@@ -7374,8 +7395,12 @@ package body Prj.Nmsc is
                Source := Object_File_Names_Htable.Get
                  (Project.Object_Files, Src.Object);
 
+               --  We cannot just check on "Source /= Src", since we might have
+               --  two different entries for the same file (and since that's
+               --  the same file it is expected that it has the same object)
+
                if Source /= No_Source
-                 and then Source = Src
+                 and then Source.Path /= Src.Path
                then
                   Error_Msg_File_1 := Src.File;
                   Error_Msg_File_2 := Source.File;
diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb
index ef398133bde..6f9897ff0c1 100644
--- a/gcc/ada/prj-proc.adb
+++ b/gcc/ada/prj-proc.adb
@@ -39,8 +39,6 @@ with GNAT.HTable;
 
 package body Prj.Proc is
 
-   Error_Report : Put_Line_Access := null;
-
    package Processed_Projects is new GNAT.HTable.Simple_HTable
      (Header_Num => Header_Num,
       Element    => Project_Id,
@@ -82,6 +80,7 @@ package body Prj.Proc is
      (In_Tree                    : Project_Tree_Ref;
       Project                    : Project_Id;
       Current_Dir                : String;
+      Report_Error               : Put_Line_Access;
       When_No_Sources            : Error_Warning;
       Require_Sources_Other_Lang : Boolean;
       Compiler_Driver_Mandatory  : Boolean;
@@ -107,6 +106,7 @@ package body Prj.Proc is
    function Expression
      (Project                : Project_Id;
       In_Tree                : Project_Tree_Ref;
+      Report_Error           : Put_Line_Access;
       From_Project_Node      : Project_Node_Id;
       From_Project_Node_Tree : Project_Node_Tree_Ref;
       Pkg                    : Package_Id;
@@ -129,6 +129,7 @@ package body Prj.Proc is
    procedure Process_Declarative_Items
      (Project                : Project_Id;
       In_Tree                : Project_Tree_Ref;
+      Report_Error           : Put_Line_Access;
       From_Project_Node      : Project_Node_Id;
       From_Project_Node_Tree : Project_Node_Tree_Ref;
       Pkg                    : Package_Id;
@@ -140,6 +141,7 @@ package body Prj.Proc is
    procedure Recursive_Process
      (In_Tree                : Project_Tree_Ref;
       Project                : out Project_Id;
+      Report_Error           : Put_Line_Access;
       From_Project_Node      : Project_Node_Id;
       From_Project_Node_Tree : Project_Node_Tree_Ref;
       Extended_By            : Project_Id);
@@ -282,6 +284,7 @@ package body Prj.Proc is
      (In_Tree                    : Project_Tree_Ref;
       Project                    : Project_Id;
       Current_Dir                : String;
+      Report_Error               : Put_Line_Access;
       When_No_Sources            : Error_Warning;
       Require_Sources_Other_Lang : Boolean;
       Compiler_Driver_Mandatory  : Boolean;
@@ -304,7 +307,7 @@ package body Prj.Proc is
          Require_Sources_Other_Lang => Require_Sources_Other_Lang,
          Compiler_Driver_Mandatory  => Compiler_Driver_Mandatory,
          When_No_Sources            => When_No_Sources,
-         Report_Error               => null);
+         Report_Error               => Report_Error);
 
       Check_All_Projects (Project, Data, Imported_First => True);
 
@@ -485,6 +488,7 @@ package body Prj.Proc is
    function Expression
      (Project                : Project_Id;
       In_Tree                : Project_Tree_Ref;
+      Report_Error           : Put_Line_Access;
       From_Project_Node      : Project_Node_Id;
       From_Project_Node_Tree : Project_Node_Tree_Ref;
       Pkg                    : Package_Id;
@@ -588,6 +592,7 @@ package body Prj.Proc is
                      Value := Expression
                        (Project                => Project,
                         In_Tree                => In_Tree,
+                        Report_Error           => Report_Error,
                         From_Project_Node      => From_Project_Node,
                         From_Project_Node_Tree => From_Project_Node_Tree,
                         Pkg                    => Pkg,
@@ -637,6 +642,7 @@ package body Prj.Proc is
                           Expression
                             (Project                => Project,
                              In_Tree                => In_Tree,
+                             Report_Error           => Report_Error,
                              From_Project_Node      => From_Project_Node,
                              From_Project_Node_Tree => From_Project_Node_Tree,
                              Pkg                    => Pkg,
@@ -1044,6 +1050,7 @@ package body Prj.Proc is
                      Def_Var := Expression
                        (Project                => Project,
                         In_Tree                => In_Tree,
+                        Report_Error           => Report_Error,
                         From_Project_Node      => From_Project_Node,
                         From_Project_Node_Tree => From_Project_Node_Tree,
                         Pkg                    => Pkg,
@@ -1061,13 +1068,13 @@ package body Prj.Proc is
 
                   if Value = No_Name then
                      if not Quiet_Output then
-                        if Error_Report = null then
+                        if Report_Error = null then
                            Error_Msg
                              ("?undefined external reference",
                               Location_Of
                                 (The_Current_Term, From_Project_Node_Tree));
                         else
-                           Error_Report
+                           Report_Error
                              ("warning: """ & Get_Name_String (Name) &
                               """ is an undefined external reference",
                               Project, In_Tree);
@@ -1277,6 +1284,7 @@ package body Prj.Proc is
    procedure Process_Declarative_Items
      (Project                : Project_Id;
       In_Tree                : Project_Tree_Ref;
+      Report_Error           : Put_Line_Access;
       From_Project_Node      : Project_Node_Id;
       From_Project_Node_Tree : Project_Node_Tree_Ref;
       Pkg                    : Package_Id;
@@ -1412,6 +1420,7 @@ package body Prj.Proc is
                         Process_Declarative_Items
                           (Project                => Project,
                            In_Tree                => In_Tree,
+                           Report_Error           => Report_Error,
                            From_Project_Node      => From_Project_Node,
                            From_Project_Node_Tree => From_Project_Node_Tree,
                            Pkg                    => New_Pkg,
@@ -1600,13 +1609,13 @@ package body Prj.Proc is
                      end loop;
 
                      if Orig_Array = No_Array then
-                        if Error_Report = null then
+                        if Report_Error = null then
                            Error_Msg
                              ("associative array value not found",
                               Location_Of
                                 (Current_Item, From_Project_Node_Tree));
                         else
-                           Error_Report
+                           Report_Error
                              ("associative array value not found",
                               Project, In_Tree);
                         end if;
@@ -1712,6 +1721,7 @@ package body Prj.Proc is
                        Expression
                          (Project                => Project,
                           In_Tree                => In_Tree,
+                          Report_Error           => Report_Error,
                           From_Project_Node      => From_Project_Node,
                           From_Project_Node_Tree => From_Project_Node_Tree,
                           Pkg                    => Pkg,
@@ -1749,13 +1759,13 @@ package body Prj.Proc is
                            Error_Msg_Name_1 :=
                              Name_Of (Current_Item, From_Project_Node_Tree);
 
-                           if Error_Report = null then
+                           if Report_Error = null then
                               Error_Msg
                                 ("no value defined for %%",
                                  Location_Of
                                    (Current_Item, From_Project_Node_Tree));
                            else
-                              Error_Report
+                              Report_Error
                                 ("no value defined for " &
                                  Get_Name_String (Error_Msg_Name_1),
                                  Project, In_Tree);
@@ -1794,7 +1804,7 @@ package body Prj.Proc is
                                    Name_Of
                                      (Current_Item, From_Project_Node_Tree);
 
-                                 if Error_Report = null then
+                                 if Report_Error = null then
                                     Error_Msg
                                       ("value %% is illegal " &
                                        "for typed string %%",
@@ -1803,7 +1813,7 @@ package body Prj.Proc is
                                           From_Project_Node_Tree));
 
                                  else
-                                    Error_Report
+                                    Report_Error
                                       ("value """ &
                                        Get_Name_String (Error_Msg_Name_1) &
                                        """ is illegal for typed string """ &
@@ -2246,6 +2256,7 @@ package body Prj.Proc is
                      Process_Declarative_Items
                        (Project                => Project,
                         In_Tree                => In_Tree,
+                        Report_Error           => Report_Error,
                         From_Project_Node      => From_Project_Node,
                         From_Project_Node_Tree => From_Project_Node_Tree,
                         Pkg                    => Pkg,
@@ -2280,8 +2291,6 @@ package body Prj.Proc is
       Reset_Tree             : Boolean := True)
    is
    begin
-      Error_Report := Report_Error;
-
       if Reset_Tree then
 
          --  Make sure there are no projects in the data structure
@@ -2297,6 +2306,7 @@ package body Prj.Proc is
       Recursive_Process
         (Project                => Project,
          In_Tree                => In_Tree,
+         Report_Error           => Report_Error,
          From_Project_Node      => From_Project_Node,
          From_Project_Node_Tree => From_Project_Node_Tree,
          Extended_By            => No_Project);
@@ -2332,12 +2342,12 @@ package body Prj.Proc is
    --  Start of processing for Process_Project_Tree_Phase_2
 
    begin
-      Error_Report := Report_Error;
-
       Success := True;
 
       if Project /= No_Project then
-         Check (In_Tree, Project, Current_Dir, When_No_Sources,
+         Check (In_Tree, Project, Current_Dir,
+                When_No_Sources            => When_No_Sources,
+                Report_Error               => Report_Error,
                 Require_Sources_Other_Lang => Require_Sources_Other_Lang,
                 Compiler_Driver_Mandatory  => Compiler_Driver_Mandatory,
                 Allow_Duplicate_Basenames  => Allow_Duplicate_Basenames);
@@ -2390,13 +2400,13 @@ package body Prj.Proc is
                      if Extending2.Virtual then
                         Error_Msg_Name_1 := Prj.Project.Display_Name;
 
-                        if Error_Report = null then
+                        if Report_Error = null then
                            Error_Msg
                              ("project %% cannot be extended by a virtual" &
                               " project with the same object directory",
                               Prj.Project.Location);
                         else
-                           Error_Report
+                           Report_Error
                              ("project """ &
                               Get_Name_String (Error_Msg_Name_1) &
                               """ cannot be extended by a virtual " &
@@ -2408,7 +2418,7 @@ package body Prj.Proc is
                         Error_Msg_Name_1 := Extending2.Display_Name;
                         Error_Msg_Name_2 := Prj.Project.Display_Name;
 
-                        if Error_Report = null then
+                        if Report_Error = null then
                            Error_Msg
                              ("project %% cannot extend project %%",
                               Extending2.Location);
@@ -2417,13 +2427,13 @@ package body Prj.Proc is
                               Extending2.Location);
 
                         else
-                           Error_Report
+                           Report_Error
                              ("project """ &
                               Get_Name_String (Error_Msg_Name_1) &
                               """ cannot extend project """ &
                               Get_Name_String (Error_Msg_Name_2) & """",
                               Project, In_Tree);
-                           Error_Report
+                           Report_Error
                              ("they share the same object directory",
                               Project, In_Tree);
                         end if;
@@ -2471,6 +2481,7 @@ package body Prj.Proc is
    procedure Recursive_Process
      (In_Tree                : Project_Tree_Ref;
       Project                : out Project_Id;
+      Report_Error           : Put_Line_Access;
       From_Project_Node      : Project_Node_Id;
       From_Project_Node_Tree : Project_Node_Tree_Ref;
       Extended_By            : Project_Id)
@@ -2511,6 +2522,7 @@ package body Prj.Proc is
                Recursive_Process
                  (In_Tree                => In_Tree,
                   Project                => New_Project,
+                  Report_Error           => Report_Error,
                   From_Project_Node      =>
                     Project_Node_Of
                       (With_Clause, From_Project_Node_Tree),
@@ -2652,6 +2664,7 @@ package body Prj.Proc is
             Recursive_Process
               (In_Tree                => In_Tree,
                Project                => Project.Extends,
+               Report_Error           => Report_Error,
                From_Project_Node      => Extended_Project_Of
                                           (Declaration_Node,
                                            From_Project_Node_Tree),
@@ -2661,6 +2674,7 @@ package body Prj.Proc is
             Process_Declarative_Items
               (Project                => Project,
                In_Tree                => In_Tree,
+               Report_Error           => Report_Error,
                From_Project_Node      => From_Project_Node,
                From_Project_Node_Tree => From_Project_Node_Tree,
                Pkg                    => No_Package,
diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index 59c9835088c..2276e80d7ab 100644
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -1193,7 +1193,6 @@ package Rtsfind is
      RE_Get_Reference,                   -- System.Partition_Interface
      RE_Asynchronous_P_To_Sync_Scope,    -- System.Partition_Interface
      RE_Buffer_Stream_Type,              -- System.Partition_Interface
-     RE_Allocate_Buffer,                 -- System.Partition_Interface
      RE_Release_Buffer,                  -- System.Partition_Interface
      RE_BS_To_Any,                       -- System.Partition_Interface
      RE_Any_To_BS,                       -- System.Partition_Interface
@@ -2350,7 +2349,6 @@ package Rtsfind is
      RE_Get_Reference                    => System_Partition_Interface,
      RE_Asynchronous_P_To_Sync_Scope     => System_Partition_Interface,
      RE_Buffer_Stream_Type               => System_Partition_Interface,
-     RE_Allocate_Buffer                  => System_Partition_Interface,
      RE_Release_Buffer                   => System_Partition_Interface,
      RE_BS_To_Any                        => System_Partition_Interface,
      RE_Any_To_BS                        => System_Partition_Interface,