diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 19 | ||||
| -rw-r--r-- | gcc/ada/exp_dist.adb | 334 | ||||
| -rw-r--r-- | gcc/ada/mlib.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.adb | 71 | ||||
| -rw-r--r-- | gcc/ada/prj-proc.adb | 56 | ||||
| -rw-r--r-- | gcc/ada/rtsfind.ads | 2 |
6 files changed, 289 insertions, 204 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7fe05126..0e8ea16 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 744c0d4..fa4327a 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 5d029db..61fa0d7 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 53bd367..6fd7b7e 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 ef39813..6f9897f 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 59c9835..2276e80d 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, |