Skip to content

R
riscv-gcc-1
Commit e2d9085b by Emmanuel Briot Committed by Arnaud Charlet
Options

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

	* prj-proc.adb, prj-part.adb, prj-part.ads, prj-strt.adb,
	prj-strt.ads, prj.adb, prj.ads, prj-makr.adb, prj-makr.ads,
	prj-dect.adb, prj-dect.ads, prj-nmsc.adb, prj-pars.adb, errutil.adb,
	errutil.ads, prj-conf.adb, gnatname.adb, prj-err.adb, prj-err.ads
	(Prj.Nmsc.Report_Error): Removed, no longer needed.
	Always use Prj.Err.Report_Message.

From-SVN: r149572
parent 442c0581
Showing with 722 additions and 766 deletions
gcc/ada/ChangeLog
2009-07-13 Emmanuel Briot <briot@adacore.com>
* prj-proc.adb, prj-part.adb, prj-part.ads, prj-strt.adb,
prj-strt.ads, prj.adb, prj.ads, prj-makr.adb, prj-makr.ads,
prj-dect.adb, prj-dect.ads, prj-nmsc.adb, prj-pars.adb, errutil.adb,
errutil.ads, prj-conf.adb, gnatname.adb, prj-err.adb, prj-err.ads
(Prj.Nmsc.Report_Error): Removed, no longer needed.
Always use Prj.Err.Report_Message.
2009-07-13 Robert Dewar <dewar@adacore.com> 2009-07-13 Robert Dewar <dewar@adacore.com>
* prj.adb, sem_ch4.adb, sem_res.adb, prj-nmsc.adb: Minor reformatting * prj.adb, sem_ch4.adb, sem_res.adb, prj-nmsc.adb: Minor reformatting
......
gcc/ada/errutil.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1991-2008, Free Software Foundation, Inc. -- -- Copyright (C) 1991-2009, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
......
gcc/ada/errutil.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2002-2007, Free Software Foundation, Inc. -- -- Copyright (C) 2002-2009, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
......
gcc/ada/gnatname.adb
...@@ -620,7 +620,8 @@ begin ...@@ -620,7 +620,8 @@ begin
(File_Path => File_Path.all, (File_Path => File_Path.all,
Project_File => Create_Project, Project_File => Create_Project,
Preproc_Switches => Prep_Switches, Preproc_Switches => Prep_Switches,
Very_Verbose => Very_Verbose); Very_Verbose => Very_Verbose,
Flags => Gnatmake_Flags);
end; end;
-- Process each section successively -- Process each section successively
......
gcc/ada/prj-conf.adb
...@@ -846,7 +846,8 @@ package body Prj.Conf is ...@@ -846,7 +846,8 @@ package body Prj.Conf is
Always_Errout_Finalize => False, Always_Errout_Finalize => False,
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Directory, Current_Directory => Current_Directory,
Is_Config_File => True); Is_Config_File => True,
Flags => Flags);
else else
-- Maybe the user will want to create his own configuration file -- Maybe the user will want to create his own configuration file
Config_Project_Node := Empty_Node; Config_Project_Node := Empty_Node;
...@@ -1004,7 +1005,8 @@ package body Prj.Conf is ...@@ -1004,7 +1005,8 @@ package body Prj.Conf is
Always_Errout_Finalize => False, Always_Errout_Finalize => False,
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Directory, Current_Directory => Current_Directory,
Is_Config_File => False); Is_Config_File => False,
Flags => Flags);
if User_Project_Node = Empty_Node then if User_Project_Node = Empty_Node then
User_Project_Node := Empty_Node; User_Project_Node := Empty_Node;
......
gcc/ada/prj-dect.adb
...@@ -54,7 +54,8 @@ package body Prj.Dect is ...@@ -54,7 +54,8 @@ package body Prj.Dect is
First_Attribute : Attribute_Node_Id; First_Attribute : Attribute_Node_Id;
Current_Project : Project_Node_Id; Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id; Current_Package : Project_Node_Id;
Packages_To_Check : String_List_Access); Packages_To_Check : String_List_Access;
Flags : Processing_Flags);
-- Parse an attribute declaration -- Parse an attribute declaration
procedure Parse_Case_Construction procedure Parse_Case_Construction
...@@ -64,7 +65,8 @@ package body Prj.Dect is ...@@ -64,7 +65,8 @@ package body Prj.Dect is
Current_Project : Project_Node_Id; Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id; Current_Package : Project_Node_Id;
Packages_To_Check : String_List_Access; Packages_To_Check : String_List_Access;
Is_Config_File : Boolean); Is_Config_File : Boolean;
Flags : Processing_Flags);
-- Parse a case construction -- Parse a case construction
procedure Parse_Declarative_Items procedure Parse_Declarative_Items
...@@ -75,7 +77,8 @@ package body Prj.Dect is ...@@ -75,7 +77,8 @@ package body Prj.Dect is
Current_Project : Project_Node_Id; Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id; Current_Package : Project_Node_Id;
Packages_To_Check : String_List_Access; Packages_To_Check : String_List_Access;
Is_Config_File : Boolean); Is_Config_File : Boolean;
Flags : Processing_Flags);
-- Parse declarative items. Depending on In_Zone, some declarative -- Parse declarative items. Depending on In_Zone, some declarative
-- items may be forbidden. -- items may be forbidden.
-- Is_Config_File should be set to True if the project represents a config -- Is_Config_File should be set to True if the project represents a config
...@@ -86,7 +89,8 @@ package body Prj.Dect is ...@@ -86,7 +89,8 @@ package body Prj.Dect is
Package_Declaration : out Project_Node_Id; Package_Declaration : out Project_Node_Id;
Current_Project : Project_Node_Id; Current_Project : Project_Node_Id;
Packages_To_Check : String_List_Access; Packages_To_Check : String_List_Access;
Is_Config_File : Boolean); Is_Config_File : Boolean;
Flags : Processing_Flags);
-- Parse a package declaration. -- Parse a package declaration.
-- Is_Config_File should be set to True if the project represents a config -- Is_Config_File should be set to True if the project represents a config
-- file (.cgpr) since some specific checks apply. -- file (.cgpr) since some specific checks apply.
...@@ -94,14 +98,16 @@ package body Prj.Dect is ...@@ -94,14 +98,16 @@ package body Prj.Dect is
procedure Parse_String_Type_Declaration procedure Parse_String_Type_Declaration
(In_Tree : Project_Node_Tree_Ref; (In_Tree : Project_Node_Tree_Ref;
String_Type : out Project_Node_Id; String_Type : out Project_Node_Id;
Current_Project : Project_Node_Id); Current_Project : Project_Node_Id;
Flags : Processing_Flags);
-- type <name> is ( <literal_string> { , <literal_string> } ) ; -- type <name> is ( <literal_string> { , <literal_string> } ) ;
procedure Parse_Variable_Declaration procedure Parse_Variable_Declaration
(In_Tree : Project_Node_Tree_Ref; (In_Tree : Project_Node_Tree_Ref;
Variable : out Project_Node_Id; Variable : out Project_Node_Id;
Current_Project : Project_Node_Id; Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id); Current_Package : Project_Node_Id;
Flags : Processing_Flags);
-- Parse a variable assignment -- Parse a variable assignment
-- <variable_Name> := <expression>; OR -- <variable_Name> := <expression>; OR
-- <variable_Name> : <string_type_Name> := <string_expression>; -- <variable_Name> : <string_type_Name> := <string_expression>;
...@@ -116,7 +122,8 @@ package body Prj.Dect is ...@@ -116,7 +122,8 @@ package body Prj.Dect is
Current_Project : Project_Node_Id; Current_Project : Project_Node_Id;
Extends : Project_Node_Id; Extends : Project_Node_Id;
Packages_To_Check : String_List_Access; Packages_To_Check : String_List_Access;
Is_Config_File : Boolean) Is_Config_File : Boolean;
Flags : Processing_Flags)
is is
First_Declarative_Item : Project_Node_Id := Empty_Node; First_Declarative_Item : Project_Node_Id := Empty_Node;
...@@ -135,7 +142,8 @@ package body Prj.Dect is ...@@ -135,7 +142,8 @@ package body Prj.Dect is
Current_Project => Current_Project, Current_Project => Current_Project,
Current_Package => Empty_Node, Current_Package => Empty_Node,
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Is_Config_File => Is_Config_File); Is_Config_File => Is_Config_File,
Flags => Flags);
Set_First_Declarative_Item_Of Set_First_Declarative_Item_Of
(Declarations, In_Tree, To => First_Declarative_Item); (Declarations, In_Tree, To => First_Declarative_Item);
end Parse; end Parse;
...@@ -150,7 +158,8 @@ package body Prj.Dect is ...@@ -150,7 +158,8 @@ package body Prj.Dect is
First_Attribute : Attribute_Node_Id; First_Attribute : Attribute_Node_Id;
Current_Project : Project_Node_Id; Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id; Current_Package : Project_Node_Id;
Packages_To_Check : String_List_Access) Packages_To_Check : String_List_Access;
Flags : Processing_Flags)
is is
Current_Attribute : Attribute_Node_Id := First_Attribute; Current_Attribute : Attribute_Node_Id := First_Attribute;
Full_Associative_Array : Boolean := False; Full_Associative_Array : Boolean := False;
...@@ -224,7 +233,7 @@ package body Prj.Dect is ...@@ -224,7 +233,7 @@ package body Prj.Dect is
if not Ignore then if not Ignore then
Error_Msg_Name_1 := Token_Name; Error_Msg_Name_1 := Token_Name;
Error_Msg ("undefined attribute %%", Token_Ptr); Error_Msg (Flags, "undefined attribute %%", Token_Ptr);
end if; end if;
end if; end if;
...@@ -234,7 +243,7 @@ package body Prj.Dect is ...@@ -234,7 +243,7 @@ package body Prj.Dect is
if Is_Read_Only (Current_Attribute) then if Is_Read_Only (Current_Attribute) then
Error_Msg_Name_1 := Token_Name; Error_Msg_Name_1 := Token_Name;
Error_Msg Error_Msg
("read-only attribute %% cannot be given a value", (Flags, "read-only attribute %% cannot be given a value",
Token_Ptr); Token_Ptr);
end if; end if;
...@@ -283,7 +292,8 @@ package body Prj.Dect is ...@@ -283,7 +292,8 @@ package body Prj.Dect is
if Current_Attribute /= Empty_Attribute if Current_Attribute /= Empty_Attribute
and then Attribute_Kind_Of (Current_Attribute) = Single and then Attribute_Kind_Of (Current_Attribute) = Single
then then
Error_Msg ("the attribute """ & Error_Msg (Flags,
"the attribute """ &
Get_Name_String Get_Name_String
(Attribute_Name_Of (Current_Attribute)) & (Attribute_Name_Of (Current_Attribute)) &
""" cannot be an associative array", """ cannot be an associative array",
...@@ -335,7 +345,8 @@ package body Prj.Dect is ...@@ -335,7 +345,8 @@ package body Prj.Dect is
UI_To_Int (Int_Literal_Value); UI_To_Int (Int_Literal_Value);
begin begin
if Index = 0 then if Index = 0 then
Error_Msg ("index cannot be zero", Token_Ptr); Error_Msg
(Flags, "index cannot be zero", Token_Ptr);
else else
Set_Source_Index_Of Set_Source_Index_Of
(Attribute, In_Tree, To => Index); (Attribute, In_Tree, To => Index);
...@@ -346,7 +357,7 @@ package body Prj.Dect is ...@@ -346,7 +357,7 @@ package body Prj.Dect is
end if; end if;
when others => when others =>
Error_Msg ("index not allowed here", Token_Ptr); Error_Msg (Flags, "index not allowed here", Token_Ptr);
Scan (In_Tree); Scan (In_Tree);
if Token = Tok_Integer_Literal then if Token = Tok_Integer_Literal then
...@@ -428,7 +439,7 @@ package body Prj.Dect is ...@@ -428,7 +439,7 @@ package body Prj.Dect is
(Current_Project, In_Tree, Token_Name); (Current_Project, In_Tree, Token_Name);
if No (The_Project) then if No (The_Project) then
Error_Msg ("unknown project", Location); Error_Msg (Flags, "unknown project", Location);
Scan (In_Tree); -- past the project name Scan (In_Tree); -- past the project name
else else
...@@ -458,7 +469,7 @@ package body Prj.Dect is ...@@ -458,7 +469,7 @@ package body Prj.Dect is
then then
The_Project := Empty_Node; The_Project := Empty_Node;
Error_Msg Error_Msg
("not the same package as " & (Flags, "not the same package as " &
Get_Name_String Get_Name_String
(Name_Of (Current_Package, In_Tree)), (Name_Of (Current_Package, In_Tree)),
Token_Ptr); Token_Ptr);
...@@ -486,8 +497,9 @@ package body Prj.Dect is ...@@ -486,8 +497,9 @@ package body Prj.Dect is
Error_Msg_Name_2 := Project_Name; Error_Msg_Name_2 := Project_Name;
Error_Msg_Name_1 := Token_Name; Error_Msg_Name_1 := Token_Name;
Error_Msg Error_Msg
("package % not declared in project %", (Flags,
Token_Ptr); "package % not declared in project %",
Token_Ptr);
end if; end if;
Scan (In_Tree); -- past the package name Scan (In_Tree); -- past the package name
...@@ -519,7 +531,8 @@ package body Prj.Dect is ...@@ -519,7 +531,8 @@ package body Prj.Dect is
if Token_Name /= Attribute_Name then if Token_Name /= Attribute_Name then
The_Project := Empty_Node; The_Project := Empty_Node;
Error_Msg_Name_1 := Attribute_Name; Error_Msg_Name_1 := Attribute_Name;
Error_Msg ("invalid name, should be %", Token_Ptr); Error_Msg
(Flags, "invalid name, should be %", Token_Ptr);
end if; end if;
Scan (In_Tree); -- past the attribute name Scan (In_Tree); -- past the attribute name
...@@ -561,6 +574,7 @@ package body Prj.Dect is ...@@ -561,6 +574,7 @@ package body Prj.Dect is
Parse_Expression Parse_Expression
(In_Tree => In_Tree, (In_Tree => In_Tree,
Expression => Expression, Expression => Expression,
Flags => Flags,
Current_Project => Current_Project, Current_Project => Current_Project,
Current_Package => Current_Package, Current_Package => Current_Package,
Optional_Index => Optional_Index); Optional_Index => Optional_Index);
...@@ -581,7 +595,7 @@ package body Prj.Dect is ...@@ -581,7 +595,7 @@ package body Prj.Dect is
else else
Error_Msg Error_Msg
("wrong expression kind for attribute """ & (Flags, "wrong expression kind for attribute """ &
Get_Name_String Get_Name_String
(Attribute_Name_Of (Current_Attribute)) & (Attribute_Name_Of (Current_Attribute)) &
"""", """",
...@@ -615,7 +629,8 @@ package body Prj.Dect is ...@@ -615,7 +629,8 @@ package body Prj.Dect is
Current_Project : Project_Node_Id; Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id; Current_Package : Project_Node_Id;
Packages_To_Check : String_List_Access; Packages_To_Check : String_List_Access;
Is_Config_File : Boolean) Is_Config_File : Boolean;
Flags : Processing_Flags)
is is
Current_Item : Project_Node_Id := Empty_Node; Current_Item : Project_Node_Id := Empty_Node;
Next_Item : Project_Node_Id := Empty_Node; Next_Item : Project_Node_Id := Empty_Node;
...@@ -653,6 +668,7 @@ package body Prj.Dect is ...@@ -653,6 +668,7 @@ package body Prj.Dect is
Parse_Variable_Reference Parse_Variable_Reference
(In_Tree => In_Tree, (In_Tree => In_Tree,
Variable => Case_Variable, Variable => Case_Variable,
Flags => Flags,
Current_Project => Current_Project, Current_Project => Current_Project,
Current_Package => Current_Package); Current_Package => Current_Package);
Set_Case_Variable_Reference_Of Set_Case_Variable_Reference_Of
...@@ -668,7 +684,8 @@ package body Prj.Dect is ...@@ -668,7 +684,8 @@ package body Prj.Dect is
String_Type := String_Type_Of (Case_Variable, In_Tree); String_Type := String_Type_Of (Case_Variable, In_Tree);
if No (String_Type) then if No (String_Type) then
Error_Msg ("variable """ & Error_Msg (Flags,
"variable """ &
Get_Name_String (Name_Of (Case_Variable, In_Tree)) & Get_Name_String (Name_Of (Case_Variable, In_Tree)) &
""" is not typed", """ is not typed",
Variable_Location); Variable_Location);
...@@ -739,7 +756,8 @@ package body Prj.Dect is ...@@ -739,7 +756,8 @@ package body Prj.Dect is
Current_Project => Current_Project, Current_Project => Current_Project,
Current_Package => Current_Package, Current_Package => Current_Package,
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Is_Config_File => Is_Config_File); Is_Config_File => Is_Config_File,
Flags => Flags);
-- "when others =>" must be the last branch, so save the -- "when others =>" must be the last branch, so save the
-- Case_Item and exit -- Case_Item and exit
...@@ -751,7 +769,8 @@ package body Prj.Dect is ...@@ -751,7 +769,8 @@ package body Prj.Dect is
else else
Parse_Choice_List Parse_Choice_List
(In_Tree => In_Tree, (In_Tree => In_Tree,
First_Choice => First_Choice); First_Choice => First_Choice,
Flags => Flags);
Set_First_Choice_Of (Current_Item, In_Tree, To => First_Choice); Set_First_Choice_Of (Current_Item, In_Tree, To => First_Choice);
Expect (Tok_Arrow, "`=>`"); Expect (Tok_Arrow, "`=>`");
...@@ -766,7 +785,8 @@ package body Prj.Dect is ...@@ -766,7 +785,8 @@ package body Prj.Dect is
Current_Project => Current_Project, Current_Project => Current_Project,
Current_Package => Current_Package, Current_Package => Current_Package,
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Is_Config_File => Is_Config_File); Is_Config_File => Is_Config_File,
Flags => Flags);
Set_First_Declarative_Item_Of Set_First_Declarative_Item_Of
(Current_Item, In_Tree, To => First_Declarative_Item); (Current_Item, In_Tree, To => First_Declarative_Item);
...@@ -776,7 +796,8 @@ package body Prj.Dect is ...@@ -776,7 +796,8 @@ package body Prj.Dect is
End_Case_Construction End_Case_Construction
(Check_All_Labels => not When_Others and not Quiet_Output, (Check_All_Labels => not When_Others and not Quiet_Output,
Case_Location => Location_Of (Case_Construction, In_Tree)); Case_Location => Location_Of (Case_Construction, In_Tree),
Flags => Flags);
Expect (Tok_End, "`END CASE`"); Expect (Tok_End, "`END CASE`");
Remove_Next_End_Node; Remove_Next_End_Node;
...@@ -812,7 +833,8 @@ package body Prj.Dect is ...@@ -812,7 +833,8 @@ package body Prj.Dect is
Current_Project : Project_Node_Id; Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id; Current_Package : Project_Node_Id;
Packages_To_Check : String_List_Access; Packages_To_Check : String_List_Access;
Is_Config_File : Boolean) Is_Config_File : Boolean;
Flags : Processing_Flags)
is is
Current_Declarative_Item : Project_Node_Id := Empty_Node; Current_Declarative_Item : Project_Node_Id := Empty_Node;
Next_Declarative_Item : Project_Node_Id := Empty_Node; Next_Declarative_Item : Project_Node_Id := Empty_Node;
...@@ -861,7 +883,8 @@ package body Prj.Dect is ...@@ -861,7 +883,8 @@ package body Prj.Dect is
if No (The_Variable) then if No (The_Variable) then
Error_Msg Error_Msg
("a variable cannot be declared " & (Flags,
"a variable cannot be declared " &
"for the first time here", "for the first time here",
Token_Ptr); Token_Ptr);
end if; end if;
...@@ -872,7 +895,8 @@ package body Prj.Dect is ...@@ -872,7 +895,8 @@ package body Prj.Dect is
(In_Tree, (In_Tree,
Current_Declaration, Current_Declaration,
Current_Project => Current_Project, Current_Project => Current_Project,
Current_Package => Current_Package); Current_Package => Current_Package,
Flags => Flags);
Set_End_Of_Line (Current_Declaration); Set_End_Of_Line (Current_Declaration);
Set_Previous_Line_Node (Current_Declaration); Set_Previous_Line_Node (Current_Declaration);
...@@ -885,7 +909,8 @@ package body Prj.Dect is ...@@ -885,7 +909,8 @@ package body Prj.Dect is
First_Attribute => First_Attribute, First_Attribute => First_Attribute,
Current_Project => Current_Project, Current_Project => Current_Project,
Current_Package => Current_Package, Current_Package => Current_Package,
Packages_To_Check => Packages_To_Check); Packages_To_Check => Packages_To_Check,
Flags => Flags);
Set_End_Of_Line (Current_Declaration); Set_End_Of_Line (Current_Declaration);
Set_Previous_Line_Node (Current_Declaration); Set_Previous_Line_Node (Current_Declaration);
...@@ -899,7 +924,8 @@ package body Prj.Dect is ...@@ -899,7 +924,8 @@ package body Prj.Dect is
-- Package declaration -- Package declaration
if In_Zone /= In_Project then if In_Zone /= In_Project then
Error_Msg ("a package cannot be declared here", Token_Ptr); Error_Msg
(Flags, "a package cannot be declared here", Token_Ptr);
end if; end if;
Parse_Package_Declaration Parse_Package_Declaration
...@@ -907,7 +933,8 @@ package body Prj.Dect is ...@@ -907,7 +933,8 @@ package body Prj.Dect is
Package_Declaration => Current_Declaration, Package_Declaration => Current_Declaration,
Current_Project => Current_Project, Current_Project => Current_Project,
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Is_Config_File => Is_Config_File); Is_Config_File => Is_Config_File,
Flags => Flags);
Set_Previous_End_Node (Current_Declaration); Set_Previous_End_Node (Current_Declaration);
...@@ -916,14 +943,16 @@ package body Prj.Dect is ...@@ -916,14 +943,16 @@ package body Prj.Dect is
-- Type String Declaration -- Type String Declaration
if In_Zone /= In_Project then if In_Zone /= In_Project then
Error_Msg ("a string type cannot be declared here", Error_Msg (Flags,
"a string type cannot be declared here",
Token_Ptr); Token_Ptr);
end if; end if;
Parse_String_Type_Declaration Parse_String_Type_Declaration
(In_Tree => In_Tree, (In_Tree => In_Tree,
String_Type => Current_Declaration, String_Type => Current_Declaration,
Current_Project => Current_Project); Current_Project => Current_Project,
Flags => Flags);
Set_End_Of_Line (Current_Declaration); Set_End_Of_Line (Current_Declaration);
Set_Previous_Line_Node (Current_Declaration); Set_Previous_Line_Node (Current_Declaration);
...@@ -939,7 +968,8 @@ package body Prj.Dect is ...@@ -939,7 +968,8 @@ package body Prj.Dect is
Current_Project => Current_Project, Current_Project => Current_Project,
Current_Package => Current_Package, Current_Package => Current_Package,
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Is_Config_File => Is_Config_File); Is_Config_File => Is_Config_File,
Flags => Flags);
Set_Previous_End_Node (Current_Declaration); Set_Previous_End_Node (Current_Declaration);
...@@ -993,7 +1023,8 @@ package body Prj.Dect is ...@@ -993,7 +1023,8 @@ package body Prj.Dect is
Package_Declaration : out Project_Node_Id; Package_Declaration : out Project_Node_Id;
Current_Project : Project_Node_Id; Current_Project : Project_Node_Id;
Packages_To_Check : String_List_Access; Packages_To_Check : String_List_Access;
Is_Config_File : Boolean) Is_Config_File : Boolean;
Flags : Processing_Flags)
is is
First_Attribute : Attribute_Node_Id := Empty_Attribute; First_Attribute : Attribute_Node_Id := Empty_Attribute;
Current_Package : Package_Node_Id := Empty_Package; Current_Package : Package_Node_Id := Empty_Package;
...@@ -1044,7 +1075,8 @@ package body Prj.Dect is ...@@ -1044,7 +1075,8 @@ package body Prj.Dect is
-- misspelling has been found. -- misspelling has been found.
if Verbose_Mode or else Index /= 0 then if Verbose_Mode or else Index /= 0 then
Error_Msg ("?""" & Error_Msg (Flags,
"?""" &
Get_Name_String Get_Name_String
(Name_Of (Package_Declaration, In_Tree)) & (Name_Of (Package_Declaration, In_Tree)) &
""" is not a known package name", """ is not a known package name",
...@@ -1053,7 +1085,8 @@ package body Prj.Dect is ...@@ -1053,7 +1085,8 @@ package body Prj.Dect is
if Index /= 0 then if Index /= 0 then
Error_Msg -- CODEFIX Error_Msg -- CODEFIX
("\?possible misspelling of """ & (Flags,
"\?possible misspelling of """ &
List (Index).all & """", Token_Ptr); List (Index).all & """", Token_Ptr);
end if; end if;
end; end;
...@@ -1095,7 +1128,8 @@ package body Prj.Dect is ...@@ -1095,7 +1128,8 @@ package body Prj.Dect is
if Present (Current) then if Present (Current) then
Error_Msg Error_Msg
("package """ & (Flags,
"package """ &
Get_Name_String (Name_Of (Package_Declaration, In_Tree)) & Get_Name_String (Name_Of (Package_Declaration, In_Tree)) &
""" is declared twice in the same project", """ is declared twice in the same project",
Token_Ptr); Token_Ptr);
...@@ -1119,7 +1153,8 @@ package body Prj.Dect is ...@@ -1119,7 +1153,8 @@ package body Prj.Dect is
if Token = Tok_Renames then if Token = Tok_Renames then
if Is_Config_File then if Is_Config_File then
Error_Msg Error_Msg
("no package renames in configuration projects", Token_Ptr); (Flags,
"no package renames in configuration projects", Token_Ptr);
end if; end if;
-- Scan past "renames" -- Scan past "renames"
...@@ -1164,7 +1199,8 @@ package body Prj.Dect is ...@@ -1164,7 +1199,8 @@ package body Prj.Dect is
else else
Error_Msg_Name_1 := Project_Name; Error_Msg_Name_1 := Project_Name;
Error_Msg Error_Msg
("% is not an imported or extended project", Token_Ptr); (Flags,
"% is not an imported or extended project", Token_Ptr);
end if; end if;
else else
Set_Project_Of_Renamed_Package_Of Set_Project_Of_Renamed_Package_Of
...@@ -1181,7 +1217,7 @@ package body Prj.Dect is ...@@ -1181,7 +1217,7 @@ package body Prj.Dect is
if Token = Tok_Identifier then if Token = Tok_Identifier then
if Name_Of (Package_Declaration, In_Tree) /= Token_Name then if Name_Of (Package_Declaration, In_Tree) /= Token_Name then
Error_Msg ("not the same package name", Token_Ptr); Error_Msg (Flags, "not the same package name", Token_Ptr);
elsif elsif
Present (Project_Of_Renamed_Package_Of Present (Project_Of_Renamed_Package_Of
(Package_Declaration, In_Tree)) (Package_Declaration, In_Tree))
...@@ -1203,7 +1239,7 @@ package body Prj.Dect is ...@@ -1203,7 +1239,7 @@ package body Prj.Dect is
if No (Current) then if No (Current) then
Error_Msg Error_Msg
("""" & (Flags, """" &
Get_Name_String (Token_Name) & Get_Name_String (Token_Name) &
""" is not a package declared by the project", """ is not a package declared by the project",
Token_Ptr); Token_Ptr);
...@@ -1233,7 +1269,8 @@ package body Prj.Dect is ...@@ -1233,7 +1269,8 @@ package body Prj.Dect is
Current_Project => Current_Project, Current_Project => Current_Project,
Current_Package => Package_Declaration, Current_Package => Package_Declaration,
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Is_Config_File => Is_Config_File); Is_Config_File => Is_Config_File,
Flags => Flags);
Set_First_Declarative_Item_Of Set_First_Declarative_Item_Of
(Package_Declaration, In_Tree, To => First_Declarative_Item); (Package_Declaration, In_Tree, To => First_Declarative_Item);
...@@ -1256,7 +1293,7 @@ package body Prj.Dect is ...@@ -1256,7 +1293,7 @@ package body Prj.Dect is
and then Token_Name /= Name_Of (Package_Declaration, In_Tree) and then Token_Name /= Name_Of (Package_Declaration, In_Tree)
then then
Error_Msg_Name_1 := Name_Of (Package_Declaration, In_Tree); Error_Msg_Name_1 := Name_Of (Package_Declaration, In_Tree);
Error_Msg ("expected %%", Token_Ptr); Error_Msg (Flags, "expected %%", Token_Ptr);
end if; end if;
if Token /= Tok_Semicolon then if Token /= Tok_Semicolon then
...@@ -1270,7 +1307,7 @@ package body Prj.Dect is ...@@ -1270,7 +1307,7 @@ package body Prj.Dect is
Remove_Next_End_Node; Remove_Next_End_Node;
else else
Error_Msg ("expected IS or RENAMES", Token_Ptr); Error_Msg (Flags, "expected IS or RENAMES", Token_Ptr);
end if; end if;
end Parse_Package_Declaration; end Parse_Package_Declaration;
...@@ -1282,7 +1319,8 @@ package body Prj.Dect is ...@@ -1282,7 +1319,8 @@ package body Prj.Dect is
procedure Parse_String_Type_Declaration procedure Parse_String_Type_Declaration
(In_Tree : Project_Node_Tree_Ref; (In_Tree : Project_Node_Tree_Ref;
String_Type : out Project_Node_Id; String_Type : out Project_Node_Id;
Current_Project : Project_Node_Id) Current_Project : Project_Node_Id;
Flags : Processing_Flags)
is is
Current : Project_Node_Id := Empty_Node; Current : Project_Node_Id := Empty_Node;
First_String : Project_Node_Id := Empty_Node; First_String : Project_Node_Id := Empty_Node;
...@@ -1312,7 +1350,8 @@ package body Prj.Dect is ...@@ -1312,7 +1350,8 @@ package body Prj.Dect is
end loop; end loop;
if Present (Current) then if Present (Current) then
Error_Msg ("duplicate string type name """ & Error_Msg (Flags,
"duplicate string type name """ &
Get_Name_String (Token_Name) & Get_Name_String (Token_Name) &
"""", """",
Token_Ptr); Token_Ptr);
...@@ -1325,7 +1364,8 @@ package body Prj.Dect is ...@@ -1325,7 +1364,8 @@ package body Prj.Dect is
end loop; end loop;
if Present (Current) then if Present (Current) then
Error_Msg ("""" & Error_Msg (Flags,
"""" &
Get_Name_String (Token_Name) & Get_Name_String (Token_Name) &
""" is already a variable name", Token_Ptr); """ is already a variable name", Token_Ptr);
else else
...@@ -1355,7 +1395,7 @@ package body Prj.Dect is ...@@ -1355,7 +1395,7 @@ package body Prj.Dect is
end if; end if;
Parse_String_Type_List Parse_String_Type_List
(In_Tree => In_Tree, First_String => First_String); (In_Tree => In_Tree, First_String => First_String, Flags => Flags);
Set_First_Literal_String (String_Type, In_Tree, To => First_String); Set_First_Literal_String (String_Type, In_Tree, To => First_String);
Expect (Tok_Right_Paren, "`)`"); Expect (Tok_Right_Paren, "`)`");
...@@ -1374,7 +1414,8 @@ package body Prj.Dect is ...@@ -1374,7 +1414,8 @@ package body Prj.Dect is
(In_Tree : Project_Node_Tree_Ref; (In_Tree : Project_Node_Tree_Ref;
Variable : out Project_Node_Id; Variable : out Project_Node_Id;
Current_Project : Project_Node_Id; Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id) Current_Package : Project_Node_Id;
Flags : Processing_Flags)
is is
Expression_Location : Source_Ptr; Expression_Location : Source_Ptr;
String_Type_Name : Name_Id := No_Name; String_Type_Name : Name_Id := No_Name;
...@@ -1448,7 +1489,8 @@ package body Prj.Dect is ...@@ -1448,7 +1489,8 @@ package body Prj.Dect is
if The_Project_Name_And_Node = if The_Project_Name_And_Node =
Tree_Private_Part.No_Project_Name_And_Node Tree_Private_Part.No_Project_Name_And_Node
then then
Error_Msg ("unknown project """ & Error_Msg (Flags,
"unknown project """ &
Get_Name_String Get_Name_String
(Project_String_Type_Name) & (Project_String_Type_Name) &
"""", """",
...@@ -1491,7 +1533,8 @@ package body Prj.Dect is ...@@ -1491,7 +1533,8 @@ package body Prj.Dect is
end if; end if;
if No (Current) then if No (Current) then
Error_Msg ("unknown string type """ & Error_Msg (Flags,
"unknown string type """ &
Get_Name_String (String_Type_Name) & Get_Name_String (String_Type_Name) &
"""", """",
Type_Location); Type_Location);
...@@ -1521,6 +1564,7 @@ package body Prj.Dect is ...@@ -1521,6 +1564,7 @@ package body Prj.Dect is
Parse_Expression Parse_Expression
(In_Tree => In_Tree, (In_Tree => In_Tree,
Expression => Expression, Expression => Expression,
Flags => Flags,
Current_Project => Current_Project, Current_Project => Current_Project,
Current_Package => Current_Package, Current_Package => Current_Package,
Optional_Index => False); Optional_Index => False);
...@@ -1533,7 +1577,8 @@ package body Prj.Dect is ...@@ -1533,7 +1577,8 @@ package body Prj.Dect is
and then Expression_Kind_Of (Expression, In_Tree) = List and then Expression_Kind_Of (Expression, In_Tree) = List
then then
Error_Msg Error_Msg
("expression must be a single string", Expression_Location); (Flags,
"expression must be a single string", Expression_Location);
end if; end if;
Set_Expression_Kind_Of Set_Expression_Kind_Of
...@@ -1587,7 +1632,8 @@ package body Prj.Dect is ...@@ -1587,7 +1632,8 @@ package body Prj.Dect is
if Expression_Kind_Of (The_Variable, In_Tree) /= if Expression_Kind_Of (The_Variable, In_Tree) /=
Expression_Kind_Of (Variable, In_Tree) Expression_Kind_Of (Variable, In_Tree)
then then
Error_Msg ("wrong expression kind for variable """ & Error_Msg (Flags,
"wrong expression kind for variable """ &
Get_Name_String Get_Name_String
(Name_Of (The_Variable, In_Tree)) & (Name_Of (The_Variable, In_Tree)) &
"""", """",
......
gcc/ada/prj-dect.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -35,7 +35,8 @@ private package Prj.Dect is ...@@ -35,7 +35,8 @@ private package Prj.Dect is
Current_Project : Prj.Tree.Project_Node_Id; Current_Project : Prj.Tree.Project_Node_Id;
Extends : Prj.Tree.Project_Node_Id; Extends : Prj.Tree.Project_Node_Id;
Packages_To_Check : String_List_Access; Packages_To_Check : String_List_Access;
Is_Config_File : Boolean); Is_Config_File : Boolean;
Flags : Processing_Flags);
-- Parse project declarative items -- Parse project declarative items
-- --
-- In_Tree is the project node tree -- In_Tree is the project node tree
......
gcc/ada/prj-err.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2002-2007, Free Software Foundation, Inc. -- -- Copyright (C) 2002-2009, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -68,4 +68,53 @@ package body Prj.Err is ...@@ -68,4 +68,53 @@ package body Prj.Err is
end if; end if;
end Post_Scan; end Post_Scan;
---------------
-- Error_Msg --
---------------
procedure Error_Msg
(Flags : Processing_Flags;
Msg : String;
Location : Source_Ptr := No_Location;
Project : Project_Id := null)
is
Real_Location : Source_Ptr := Location;
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
and then Project /= null
then
Real_Location := Project.Location;
end if;
if Real_Location = No_Location then
-- If still null, we are parsing a project that was created in-memory
-- so we shouldn't report errors for projects that the user has no
-- access to in any case.
return;
end if;
-- Report the error through Errutil, so that duplicate errors are
-- properly removed, messages are sorted, and correctly interpreted,...
Errutil.Error_Msg (Msg, Real_Location);
-- Let the application know there was an error
if Flags.Report_Error /= null then
Flags.Report_Error (Project, Is_Warning => Msg (Msg'First) = '?');
end if;
end Error_Msg;
end Prj.Err; end Prj.Err;
gcc/ada/prj-err.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2002-2007, Free Software Foundation, Inc. -- -- Copyright (C) 2002-2009, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -28,6 +28,14 @@ ...@@ -28,6 +28,14 @@
-- the GNAT tree packages (Atree, Sinfo, ...). It uses exactly the same global -- the GNAT tree packages (Atree, Sinfo, ...). It uses exactly the same global
-- variables as Errout, located in package Err_Vars. Like Errout, it also uses -- variables as Errout, located in package Err_Vars. Like Errout, it also uses
-- the common variables and routines in package Erroutc. -- the common variables and routines in package Erroutc.
--
-- Parameters are set through Err_Vars.Error_Msg_File_* or
-- Err_Vars.Error_Msg_Name_*, and replaced automatically in the messages
-- ("{{" for files, "%%" for names).
--
-- However, in this package you can configure the error messages to be sent
-- to your own callback by setting Report_Error in the flags. This ensures
-- that applications can control where error messages are displayed.
with Scng; with Scng;
with Errutil; with Errutil;
...@@ -59,29 +67,22 @@ package Prj.Err is ...@@ -59,29 +67,22 @@ package Prj.Err is
-- Finalize processing of error messages for one file and output message -- Finalize processing of error messages for one file and output message
-- indicating the number of detected errors. -- indicating the number of detected errors.
procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) procedure Error_Msg
renames Errutil.Error_Msg; (Flags : Processing_Flags;
-- Output a message at specified location Msg : String;
Location : Source_Ptr := No_Location;
procedure Error_Msg_S (Msg : String) renames Errutil.Error_Msg_S; Project : Project_Id := null);
-- Output a message at current scan pointer location -- Output an error message, either through Flags.Error_Report or through
-- Errutil. The location defaults to the project's location ("project" in
procedure Error_Msg_SC (Msg : String) renames Errutil.Error_Msg_SC; -- the source code).
-- Output a message at the start of the current token, unless we are at -- If Msg starts with "?", this is a warning, and Warning: is added at the
-- the end of file, in which case we always output the message after the -- beginning. If Msg starts with "<", see comment for
-- last real token in the file. -- Err_Vars.Error_Msg_Warn
procedure Error_Msg_SP (Msg : String) renames Errutil.Error_Msg_SP;
-- Output a message at the start of the previous token
------------- -------------
-- Scanner -- -- Scanner --
------------- -------------
package Style renames Errutil.Style;
-- Instantiation of the generic style package, needed for the instantiation
-- of the generic scanner below.
procedure Obsolescent_Check (S : Source_Ptr); procedure Obsolescent_Check (S : Source_Ptr);
-- Dummy null procedure for Scng instantiation -- Dummy null procedure for Scng instantiation
...@@ -90,12 +91,12 @@ package Prj.Err is ...@@ -90,12 +91,12 @@ package Prj.Err is
package Scanner is new Scng package Scanner is new Scng
(Post_Scan => Post_Scan, (Post_Scan => Post_Scan,
Error_Msg => Error_Msg, Error_Msg => Errutil.Error_Msg,
Error_Msg_S => Error_Msg_S, Error_Msg_S => Errutil.Error_Msg_S,
Error_Msg_SC => Error_Msg_SC, Error_Msg_SC => Errutil.Error_Msg_SC,
Error_Msg_SP => Error_Msg_SP, Error_Msg_SP => Errutil.Error_Msg_SP,
Obsolescent_Check => Obsolescent_Check, Obsolescent_Check => Obsolescent_Check,
Style => Style); Style => Errutil.Style);
-- Instantiation of the generic scanner -- Instantiation of the generic scanner
end Prj.Err; end Prj.Err;
gcc/ada/prj-makr.adb
...@@ -766,7 +766,8 @@ package body Prj.Makr is ...@@ -766,7 +766,8 @@ package body Prj.Makr is
(File_Path : String; (File_Path : String;
Project_File : Boolean; Project_File : Boolean;
Preproc_Switches : Argument_List; Preproc_Switches : Argument_List;
Very_Verbose : Boolean) Very_Verbose : Boolean;
Flags : Processing_Flags)
is is
begin begin
Makr.Very_Verbose := Initialize.Very_Verbose; Makr.Very_Verbose := Initialize.Very_Verbose;
...@@ -846,6 +847,7 @@ package body Prj.Makr is ...@@ -846,6 +847,7 @@ package body Prj.Makr is
Always_Errout_Finalize => False, Always_Errout_Finalize => False,
Store_Comments => True, Store_Comments => True,
Is_Config_File => False, Is_Config_File => False,
Flags => Flags,
Current_Directory => Get_Current_Dir, Current_Directory => Get_Current_Dir,
Packages_To_Check => Packages_To_Check_By_Gnatname); Packages_To_Check => Packages_To_Check_By_Gnatname);
......
gcc/ada/prj-makr.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2001-2008, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -36,7 +36,8 @@ package Prj.Makr is ...@@ -36,7 +36,8 @@ package Prj.Makr is
(File_Path : String; (File_Path : String;
Project_File : Boolean; Project_File : Boolean;
Preproc_Switches : Argument_List; Preproc_Switches : Argument_List;
Very_Verbose : Boolean); Very_Verbose : Boolean;
Flags : Processing_Flags);
-- Start the creation of a configuration pragmas file or the creation or -- Start the creation of a configuration pragmas file or the creation or
-- modification of a project file, for gnatname. -- modification of a project file, for gnatname.
-- --
......
gcc/ada/prj-nmsc.adb
...@@ -31,7 +31,7 @@ with Err_Vars; use Err_Vars; ...@@ -31,7 +31,7 @@ with Err_Vars; use Err_Vars;
with Opt; use Opt; with Opt; use Opt;
with Osint; use Osint; with Osint; use Osint;
with Output; use Output; with Output; use Output;
with Prj.Err; with Prj.Err; use Prj.Err;
with Prj.Util; use Prj.Util; with Prj.Util; use Prj.Util;
with Sinput.P; with Sinput.P;
with Snames; use Snames; with Snames; use Snames;
...@@ -199,8 +199,9 @@ package body Prj.Nmsc is ...@@ -199,8 +199,9 @@ package body Prj.Nmsc is
Naming_Exception : Boolean := False; Naming_Exception : Boolean := False;
Path : Path_Information := No_Path_Information; Path : Path_Information := No_Path_Information;
Alternate_Languages : Language_List := null; Alternate_Languages : Language_List := null;
Unit : Name_Id := No_Name; Unit : Name_Id := No_Name;
Index : Int := 0; Index : Int := 0;
Locally_Removed : Boolean := False;
Location : Source_Ptr := No_Location); Location : Source_Ptr := No_Location);
-- Add a new source to the different lists: list of all sources in the -- 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 -- project tree, list of source of a project and list of sources of a
...@@ -280,17 +281,6 @@ package body Prj.Nmsc is ...@@ -280,17 +281,6 @@ package body Prj.Nmsc is
-- Return the index of the last significant character in Dir. This is used -- Return the index of the last significant character in Dir. This is used
-- to avoid duplicate '/' (slash) characters at the end of directory names. -- to avoid duplicate '/' (slash) characters at the end of directory names.
procedure Error_Msg
(Project : Project_Id;
Msg : String;
Flag_Location : Source_Ptr;
Data : Tree_Processing_Data);
-- Output an error message. If Data.Error_Report is null, simply call
-- Prj.Err.Error_Msg. Otherwise, disregard Flag_Location and use
-- Error_Report. If Msg starts with "?", this is a warning, and the
-- string "Warning:" is prepended to the message. If Msg starts with "<",
-- see comment for Err_Vars.Error_Msg_Warn.
procedure Search_Directories procedure Search_Directories
(Project : in out Project_Processing_Data; (Project : in out Project_Processing_Data;
Data : in out Tree_Processing_Data; Data : in out Tree_Processing_Data;
...@@ -552,8 +542,9 @@ package body Prj.Nmsc is ...@@ -552,8 +542,9 @@ package body Prj.Nmsc is
Naming_Exception : Boolean := False; Naming_Exception : Boolean := False;
Path : Path_Information := No_Path_Information; Path : Path_Information := No_Path_Information;
Alternate_Languages : Language_List := null; Alternate_Languages : Language_List := null;
Unit : Name_Id := No_Name; Unit : Name_Id := No_Name;
Index : Int := 0; Index : Int := 0;
Locally_Removed : Boolean := False;
Location : Source_Ptr := No_Location) Location : Source_Ptr := No_Location)
is is
Config : constant Language_Config := Lang_Id.Config; Config : constant Language_Config := Lang_Id.Config;
...@@ -608,8 +599,8 @@ package body Prj.Nmsc is ...@@ -608,8 +599,8 @@ package body Prj.Nmsc is
else else
Error_Msg_File_1 := File_Name; Error_Msg_File_1 := File_Name;
Error_Msg Error_Msg
(Project, "duplicate source file name {", (Data.Flags, "duplicate source file name {",
Location, Data); Location, Project);
Add_Src := False; Add_Src := False;
end if; end if;
...@@ -623,7 +614,7 @@ package body Prj.Nmsc is ...@@ -623,7 +614,7 @@ package body Prj.Nmsc is
elsif Source.Path.Name /= Path.Name then elsif Source.Path.Name /= Path.Name then
Error_Msg_Name_1 := Unit; Error_Msg_Name_1 := Unit;
Error_Msg Error_Msg
(Project, "duplicate unit %%", Location, Data); (Data.Flags, "duplicate unit %%", Location, Project);
Add_Src := False; Add_Src := False;
end if; end if;
end if; end if;
...@@ -636,7 +627,9 @@ package body Prj.Nmsc is ...@@ -636,7 +627,9 @@ package body Prj.Nmsc is
-- to have the same file name in unrelated projects. -- to have the same file name in unrelated projects.
elsif Is_Extending (Project, Source.Project) then elsif Is_Extending (Project, Source.Project) then
Source_To_Replace := Source; if not Locally_Removed then
Source_To_Replace := Source;
end if;
elsif Prev_Unit /= No_Unit_Index elsif Prev_Unit /= No_Unit_Index
and then not Source.Locally_Removed and then not Source.Locally_Removed
...@@ -649,26 +642,26 @@ package body Prj.Nmsc is ...@@ -649,26 +642,26 @@ package body Prj.Nmsc is
if Path /= No_Path_Information then if Path /= No_Path_Information then
Error_Msg_Name_1 := Unit; Error_Msg_Name_1 := Unit;
Error_Msg Error_Msg
(Project, (Data.Flags,
"unit %% cannot belong to several projects", "unit %% cannot belong to several projects",
Location, Data); Location, Project);
Error_Msg_Name_1 := Project.Name; Error_Msg_Name_1 := Project.Name;
Error_Msg_Name_2 := Name_Id (Path.Name); Error_Msg_Name_2 := Name_Id (Path.Name);
Error_Msg Error_Msg
(Project, "\ project %%, %%", Location, Data); (Data.Flags, "\ project %%, %%", Location, Project);
Error_Msg_Name_1 := Source.Project.Name; Error_Msg_Name_1 := Source.Project.Name;
Error_Msg_Name_2 := Name_Id (Source.Path.Display_Name); Error_Msg_Name_2 := Name_Id (Source.Path.Display_Name);
Error_Msg Error_Msg
(Project, "\ project %%, %%", Location, Data); (Data.Flags, "\ project %%, %%", Location, Project);
else else
Error_Msg_Name_1 := Unit; Error_Msg_Name_1 := Unit;
Error_Msg_Name_2 := Source.Project.Name; Error_Msg_Name_2 := Source.Project.Name;
Error_Msg Error_Msg
(Project, "unit %% already belongs to project %%", (Data.Flags, "unit %% already belongs to project %%",
Location, Data); Location, Project);
end if; end if;
Add_Src := False; Add_Src := False;
...@@ -680,8 +673,8 @@ package body Prj.Nmsc is ...@@ -680,8 +673,8 @@ package body Prj.Nmsc is
Error_Msg_File_1 := File_Name; Error_Msg_File_1 := File_Name;
Error_Msg_File_2 := File_Name_Type (Source.Project.Name); Error_Msg_File_2 := File_Name_Type (Source.Project.Name);
Error_Msg Error_Msg
(Project, (Data.Flags,
"{ is already a source of project {", Location, Data); "{ is already a source of project {", Location, Project);
-- Add the file anyway, to avoid further warnings like "language -- Add the file anyway, to avoid further warnings like "language
-- unknown". -- unknown".
...@@ -727,6 +720,7 @@ package body Prj.Nmsc is ...@@ -727,6 +720,7 @@ package body Prj.Nmsc is
Id.Language := Lang_Id; Id.Language := Lang_Id;
Id.Kind := Kind; Id.Kind := Kind;
Id.Alternate_Languages := Alternate_Languages; Id.Alternate_Languages := Alternate_Languages;
Id.Locally_Removed := Locally_Removed;
-- Add the source id to the Unit_Sources_HT hash table, if the unit name -- Add the source id to the Unit_Sources_HT hash table, if the unit name
-- is not null. -- is not null.
...@@ -848,10 +842,10 @@ package body Prj.Nmsc is ...@@ -848,10 +842,10 @@ package body Prj.Nmsc is
else else
Error_Msg Error_Msg
(Project, (Data.Flags,
"at least one of Source_Files, Source_Dirs or Languages " "at least one of Source_Files, Source_Dirs or Languages "
& "must be declared empty for an abstract project", & "must be declared empty for an abstract project",
Project.Location, Data); Project.Location, Project);
end if; end if;
end; end;
end if; end if;
...@@ -1374,8 +1368,8 @@ package body Prj.Nmsc is ...@@ -1374,8 +1368,8 @@ package body Prj.Nmsc is
if List = Nil_String then if List = Nil_String then
Error_Msg Error_Msg
(Project, "include option cannot be null", (Data.Flags, "include option cannot be null",
Element.Value.Location, Data); Element.Value.Location, Project);
end if; end if;
Put (Into_List => Lang_Index.Config.Include_Option, Put (Into_List => Lang_Index.Config.Include_Option,
...@@ -1427,15 +1421,17 @@ package body Prj.Nmsc is ...@@ -1427,15 +1421,17 @@ package body Prj.Nmsc is
exception exception
when Constraint_Error => when Constraint_Error =>
Error_Msg Error_Msg
(Project, "invalid value for Path_Syntax", (Data.Flags,
Element.Value.Location, Data); "invalid value for Path_Syntax",
Element.Value.Location, Project);
end; end;
when Name_Object_File_Suffix => when Name_Object_File_Suffix =>
if Get_Name_String (Element.Value.Value) = "" then if Get_Name_String (Element.Value.Value) = "" then
Error_Msg Error_Msg
(Project, "object file suffix cannot be empty", (Data.Flags,
Element.Value.Location, Data); "object file suffix cannot be empty",
Element.Value.Location, Project);
else else
Lang_Index.Config.Object_File_Suffix := Lang_Index.Config.Object_File_Suffix :=
...@@ -1456,8 +1452,9 @@ package body Prj.Nmsc is ...@@ -1456,8 +1452,9 @@ package body Prj.Nmsc is
if List = Nil_String then if List = Nil_String then
Error_Msg Error_Msg
(Project, "compiler PIC option cannot be null", (Data.Flags,
Element.Value.Location, Data); "compiler PIC option cannot be null",
Element.Value.Location, Project);
end if; end if;
Put (Into_List => Put (Into_List =>
...@@ -1473,9 +1470,9 @@ package body Prj.Nmsc is ...@@ -1473,9 +1470,9 @@ package body Prj.Nmsc is
if List = Nil_String then if List = Nil_String then
Error_Msg Error_Msg
(Project, (Data.Flags,
"mapping file switches cannot be null", "mapping file switches cannot be null",
Element.Value.Location, Data); Element.Value.Location, Project);
end if; end if;
Put (Into_List => Put (Into_List =>
...@@ -1505,9 +1502,9 @@ package body Prj.Nmsc is ...@@ -1505,9 +1502,9 @@ package body Prj.Nmsc is
if List = Nil_String then if List = Nil_String then
Error_Msg Error_Msg
(Project, (Data.Flags,
"config file switches cannot be null", "config file switches cannot be null",
Element.Value.Location, Data); Element.Value.Location, Project);
end if; end if;
Put (Into_List => Put (Into_List =>
...@@ -1570,9 +1567,9 @@ package body Prj.Nmsc is ...@@ -1570,9 +1567,9 @@ package body Prj.Nmsc is
exception exception
when Constraint_Error => when Constraint_Error =>
Error_Msg Error_Msg
(Project, (Data.Flags,
"illegal value for Config_File_Unique", "illegal value for Config_File_Unique",
Element.Value.Location, Data); Element.Value.Location, Project);
end; end;
when others => when others =>
...@@ -1623,9 +1620,9 @@ package body Prj.Nmsc is ...@@ -1623,9 +1620,9 @@ package body Prj.Nmsc is
exception exception
when Constraint_Error => when Constraint_Error =>
Error_Msg Error_Msg
(Project, (Data.Flags,
"invalid value for Casing", "invalid value for Casing",
Attribute.Value.Location, Data); Attribute.Value.Location, Project);
end; end;
elsif Attribute.Name = Name_Dot_Replacement then elsif Attribute.Name = Name_Dot_Replacement then
...@@ -1754,9 +1751,9 @@ package body Prj.Nmsc is ...@@ -1754,9 +1751,9 @@ package body Prj.Nmsc is
exception exception
when Constraint_Error => when Constraint_Error =>
Error_Msg Error_Msg
(Project, (Data.Flags,
"value must be positive or equal to 0", "value must be positive or equal to 0",
Attribute.Value.Location, Data); Attribute.Value.Location, Project);
end; end;
elsif Attribute.Name = Name_Response_File_Format then elsif Attribute.Name = Name_Response_File_Format then
...@@ -1782,9 +1779,9 @@ package body Prj.Nmsc is ...@@ -1782,9 +1779,9 @@ package body Prj.Nmsc is
else else
Error_Msg Error_Msg
(Project, (Data.Flags,
"illegal response file format", "illegal response file format",
Attribute.Value.Location, Data); Attribute.Value.Location, Project);
end if; end if;
end; end;
...@@ -1887,9 +1884,9 @@ package body Prj.Nmsc is ...@@ -1887,9 +1884,9 @@ package body Prj.Nmsc is
if List = Nil_String then if List = Nil_String then
Error_Msg Error_Msg
(Project, (Data.Flags,
"archive builder cannot be null", "archive builder cannot be null",
Attribute.Value.Location, Data); Attribute.Value.Location, Project);
end if; end if;
Put (Into_List => Project.Config.Archive_Builder, Put (Into_List => Project.Config.Archive_Builder,
...@@ -1921,9 +1918,9 @@ package body Prj.Nmsc is ...@@ -1921,9 +1918,9 @@ package body Prj.Nmsc is
if List = Nil_String then if List = Nil_String then
Error_Msg Error_Msg
(Project, (Data.Flags,
"archive indexer cannot be null", "archive indexer cannot be null",
Attribute.Value.Location, Data); Attribute.Value.Location, Project);
end if; end if;
Put (Into_List => Project.Config.Archive_Indexer, Put (Into_List => Project.Config.Archive_Indexer,
...@@ -1940,9 +1937,9 @@ package body Prj.Nmsc is ...@@ -1940,9 +1937,9 @@ package body Prj.Nmsc is
if List = Nil_String then if List = Nil_String then
Error_Msg Error_Msg
(Project, (Data.Flags,
"partial linker cannot be null", "partial linker cannot be null",
Attribute.Value.Location, Data); Attribute.Value.Location, Project);
end if; end if;
Put (Into_List => Project.Config.Lib_Partial_Linker, Put (Into_List => Project.Config.Lib_Partial_Linker,
...@@ -1953,10 +1950,10 @@ package body Prj.Nmsc is ...@@ -1953,10 +1950,10 @@ package body Prj.Nmsc is
Project.Config.Shared_Lib_Driver := Project.Config.Shared_Lib_Driver :=
File_Name_Type (Attribute.Value.Value); File_Name_Type (Attribute.Value.Value);
Error_Msg Error_Msg
(Project, (Data.Flags,
"?Library_'G'C'C is an obsolescent attribute, " & "?Library_'G'C'C is an obsolescent attribute, " &
"use Linker''Driver instead", "use Linker''Driver instead",
Attribute.Value.Location, Data); Attribute.Value.Location, Project);
elsif Attribute.Name = Name_Archive_Suffix then elsif Attribute.Name = Name_Archive_Suffix then
Project.Config.Archive_Suffix := Project.Config.Archive_Suffix :=
...@@ -1971,9 +1968,9 @@ package body Prj.Nmsc is ...@@ -1971,9 +1968,9 @@ package body Prj.Nmsc is
if List = Nil_String then if List = Nil_String then
Error_Msg Error_Msg
(Project, (Data.Flags,
"linker executable option cannot be null", "linker executable option cannot be null",
Attribute.Value.Location, Data); Attribute.Value.Location, Project);
end if; end if;
Put (Into_List => Project.Config.Linker_Executable_Option, Put (Into_List => Project.Config.Linker_Executable_Option,
...@@ -1990,9 +1987,9 @@ package body Prj.Nmsc is ...@@ -1990,9 +1987,9 @@ package body Prj.Nmsc is
if Name_Len = 0 then if Name_Len = 0 then
Error_Msg Error_Msg
(Project, (Data.Flags,
"linker library directory option cannot be empty", "linker library directory option cannot be empty",
Attribute.Value.Location, Data); Attribute.Value.Location, Project);
end if; end if;
Project.Config.Linker_Lib_Dir_Option := Project.Config.Linker_Lib_Dir_Option :=
...@@ -2008,9 +2005,9 @@ package body Prj.Nmsc is ...@@ -2008,9 +2005,9 @@ package body Prj.Nmsc is
if Name_Len = 0 then if Name_Len = 0 then
Error_Msg Error_Msg
(Project, (Data.Flags,
"linker library name option cannot be empty", "linker library name option cannot be empty",
Attribute.Value.Location, Data); Attribute.Value.Location, Project);
end if; end if;
Project.Config.Linker_Lib_Name_Option := Project.Config.Linker_Lib_Name_Option :=
...@@ -2038,11 +2035,11 @@ package body Prj.Nmsc is ...@@ -2038,11 +2035,11 @@ package body Prj.Nmsc is
exception exception
when Constraint_Error => when Constraint_Error =>
Error_Msg Error_Msg
(Project, (Data.Flags,
"invalid value """ & "invalid value """ &
Get_Name_String (Attribute.Value.Value) & Get_Name_String (Attribute.Value.Value) &
""" for Separate_Run_Path_Options", """ for Separate_Run_Path_Options",
Attribute.Value.Location, Data); Attribute.Value.Location, Project);
end; end;
elsif Attribute.Name = Name_Library_Support then elsif Attribute.Name = Name_Library_Support then
...@@ -2055,11 +2052,11 @@ package body Prj.Nmsc is ...@@ -2055,11 +2052,11 @@ package body Prj.Nmsc is
exception exception
when Constraint_Error => when Constraint_Error =>
Error_Msg Error_Msg
(Project, (Data.Flags,
"invalid value """ & "invalid value """ &
Get_Name_String (Attribute.Value.Value) & Get_Name_String (Attribute.Value.Value) &
""" for Library_Support", """ for Library_Support",
Attribute.Value.Location, Data); Attribute.Value.Location, Project);
end; end;
elsif Attribute.Name = Name_Shared_Library_Prefix then elsif Attribute.Name = Name_Shared_Library_Prefix then
...@@ -2080,11 +2077,11 @@ package body Prj.Nmsc is ...@@ -2080,11 +2077,11 @@ package body Prj.Nmsc is
exception exception
when Constraint_Error => when Constraint_Error =>
Error_Msg Error_Msg
(Project, (Data.Flags,
"invalid value """ "invalid value """
& Get_Name_String (Attribute.Value.Value) & Get_Name_String (Attribute.Value.Value)
& """ for Symbolic_Link_Supported", & """ for Symbolic_Link_Supported",
Attribute.Value.Location, Data); Attribute.Value.Location, Project);
end; end;
elsif elsif
...@@ -2099,11 +2096,11 @@ package body Prj.Nmsc is ...@@ -2099,11 +2096,11 @@ package body Prj.Nmsc is
exception exception
when Constraint_Error => when Constraint_Error =>
Error_Msg Error_Msg
(Project, (Data.Flags,
"invalid value """ & "invalid value """ &
Get_Name_String (Attribute.Value.Value) & Get_Name_String (Attribute.Value.Value) &
""" for Library_Major_Minor_Id_Supported", """ for Library_Major_Minor_Id_Supported",
Attribute.Value.Location, Data); Attribute.Value.Location, Project);
end; end;
elsif Attribute.Name = Name_Library_Auto_Init_Supported then elsif Attribute.Name = Name_Library_Auto_Init_Supported then
...@@ -2115,11 +2112,11 @@ package body Prj.Nmsc is ...@@ -2115,11 +2112,11 @@ package body Prj.Nmsc is
exception exception
when Constraint_Error => when Constraint_Error =>
Error_Msg Error_Msg
(Project, (Data.Flags,
"invalid value """ "invalid value """
& Get_Name_String (Attribute.Value.Value) & Get_Name_String (Attribute.Value.Value)
& """ for Library_Auto_Init_Supported", & """ for Library_Auto_Init_Supported",
Attribute.Value.Location, Data); Attribute.Value.Location, Project);
end; end;
elsif Attribute.Name = Name_Shared_Library_Minimum_Switches then elsif Attribute.Name = Name_Shared_Library_Minimum_Switches then
...@@ -2238,11 +2235,11 @@ package body Prj.Nmsc is ...@@ -2238,11 +2235,11 @@ package body Prj.Nmsc is
exception exception
when Constraint_Error => when Constraint_Error =>
Error_Msg Error_Msg
(Project, (Data.Flags,
"invalid value """ "invalid value """
& Get_Name_String (Element.Value.Value) & Get_Name_String (Element.Value.Value)
& """ for Object_Generated", & """ for Object_Generated",
Element.Value.Location, Data); Element.Value.Location, Project);
end; end;
when Name_Objects_Linked => when Name_Objects_Linked =>
...@@ -2265,11 +2262,11 @@ package body Prj.Nmsc is ...@@ -2265,11 +2262,11 @@ package body Prj.Nmsc is
exception exception
when Constraint_Error => when Constraint_Error =>
Error_Msg Error_Msg
(Project, (Data.Flags,
"invalid value """ "invalid value """
& Get_Name_String (Element.Value.Value) & Get_Name_String (Element.Value.Value)
& """ for Objects_Linked", & """ for Objects_Linked",
Element.Value.Location, Data); Element.Value.Location, Project);
end; end;
when others => when others =>
null; null;
...@@ -2336,10 +2333,10 @@ package body Prj.Nmsc is ...@@ -2336,10 +2333,10 @@ package body Prj.Nmsc is
then then
Error_Msg_Name_1 := Lang_Index.Display_Name; Error_Msg_Name_1 := Lang_Index.Display_Name;
Error_Msg Error_Msg
(Project, (Data.Flags,
"?no compiler specified for language %%" & "?no compiler specified for language %%" &
", ignoring all its sources", ", ignoring all its sources",
No_Location, Data); No_Location, Project);
if Lang_Index = Project.Languages then if Lang_Index = Project.Languages then
Project.Languages := Lang_Index.Next; Project.Languages := Lang_Index.Next;
...@@ -2355,23 +2352,23 @@ package body Prj.Nmsc is ...@@ -2355,23 +2352,23 @@ package body Prj.Nmsc is
if Lang_Index.Config.Naming_Data.Dot_Replacement = No_File then if Lang_Index.Config.Naming_Data.Dot_Replacement = No_File then
Error_Msg Error_Msg
(Project, (Data.Flags,
"Dot_Replacement not specified for Ada", "Dot_Replacement not specified for Ada",
No_Location, Data); No_Location, Project);
end if; end if;
if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File then if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File then
Error_Msg Error_Msg
(Project, (Data.Flags,
"Spec_Suffix not specified for Ada", "Spec_Suffix not specified for Ada",
No_Location, Data); No_Location, Project);
end if; end if;
if Lang_Index.Config.Naming_Data.Body_Suffix = No_File then if Lang_Index.Config.Naming_Data.Body_Suffix = No_File then
Error_Msg Error_Msg
(Project, (Data.Flags,
"Body_Suffix not specified for Ada", "Body_Suffix not specified for Ada",
No_Location, Data); No_Location, Project);
end if; end if;
else else
...@@ -2386,9 +2383,9 @@ package body Prj.Nmsc is ...@@ -2386,9 +2383,9 @@ package body Prj.Nmsc is
then then
Error_Msg_Name_1 := Lang_Index.Display_Name; Error_Msg_Name_1 := Lang_Index.Display_Name;
Error_Msg Error_Msg
(Project, (Data.Flags,
"no suffixes specified for %%", "no suffixes specified for %%",
No_Location, Data); No_Location, Project);
end if; end if;
end if; end if;
...@@ -2418,9 +2415,9 @@ package body Prj.Nmsc is ...@@ -2418,9 +2415,9 @@ package body Prj.Nmsc is
Project.Externally_Built := True; Project.Externally_Built := True;
elsif Name_Buffer (1 .. Name_Len) /= "false" then elsif Name_Buffer (1 .. Name_Len) /= "false" then
Error_Msg (Project, Error_Msg (Data.Flags,
"Externally_Built may only be true or false", "Externally_Built may only be true or false",
Externally_Built.Location, Data); Externally_Built.Location, Project);
end if; end if;
end if; end if;
...@@ -2529,10 +2526,10 @@ package body Prj.Nmsc is ...@@ -2529,10 +2526,10 @@ package body Prj.Nmsc is
Error_Msg_Name_1 := Project.Name; Error_Msg_Name_1 := Project.Name;
Error_Msg Error_Msg
(Project, (Data.Flags,
"{ cannot be an interface of project %% " "{ cannot be an interface of project %% "
& "as it is not one of its sources", & "as it is not one of its sources",
Element.Location, Data); Element.Location, Project);
end if; end if;
List := Element.Next; List := Element.Next;
...@@ -2635,8 +2632,8 @@ package body Prj.Nmsc is ...@@ -2635,8 +2632,8 @@ package body Prj.Nmsc is
if Length_Of_Name (Dot_Repl.Value) = 0 then if Length_Of_Name (Dot_Repl.Value) = 0 then
Error_Msg Error_Msg
(Project, "Dot_Replacement cannot be empty", (Data.Flags, "Dot_Replacement cannot be empty",
Dot_Repl.Location, Data); Dot_Repl.Location, Project);
end if; end if;
Dot_Replacement := Canonical_Case_File_Name (Dot_Repl.Value); Dot_Replacement := Canonical_Case_File_Name (Dot_Repl.Value);
...@@ -2666,10 +2663,10 @@ package body Prj.Nmsc is ...@@ -2666,10 +2663,10 @@ package body Prj.Nmsc is
Index (Source => Repl, Pattern => ".") /= 0) Index (Source => Repl, Pattern => ".") /= 0)
then then
Error_Msg Error_Msg
(Project, (Data.Flags,
'"' & Repl & '"' & Repl &
""" is illegal for Dot_Replacement.", """ is illegal for Dot_Replacement.",
Dot_Repl_Loc, Data); Dot_Repl_Loc, Project);
end if; end if;
end; end;
end if; end if;
...@@ -2692,9 +2689,9 @@ package body Prj.Nmsc is ...@@ -2692,9 +2689,9 @@ package body Prj.Nmsc is
begin begin
if Casing_Image'Length = 0 then if Casing_Image'Length = 0 then
Error_Msg Error_Msg
(Project, (Data.Flags,
"Casing cannot be an empty string", "Casing cannot be an empty string",
Casing_String.Location, Data); Casing_String.Location, Project);
end if; end if;
Casing := Value (Casing_Image); Casing := Value (Casing_Image);
...@@ -2706,9 +2703,9 @@ package body Prj.Nmsc is ...@@ -2706,9 +2703,9 @@ package body Prj.Nmsc is
Name_Buffer (1 .. Name_Len) := Casing_Image; Name_Buffer (1 .. Name_Len) := Casing_Image;
Err_Vars.Error_Msg_Name_1 := Name_Find; Err_Vars.Error_Msg_Name_1 := Name_Find;
Error_Msg Error_Msg
(Project, (Data.Flags,
"%% is not a correct Casing", "%% is not a correct Casing",
Casing_String.Location, Data); Casing_String.Location, Project);
end; end;
end if; end if;
...@@ -2717,9 +2714,9 @@ package body Prj.Nmsc is ...@@ -2717,9 +2714,9 @@ package body Prj.Nmsc is
if not Sep_Suffix.Default then if not Sep_Suffix.Default then
if Length_Of_Name (Sep_Suffix.Value) = 0 then if Length_Of_Name (Sep_Suffix.Value) = 0 then
Error_Msg Error_Msg
(Project, (Data.Flags,
"Separate_Suffix cannot be empty", "Separate_Suffix cannot be empty",
Sep_Suffix.Location, Data); Sep_Suffix.Location, Project);
else else
Separate_Suffix := Canonical_Case_File_Name (Sep_Suffix.Value); Separate_Suffix := Canonical_Case_File_Name (Sep_Suffix.Value);
...@@ -2807,15 +2804,15 @@ package body Prj.Nmsc is ...@@ -2807,15 +2804,15 @@ package body Prj.Nmsc is
if Source.Language /= Lang_Id then if Source.Language /= Lang_Id then
Error_Msg Error_Msg
(Project, (Data.Flags,
"the same file cannot be a source of two languages", "the same file cannot be a source of two languages",
Element.Location, Data); Element.Location, Project);
elsif Source.Kind /= Kind then elsif Source.Kind /= Kind then
Error_Msg Error_Msg
(Project, (Data.Flags,
"the same file cannot be a source and a template", "the same file cannot be a source and a template",
Element.Location, Data); Element.Location, Project);
end if; end if;
-- If the file is already recorded for the same -- If the file is already recorded for the same
...@@ -2896,9 +2893,9 @@ package body Prj.Nmsc is ...@@ -2896,9 +2893,9 @@ package body Prj.Nmsc is
if Unit = No_Name then if Unit = No_Name then
Err_Vars.Error_Msg_Name_1 := Element.Index; Err_Vars.Error_Msg_Name_1 := Element.Index;
Error_Msg Error_Msg
(Project, (Data.Flags,
"%% is not a valid unit name.", "%% is not a valid unit name.",
Element.Value.Location, Data); Element.Value.Location, Project);
end if; end if;
end if; end if;
...@@ -3070,11 +3067,11 @@ package body Prj.Nmsc is ...@@ -3070,11 +3067,11 @@ package body Prj.Nmsc is
Lang_Id.Config.Naming_Data.Body_Suffix Lang_Id.Config.Naming_Data.Body_Suffix
then then
Error_Msg Error_Msg
(Project, (Data.Flags,
"Body_Suffix (""" "Body_Suffix ("""
& Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix) & Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix)
& """) cannot be the same as Spec_Suffix.", & """) cannot be the same as Spec_Suffix.",
Ada_Body_Suffix_Loc, Data); Ada_Body_Suffix_Loc, Project);
end if; end if;
if Lang_Id.Config.Naming_Data.Body_Suffix /= if Lang_Id.Config.Naming_Data.Body_Suffix /=
...@@ -3083,12 +3080,12 @@ package body Prj.Nmsc is ...@@ -3083,12 +3080,12 @@ package body Prj.Nmsc is
Lang_Id.Config.Naming_Data.Separate_Suffix Lang_Id.Config.Naming_Data.Separate_Suffix
then then
Error_Msg Error_Msg
(Project, (Data.Flags,
"Separate_Suffix (""" "Separate_Suffix ("""
& Get_Name_String & Get_Name_String
(Lang_Id.Config.Naming_Data.Separate_Suffix) (Lang_Id.Config.Naming_Data.Separate_Suffix)
& """) cannot be the same as Spec_Suffix.", & """) cannot be the same as Spec_Suffix.",
Sep_Suffix_Loc, Data); Sep_Suffix_Loc, Project);
end if; end if;
Lang_Id := Lang_Id.Next; Lang_Id := Lang_Id.Next;
...@@ -3318,11 +3315,11 @@ package body Prj.Nmsc is ...@@ -3318,11 +3315,11 @@ package body Prj.Nmsc is
if Extends then if Extends then
if Project.Library_Kind /= Static then if Project.Library_Kind /= Static then
Error_Msg Error_Msg
(Project, (Data.Flags,
Continuation.all & Continuation.all &
"shared library project %% cannot extend " & "shared library project %% cannot extend " &
"project %% that is not a library project", "project %% that is not a library project",
Project.Location, Data); Project.Location, Project);
Continuation := Continuation_String'Access; Continuation := Continuation_String'Access;
end if; end if;
...@@ -3330,11 +3327,11 @@ package body Prj.Nmsc is ...@@ -3330,11 +3327,11 @@ package body Prj.Nmsc is
and then Project.Library_Kind /= Static and then Project.Library_Kind /= Static
then then
Error_Msg Error_Msg
(Project, (Data.Flags,
Continuation.all & Continuation.all &
"shared library project %% cannot import project %% " & "shared library project %% cannot import project %% " &
"that is not a shared library project", "that is not a shared library project",
Project.Location, Data); Project.Location, Project);
Continuation := Continuation_String'Access; Continuation := Continuation_String'Access;
end if; end if;
end if; end if;
...@@ -3347,20 +3344,20 @@ package body Prj.Nmsc is ...@@ -3347,20 +3344,20 @@ package body Prj.Nmsc is
if Extends then if Extends then
Error_Msg Error_Msg
(Project, (Data.Flags,
Continuation.all & Continuation.all &
"shared library project %% cannot extend static " & "shared library project %% cannot extend static " &
"library project %%", "library project %%",
Project.Location, Data); Project.Location, Project);
Continuation := Continuation_String'Access; Continuation := Continuation_String'Access;
elsif not Unchecked_Shared_Lib_Imports then elsif not Unchecked_Shared_Lib_Imports then
Error_Msg Error_Msg
(Project, (Data.Flags,
Continuation.all & Continuation.all &
"shared library project %% cannot import static " & "shared library project %% cannot import static " &
"library project %%", "library project %%",
Project.Location, Data); Project.Location, Project);
Continuation := Continuation_String'Access; Continuation := Continuation_String'Access;
end if; end if;
...@@ -3386,9 +3383,9 @@ package body Prj.Nmsc is ...@@ -3386,9 +3383,9 @@ package body Prj.Nmsc is
if Project.Extends.Library then if Project.Extends.Library then
if Project.Qualifier = Standard then if Project.Qualifier = Standard then
Error_Msg Error_Msg
(Project, (Data.Flags,
"a standard project cannot extend a library project", "a standard project cannot extend a library project",
Project.Location, Data); Project.Location, Project);
else else
if Lib_Name.Default then if Lib_Name.Default then
...@@ -3398,10 +3395,10 @@ package body Prj.Nmsc is ...@@ -3398,10 +3395,10 @@ package body Prj.Nmsc is
if Lib_Dir.Default then if Lib_Dir.Default then
if not Project.Virtual then if not Project.Virtual then
Error_Msg Error_Msg
(Project, (Data.Flags,
"a project extending a library project must " & "a project extending a library project must " &
"specify an attribute Library_Dir", "specify an attribute Library_Dir",
Project.Location, Data); Project.Location, Project);
else else
-- For a virtual project extending a library project, -- For a virtual project extending a library project,
...@@ -3473,19 +3470,19 @@ package body Prj.Nmsc is ...@@ -3473,19 +3470,19 @@ package body Prj.Nmsc is
Err_Vars.Error_Msg_File_1 := Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Project.Library_Dir.Display_Name); File_Name_Type (Project.Library_Dir.Display_Name);
Error_Msg Error_Msg
(Project, (Data.Flags,
"library directory { does not exist", "library directory { does not exist",
Lib_Dir.Location, Data); Lib_Dir.Location, Project);
-- The library directory cannot be the same as the Object -- The library directory cannot be the same as the Object
-- directory. -- directory.
elsif Project.Library_Dir.Name = Project.Object_Directory.Name then elsif Project.Library_Dir.Name = Project.Object_Directory.Name then
Error_Msg Error_Msg
(Project, (Data.Flags,
"library directory cannot be the same " & "library directory cannot be the same " &
"as object directory", "as object directory",
Lib_Dir.Location, Data); Lib_Dir.Location, Project);
Project.Library_Dir := No_Path_Information; Project.Library_Dir := No_Path_Information;
else else
...@@ -3510,10 +3507,10 @@ package body Prj.Nmsc is ...@@ -3510,10 +3507,10 @@ package body Prj.Nmsc is
Err_Vars.Error_Msg_File_1 := Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Dir_Elem.Value); File_Name_Type (Dir_Elem.Value);
Error_Msg Error_Msg
(Project, (Data.Flags,
"library directory cannot be the same " & "library directory cannot be the same " &
"as source directory {", "as source directory {",
Lib_Dir.Location, Data); Lib_Dir.Location, Project);
OK := False; OK := False;
exit; exit;
end if; end if;
...@@ -3544,10 +3541,10 @@ package body Prj.Nmsc is ...@@ -3544,10 +3541,10 @@ package body Prj.Nmsc is
Err_Vars.Error_Msg_Name_1 := Pid.Project.Name; Err_Vars.Error_Msg_Name_1 := Pid.Project.Name;
Error_Msg Error_Msg
(Project, (Data.Flags,
"library directory cannot be the same " & "library directory cannot be the same " &
"as source directory { of project %%", "as source directory { of project %%",
Lib_Dir.Location, Data); Lib_Dir.Location, Project);
OK := False; OK := False;
exit Project_Loop; exit Project_Loop;
end if; end if;
...@@ -3584,25 +3581,25 @@ package body Prj.Nmsc is ...@@ -3584,25 +3581,25 @@ package body Prj.Nmsc is
when Standard => when Standard =>
if Project.Library then if Project.Library then
Error_Msg Error_Msg
(Project, (Data.Flags,
"a standard project cannot be a library project", "a standard project cannot be a library project",
Lib_Name.Location, Data); Lib_Name.Location, Project);
end if; end if;
when Library => when Library =>
if not Project.Library then if not Project.Library then
if Project.Library_Dir = No_Path_Information then if Project.Library_Dir = No_Path_Information then
Error_Msg Error_Msg
(Project, (Data.Flags,
"\attribute Library_Dir not declared", "\attribute Library_Dir not declared",
Project.Location, Data); Project.Location, Project);
end if; end if;
if Project.Library_Name = No_Name then if Project.Library_Name = No_Name then
Error_Msg Error_Msg
(Project, (Data.Flags,
"\attribute Library_Name not declared", "\attribute Library_Name not declared",
Project.Location, Data); Project.Location, Project);
end if; end if;
end if; end if;
...@@ -3617,9 +3614,9 @@ package body Prj.Nmsc is ...@@ -3617,9 +3614,9 @@ package body Prj.Nmsc is
if Support_For_Libraries = Prj.None then if Support_For_Libraries = Prj.None then
Error_Msg Error_Msg
(Project, (Data.Flags,
"?libraries are not supported on this platform", "?libraries are not supported on this platform",
Lib_Name.Location, Data); Lib_Name.Location, Project);
Project.Library := False; Project.Library := False;
else else
...@@ -3652,9 +3649,9 @@ package body Prj.Nmsc is ...@@ -3652,9 +3649,9 @@ package body Prj.Nmsc is
Err_Vars.Error_Msg_File_1 := Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Project.Library_ALI_Dir.Display_Name); File_Name_Type (Project.Library_ALI_Dir.Display_Name);
Error_Msg Error_Msg
(Project, (Data.Flags,
"library 'A'L'I directory { does not exist", "library 'A'L'I directory { does not exist",
Lib_ALI_Dir.Location, Data); Lib_ALI_Dir.Location, Project);
end if; end if;
if Project.Library_ALI_Dir /= Project.Library_Dir then if Project.Library_ALI_Dir /= Project.Library_Dir then
...@@ -3664,10 +3661,10 @@ package body Prj.Nmsc is ...@@ -3664,10 +3661,10 @@ package body Prj.Nmsc is
if Project.Library_ALI_Dir = Project.Object_Directory then if Project.Library_ALI_Dir = Project.Object_Directory then
Error_Msg Error_Msg
(Project, (Data.Flags,
"library 'A'L'I directory cannot be the same " & "library 'A'L'I directory cannot be the same " &
"as object directory", "as object directory",
Lib_ALI_Dir.Location, Data); Lib_ALI_Dir.Location, Project);
Project.Library_ALI_Dir := No_Path_Information; Project.Library_ALI_Dir := No_Path_Information;
else else
...@@ -3693,10 +3690,10 @@ package body Prj.Nmsc is ...@@ -3693,10 +3690,10 @@ package body Prj.Nmsc is
Err_Vars.Error_Msg_File_1 := Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Dir_Elem.Value); File_Name_Type (Dir_Elem.Value);
Error_Msg Error_Msg
(Project, (Data.Flags,
"library 'A'L'I directory cannot be " & "library 'A'L'I directory cannot be " &
"the same as source directory {", "the same as source directory {",
Lib_ALI_Dir.Location, Data); Lib_ALI_Dir.Location, Project);
OK := False; OK := False;
exit; exit;
end if; end if;
...@@ -3730,11 +3727,11 @@ package body Prj.Nmsc is ...@@ -3730,11 +3727,11 @@ package body Prj.Nmsc is
Pid.Project.Name; Pid.Project.Name;
Error_Msg Error_Msg
(Project, (Data.Flags,
"library 'A'L'I directory cannot " & "library 'A'L'I directory cannot " &
"be the same as source directory " & "be the same as source directory " &
"{ of project %%", "{ of project %%",
Lib_ALI_Dir.Location, Data); Lib_ALI_Dir.Location, Project);
OK := False; OK := False;
exit ALI_Project_Loop; exit ALI_Project_Loop;
end if; end if;
...@@ -3800,9 +3797,9 @@ package body Prj.Nmsc is ...@@ -3800,9 +3797,9 @@ package body Prj.Nmsc is
else else
Error_Msg Error_Msg
(Project, (Data.Flags,
"illegal value for Library_Kind", "illegal value for Library_Kind",
The_Lib_Kind.Location, Data); The_Lib_Kind.Location, Project);
OK := False; OK := False;
end if; end if;
...@@ -3813,10 +3810,10 @@ package body Prj.Nmsc is ...@@ -3813,10 +3810,10 @@ package body Prj.Nmsc is
if Project.Library_Kind /= Static then if Project.Library_Kind /= Static then
if Support_For_Libraries = Prj.Static_Only then if Support_For_Libraries = Prj.Static_Only then
Error_Msg Error_Msg
(Project, (Data.Flags,
"only static libraries are supported " & "only static libraries are supported " &
"on this platform", "on this platform",
The_Lib_Kind.Location, Data); The_Lib_Kind.Location, Project);
Project.Library := False; Project.Library := False;
else else
...@@ -3825,10 +3822,10 @@ package body Prj.Nmsc is ...@@ -3825,10 +3822,10 @@ package body Prj.Nmsc is
if Lib_GCC.Value /= Empty_String then if Lib_GCC.Value /= Empty_String then
Error_Msg Error_Msg
(Project, (Data.Flags,
"?Library_'G'C'C is an obsolescent attribute, " & "?Library_'G'C'C is an obsolescent attribute, " &
"use Linker''Driver instead", "use Linker''Driver instead",
Lib_GCC.Location, Data); Lib_GCC.Location, Project);
Project.Config.Shared_Lib_Driver := Project.Config.Shared_Lib_Driver :=
File_Name_Type (Lib_GCC.Value); File_Name_Type (Lib_GCC.Value);
...@@ -3913,10 +3910,10 @@ package body Prj.Nmsc is ...@@ -3913,10 +3910,10 @@ package body Prj.Nmsc is
if Switches /= No_Array_Element then if Switches /= No_Array_Element then
Error_Msg Error_Msg
(Project, (Data.Flags,
"?Linker switches not taken into account in library " & "?Linker switches not taken into account in library " &
"projects", "projects",
No_Location, Data); No_Location, Project);
end if; end if;
end if; end if;
end; end;
...@@ -3994,9 +3991,9 @@ package body Prj.Nmsc is ...@@ -3994,9 +3991,9 @@ package body Prj.Nmsc is
if Def_Lang.Default then if Def_Lang.Default then
Error_Msg Error_Msg
(Project, (Data.Flags,
"no languages defined for this project", "no languages defined for this project",
Project.Location, Data); Project.Location, Project);
Def_Lang_Id := No_Name; Def_Lang_Id := No_Name;
else else
...@@ -4026,9 +4023,9 @@ package body Prj.Nmsc is ...@@ -4026,9 +4023,9 @@ package body Prj.Nmsc is
if Project.Qualifier = Standard then if Project.Qualifier = Standard then
Error_Msg Error_Msg
(Project, (Data.Flags,
"a standard project must have at least one language", "a standard project must have at least one language",
Languages.Location, Data); Languages.Location, Project);
end if; end if;
else else
...@@ -4123,9 +4120,9 @@ package body Prj.Nmsc is ...@@ -4123,9 +4120,9 @@ package body Prj.Nmsc is
if Interfaces = Nil_String then if Interfaces = Nil_String then
Error_Msg Error_Msg
(Project, (Data.Flags,
"Library_Interface cannot be an empty list", "Library_Interface cannot be an empty list",
Lib_Interfaces.Location, Data); Lib_Interfaces.Location, Project);
end if; end if;
-- Process each unit name specified in the attribute -- Process each unit name specified in the attribute
...@@ -4138,10 +4135,10 @@ package body Prj.Nmsc is ...@@ -4138,10 +4135,10 @@ package body Prj.Nmsc is
if Name_Len = 0 then if Name_Len = 0 then
Error_Msg Error_Msg
(Project, (Data.Flags,
"an interface cannot be an empty string", "an interface cannot be an empty string",
Data.Tree.String_Elements.Table (Interfaces).Location, Data.Tree.String_Elements.Table (Interfaces).Location,
Data); Project);
else else
Unit := Name_Find; Unit := Name_Find;
...@@ -4187,10 +4184,10 @@ package body Prj.Nmsc is ...@@ -4187,10 +4184,10 @@ package body Prj.Nmsc is
if Source = No_Source then if Source = No_Source then
Error_Msg Error_Msg
(Project, (Data.Flags,
"%% is not a unit of this project", "%% is not a unit of this project",
Data.Tree.String_Elements.Table Data.Tree.String_Elements.Table
(Interfaces).Location, Data); (Interfaces).Location, Project);
else else
if Source.Kind = Spec if Source.Kind = Spec
...@@ -4253,17 +4250,17 @@ package body Prj.Nmsc is ...@@ -4253,17 +4250,17 @@ package body Prj.Nmsc is
-- supported. -- supported.
Error_Msg Error_Msg
(Project, (Data.Flags,
"library auto init not supported " & "library auto init not supported " &
"on this platform", "on this platform",
Lib_Auto_Init.Location, Data); Lib_Auto_Init.Location, Project);
end if; end if;
else else
Error_Msg Error_Msg
(Project, (Data.Flags,
"invalid value for attribute Library_Auto_Init", "invalid value for attribute Library_Auto_Init",
Lib_Auto_Init.Location, Data); Lib_Auto_Init.Location, Project);
end if; end if;
end if; end if;
end; end;
...@@ -4302,18 +4299,18 @@ package body Prj.Nmsc is ...@@ -4302,18 +4299,18 @@ package body Prj.Nmsc is
Err_Vars.Error_Msg_File_1 := Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Project.Library_Src_Dir.Display_Name); File_Name_Type (Project.Library_Src_Dir.Display_Name);
Error_Msg Error_Msg
(Project, (Data.Flags,
"Directory { does not exist", "Directory { does not exist",
Lib_Src_Dir.Location, Data); Lib_Src_Dir.Location, Project);
-- Report error if it is the same as the object directory -- Report error if it is the same as the object directory
elsif Project.Library_Src_Dir = Project.Object_Directory then elsif Project.Library_Src_Dir = Project.Object_Directory then
Error_Msg Error_Msg
(Project, (Data.Flags,
"directory to copy interfaces cannot be " & "directory to copy interfaces cannot be " &
"the object directory", "the object directory",
Lib_Src_Dir.Location, Data); Lib_Src_Dir.Location, Project);
Project.Library_Src_Dir := No_Path_Information; Project.Library_Src_Dir := No_Path_Information;
else else
...@@ -4336,10 +4333,10 @@ package body Prj.Nmsc is ...@@ -4336,10 +4333,10 @@ package body Prj.Nmsc is
Path_Name_Type (Src_Dir.Value) Path_Name_Type (Src_Dir.Value)
then then
Error_Msg Error_Msg
(Project, (Data.Flags,
"directory to copy interfaces cannot " & "directory to copy interfaces cannot " &
"be one of the source directories", "be one of the source directories",
Lib_Src_Dir.Location, Data); Lib_Src_Dir.Location, Project);
Project.Library_Src_Dir := No_Path_Information; Project.Library_Src_Dir := No_Path_Information;
exit; exit;
end if; end if;
...@@ -4371,11 +4368,11 @@ package body Prj.Nmsc is ...@@ -4371,11 +4368,11 @@ package body Prj.Nmsc is
File_Name_Type (Src_Dir.Value); File_Name_Type (Src_Dir.Value);
Error_Msg_Name_1 := Pid.Project.Name; Error_Msg_Name_1 := Pid.Project.Name;
Error_Msg Error_Msg
(Project, (Data.Flags,
"directory to copy interfaces cannot " & "directory to copy interfaces cannot " &
"be the same as source directory { of " & "be the same as source directory { of " &
"project %%", "project %%",
Lib_Src_Dir.Location, Data); Lib_Src_Dir.Location, Project);
Project.Library_Src_Dir := Project.Library_Src_Dir :=
No_Path_Information; No_Path_Information;
exit Project_Loop; exit Project_Loop;
...@@ -4433,9 +4430,9 @@ package body Prj.Nmsc is ...@@ -4433,9 +4430,9 @@ package body Prj.Nmsc is
else else
Error_Msg Error_Msg
(Project, (Data.Flags,
"illegal value for Library_Symbol_Policy", "illegal value for Library_Symbol_Policy",
Lib_Symbol_Policy.Location, Data); Lib_Symbol_Policy.Location, Project);
end if; end if;
end; end;
end if; end if;
...@@ -4446,10 +4443,10 @@ package body Prj.Nmsc is ...@@ -4446,10 +4443,10 @@ package body Prj.Nmsc is
if Lib_Symbol_File.Default then if Lib_Symbol_File.Default then
if Project.Symbol_Data.Symbol_Policy = Restricted then if Project.Symbol_Data.Symbol_Policy = Restricted then
Error_Msg Error_Msg
(Project, (Data.Flags,
"Library_Symbol_File needs to be defined when " & "Library_Symbol_File needs to be defined when " &
"symbol policy is Restricted", "symbol policy is Restricted",
Lib_Symbol_Policy.Location, Data); Lib_Symbol_Policy.Location, Project);
end if; end if;
else else
...@@ -4462,9 +4459,9 @@ package body Prj.Nmsc is ...@@ -4462,9 +4459,9 @@ package body Prj.Nmsc is
if Name_Len = 0 then if Name_Len = 0 then
Error_Msg Error_Msg
(Project, (Data.Flags,
"symbol file name cannot be an empty string", "symbol file name cannot be an empty string",
Lib_Symbol_File.Location, Data); Lib_Symbol_File.Location, Project);
else else
OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)); OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
...@@ -4483,10 +4480,10 @@ package body Prj.Nmsc is ...@@ -4483,10 +4480,10 @@ package body Prj.Nmsc is
if not OK then if not OK then
Error_Msg_File_1 := File_Name_Type (Lib_Symbol_File.Value); Error_Msg_File_1 := File_Name_Type (Lib_Symbol_File.Value);
Error_Msg Error_Msg
(Project, (Data.Flags,
"symbol file name { is illegal. " & "symbol file name { is illegal. " &
"Name cannot include directory info.", "Name cannot include directory info.",
Lib_Symbol_File.Location, Data); Lib_Symbol_File.Location, Project);
end if; end if;
end if; end if;
end if; end if;
...@@ -4499,9 +4496,9 @@ package body Prj.Nmsc is ...@@ -4499,9 +4496,9 @@ package body Prj.Nmsc is
or else Project.Symbol_Data.Symbol_Policy = Controlled or else Project.Symbol_Data.Symbol_Policy = Controlled
then then
Error_Msg Error_Msg
(Project, (Data.Flags,
"a reference symbol file needs to be defined", "a reference symbol file needs to be defined",
Lib_Symbol_Policy.Location, Data); Lib_Symbol_Policy.Location, Project);
end if; end if;
else else
...@@ -4514,9 +4511,9 @@ package body Prj.Nmsc is ...@@ -4514,9 +4511,9 @@ package body Prj.Nmsc is
if Name_Len = 0 then if Name_Len = 0 then
Error_Msg Error_Msg
(Project, (Data.Flags,
"reference symbol file name cannot be an empty string", "reference symbol file name cannot be an empty string",
Lib_Symbol_File.Location, Data); Lib_Symbol_File.Location, Project);
else else
if not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)) then if not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)) then
...@@ -4543,9 +4540,9 @@ package body Prj.Nmsc is ...@@ -4543,9 +4540,9 @@ package body Prj.Nmsc is
and then Project.Symbol_Data.Symbol_Policy /= Direct; and then Project.Symbol_Data.Symbol_Policy /= Direct;
Error_Msg Error_Msg
(Project, (Data.Flags,
"<library reference symbol file { does not exist", "<library reference symbol file { does not exist",
Lib_Ref_Symbol_File.Location, Data); Lib_Ref_Symbol_File.Location, Project);
-- In addition in the non-controlled case, if symbol policy -- In addition in the non-controlled case, if symbol policy
-- is Compliant, it is changed to Autonomous, because there -- is Compliant, it is changed to Autonomous, because there
...@@ -4589,10 +4586,10 @@ package body Prj.Nmsc is ...@@ -4589,10 +4586,10 @@ package body Prj.Nmsc is
begin begin
if Symb_Path = Ref_Path then if Symb_Path = Ref_Path then
Error_Msg Error_Msg
(Project, (Data.Flags,
"library reference symbol file and library" & "library reference symbol file and library" &
" symbol file cannot be the same file", " symbol file cannot be the same file",
Lib_Ref_Symbol_File.Location, Data); Lib_Ref_Symbol_File.Location, Project);
end if; end if;
end; end;
end if; end if;
...@@ -4619,171 +4616,6 @@ package body Prj.Nmsc is ...@@ -4619,171 +4616,6 @@ package body Prj.Nmsc is
end if; end if;
end Compute_Directory_Last; end Compute_Directory_Last;
---------------
-- Error_Msg --
---------------
procedure Error_Msg
(Project : Project_Id;
Msg : String;
Flag_Location : Source_Ptr;
Data : Tree_Processing_Data)
is
Real_Location : Source_Ptr := Flag_Location;
Error_Buffer : String (1 .. 5_000);
Error_Last : Natural := 0;
Name_Number : Natural := 0;
File_Number : Natural := 0;
First : Positive := Msg'First;
Index : Positive;
procedure Add (C : Character);
-- Add a character to the buffer
procedure Add (S : String);
-- Add a string to the buffer
procedure Add_Name;
-- Add a name to the buffer
procedure Add_File;
-- Add a file name to the buffer
---------
-- Add --
---------
procedure Add (C : Character) is
begin
Error_Last := Error_Last + 1;
Error_Buffer (Error_Last) := C;
end Add;
procedure Add (S : String) is
begin
Error_Buffer (Error_Last + 1 .. Error_Last + S'Length) := S;
Error_Last := Error_Last + S'Length;
end Add;
--------------
-- Add_File --
--------------
procedure Add_File is
File : File_Name_Type;
begin
Add ('"');
File_Number := File_Number + 1;
case File_Number is
when 1 =>
File := Err_Vars.Error_Msg_File_1;
when 2 =>
File := Err_Vars.Error_Msg_File_2;
when 3 =>
File := Err_Vars.Error_Msg_File_3;
when others =>
null;
end case;
Get_Name_String (File);
Add (Name_Buffer (1 .. Name_Len));
Add ('"');
end Add_File;
--------------
-- Add_Name --
--------------
procedure Add_Name is
Name : Name_Id;
begin
Add ('"');
Name_Number := Name_Number + 1;
case Name_Number is
when 1 =>
Name := Err_Vars.Error_Msg_Name_1;
when 2 =>
Name := Err_Vars.Error_Msg_Name_2;
when 3 =>
Name := Err_Vars.Error_Msg_Name_3;
when others =>
null;
end case;
Get_Name_String (Name);
Add (Name_Buffer (1 .. Name_Len));
Add ('"');
end Add_Name;
-- 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
Real_Location := Project.Location;
end if;
if Data.Flags.Report_Error = null then
Prj.Err.Error_Msg (Msg, Real_Location);
return;
end if;
-- Ignore continuation character
if Msg (First) = '\' then
First := First + 1;
end if;
if Msg (First) = '?' then
First := First + 1;
Add ("Warning: ");
elsif Msg (First) = '<' then
First := First + 1;
if Err_Vars.Error_Msg_Warn then
Add ("Warning: ");
end if;
end if;
Index := First;
while Index <= Msg'Last loop
if Msg (Index) = '{' then
Add_File;
elsif Msg (Index) = '%' then
if Index < Msg'Last and then Msg (Index + 1) = '%' then
Index := Index + 1;
end if;
Add_Name;
else
Add (Msg (Index));
end if;
Index := Index + 1;
end loop;
Data.Flags.Report_Error
(Error_Buffer (1 .. Error_Last), Project, Data.Tree);
end Error_Msg;
--------------------- ---------------------
-- Get_Directories -- -- Get_Directories --
--------------------- ---------------------
...@@ -5078,14 +4910,14 @@ package body Prj.Nmsc is ...@@ -5078,14 +4910,14 @@ package body Prj.Nmsc is
if Location = No_Location then if Location = No_Location then
Error_Msg Error_Msg
(Project, (Data.Flags,
"{ is not a valid directory.", "{ is not a valid directory.",
Project.Location, Data); Project.Location, Project);
else else
Error_Msg Error_Msg
(Project, (Data.Flags,
"{ is not a valid directory.", "{ is not a valid directory.",
Location, Data); Location, Project);
end if; end if;
else else
...@@ -5129,14 +4961,14 @@ package body Prj.Nmsc is ...@@ -5129,14 +4961,14 @@ package body Prj.Nmsc is
if Location = No_Location then if Location = No_Location then
Error_Msg Error_Msg
(Project, (Data.Flags,
"{ is not a valid directory", "{ is not a valid directory",
Project.Location, Data); Project.Location, Project);
else else
Error_Msg Error_Msg
(Project, (Data.Flags,
"{ is not a valid directory", "{ is not a valid directory",
Location, Data); Location, Project);
end if; end if;
else else
...@@ -5271,9 +5103,9 @@ package body Prj.Nmsc is ...@@ -5271,9 +5103,9 @@ package body Prj.Nmsc is
if Name_Len = 0 then if Name_Len = 0 then
Error_Msg Error_Msg
(Project, (Data.Flags,
"Object_Dir cannot be empty", "Object_Dir cannot be empty",
Object_Dir.Location, Data); Object_Dir.Location, Project);
else else
-- We check that the specified object directory does exist. -- We check that the specified object directory does exist.
...@@ -5302,9 +5134,9 @@ package body Prj.Nmsc is ...@@ -5302,9 +5134,9 @@ package body Prj.Nmsc is
Err_Vars.Error_Msg_File_1 := Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Object_Dir.Value); File_Name_Type (Object_Dir.Value);
Error_Msg Error_Msg
(Project, (Data.Flags,
"object directory { not found", "object directory { not found",
Project.Location, Data); Project.Location, Project);
end if; end if;
end if; end if;
...@@ -5345,9 +5177,9 @@ package body Prj.Nmsc is ...@@ -5345,9 +5177,9 @@ package body Prj.Nmsc is
if Name_Len = 0 then if Name_Len = 0 then
Error_Msg Error_Msg
(Project, (Data.Flags,
"Exec_Dir cannot be empty", "Exec_Dir cannot be empty",
Exec_Dir.Location, Data); Exec_Dir.Location, Project);
else else
-- We check that the specified exec directory does exist -- We check that the specified exec directory does exist
...@@ -5365,9 +5197,9 @@ package body Prj.Nmsc is ...@@ -5365,9 +5197,9 @@ package body Prj.Nmsc is
if not Dir_Exists then if not Dir_Exists then
Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value); Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
Error_Msg Error_Msg
(Project, (Data.Flags,
"exec directory { not found", "exec directory { not found",
Project.Location, Data); Project.Location, Project);
end if; end if;
end if; end if;
end if; end if;
...@@ -5397,9 +5229,9 @@ package body Prj.Nmsc is ...@@ -5397,9 +5229,9 @@ package body Prj.Nmsc is
if Project.Qualifier = Standard then if Project.Qualifier = Standard then
Error_Msg Error_Msg
(Project, (Data.Flags,
"a standard project cannot have no sources", "a standard project cannot have no sources",
Source_Files.Location, Data); Source_Files.Location, Project);
end if; end if;
elsif Source_Dirs.Default then elsif Source_Dirs.Default then
...@@ -5427,9 +5259,9 @@ package body Prj.Nmsc is ...@@ -5427,9 +5259,9 @@ package body Prj.Nmsc is
elsif Source_Dirs.Values = Nil_String then elsif Source_Dirs.Values = Nil_String then
if Project.Qualifier = Standard then if Project.Qualifier = Standard then
Error_Msg Error_Msg
(Project, (Data.Flags,
"a standard project cannot have no source directories", "a standard project cannot have no source directories",
Source_Dirs.Location, Data); Source_Dirs.Location, Project);
end if; end if;
Project.Source_Dirs := Nil_String; Project.Source_Dirs := Nil_String;
...@@ -5525,9 +5357,9 @@ package body Prj.Nmsc is ...@@ -5525,9 +5357,9 @@ package body Prj.Nmsc is
elsif Project.Library then elsif Project.Library then
Error_Msg Error_Msg
(Project, (Data.Flags,
"a library project file cannot have Main specified", "a library project file cannot have Main specified",
Mains.Location, Data); Mains.Location, Project);
else else
List := Mains.Values; List := Mains.Values;
...@@ -5536,9 +5368,9 @@ package body Prj.Nmsc is ...@@ -5536,9 +5368,9 @@ package body Prj.Nmsc is
if Length_Of_Name (Elem.Value) = 0 then if Length_Of_Name (Elem.Value) = 0 then
Error_Msg Error_Msg
(Project, (Data.Flags,
"?a main cannot have an empty name", "?a main cannot have an empty name",
Elem.Location, Data); Elem.Location, Project);
exit; exit;
end if; end if;
...@@ -5575,7 +5407,8 @@ package body Prj.Nmsc is ...@@ -5575,7 +5407,8 @@ package body Prj.Nmsc is
Prj.Util.Open (File, Path); Prj.Util.Open (File, Path);
if not Prj.Util.Is_Valid (File) then if not Prj.Util.Is_Valid (File) then
Error_Msg (Project.Project, "file does not exist", Location, Data); Error_Msg
(Data.Flags, "file does not exist", Location, Project.Project);
else else
-- Read the lines one by one -- Read the lines one by one
...@@ -5599,9 +5432,9 @@ package body Prj.Nmsc is ...@@ -5599,9 +5432,9 @@ package body Prj.Nmsc is
if Line (J) = '/' or else Line (J) = Directory_Separator then if Line (J) = '/' or else Line (J) = Directory_Separator then
Error_Msg_File_1 := Source_Name; Error_Msg_File_1 := Source_Name;
Error_Msg Error_Msg
(Project.Project, (Data.Flags,
"file name cannot include directory information ({)", "file name cannot include directory information ({)",
Location, Data); Location, Project.Project);
exit; exit;
end if; end if;
end loop; end loop;
...@@ -5889,9 +5722,9 @@ package body Prj.Nmsc is ...@@ -5889,9 +5722,9 @@ package body Prj.Nmsc is
elsif Index (Suffix_Str, ".") = 0 then elsif Index (Suffix_Str, ".") = 0 then
Err_Vars.Error_Msg_File_1 := Suffix; Err_Vars.Error_Msg_File_1 := Suffix;
Error_Msg Error_Msg
(Project, (Data.Flags,
"{ is illegal for " & Attribute_Name & ": must have a dot", "{ is illegal for " & Attribute_Name & ": must have a dot",
Location, Data); Location, Project);
return; return;
end if; end if;
...@@ -5913,10 +5746,10 @@ package body Prj.Nmsc is ...@@ -5913,10 +5746,10 @@ package body Prj.Nmsc is
if Is_Letter (Suffix_Str (Suffix_Str'First + 1)) then if Is_Letter (Suffix_Str (Suffix_Str'First + 1)) then
Err_Vars.Error_Msg_File_1 := Suffix; Err_Vars.Error_Msg_File_1 := Suffix;
Error_Msg Error_Msg
(Project, (Data.Flags,
"{ is illegal for " & Attribute_Name "{ is illegal for " & Attribute_Name
& ": ambiguous prefix when Dot_Replacement is a dot", & ": ambiguous prefix when Dot_Replacement is a dot",
Location, Data); Location, Project);
end if; end if;
return; return;
end if; end if;
...@@ -6035,10 +5868,10 @@ package body Prj.Nmsc is ...@@ -6035,10 +5868,10 @@ package body Prj.Nmsc is
exception exception
when Use_Error => when Use_Error =>
Error_Msg Error_Msg
(Project, (Data.Flags,
"could not create " & Create & "could not create " & Create &
" directory " & Full_Path_Name.all, " directory " & Full_Path_Name.all,
Location, Data); Location, Project);
end; end;
end if; end if;
end if; end if;
...@@ -6137,16 +5970,16 @@ package body Prj.Nmsc is ...@@ -6137,16 +5970,16 @@ package body Prj.Nmsc is
if not Excluded_Source_List_File.Default then if not Excluded_Source_List_File.Default then
if Locally_Removed then if Locally_Removed then
Error_Msg Error_Msg
(Project.Project, (Data.Flags,
"?both attributes Locally_Removed_Files and " & "?both attributes Locally_Removed_Files and " &
"Excluded_Source_List_File are present", "Excluded_Source_List_File are present",
Excluded_Source_List_File.Location, Data); Excluded_Source_List_File.Location, Project.Project);
else else
Error_Msg Error_Msg
(Project.Project, (Data.Flags,
"?both attributes Excluded_Source_Files and " & "?both attributes Excluded_Source_Files and " &
"Excluded_Source_List_File are present", "Excluded_Source_List_File are present",
Excluded_Source_List_File.Location, Data); Excluded_Source_List_File.Location, Project.Project);
end if; end if;
end if; end if;
...@@ -6184,9 +6017,9 @@ package body Prj.Nmsc is ...@@ -6184,9 +6017,9 @@ package body Prj.Nmsc is
Err_Vars.Error_Msg_File_1 := Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Excluded_Source_List_File.Value); File_Name_Type (Excluded_Source_List_File.Value);
Error_Msg Error_Msg
(Project.Project, (Data.Flags,
"file with excluded sources { does not exist", "file with excluded sources { does not exist",
Excluded_Source_List_File.Location, Data); Excluded_Source_List_File.Location, Project.Project);
else else
-- Open the file -- Open the file
...@@ -6195,7 +6028,8 @@ package body Prj.Nmsc is ...@@ -6195,7 +6028,8 @@ package body Prj.Nmsc is
if not Prj.Util.Is_Valid (File) then if not Prj.Util.Is_Valid (File) then
Error_Msg Error_Msg
(Project.Project, "file does not exist", Location, Data); (Data.Flags, "file does not exist",
Location, Project.Project);
else else
-- Read the lines one by one -- Read the lines one by one
...@@ -6220,10 +6054,10 @@ package body Prj.Nmsc is ...@@ -6220,10 +6054,10 @@ package body Prj.Nmsc is
then then
Error_Msg_File_1 := Name; Error_Msg_File_1 := Name;
Error_Msg Error_Msg
(Project.Project, (Data.Flags,
"file name cannot include " & "file name cannot include " &
"directory information ({)", "directory information ({)",
Location, Data); Location, Project.Project);
exit; exit;
end if; end if;
end loop; end loop;
...@@ -6276,10 +6110,10 @@ package body Prj.Nmsc is ...@@ -6276,10 +6110,10 @@ package body Prj.Nmsc is
if not Sources.Default then if not Sources.Default then
if not Source_List_File.Default then if not Source_List_File.Default then
Error_Msg Error_Msg
(Project.Project, (Data.Flags,
"?both attributes source_files and " & "?both attributes source_files and " &
"source_list_file are present", "source_list_file are present",
Source_List_File.Location, Data); Source_List_File.Location, Project.Project);
end if; end if;
-- Sources is a list of file names -- Sources is a list of file names
...@@ -6328,10 +6162,10 @@ package body Prj.Nmsc is ...@@ -6328,10 +6162,10 @@ package body Prj.Nmsc is
then then
Error_Msg_File_1 := Name; Error_Msg_File_1 := Name;
Error_Msg Error_Msg
(Project.Project, (Data.Flags,
"file name cannot include directory " & "file name cannot include directory " &
"information ({)", "information ({)",
Location, Data); Location, Project.Project);
exit; exit;
end if; end if;
end loop; end loop;
...@@ -6380,9 +6214,9 @@ package body Prj.Nmsc is ...@@ -6380,9 +6214,9 @@ package body Prj.Nmsc is
Err_Vars.Error_Msg_File_1 := Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Source_List_File.Value); File_Name_Type (Source_List_File.Value);
Error_Msg Error_Msg
(Project.Project, (Data.Flags,
"file with sources { does not exist", "file with sources { does not exist",
Source_List_File.Location, Data); Source_List_File.Location, Project.Project);
else else
Get_Sources_From_File Get_Sources_From_File
...@@ -6433,10 +6267,9 @@ package body Prj.Nmsc is ...@@ -6433,10 +6267,9 @@ package body Prj.Nmsc is
Error_Msg_Name_1 := Name_Id (Source.Display_File); Error_Msg_Name_1 := Name_Id (Source.Display_File);
Error_Msg_Name_2 := Name_Id (Source.Unit.Name); Error_Msg_Name_2 := Name_Id (Source.Unit.Name);
Error_Msg Error_Msg
(Project.Project, (Data.Flags,
"source file %% for unit %% not found", "source file %% for unit %% not found",
No_Location, No_Location, Project.Project);
Data);
else else
Source.Path := Files_Htable.Get Source.Path := Files_Htable.Get
...@@ -6480,16 +6313,16 @@ package body Prj.Nmsc is ...@@ -6480,16 +6313,16 @@ package body Prj.Nmsc is
if First_Error then if First_Error then
Error_Msg Error_Msg
(Project.Project, (Data.Flags,
"source file { not found", "source file { not found",
NL.Location, Data); NL.Location, Project.Project);
First_Error := False; First_Error := False;
else else
Error_Msg Error_Msg
(Project.Project, (Data.Flags,
"\source file { not found", "\source file { not found",
NL.Location, Data); NL.Location, Project.Project);
end if; end if;
end if; end if;
...@@ -6751,9 +6584,9 @@ package body Prj.Nmsc is ...@@ -6751,9 +6584,9 @@ package body Prj.Nmsc is
if not Project.Project.Known_Order_Of_Source_Dirs then if not Project.Project.Known_Order_Of_Source_Dirs then
Error_Msg_File_1 := File_Name; Error_Msg_File_1 := File_Name;
Error_Msg Error_Msg
(Project.Project, (Data.Flags,
"{ is found in several source directories", "{ is found in several source directories",
Name_Loc.Location, Data); Name_Loc.Location, Project.Project);
end if; end if;
else else
...@@ -6813,9 +6646,9 @@ package body Prj.Nmsc is ...@@ -6813,9 +6646,9 @@ package body Prj.Nmsc is
then then
Error_Msg_File_1 := File_Name; Error_Msg_File_1 := File_Name;
Error_Msg Error_Msg
(Project.Project, (Data.Flags,
"language unknown for {", "language unknown for {",
Name_Loc.Location, Data); Name_Loc.Location, Project.Project);
end if; end if;
else else
...@@ -6829,11 +6662,8 @@ package body Prj.Nmsc is ...@@ -6829,11 +6662,8 @@ package body Prj.Nmsc is
File_Name => File_Name, File_Name => File_Name,
Display_File => Display_File_Name, Display_File => Display_File_Name,
Unit => Unit, Unit => Unit,
Locally_Removed => Locally_Removed,
Path => (Canonical_Path, Path)); Path => (Canonical_Path, Path));
if Source /= No_Source then
Source.Locally_Removed := Locally_Removed;
end if;
end if; end if;
end if; end if;
end Check_File; end Check_File;
...@@ -7014,9 +6844,9 @@ package body Prj.Nmsc is ...@@ -7014,9 +6844,9 @@ package body Prj.Nmsc is
then then
Error_Msg_File_1 := Source.File; Error_Msg_File_1 := Source.File;
Error_Msg Error_Msg
(Project.Project, (Data.Flags,
"{ cannot be both excluded and an exception file name", "{ cannot be both excluded and an exception file name",
No_Location, Data); No_Location, Project.Project);
end if; end if;
if Current_Verbosity = High then if Current_Verbosity = High then
...@@ -7102,9 +6932,9 @@ package body Prj.Nmsc is ...@@ -7102,9 +6932,9 @@ package body Prj.Nmsc is
Error_Msg_File_1 := Src.File; Error_Msg_File_1 := Src.File;
Error_Msg_File_2 := Source.File; Error_Msg_File_2 := Source.File;
Error_Msg Error_Msg
(Project.Project, (Data.Flags,
"{ and { have the same object file name", "{ and { have the same object file name",
No_Location, Data); No_Location, Project.Project);
else else
Object_File_Names_Htable.Set (Object_Files, Src.Object, Src); Object_File_Names_Htable.Set (Object_Files, Src.Object, Src);
...@@ -7180,13 +7010,13 @@ package body Prj.Nmsc is ...@@ -7180,13 +7010,13 @@ package body Prj.Nmsc is
if Src = No_Source then if Src = No_Source then
Error_Msg Error_Msg
(Project.Project, (Data.Flags,
"unknown file {", Excluded.Location, Data); "unknown file {", Excluded.Location, Project.Project);
else else
Error_Msg Error_Msg
(Project.Project, (Data.Flags,
"cannot remove a source from an imported project: {", "cannot remove a source from an imported project: {",
Excluded.Location, Data); Excluded.Location, Project.Project);
end if; end if;
end if; end if;
...@@ -7371,9 +7201,9 @@ package body Prj.Nmsc is ...@@ -7371,9 +7201,9 @@ package body Prj.Nmsc is
Error_Msg_Warn := Data.Flags.When_No_Sources = Warning; Error_Msg_Warn := Data.Flags.When_No_Sources = Warning;
if Continuation then if Continuation then
Error_Msg (Project, "\" & Msg, Location, Data); Error_Msg (Data.Flags, "\" & Msg, Location, Project);
else else
Error_Msg (Project, Msg, Location, Data); Error_Msg (Data.Flags, Msg, Location, Project);
end if; end if;
end; end;
end case; end case;
......
gcc/ada/prj-pars.adb
...@@ -68,6 +68,7 @@ package body Prj.Pars is ...@@ -68,6 +68,7 @@ package body Prj.Pars is
Always_Errout_Finalize => False, Always_Errout_Finalize => False,
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Dir, Current_Directory => Current_Dir,
Flags => Flags,
Is_Config_File => False); Is_Config_File => False);
-- If there were no error, process the tree -- If there were no error, process the tree
......
gcc/ada/prj-part.adb
...@@ -165,7 +165,8 @@ package body Prj.Part is ...@@ -165,7 +165,8 @@ package body Prj.Part is
Packages_To_Check : String_List_Access; Packages_To_Check : String_List_Access;
Depth : Natural; Depth : Natural;
Current_Dir : String; Current_Dir : String;
Is_Config_File : Boolean); Is_Config_File : Boolean;
Flags : Processing_Flags);
-- Parse a project file. This is a recursive procedure: it calls itself for -- Parse a project file. This is a recursive procedure: it calls itself for
-- imported and extended projects. When From_Extended is not None, if the -- imported and extended projects. When From_Extended is not None, if the
-- project has already been parsed and is an extended project A, return the -- project has already been parsed and is an extended project A, return the
...@@ -179,7 +180,8 @@ package body Prj.Part is ...@@ -179,7 +180,8 @@ package body Prj.Part is
procedure Pre_Parse_Context_Clause procedure Pre_Parse_Context_Clause
(In_Tree : Project_Node_Tree_Ref; (In_Tree : Project_Node_Tree_Ref;
Context_Clause : out With_Id; Context_Clause : out With_Id;
Is_Config_File : Boolean); Is_Config_File : Boolean;
Flags : Processing_Flags);
-- Parse the context clause of a project. Store the paths and locations of -- Parse the context clause of a project. Store the paths and locations of
-- the imported projects in table Withs. Does nothing if there is no -- the imported projects in table Withs. Does nothing if there is no
-- context clause (if the current token is not "with" or "limited" followed -- context clause (if the current token is not "with" or "limited" followed
...@@ -198,7 +200,8 @@ package body Prj.Part is ...@@ -198,7 +200,8 @@ package body Prj.Part is
Packages_To_Check : String_List_Access; Packages_To_Check : String_List_Access;
Depth : Natural; Depth : Natural;
Current_Dir : String; Current_Dir : String;
Is_Config_File : Boolean); Is_Config_File : Boolean;
Flags : Processing_Flags);
-- Parse the imported projects that have been stored in table Withs, if -- Parse the imported projects that have been stored in table Withs, if
-- any. From_Extended is used for the call to Parse_Single_Project below. -- any. From_Extended is used for the call to Parse_Single_Project below.
-- When In_Limited is True, the importing path includes at least one -- When In_Limited is True, the importing path includes at least one
...@@ -431,7 +434,8 @@ package body Prj.Part is ...@@ -431,7 +434,8 @@ package body Prj.Part is
Packages_To_Check : String_List_Access := All_Packages; Packages_To_Check : String_List_Access := All_Packages;
Store_Comments : Boolean := False; Store_Comments : Boolean := False;
Current_Directory : String := ""; Current_Directory : String := "";
Is_Config_File : Boolean) Is_Config_File : Boolean;
Flags : Processing_Flags)
is is
Dummy : Boolean; Dummy : Boolean;
pragma Warnings (Off, Dummy); pragma Warnings (Off, Dummy);
...@@ -490,7 +494,8 @@ package body Prj.Part is ...@@ -490,7 +494,8 @@ package body Prj.Part is
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Depth => 0, Depth => 0,
Current_Dir => Current_Directory, Current_Dir => Current_Directory,
Is_Config_File => Is_Config_File); Is_Config_File => Is_Config_File,
Flags => Flags);
-- If Project is an extending-all project, create the eventual -- If Project is an extending-all project, create the eventual
-- virtual extending projects and check that there are no illegally -- virtual extending projects and check that there are no illegally
...@@ -600,7 +605,8 @@ package body Prj.Part is ...@@ -600,7 +605,8 @@ package body Prj.Part is
procedure Pre_Parse_Context_Clause procedure Pre_Parse_Context_Clause
(In_Tree : Project_Node_Tree_Ref; (In_Tree : Project_Node_Tree_Ref;
Context_Clause : out With_Id; Context_Clause : out With_Id;
Is_Config_File : Boolean) Is_Config_File : Boolean;
Flags : Processing_Flags)
is is
Current_With_Clause : With_Id := No_With; Current_With_Clause : With_Id := No_With;
Limited_With : Boolean := False; Limited_With : Boolean := False;
...@@ -623,7 +629,8 @@ package body Prj.Part is ...@@ -623,7 +629,8 @@ package body Prj.Part is
if Is_Config_File then if Is_Config_File then
Error_Msg Error_Msg
("configuration project cannot import " & (Flags,
"configuration project cannot import " &
"other configuration projects", "other configuration projects",
Token_Ptr); Token_Ptr);
end if; end if;
...@@ -680,7 +687,7 @@ package body Prj.Part is ...@@ -680,7 +687,7 @@ package body Prj.Part is
Set_Is_Not_Last_In_List (Current_With_Node, In_Tree); Set_Is_Not_Last_In_List (Current_With_Node, In_Tree);
else else
Error_Msg ("expected comma or semi colon", Token_Ptr); Error_Msg (Flags, "expected comma or semi colon", Token_Ptr);
exit Comma_Loop; exit Comma_Loop;
end if; end if;
...@@ -706,7 +713,8 @@ package body Prj.Part is ...@@ -706,7 +713,8 @@ package body Prj.Part is
Packages_To_Check : String_List_Access; Packages_To_Check : String_List_Access;
Depth : Natural; Depth : Natural;
Current_Dir : String; Current_Dir : String;
Is_Config_File : Boolean) Is_Config_File : Boolean;
Flags : Processing_Flags)
is is
Current_With_Clause : With_Id := Context_Clause; Current_With_Clause : With_Id := Context_Clause;
...@@ -763,7 +771,7 @@ package body Prj.Part is ...@@ -763,7 +771,7 @@ package body Prj.Part is
Error_Msg_File_1 := File_Name_Type (Current_With.Path); Error_Msg_File_1 := File_Name_Type (Current_With.Path);
Error_Msg Error_Msg
("unknown project file: {", Current_With.Location); (Flags, "unknown project file: {", Current_With.Location);
-- If this is not imported by the main project file, display -- If this is not imported by the main project file, display
-- the import path. -- the import path.
...@@ -774,7 +782,7 @@ package body Prj.Part is ...@@ -774,7 +782,7 @@ package body Prj.Part is
File_Name_Type File_Name_Type
(Project_Stack.Table (Index).Path_Name); (Project_Stack.Table (Index).Path_Name);
Error_Msg Error_Msg
("\imported by {", Current_With.Location); (Flags, "\imported by {", Current_With.Location);
end loop; end loop;
end if; end if;
...@@ -846,7 +854,8 @@ package body Prj.Part is ...@@ -846,7 +854,8 @@ package body Prj.Part is
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Depth => Depth, Depth => Depth,
Current_Dir => Current_Dir, Current_Dir => Current_Dir,
Is_Config_File => Is_Config_File); Is_Config_File => Is_Config_File,
Flags => Flags);
else else
Extends_All := Is_Extending_All (Withed_Project, In_Tree); Extends_All := Is_Extending_All (Withed_Project, In_Tree);
...@@ -908,7 +917,8 @@ package body Prj.Part is ...@@ -908,7 +917,8 @@ package body Prj.Part is
Packages_To_Check : String_List_Access; Packages_To_Check : String_List_Access;
Depth : Natural; Depth : Natural;
Current_Dir : String; Current_Dir : String;
Is_Config_File : Boolean) Is_Config_File : Boolean;
Flags : Processing_Flags)
is is
Normed_Path_Name : Path_Name_Type; Normed_Path_Name : Path_Name_Type;
Canonical_Path_Name : Path_Name_Type; Canonical_Path_Name : Path_Name_Type;
...@@ -971,9 +981,9 @@ package body Prj.Part is ...@@ -971,9 +981,9 @@ package body Prj.Part is
if Canonical_Path_Name = if Canonical_Path_Name =
Project_Stack.Table (Index).Canonical_Path_Name Project_Stack.Table (Index).Canonical_Path_Name
then then
Error_Msg ("circular dependency detected", Token_Ptr); Error_Msg (Flags, "circular dependency detected", Token_Ptr);
Error_Msg_Name_1 := Name_Id (Normed_Path_Name); Error_Msg_Name_1 := Name_Id (Normed_Path_Name);
Error_Msg ("\ %% is imported by", Token_Ptr); Error_Msg (Flags, "\ %% is imported by", Token_Ptr);
for Current in reverse 1 .. Project_Stack.Last loop for Current in reverse 1 .. Project_Stack.Last loop
Error_Msg_Name_1 := Error_Msg_Name_1 :=
...@@ -983,10 +993,10 @@ package body Prj.Part is ...@@ -983,10 +993,10 @@ package body Prj.Part is
Canonical_Path_Name Canonical_Path_Name
then then
Error_Msg Error_Msg
("\ %% which itself is imported by", Token_Ptr); (Flags, "\ %% which itself is imported by", Token_Ptr);
else else
Error_Msg ("\ %%", Token_Ptr); Error_Msg (Flags, "\ %%", Token_Ptr);
exit; exit;
end if; end if;
end loop; end loop;
...@@ -1015,12 +1025,14 @@ package body Prj.Part is ...@@ -1015,12 +1025,14 @@ package body Prj.Part is
if A_Project_Name_And_Node.Extended then if A_Project_Name_And_Node.Extended then
if A_Project_Name_And_Node.Proj_Qualifier /= Dry then if A_Project_Name_And_Node.Proj_Qualifier /= Dry then
Error_Msg Error_Msg
("cannot extend the same project file several times", (Flags,
"cannot extend the same project file several times",
Token_Ptr); Token_Ptr);
end if; end if;
else else
Error_Msg Error_Msg
("cannot extend an already imported project file", (Flags,
"cannot extend an already imported project file",
Token_Ptr); Token_Ptr);
end if; end if;
...@@ -1060,7 +1072,8 @@ package body Prj.Part is ...@@ -1060,7 +1072,8 @@ package body Prj.Part is
end; end;
else else
Error_Msg Error_Msg
("cannot import an already extended project file", (Flags,
"cannot import an already extended project file",
Token_Ptr); Token_Ptr);
end if; end if;
end if; end if;
...@@ -1099,7 +1112,8 @@ package body Prj.Part is ...@@ -1099,7 +1112,8 @@ package body Prj.Part is
-- following Ada identifier's syntax). -- following Ada identifier's syntax).
Error_Msg_File_1 := File_Name_Type (Canonical_Path_Name); Error_Msg_File_1 := File_Name_Type (Canonical_Path_Name);
Error_Msg ("?{ is not a valid path name for a project file", Error_Msg (Flags,
"?{ is not a valid path name for a project file",
Token_Ptr); Token_Ptr);
end if; end if;
...@@ -1118,7 +1132,8 @@ package body Prj.Part is ...@@ -1118,7 +1132,8 @@ package body Prj.Part is
Pre_Parse_Context_Clause Pre_Parse_Context_Clause
(In_Tree => In_Tree, (In_Tree => In_Tree,
Is_Config_File => Is_Config_File, Is_Config_File => Is_Config_File,
Context_Clause => First_With); Context_Clause => First_With,
Flags => Flags);
Project := Default_Project_Node Project := Default_Project_Node
(Of_Kind => N_Project, In_Tree => In_Tree); (Of_Kind => N_Project, In_Tree => In_Tree);
...@@ -1157,9 +1172,11 @@ package body Prj.Part is ...@@ -1157,9 +1172,11 @@ package body Prj.Part is
when Snames.Name_Configuration => when Snames.Name_Configuration =>
if not Is_Config_File then if not Is_Config_File then
Error_Msg ("configuration projects cannot belong to a user" & Error_Msg
" project tree", (Flags,
Token_Ptr); "configuration projects cannot belong to a user" &
" project tree",
Token_Ptr);
end if; end if;
Proj_Qualifier := Configuration; Proj_Qualifier := Configuration;
...@@ -1183,7 +1200,8 @@ package body Prj.Part is ...@@ -1183,7 +1200,8 @@ package body Prj.Part is
if Is_Config_File if Is_Config_File
and then Proj_Qualifier /= Configuration and then Proj_Qualifier /= Configuration
then then
Error_Msg ("a configuration project cannot be qualified except " & Error_Msg (Flags,
"a configuration project cannot be qualified except " &
"as configuration project", "as configuration project",
Qualifier_Location); Qualifier_Location);
end if; end if;
...@@ -1242,7 +1260,8 @@ package body Prj.Part is ...@@ -1242,7 +1260,8 @@ package body Prj.Part is
if Is_Config_File then if Is_Config_File then
Error_Msg Error_Msg
("extending configuration project not allowed", Token_Ptr); (Flags,
"extending configuration project not allowed", Token_Ptr);
end if; end if;
-- Make sure that gnatmake will use mapping files -- Make sure that gnatmake will use mapping files
...@@ -1306,9 +1325,11 @@ package body Prj.Part is ...@@ -1306,9 +1325,11 @@ package body Prj.Part is
Extension := new String'(Project_File_Extension); Extension := new String'(Project_File_Extension);
end if; end if;
Error_Msg ("?file name does not match project name, " & Error_Msg
"should be `%%" & Extension.all & "`", (Flags,
Token_Ptr); "?file name does not match project name, should be `%%"
& Extension.all & "`",
Token_Ptr);
end if; end if;
end; end;
...@@ -1339,7 +1360,8 @@ package body Prj.Part is ...@@ -1339,7 +1360,8 @@ package body Prj.Part is
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Depth => Depth + 1, Depth => Depth + 1,
Current_Dir => Current_Dir, Current_Dir => Current_Dir,
Is_Config_File => Is_Config_File); Is_Config_File => Is_Config_File,
Flags => Flags);
Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects); Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
end; end;
...@@ -1368,12 +1390,12 @@ package body Prj.Part is ...@@ -1368,12 +1390,12 @@ package body Prj.Part is
Duplicated := True; Duplicated := True;
Error_Msg_Name_1 := Project_Name; Error_Msg_Name_1 := Project_Name;
Error_Msg Error_Msg
("duplicate project name %%", (Flags, "duplicate project name %%",
Location_Of (Project, In_Tree)); Location_Of (Project, In_Tree));
Error_Msg_Name_1 := Error_Msg_Name_1 :=
Name_Id (Path_Name_Of (Name_And_Node.Node, In_Tree)); Name_Id (Path_Name_Of (Name_And_Node.Node, In_Tree));
Error_Msg Error_Msg
("\already in %%", Location_Of (Project, In_Tree)); (Flags, "\already in %%", Location_Of (Project, In_Tree));
end if; end if;
end; end;
end if; end if;
...@@ -1406,7 +1428,7 @@ package body Prj.Part is ...@@ -1406,7 +1428,7 @@ package body Prj.Part is
Error_Msg_Name_1 := Token_Name; Error_Msg_Name_1 := Token_Name;
Error_Msg ("unknown project file: %%", Token_Ptr); Error_Msg (Flags, "unknown project file: %%", Token_Ptr);
-- If we are not in the main project file, display the -- If we are not in the main project file, display the
-- import path. -- import path.
...@@ -1415,13 +1437,13 @@ package body Prj.Part is ...@@ -1415,13 +1437,13 @@ package body Prj.Part is
Error_Msg_Name_1 := Error_Msg_Name_1 :=
Name_Id Name_Id
(Project_Stack.Table (Project_Stack.Last).Path_Name); (Project_Stack.Table (Project_Stack.Last).Path_Name);
Error_Msg ("\extended by %%", Token_Ptr); Error_Msg (Flags, "\extended by %%", Token_Ptr);
for Index in reverse 1 .. Project_Stack.Last - 1 loop for Index in reverse 1 .. Project_Stack.Last - 1 loop
Error_Msg_Name_1 := Error_Msg_Name_1 :=
Name_Id Name_Id
(Project_Stack.Table (Index).Path_Name); (Project_Stack.Table (Index).Path_Name);
Error_Msg ("\imported by %%", Token_Ptr); Error_Msg (Flags, "\imported by %%", Token_Ptr);
end loop; end loop;
end if; end if;
...@@ -1445,7 +1467,8 @@ package body Prj.Part is ...@@ -1445,7 +1467,8 @@ package body Prj.Part is
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Depth => Depth + 1, Depth => Depth + 1,
Current_Dir => Current_Dir, Current_Dir => Current_Dir,
Is_Config_File => Is_Config_File); Is_Config_File => Is_Config_File,
Flags => Flags);
end; end;
if Present (Extended_Project) then if Present (Extended_Project) then
...@@ -1466,7 +1489,7 @@ package body Prj.Part is ...@@ -1466,7 +1489,7 @@ package body Prj.Part is
Project_Qualifier_Of (Extended_Project, In_Tree) /= Dry Project_Qualifier_Of (Extended_Project, In_Tree) /= Dry
then then
Error_Msg Error_Msg
("an abstract project can only extend " & (Flags, "an abstract project can only extend " &
"another abstract project", "another abstract project",
Qualifier_Location); Qualifier_Location);
end if; end if;
...@@ -1494,7 +1517,7 @@ package body Prj.Part is ...@@ -1494,7 +1517,7 @@ package body Prj.Part is
if Is_Extending_All (With_Clause, In_Tree) then if Is_Extending_All (With_Clause, In_Tree) then
Error_Msg_Name_1 := Name_Of (Imported, In_Tree); Error_Msg_Name_1 := Name_Of (Imported, In_Tree);
Error_Msg ("cannot import extending-all project %%", Error_Msg (Flags, "cannot import extending-all project %%",
Token_Ptr); Token_Ptr);
exit With_Clause_Loop; exit With_Clause_Loop;
end if; end if;
...@@ -1559,7 +1582,8 @@ package body Prj.Part is ...@@ -1559,7 +1582,8 @@ package body Prj.Part is
Error_Msg_Name_1 := Name_Of_Project; Error_Msg_Name_1 := Name_Of_Project;
Error_Msg_Name_2 := Parent_Name; Error_Msg_Name_2 := Parent_Name;
Error_Msg ("project %% does not import or extend project %%", Error_Msg (Flags,
"project %% does not import or extend project %%",
Location_Of (Project, In_Tree)); Location_Of (Project, In_Tree));
end if; end if;
end; end;
...@@ -1582,7 +1606,8 @@ package body Prj.Part is ...@@ -1582,7 +1606,8 @@ package body Prj.Part is
Current_Project => Project, Current_Project => Project,
Extends => Extended_Project, Extends => Extended_Project,
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Is_Config_File => Is_Config_File); Is_Config_File => Is_Config_File,
Flags => Flags);
Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration); Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration);
if Present (Extended_Project) if Present (Extended_Project)
...@@ -1641,7 +1666,7 @@ package body Prj.Part is ...@@ -1641,7 +1666,7 @@ package body Prj.Part is
then then
-- Invalid name: report an error -- Invalid name: report an error
Error_Msg ("expected """ & Error_Msg (Flags, "expected """ &
Get_Name_String (Name_Of (Project, In_Tree)) & """", Get_Name_String (Name_Of (Project, In_Tree)) & """",
Token_Ptr); Token_Ptr);
end if; end if;
...@@ -1658,7 +1683,7 @@ package body Prj.Part is ...@@ -1658,7 +1683,7 @@ package body Prj.Part is
if Token /= Tok_EOF then if Token /= Tok_EOF then
Error_Msg Error_Msg
("unexpected text following end of project", Token_Ptr); (Flags, "unexpected text following end of project", Token_Ptr);
end if; end if;
end if; end if;
...@@ -1704,7 +1729,8 @@ package body Prj.Part is ...@@ -1704,7 +1729,8 @@ package body Prj.Part is
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Depth => Depth + 1, Depth => Depth + 1,
Current_Dir => Current_Dir, Current_Dir => Current_Dir,
Is_Config_File => Is_Config_File); Is_Config_File => Is_Config_File,
Flags => Flags);
Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects); Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
end; end;
......
gcc/ada/prj-part.ads
...@@ -37,7 +37,8 @@ package Prj.Part is ...@@ -37,7 +37,8 @@ package Prj.Part is
Packages_To_Check : String_List_Access := All_Packages; Packages_To_Check : String_List_Access := All_Packages;
Store_Comments : Boolean := False; Store_Comments : Boolean := False;
Current_Directory : String := ""; Current_Directory : String := "";
Is_Config_File : Boolean); Is_Config_File : Boolean;
Flags : Processing_Flags);
-- Parse project file and all its imported project files and create a tree. -- Parse project file and all its imported project files and create a tree.
-- Return the node for the project (or Empty_Node if parsing failed). If -- Return the node for the project (or Empty_Node if parsing failed). If
-- Always_Errout_Finalize is True, Errout.Finalize is called in all cases, -- Always_Errout_Finalize is True, Errout.Finalize is called in all cases,
......
gcc/ada/prj-proc.adb
...@@ -101,7 +101,7 @@ package body Prj.Proc is ...@@ -101,7 +101,7 @@ package body Prj.Proc is
function Expression function Expression
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Report_Error : Put_Line_Access; Flags : Processing_Flags;
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Pkg : Package_Id; Pkg : Package_Id;
...@@ -124,7 +124,7 @@ package body Prj.Proc is ...@@ -124,7 +124,7 @@ package body Prj.Proc is
procedure Process_Declarative_Items procedure Process_Declarative_Items
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Report_Error : Put_Line_Access; Flags : Processing_Flags;
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Pkg : Package_Id; Pkg : Package_Id;
...@@ -488,7 +488,7 @@ package body Prj.Proc is ...@@ -488,7 +488,7 @@ package body Prj.Proc is
function Expression function Expression
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Report_Error : Put_Line_Access; Flags : Processing_Flags;
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Pkg : Package_Id; Pkg : Package_Id;
...@@ -593,7 +593,7 @@ package body Prj.Proc is ...@@ -593,7 +593,7 @@ package body Prj.Proc is
Value := Expression Value := Expression
(Project => Project, (Project => Project,
In_Tree => In_Tree, In_Tree => In_Tree,
Report_Error => Report_Error, Flags => Flags,
From_Project_Node => From_Project_Node, From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Pkg => Pkg, Pkg => Pkg,
...@@ -643,7 +643,7 @@ package body Prj.Proc is ...@@ -643,7 +643,7 @@ package body Prj.Proc is
Expression Expression
(Project => Project, (Project => Project,
In_Tree => In_Tree, In_Tree => In_Tree,
Report_Error => Report_Error, Flags => Flags,
From_Project_Node => From_Project_Node, From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Pkg => Pkg, Pkg => Pkg,
...@@ -1028,7 +1028,7 @@ package body Prj.Proc is ...@@ -1028,7 +1028,7 @@ package body Prj.Proc is
Def_Var := Expression Def_Var := Expression
(Project => Project, (Project => Project,
In_Tree => In_Tree, In_Tree => In_Tree,
Report_Error => Report_Error, Flags => Flags,
From_Project_Node => From_Project_Node, From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Pkg => Pkg, Pkg => Pkg,
...@@ -1046,17 +1046,11 @@ package body Prj.Proc is ...@@ -1046,17 +1046,11 @@ package body Prj.Proc is
if Value = No_Name then if Value = No_Name then
if not Quiet_Output then if not Quiet_Output then
if Report_Error = null then Error_Msg
Error_Msg (Flags, "?undefined external reference",
("?undefined external reference", Location_Of
Location_Of (The_Current_Term, From_Project_Node_Tree),
(The_Current_Term, From_Project_Node_Tree)); Project);
else
Report_Error
("warning: """ & Get_Name_String (Name) &
""" is an undefined external reference",
Project, In_Tree);
end if;
end if; end if;
Value := Empty_String; Value := Empty_String;
...@@ -1255,7 +1249,7 @@ package body Prj.Proc is ...@@ -1255,7 +1249,7 @@ package body Prj.Proc is
procedure Process_Declarative_Items procedure Process_Declarative_Items
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Report_Error : Put_Line_Access; Flags : Processing_Flags;
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Pkg : Package_Id; Pkg : Package_Id;
...@@ -1391,7 +1385,7 @@ package body Prj.Proc is ...@@ -1391,7 +1385,7 @@ package body Prj.Proc is
Process_Declarative_Items Process_Declarative_Items
(Project => Project, (Project => Project,
In_Tree => In_Tree, In_Tree => In_Tree,
Report_Error => Report_Error, Flags => Flags,
From_Project_Node => From_Project_Node, From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Pkg => New_Pkg, Pkg => New_Pkg,
...@@ -1580,16 +1574,11 @@ package body Prj.Proc is ...@@ -1580,16 +1574,11 @@ package body Prj.Proc is
end loop; end loop;
if Orig_Array = No_Array then if Orig_Array = No_Array then
if Report_Error = null then Error_Msg
Error_Msg (Flags,
("associative array value not found", "associative array value not found",
Location_Of Location_Of (Current_Item, From_Project_Node_Tree),
(Current_Item, From_Project_Node_Tree)); Project);
else
Report_Error
("associative array value not found",
Project, In_Tree);
end if;
else else
Orig_Element := Orig_Element :=
...@@ -1692,7 +1681,7 @@ package body Prj.Proc is ...@@ -1692,7 +1681,7 @@ package body Prj.Proc is
Expression Expression
(Project => Project, (Project => Project,
In_Tree => In_Tree, In_Tree => In_Tree,
Report_Error => Report_Error, Flags => Flags,
From_Project_Node => From_Project_Node, From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Pkg => Pkg, Pkg => Pkg,
...@@ -1729,18 +1718,12 @@ package body Prj.Proc is ...@@ -1729,18 +1718,12 @@ package body Prj.Proc is
if New_Value.Value = Empty_String then if New_Value.Value = Empty_String then
Error_Msg_Name_1 := Error_Msg_Name_1 :=
Name_Of (Current_Item, From_Project_Node_Tree); Name_Of (Current_Item, From_Project_Node_Tree);
Error_Msg
if Report_Error = null then (Flags,
Error_Msg "no value defined for %%",
("no value defined for %%", Location_Of
Location_Of (Current_Item, From_Project_Node_Tree),
(Current_Item, From_Project_Node_Tree)); Project);
else
Report_Error
("no value defined for " &
Get_Name_String (Error_Msg_Name_1),
Project, In_Tree);
end if;
else else
declare declare
...@@ -1774,24 +1757,12 @@ package body Prj.Proc is ...@@ -1774,24 +1757,12 @@ package body Prj.Proc is
Error_Msg_Name_2 := Error_Msg_Name_2 :=
Name_Of Name_Of
(Current_Item, From_Project_Node_Tree); (Current_Item, From_Project_Node_Tree);
Error_Msg
if Report_Error = null then (Flags,
Error_Msg "value %% is illegal for typed string %%",
("value %% is illegal " & Location_Of
"for typed string %%", (Current_Item, From_Project_Node_Tree),
Location_Of Project);
(Current_Item,
From_Project_Node_Tree));
else
Report_Error
("value """ &
Get_Name_String (Error_Msg_Name_1) &
""" is illegal for typed string """ &
Get_Name_String (Error_Msg_Name_2) &
"""",
Project, In_Tree);
end if;
end if; end if;
end; end;
end if; end if;
...@@ -2198,7 +2169,7 @@ package body Prj.Proc is ...@@ -2198,7 +2169,7 @@ package body Prj.Proc is
Process_Declarative_Items Process_Declarative_Items
(Project => Project, (Project => Project,
In_Tree => In_Tree, In_Tree => In_Tree,
Report_Error => Report_Error, Flags => Flags,
From_Project_Node => From_Project_Node, From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Pkg => Pkg, Pkg => Pkg,
...@@ -2331,44 +2302,23 @@ package body Prj.Proc is ...@@ -2331,44 +2302,23 @@ package body Prj.Proc is
then then
if Extending2.Virtual then if Extending2.Virtual then
Error_Msg_Name_1 := Prj.Project.Display_Name; Error_Msg_Name_1 := Prj.Project.Display_Name;
Error_Msg
if Flags.Report_Error = null then (Flags,
Error_Msg "project %% cannot be extended by a virtual" &
("project %% cannot be extended by a virtual" & " project with the same object directory",
" project with the same object directory", Prj.Project.Location, Project);
Prj.Project.Location);
else
Flags.Report_Error
("project """ &
Get_Name_String (Error_Msg_Name_1) &
""" cannot be extended by a virtual " &
"project with the same object directory",
Project, In_Tree);
end if;
else else
Error_Msg_Name_1 := Extending2.Display_Name; Error_Msg_Name_1 := Extending2.Display_Name;
Error_Msg_Name_2 := Prj.Project.Display_Name; Error_Msg_Name_2 := Prj.Project.Display_Name;
Error_Msg
if Flags.Report_Error = null then (Flags,
Error_Msg "project %% cannot extend project %%",
("project %% cannot extend project %%", Extending2.Location, Project);
Extending2.Location); Error_Msg
Error_Msg (Flags,
("\they share the same object directory", "\they share the same object directory",
Extending2.Location); Extending2.Location, Project);
else
Flags.Report_Error
("project """ &
Get_Name_String (Error_Msg_Name_1) &
""" cannot extend project """ &
Get_Name_String (Error_Msg_Name_2) & """",
Project, In_Tree);
Flags.Report_Error
("they share the same object directory",
Project, In_Tree);
end if;
end if; end if;
end if; end if;
...@@ -2588,7 +2538,7 @@ package body Prj.Proc is ...@@ -2588,7 +2538,7 @@ package body Prj.Proc is
Process_Declarative_Items Process_Declarative_Items
(Project => Project, (Project => Project,
In_Tree => In_Tree, In_Tree => In_Tree,
Report_Error => Flags.Report_Error, Flags => Flags,
From_Project_Node => From_Project_Node, From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Pkg => No_Package, Pkg => No_Package,
......
gcc/ada/prj-strt.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2008, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -108,7 +108,8 @@ package body Prj.Strt is ...@@ -108,7 +108,8 @@ package body Prj.Strt is
(In_Tree : Project_Node_Tree_Ref; (In_Tree : Project_Node_Tree_Ref;
Current_Project : Project_Node_Id; Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id; Current_Package : Project_Node_Id;
External_Value : out Project_Node_Id); External_Value : out Project_Node_Id;
Flags : Processing_Flags);
-- Parse an external reference. Current token is "external" -- Parse an external reference. Current token is "external"
procedure Attribute_Reference procedure Attribute_Reference
...@@ -116,7 +117,8 @@ package body Prj.Strt is ...@@ -116,7 +117,8 @@ package body Prj.Strt is
Reference : out Project_Node_Id; Reference : out Project_Node_Id;
First_Attribute : Attribute_Node_Id; First_Attribute : Attribute_Node_Id;
Current_Project : Project_Node_Id; Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id); Current_Package : Project_Node_Id;
Flags : Processing_Flags);
-- Parse an attribute reference. Current token is an apostrophe -- Parse an attribute reference. Current token is an apostrophe
procedure Terms procedure Terms
...@@ -125,7 +127,8 @@ package body Prj.Strt is ...@@ -125,7 +127,8 @@ package body Prj.Strt is
Expr_Kind : in out Variable_Kind; Expr_Kind : in out Variable_Kind;
Current_Project : Project_Node_Id; Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id; Current_Package : Project_Node_Id;
Optional_Index : Boolean); Optional_Index : Boolean;
Flags : Processing_Flags);
-- Recursive procedure to parse one term or several terms concatenated -- Recursive procedure to parse one term or several terms concatenated
-- using "&". -- using "&".
...@@ -160,7 +163,8 @@ package body Prj.Strt is ...@@ -160,7 +163,8 @@ package body Prj.Strt is
Reference : out Project_Node_Id; Reference : out Project_Node_Id;
First_Attribute : Attribute_Node_Id; First_Attribute : Attribute_Node_Id;
Current_Project : Project_Node_Id; Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id) Current_Package : Project_Node_Id;
Flags : Processing_Flags)
is is
Current_Attribute : Attribute_Node_Id := First_Attribute; Current_Attribute : Attribute_Node_Id := First_Attribute;
...@@ -195,7 +199,7 @@ package body Prj.Strt is ...@@ -195,7 +199,7 @@ package body Prj.Strt is
if Current_Attribute = Empty_Attribute then if Current_Attribute = Empty_Attribute then
Error_Msg_Name_1 := Token_Name; Error_Msg_Name_1 := Token_Name;
Error_Msg ("unknown attribute %%", Token_Ptr); Error_Msg (Flags, "unknown attribute %%", Token_Ptr);
Reference := Empty_Node; Reference := Empty_Node;
-- Scan past the attribute name -- Scan past the attribute name
...@@ -273,7 +277,8 @@ package body Prj.Strt is ...@@ -273,7 +277,8 @@ package body Prj.Strt is
procedure End_Case_Construction procedure End_Case_Construction
(Check_All_Labels : Boolean; (Check_All_Labels : Boolean;
Case_Location : Source_Ptr) Case_Location : Source_Ptr;
Flags : Processing_Flags)
is is
Non_Used : Natural := 0; Non_Used : Natural := 0;
First_Non_Used : Choice_Node_Id := First_Choice_Node_Id; First_Non_Used : Choice_Node_Id := First_Choice_Node_Id;
...@@ -296,19 +301,19 @@ package body Prj.Strt is ...@@ -296,19 +301,19 @@ package body Prj.Strt is
if Non_Used = 1 then if Non_Used = 1 then
Error_Msg_Name_1 := Choices.Table (First_Non_Used).The_String; Error_Msg_Name_1 := Choices.Table (First_Non_Used).The_String;
Error_Msg ("?value %% is not used as label", Case_Location); Error_Msg (Flags, "?value %% is not used as label", Case_Location);
-- If several are not used, report a warning for each one of them -- If several are not used, report a warning for each one of them
elsif Non_Used > 1 then elsif Non_Used > 1 then
Error_Msg Error_Msg
("?the following values are not used as labels:", (Flags, "?the following values are not used as labels:",
Case_Location); Case_Location);
for Choice in First_Non_Used .. Choices.Last loop for Choice in First_Non_Used .. Choices.Last loop
if not Choices.Table (Choice).Already_Used then if not Choices.Table (Choice).Already_Used then
Error_Msg_Name_1 := Choices.Table (Choice).The_String; Error_Msg_Name_1 := Choices.Table (Choice).The_String;
Error_Msg ("\?%%", Case_Location); Error_Msg (Flags, "\?%%", Case_Location);
end if; end if;
end loop; end loop;
end if; end if;
...@@ -347,7 +352,8 @@ package body Prj.Strt is ...@@ -347,7 +352,8 @@ package body Prj.Strt is
(In_Tree : Project_Node_Tree_Ref; (In_Tree : Project_Node_Tree_Ref;
Current_Project : Project_Node_Id; Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id; Current_Package : Project_Node_Id;
External_Value : out Project_Node_Id) External_Value : out Project_Node_Id;
Flags : Processing_Flags)
is is
Field_Id : Project_Node_Id := Empty_Node; Field_Id : Project_Node_Id := Empty_Node;
...@@ -406,12 +412,14 @@ package body Prj.Strt is ...@@ -406,12 +412,14 @@ package body Prj.Strt is
Parse_Expression Parse_Expression
(In_Tree => In_Tree, (In_Tree => In_Tree,
Expression => Field_Id, Expression => Field_Id,
Flags => Flags,
Current_Project => Current_Project, Current_Project => Current_Project,
Current_Package => Current_Package, Current_Package => Current_Package,
Optional_Index => False); Optional_Index => False);
if Expression_Kind_Of (Field_Id, In_Tree) = List then if Expression_Kind_Of (Field_Id, In_Tree) = List then
Error_Msg ("expression must be a single string", Loc); Error_Msg
(Flags, "expression must be a single string", Loc);
else else
Set_External_Default_Of Set_External_Default_Of
(External_Value, In_Tree, To => Field_Id); (External_Value, In_Tree, To => Field_Id);
...@@ -425,7 +433,7 @@ package body Prj.Strt is ...@@ -425,7 +433,7 @@ package body Prj.Strt is
end if; end if;
when others => when others =>
Error_Msg ("`,` or `)` expected", Token_Ptr); Error_Msg (Flags, "`,` or `)` expected", Token_Ptr);
end case; end case;
end if; end if;
end External_Reference; end External_Reference;
...@@ -436,7 +444,8 @@ package body Prj.Strt is ...@@ -436,7 +444,8 @@ package body Prj.Strt is
procedure Parse_Choice_List procedure Parse_Choice_List
(In_Tree : Project_Node_Tree_Ref; (In_Tree : Project_Node_Tree_Ref;
First_Choice : out Project_Node_Id) First_Choice : out Project_Node_Id;
Flags : Processing_Flags)
is is
Current_Choice : Project_Node_Id := Empty_Node; Current_Choice : Project_Node_Id := Empty_Node;
Next_Choice : Project_Node_Id := Empty_Node; Next_Choice : Project_Node_Id := Empty_Node;
...@@ -483,7 +492,7 @@ package body Prj.Strt is ...@@ -483,7 +492,7 @@ package body Prj.Strt is
-- case construction so report an error. -- case construction so report an error.
Error_Msg_Name_1 := Choice_String; Error_Msg_Name_1 := Choice_String;
Error_Msg ("duplicate case label %%", Token_Ptr); Error_Msg (Flags, "duplicate case label %%", Token_Ptr);
else else
Choices.Table (Choice).Already_Used := True; Choices.Table (Choice).Already_Used := True;
...@@ -497,7 +506,7 @@ package body Prj.Strt is ...@@ -497,7 +506,7 @@ package body Prj.Strt is
if not Found then if not Found then
Error_Msg_Name_1 := Choice_String; Error_Msg_Name_1 := Choice_String;
Error_Msg ("illegal case label %%", Token_Ptr); Error_Msg (Flags, "illegal case label %%", Token_Ptr);
end if; end if;
-- Scan past the label -- Scan past the label
...@@ -535,7 +544,8 @@ package body Prj.Strt is ...@@ -535,7 +544,8 @@ package body Prj.Strt is
Expression : out Project_Node_Id; Expression : out Project_Node_Id;
Current_Project : Project_Node_Id; Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id; Current_Package : Project_Node_Id;
Optional_Index : Boolean) Optional_Index : Boolean;
Flags : Processing_Flags)
is is
First_Term : Project_Node_Id := Empty_Node; First_Term : Project_Node_Id := Empty_Node;
Expression_Kind : Variable_Kind := Undefined; Expression_Kind : Variable_Kind := Undefined;
...@@ -552,6 +562,7 @@ package body Prj.Strt is ...@@ -552,6 +562,7 @@ package body Prj.Strt is
Terms (In_Tree => In_Tree, Terms (In_Tree => In_Tree,
Term => First_Term, Term => First_Term,
Expr_Kind => Expression_Kind, Expr_Kind => Expression_Kind,
Flags => Flags,
Current_Project => Current_Project, Current_Project => Current_Project,
Current_Package => Current_Package, Current_Package => Current_Package,
Optional_Index => Optional_Index); Optional_Index => Optional_Index);
...@@ -568,7 +579,8 @@ package body Prj.Strt is ...@@ -568,7 +579,8 @@ package body Prj.Strt is
procedure Parse_String_Type_List procedure Parse_String_Type_List
(In_Tree : Project_Node_Tree_Ref; (In_Tree : Project_Node_Tree_Ref;
First_String : out Project_Node_Id) First_String : out Project_Node_Id;
Flags : Processing_Flags)
is is
Last_String : Project_Node_Id := Empty_Node; Last_String : Project_Node_Id := Empty_Node;
Next_String : Project_Node_Id := Empty_Node; Next_String : Project_Node_Id := Empty_Node;
...@@ -609,7 +621,7 @@ package body Prj.Strt is ...@@ -609,7 +621,7 @@ package body Prj.Strt is
-- This is a repetition, report an error -- This is a repetition, report an error
Error_Msg_Name_1 := String_Value; Error_Msg_Name_1 := String_Value;
Error_Msg ("duplicate value %% in type", Token_Ptr); Error_Msg (Flags, "duplicate value %% in type", Token_Ptr);
exit; exit;
end if; end if;
...@@ -650,7 +662,8 @@ package body Prj.Strt is ...@@ -650,7 +662,8 @@ package body Prj.Strt is
(In_Tree : Project_Node_Tree_Ref; (In_Tree : Project_Node_Tree_Ref;
Variable : out Project_Node_Id; Variable : out Project_Node_Id;
Current_Project : Project_Node_Id; Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id) Current_Package : Project_Node_Id;
Flags : Processing_Flags)
is is
Current_Variable : Project_Node_Id := Empty_Node; Current_Variable : Project_Node_Id := Empty_Node;
...@@ -723,7 +736,7 @@ package body Prj.Strt is ...@@ -723,7 +736,7 @@ package body Prj.Strt is
if First_Attribute = Empty_Attribute then if First_Attribute = Empty_Attribute then
Error_Msg_Name_1 := Names.Table (1).Name; Error_Msg_Name_1 := Names.Table (1).Name;
Error_Msg ("unknown project %", Error_Msg (Flags, "unknown project %",
Names.Table (1).Location); Names.Table (1).Location);
First_Attribute := Attribute_First; First_Attribute := Attribute_First;
...@@ -747,7 +760,7 @@ package body Prj.Strt is ...@@ -747,7 +760,7 @@ package body Prj.Strt is
if No (The_Package) then if No (The_Package) then
Error_Msg_Name_1 := Names.Table (1).Name; Error_Msg_Name_1 := Names.Table (1).Name;
Error_Msg ("package % not yet defined", Error_Msg (Flags, "package % not yet defined",
Names.Table (1).Location); Names.Table (1).Location);
end if; end if;
end if; end if;
...@@ -844,7 +857,7 @@ package body Prj.Strt is ...@@ -844,7 +857,7 @@ package body Prj.Strt is
if No (The_Project) then if No (The_Project) then
Error_Msg_Name_1 := Long_Project; Error_Msg_Name_1 := Long_Project;
Error_Msg_Name_2 := Short_Project; Error_Msg_Name_2 := Short_Project;
Error_Msg ("unknown projects % or %", Error_Msg (Flags, "unknown projects % or %",
Names.Table (1).Location); Names.Table (1).Location);
The_Package := Empty_Node; The_Package := Empty_Node;
First_Attribute := Attribute_First; First_Attribute := Attribute_First;
...@@ -869,7 +882,8 @@ package body Prj.Strt is ...@@ -869,7 +882,8 @@ package body Prj.Strt is
Error_Msg_Name_1 := Error_Msg_Name_1 :=
Names.Table (Names.Last).Name; Names.Table (Names.Last).Name;
Error_Msg_Name_2 := Short_Project; Error_Msg_Name_2 := Short_Project;
Error_Msg ("package % not declared in project %", Error_Msg (Flags,
"package % not declared in project %",
Names.Table (Names.Last).Location); Names.Table (Names.Last).Location);
First_Attribute := Attribute_First; First_Attribute := Attribute_First;
...@@ -889,6 +903,7 @@ package body Prj.Strt is ...@@ -889,6 +903,7 @@ package body Prj.Strt is
Attribute_Reference Attribute_Reference
(In_Tree, (In_Tree,
Variable, Variable,
Flags => Flags,
Current_Project => The_Project, Current_Project => The_Project,
Current_Package => The_Package, Current_Package => The_Package,
First_Attribute => First_Attribute); First_Attribute => First_Attribute);
...@@ -944,7 +959,7 @@ package body Prj.Strt is ...@@ -944,7 +959,7 @@ package body Prj.Strt is
elsif No (The_Package) then elsif No (The_Package) then
Error_Msg_Name_1 := Names.Table (1).Name; Error_Msg_Name_1 := Names.Table (1).Name;
Error_Msg ("unknown package or project %", Error_Msg (Flags, "unknown package or project %",
Names.Table (1).Location); Names.Table (1).Location);
Look_For_Variable := False; Look_For_Variable := False;
...@@ -1023,7 +1038,7 @@ package body Prj.Strt is ...@@ -1023,7 +1038,7 @@ package body Prj.Strt is
Error_Msg_Name_1 := Long_Project; Error_Msg_Name_1 := Long_Project;
Error_Msg_Name_2 := Short_Project; Error_Msg_Name_2 := Short_Project;
Error_Msg Error_Msg
("unknown projects % or %", (Flags, "unknown projects % or %",
Names.Table (1).Location); Names.Table (1).Location);
Look_For_Variable := False; Look_For_Variable := False;
...@@ -1047,7 +1062,7 @@ package body Prj.Strt is ...@@ -1047,7 +1062,7 @@ package body Prj.Strt is
-- The package does not exist, report an error -- The package does not exist, report an error
Error_Msg_Name_1 := Names.Table (2).Name; Error_Msg_Name_1 := Names.Table (2).Name;
Error_Msg ("unknown package %", Error_Msg (Flags, "unknown package %",
Names.Table (Names.Last - 1).Location); Names.Table (Names.Last - 1).Location);
Look_For_Variable := False; Look_For_Variable := False;
...@@ -1143,7 +1158,7 @@ package body Prj.Strt is ...@@ -1143,7 +1158,7 @@ package body Prj.Strt is
if No (Current_Variable) then if No (Current_Variable) then
Error_Msg_Name_1 := Variable_Name; Error_Msg_Name_1 := Variable_Name;
Error_Msg Error_Msg
("unknown variable %", Names.Table (Names.Last).Location); (Flags, "unknown variable %", Names.Table (Names.Last).Location);
end if; end if;
end if; end if;
...@@ -1165,7 +1180,8 @@ package body Prj.Strt is ...@@ -1165,7 +1180,8 @@ package body Prj.Strt is
-- but attempt to scan the index. -- but attempt to scan the index.
if Token = Tok_Left_Paren then if Token = Tok_Left_Paren then
Error_Msg ("\variables cannot be associative arrays", Token_Ptr); Error_Msg
(Flags, "\variables cannot be associative arrays", Token_Ptr);
Scan (In_Tree); Scan (In_Tree);
Expect (Tok_String_Literal, "literal string"); Expect (Tok_String_Literal, "literal string");
...@@ -1227,7 +1243,8 @@ package body Prj.Strt is ...@@ -1227,7 +1243,8 @@ package body Prj.Strt is
Expr_Kind : in out Variable_Kind; Expr_Kind : in out Variable_Kind;
Current_Project : Project_Node_Id; Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id; Current_Package : Project_Node_Id;
Optional_Index : Boolean) Optional_Index : Boolean;
Flags : Processing_Flags)
is is
Next_Term : Project_Node_Id := Empty_Node; Next_Term : Project_Node_Id := Empty_Node;
Term_Id : Project_Node_Id := Empty_Node; Term_Id : Project_Node_Id := Empty_Node;
...@@ -1263,7 +1280,7 @@ package body Prj.Strt is ...@@ -1263,7 +1280,7 @@ package body Prj.Strt is
Expr_Kind := List; Expr_Kind := List;
Error_Msg Error_Msg
("literal string list cannot appear in a string", (Flags, "literal string list cannot appear in a string",
Token_Ptr); Token_Ptr);
end case; end case;
...@@ -1294,6 +1311,7 @@ package body Prj.Strt is ...@@ -1294,6 +1311,7 @@ package body Prj.Strt is
Parse_Expression Parse_Expression
(In_Tree => In_Tree, (In_Tree => In_Tree,
Expression => Next_Expression, Expression => Next_Expression,
Flags => Flags,
Current_Project => Current_Project, Current_Project => Current_Project,
Current_Package => Current_Package, Current_Package => Current_Package,
Optional_Index => Optional_Index); Optional_Index => Optional_Index);
...@@ -1301,7 +1319,7 @@ package body Prj.Strt is ...@@ -1301,7 +1319,7 @@ package body Prj.Strt is
-- The expression kind is String list, report an error -- The expression kind is String list, report an error
if Expression_Kind_Of (Next_Expression, In_Tree) = List then if Expression_Kind_Of (Next_Expression, In_Tree) = List then
Error_Msg ("single expression expected", Error_Msg (Flags, "single expression expected",
Current_Location); Current_Location);
end if; end if;
...@@ -1358,7 +1376,7 @@ package body Prj.Strt is ...@@ -1358,7 +1376,7 @@ package body Prj.Strt is
if Token = Tok_At then if Token = Tok_At then
if not Optional_Index then if not Optional_Index then
Error_Msg ("index not allowed here", Token_Ptr); Error_Msg (Flags, "index not allowed here", Token_Ptr);
Scan (In_Tree); Scan (In_Tree);
if Token = Tok_Integer_Literal then if Token = Tok_Integer_Literal then
...@@ -1376,7 +1394,8 @@ package body Prj.Strt is ...@@ -1376,7 +1394,8 @@ package body Prj.Strt is
Index : constant Int := UI_To_Int (Int_Literal_Value); Index : constant Int := UI_To_Int (Int_Literal_Value);
begin begin
if Index = 0 then if Index = 0 then
Error_Msg ("index cannot be zero", Token_Ptr); Error_Msg
(Flags, "index cannot be zero", Token_Ptr);
else else
Set_Source_Index_Of Set_Source_Index_Of
(Term_Id, In_Tree, To => Index); (Term_Id, In_Tree, To => Index);
...@@ -1396,6 +1415,7 @@ package body Prj.Strt is ...@@ -1396,6 +1415,7 @@ package body Prj.Strt is
Parse_Variable_Reference Parse_Variable_Reference
(In_Tree => In_Tree, (In_Tree => In_Tree,
Variable => Reference, Variable => Reference,
Flags => Flags,
Current_Project => Current_Project, Current_Project => Current_Project,
Current_Package => Current_Package); Current_Package => Current_Package);
Set_Current_Term (Term, In_Tree, To => Reference); Set_Current_Term (Term, In_Tree, To => Reference);
...@@ -1417,7 +1437,8 @@ package body Prj.Strt is ...@@ -1417,7 +1437,8 @@ package body Prj.Strt is
Expr_Kind := List; Expr_Kind := List;
Error_Msg Error_Msg
("list variable cannot appear in single string expression", (Flags,
"list variable cannot appear in single string expression",
Current_Location); Current_Location);
end if; end if;
end if; end if;
...@@ -1435,6 +1456,7 @@ package body Prj.Strt is ...@@ -1435,6 +1456,7 @@ package body Prj.Strt is
Attribute_Reference Attribute_Reference
(In_Tree => In_Tree, (In_Tree => In_Tree,
Reference => Reference, Reference => Reference,
Flags => Flags,
First_Attribute => Prj.Attr.Attribute_First, First_Attribute => Prj.Attr.Attribute_First,
Current_Project => Current_Project, Current_Project => Current_Project,
Current_Package => Empty_Node); Current_Package => Empty_Node);
...@@ -1451,7 +1473,7 @@ package body Prj.Strt is ...@@ -1451,7 +1473,7 @@ package body Prj.Strt is
and then Expression_Kind_Of (Reference, In_Tree) = List and then Expression_Kind_Of (Reference, In_Tree) = List
then then
Error_Msg Error_Msg
("lists cannot appear in single string expression", (Flags, "lists cannot appear in single string expression",
Current_Location); Current_Location);
end if; end if;
end if; end if;
...@@ -1466,13 +1488,14 @@ package body Prj.Strt is ...@@ -1466,13 +1488,14 @@ package body Prj.Strt is
External_Reference External_Reference
(In_Tree => In_Tree, (In_Tree => In_Tree,
Flags => Flags,
Current_Project => Current_Project, Current_Project => Current_Project,
Current_Package => Current_Package, Current_Package => Current_Package,
External_Value => Reference); External_Value => Reference);
Set_Current_Term (Term, In_Tree, To => Reference); Set_Current_Term (Term, In_Tree, To => Reference);
when others => when others =>
Error_Msg ("cannot be part of an expression", Token_Ptr); Error_Msg (Flags, "cannot be part of an expression", Token_Ptr);
Term := Empty_Node; Term := Empty_Node;
return; return;
end case; end case;
...@@ -1486,6 +1509,7 @@ package body Prj.Strt is ...@@ -1486,6 +1509,7 @@ package body Prj.Strt is
(In_Tree => In_Tree, (In_Tree => In_Tree,
Term => Next_Term, Term => Next_Term,
Expr_Kind => Expr_Kind, Expr_Kind => Expr_Kind,
Flags => Flags,
Current_Project => Current_Project, Current_Project => Current_Project,
Current_Package => Current_Package, Current_Package => Current_Package,
Optional_Index => Optional_Index); Optional_Index => Optional_Index);
......
gcc/ada/prj-strt.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2001-2008, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -31,7 +31,8 @@ private package Prj.Strt is ...@@ -31,7 +31,8 @@ private package Prj.Strt is
procedure Parse_String_Type_List procedure Parse_String_Type_List
(In_Tree : Project_Node_Tree_Ref; (In_Tree : Project_Node_Tree_Ref;
First_String : out Project_Node_Id); First_String : out Project_Node_Id;
Flags : Processing_Flags);
-- Get the list of literal strings that are allowed for a typed string. -- Get the list of literal strings that are allowed for a typed string.
-- On entry, the current token is the first literal string following -- On entry, the current token is the first literal string following
-- a left parenthesis in a string type declaration such as: -- a left parenthesis in a string type declaration such as:
...@@ -58,7 +59,8 @@ private package Prj.Strt is ...@@ -58,7 +59,8 @@ private package Prj.Strt is
procedure End_Case_Construction procedure End_Case_Construction
(Check_All_Labels : Boolean; (Check_All_Labels : Boolean;
Case_Location : Source_Ptr); Case_Location : Source_Ptr;
Flags : Processing_Flags);
-- This procedure is called at the end of a case construction -- This procedure is called at the end of a case construction
-- to remove the case labels and to restore the previous state. -- to remove the case labels and to restore the previous state.
-- In particular, in the case of nested case constructions, -- In particular, in the case of nested case constructions,
...@@ -69,7 +71,8 @@ private package Prj.Strt is ...@@ -69,7 +71,8 @@ private package Prj.Strt is
procedure Parse_Choice_List procedure Parse_Choice_List
(In_Tree : Project_Node_Tree_Ref; (In_Tree : Project_Node_Tree_Ref;
First_Choice : out Project_Node_Id); First_Choice : out Project_Node_Id;
Flags : Processing_Flags);
-- Get the label for a choice list. -- Get the label for a choice list.
-- Report an error if -- Report an error if
-- - a case label is not a literal string -- - a case label is not a literal string
...@@ -81,7 +84,8 @@ private package Prj.Strt is ...@@ -81,7 +84,8 @@ private package Prj.Strt is
Expression : out Project_Node_Id; Expression : out Project_Node_Id;
Current_Project : Project_Node_Id; Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id; Current_Package : Project_Node_Id;
Optional_Index : Boolean); Optional_Index : Boolean;
Flags : Processing_Flags);
-- Parse a simple string expression or a string list expression. -- Parse a simple string expression or a string list expression.
-- Current_Project is the node of the project file being parsed. -- Current_Project is the node of the project file being parsed.
-- Current_Package is the node of the package being parsed, -- Current_Package is the node of the package being parsed,
...@@ -93,7 +97,8 @@ private package Prj.Strt is ...@@ -93,7 +97,8 @@ private package Prj.Strt is
(In_Tree : Project_Node_Tree_Ref; (In_Tree : Project_Node_Tree_Ref;
Variable : out Project_Node_Id; Variable : out Project_Node_Id;
Current_Project : Project_Node_Id; Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id); Current_Package : Project_Node_Id;
Flags : Processing_Flags);
-- Parse a variable or attribute reference. -- Parse a variable or attribute reference.
-- Used internally (in expressions) and for case variables (in Prj.Dect). -- Used internally (in expressions) and for case variables (in Prj.Dect).
-- Current_Package is the node of the package being parsed, -- Current_Package is the node of the package being parsed,
......
gcc/ada/prj.adb
...@@ -299,7 +299,8 @@ package body Prj is ...@@ -299,7 +299,8 @@ package body Prj is
procedure Expect (The_Token : Token_Type; Token_Image : String) is procedure Expect (The_Token : Token_Type; Token_Image : String) is
begin begin
if Token /= The_Token then if Token /= The_Token then
Error_Msg (Token_Image & " expected", Token_Ptr); -- ??? Should pass user flags here instead
Error_Msg (Gnatmake_Flags, Token_Image & " expected", Token_Ptr);
end if; end if;
end Expect; end Expect;
...@@ -1179,7 +1180,7 @@ package body Prj is ...@@ -1179,7 +1180,7 @@ package body Prj is
------------------ ------------------
function Create_Flags function Create_Flags
(Report_Error : Put_Line_Access; (Report_Error : Error_Handler;
When_No_Sources : Error_Warning; When_No_Sources : Error_Warning;
Require_Sources_Other_Lang : Boolean := True; Require_Sources_Other_Lang : Boolean := True;
Allow_Duplicate_Basenames : Boolean := True; Allow_Duplicate_Basenames : Boolean := True;
......
gcc/ada/prj.ads
...@@ -96,16 +96,6 @@ package Prj is ...@@ -96,16 +96,6 @@ package Prj is
-- constants, because Canonical_Case_File_Name is called on these variables -- constants, because Canonical_Case_File_Name is called on these variables
-- in the body of Prj. -- in the body of Prj.
type Error_Warning is (Silent, Warning, Error);
-- Severity of some situations, such as: no Ada sources in a project where
-- Ada is one of the language.
--
-- When the situation occurs, the behaviour depends on the setting:
--
-- - Silent: no action
-- - Warning: issue a warning, does not cause the tool to fail
-- - Error: issue an error, causes the tool to fail
function Empty_File return File_Name_Type; function Empty_File return File_Name_Type;
function Empty_String return Name_Id; function Empty_String return Name_Id;
-- Return the id for an empty string "" -- Return the id for an empty string ""
...@@ -1290,12 +1280,6 @@ package Prj is ...@@ -1290,12 +1280,6 @@ package Prj is
end record; end record;
-- Data for a project tree -- Data for a project tree
type Put_Line_Access is access procedure
(Line : String;
Project : Project_Id;
In_Tree : Project_Tree_Ref);
-- Use to customize error reporting in Prj.Proc and Prj.Nmsc
procedure Expect (The_Token : Token_Type; Token_Image : String); procedure Expect (The_Token : Token_Type; Token_Image : String);
-- Check that the current token is The_Token. If it is not, then output -- Check that the current token is The_Token. If it is not, then output
-- an error message. -- an error message.
...@@ -1308,47 +1292,6 @@ package Prj is ...@@ -1308,47 +1292,6 @@ package Prj is
-- This procedure resets all the tables that are used when processing a -- This procedure resets all the tables that are used when processing a
-- project file tree. Initialize must be called before the call to Reset. -- project file tree. Initialize must be called before the call to Reset.
type Processing_Flags is private;
-- Flags used while parsing and processing a project tree to configure the
-- behavior of the parser, and indicate how to report error messages. This
-- structure does not allocate memory and never needs to be freed
function Create_Flags
(Report_Error : Put_Line_Access;
When_No_Sources : Error_Warning;
Require_Sources_Other_Lang : Boolean := True;
Allow_Duplicate_Basenames : Boolean := True;
Compiler_Driver_Mandatory : Boolean := False;
Error_On_Unknown_Language : Boolean := True) return Processing_Flags;
-- Function used to create Processing_Flags structure
--
-- If Allow_Duplicate_Basenames, then files with the same base names are
-- authorized within a project for source-based languages (never for unit
-- based languages).
--
-- If Compiler_Driver_Mandatory is true, then a Compiler.Driver attribute
-- for each language must be defined, or we will not look for its source
-- files.
--
-- When_No_Sources indicates what should be done when no sources of a
-- language are found in a project where this language is declared.
-- If Require_Sources_Other_Lang is true, then all languages must have at
-- least one source file, or an error is reported via When_No_Sources. If
-- it is false, this is only required for Ada (and only if it is a language
-- of the project). When this parameter is set to False, we do not check
-- that a proper naming scheme is defined for languages other than Ada.
--
-- If Report_Error is null, use the standard error reporting mechanism
-- (Errout). Otherwise, report errors using Report_Error.
--
-- If Error_On_Unknown_Language is true, an error is displayed if some of
-- the source files listed in the project do not match any naming scheme
Gprbuild_Flags : constant Processing_Flags;
Gnatmake_Flags : constant Processing_Flags;
-- Flags used by the various tools. They all display the error messages
-- through Prj.Err.
package Project_Boolean_Htable is new Simple_HTable package Project_Boolean_Htable is new Simple_HTable
(Header_Num => Header_Num, (Header_Num => Header_Num,
Element => Boolean, Element => Boolean,
...@@ -1399,6 +1342,69 @@ package Prj is ...@@ -1399,6 +1342,69 @@ package Prj is
(Source_File_Name : File_Name_Type) return File_Name_Type; (Source_File_Name : File_Name_Type) return File_Name_Type;
-- Returns the switches file name corresponding to a source file name -- Returns the switches file name corresponding to a source file name
-----------
-- Flags --
-----------
type Processing_Flags is private;
-- Flags used while parsing and processing a project tree to configure the
-- behavior of the parser, and indicate how to report error messages. This
-- structure does not allocate memory and never needs to be freed
type Error_Warning is (Silent, Warning, Error);
-- Severity of some situations, such as: no Ada sources in a project where
-- Ada is one of the language.
--
-- When the situation occurs, the behaviour depends on the setting:
--
-- - Silent: no action
-- - Warning: issue a warning, does not cause the tool to fail
-- - Error: issue an error, causes the tool to fail
type Error_Handler is access procedure
(Project : Project_Id; Is_Warning : Boolean);
-- This warngs when an error was found when parsing a project. The error
-- itself is handled through Prj.Err (and you should call
-- Prj.Err.Finalize to actually print the error). This ensures that
-- duplicate error messages are always correctly removed, that errors msgs
-- are sorted, and that all tools will report the same error to the user.
function Create_Flags
(Report_Error : Error_Handler;
When_No_Sources : Error_Warning;
Require_Sources_Other_Lang : Boolean := True;
Allow_Duplicate_Basenames : Boolean := True;
Compiler_Driver_Mandatory : Boolean := False;
Error_On_Unknown_Language : Boolean := True) return Processing_Flags;
-- Function used to create Processing_Flags structure
--
-- If Allow_Duplicate_Basenames, then files with the same base names are
-- authorized within a project for source-based languages (never for unit
-- based languages).
--
-- If Compiler_Driver_Mandatory is true, then a Compiler.Driver attribute
-- for each language must be defined, or we will not look for its source
-- files.
--
-- When_No_Sources indicates what should be done when no sources of a
-- language are found in a project where this language is declared.
-- If Require_Sources_Other_Lang is true, then all languages must have at
-- least one source file, or an error is reported via When_No_Sources. If
-- it is false, this is only required for Ada (and only if it is a language
-- of the project). When this parameter is set to False, we do not check
-- that a proper naming scheme is defined for languages other than Ada.
--
-- If Report_Error is null, use the standard error reporting mechanism
-- (Errout). Otherwise, report errors using Report_Error.
--
-- If Error_On_Unknown_Language is true, an error is displayed if some of
-- the source files listed in the project do not match any naming scheme
Gprbuild_Flags : constant Processing_Flags;
Gnatmake_Flags : constant Processing_Flags;
-- Flags used by the various tools. They all display the error messages
-- through Prj.Err.
---------------- ----------------
-- Temp Files -- -- Temp Files --
---------------- ----------------
...@@ -1494,7 +1500,7 @@ private ...@@ -1494,7 +1500,7 @@ private
type Processing_Flags is record type Processing_Flags is record
Require_Sources_Other_Lang : Boolean; Require_Sources_Other_Lang : Boolean;
Report_Error : Put_Line_Access; Report_Error : Error_Handler;
When_No_Sources : Error_Warning; When_No_Sources : Error_Warning;
Allow_Duplicate_Basenames : Boolean; Allow_Duplicate_Basenames : Boolean;
Compiler_Driver_Mandatory : Boolean; Compiler_Driver_Mandatory : Boolean;
......
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