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