+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
-- --
-- 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- --
-- --
-- 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- --
(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
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;
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;
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
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
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
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.
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>;
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;
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;
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;
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;
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;
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",
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);
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
(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
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);
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
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
Parse_Expression
(In_Tree => In_Tree,
Expression => Expression,
+ Flags => Flags,
Current_Project => Current_Project,
Current_Package => Current_Package,
Optional_Index => Optional_Index);
else
Error_Msg
- ("wrong expression kind for attribute """ &
+ (Flags, "wrong expression kind for attribute """ &
Get_Name_String
(Attribute_Name_Of (Current_Attribute)) &
"""",
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;
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
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);
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
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, "`=>`");
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);
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;
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;
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;
(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);
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);
-- 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
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);
-- 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);
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);
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;
-- 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",
if Index /= 0 then
Error_Msg -- CODEFIX
- ("\?possible misspelling of """ &
+ (Flags,
+ "\?possible misspelling of """ &
List (Index).all & """", Token_Ptr);
end if;
end;
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);
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"
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
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))
if No (Current) then
Error_Msg
- ("""" &
+ (Flags, """" &
Get_Name_String (Token_Name) &
""" is not a package declared by the project",
Token_Ptr);
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);
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
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;
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;
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);
end loop;
if Present (Current) then
- Error_Msg ("""" &
+ Error_Msg (Flags,
+ """" &
Get_Name_String (Token_Name) &
""" is already a variable name", Token_Ptr);
else
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, "`)`");
(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;
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) &
"""",
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);
Parse_Expression
(In_Tree => In_Tree,
Expression => Expression,
+ Flags => Flags,
Current_Project => Current_Project,
Current_Package => Current_Package,
Optional_Index => False);
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
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)) &
"""",
-- --
-- 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- --
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
-- --
-- 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- --
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;
-- --
-- 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- --
-- 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;
-- 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
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;
(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;
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);
-- --
-- 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- --
(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.
--
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;
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
-- 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;
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;
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;
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;
-- 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
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;
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".
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.
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;
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,
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 :=
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 =>
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 =>
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 =>
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 =>
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
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
else
Error_Msg
- (Project,
+ (Data.Flags,
"illegal response file format",
- Attribute.Value.Location, Data);
+ Attribute.Value.Location, Project);
end if;
end;
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,
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,
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,
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 :=
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,
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 :=
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 :=
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
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
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
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
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
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 =>
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;
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;
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
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;
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;
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;
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);
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;
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);
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;
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);
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
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;
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 /=
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;
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;
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;
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;
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
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,
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
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;
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;
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;
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
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
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
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;
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;
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;
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
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);
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;
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
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
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
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;
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
-- 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;
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
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;
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;
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;
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
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));
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;
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
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
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
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;
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 --
---------------------
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
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
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.
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;
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
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;
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
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;
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;
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;
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
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;
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;
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;
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;
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;
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
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
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;
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
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;
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
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
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;
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
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
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;
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
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);
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;
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;
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
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
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
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
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);
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
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;
if Is_Config_File then
Error_Msg
- ("configuration project cannot import " &
+ (Flags,
+ "configuration project cannot import " &
"other configuration projects",
Token_Ptr);
end if;
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;
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;
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.
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;
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);
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;
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 :=
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;
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;
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;
-- 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;
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);
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;
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;
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
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;
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;
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;
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.
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;
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
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;
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;
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;
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)
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;
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;
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;
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,
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;
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;
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;
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,
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,
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,
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;
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;
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,
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 :=
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,
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
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;
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,
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;
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,
-- --
-- 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- --
(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
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
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 "&".
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;
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
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;
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;
(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;
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);
end if;
when others =>
- Error_Msg ("`,` or `)` expected", Token_Ptr);
+ Error_Msg (Flags, "`,` or `)` expected", Token_Ptr);
end case;
end if;
end External_Reference;
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;
-- 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;
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
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;
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);
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;
-- 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;
(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;
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;
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;
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;
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;
Attribute_Reference
(In_Tree,
Variable,
+ Flags => Flags,
Current_Project => The_Project,
Current_Package => The_Package,
First_Attribute => First_Attribute);
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;
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;
-- 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;
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;
-- 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");
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;
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;
Parse_Expression
(In_Tree => In_Tree,
Expression => Next_Expression,
+ Flags => Flags,
Current_Project => Current_Project,
Current_Package => Current_Package,
Optional_Index => Optional_Index);
-- 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;
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
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);
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);
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;
Attribute_Reference
(In_Tree => In_Tree,
Reference => Reference,
+ Flags => Flags,
First_Attribute => Prj.Attr.Attribute_First,
Current_Project => Current_Project,
Current_Package => Empty_Node);
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;
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;
(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);
-- --
-- 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- --
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:
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,
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
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,
(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,
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;
------------------
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;
-- 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 ""
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.
-- 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,
(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 --
----------------
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;
projects / platform / upstream / linaro-gcc.git / commitdiff