Skip to content

R
riscv-gcc-1
Commit 72a3d7c7 by Arnaud Charlet
Options

[multiple changes] 

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.

From-SVN: r149560
parent 223eab97
Showing with 270 additions and 185 deletions
gcc/ada/ChangeLog
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.
......
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,6 +7418,14 @@ package body Exp_Dist is
if Out_Present (Current_Parameter)
and then not Is_Controlling_Formal
then
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 =>
......@@ -7410,10 +7433,10 @@ package body Exp_Dist is
Defining_Identifier (Current_Parameter), Loc),
Expression =>
PolyORB_Support.Helpers.Build_From_Any_Call
(Etype (Parameter_Type (Current_Parameter)),
(Etyp,
New_Occurrence_Of (Any, Loc),
Decls)));
end if;
end if;
end;
end if;
......@@ -7931,8 +7954,15 @@ 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
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 := Helpers.Build_From_Any_Call
(Etyp, New_Occurrence_Of (Any, Loc), Decls);
if Constrained then
......@@ -7945,10 +7975,11 @@ package body Exp_Dist is
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,
......
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;
......
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;
......
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,
......
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,
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment