Skip to content

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

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

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

From-SVN: r149572
parent 442c0581
Showing with 182 additions and 102 deletions
gcc/ada/ChangeLog
2009-07-13 Emmanuel Briot <briot@adacore.com>
* prj-proc.adb, prj-part.adb, prj-part.ads, prj-strt.adb,
prj-strt.ads, prj.adb, prj.ads, prj-makr.adb, prj-makr.ads,
prj-dect.adb, prj-dect.ads, prj-nmsc.adb, prj-pars.adb, errutil.adb,
errutil.ads, prj-conf.adb, gnatname.adb, prj-err.adb, prj-err.ads
(Prj.Nmsc.Report_Error): Removed, no longer needed.
Always use Prj.Err.Report_Message.
2009-07-13 Robert Dewar <dewar@adacore.com>
* prj.adb, sem_ch4.adb, sem_res.adb, prj-nmsc.adb: Minor reformatting
......
gcc/ada/errutil.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1991-2008, Free Software Foundation, Inc. --
-- Copyright (C) 1991-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......
gcc/ada/errutil.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2002-2007, Free Software Foundation, Inc. --
-- Copyright (C) 2002-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......
gcc/ada/gnatname.adb
......@@ -620,7 +620,8 @@ begin
(File_Path => File_Path.all,
Project_File => Create_Project,
Preproc_Switches => Prep_Switches,
Very_Verbose => Very_Verbose);
Very_Verbose => Very_Verbose,
Flags => Gnatmake_Flags);
end;
-- Process each section successively
......
gcc/ada/prj-conf.adb
......@@ -846,7 +846,8 @@ package body Prj.Conf is
Always_Errout_Finalize => False,
Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Directory,
Is_Config_File => True);
Is_Config_File => True,
Flags => Flags);
else
-- Maybe the user will want to create his own configuration file
Config_Project_Node := Empty_Node;
......@@ -1004,7 +1005,8 @@ package body Prj.Conf is
Always_Errout_Finalize => False,
Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Directory,
Is_Config_File => False);
Is_Config_File => False,
Flags => Flags);
if User_Project_Node = Empty_Node then
User_Project_Node := Empty_Node;
......
gcc/ada/prj-dect.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -35,7 +35,8 @@ private package Prj.Dect is
Current_Project : Prj.Tree.Project_Node_Id;
Extends : Prj.Tree.Project_Node_Id;
Packages_To_Check : String_List_Access;
Is_Config_File : Boolean);
Is_Config_File : Boolean;
Flags : Processing_Flags);
-- Parse project declarative items
--
-- In_Tree is the project node tree
......
gcc/ada/prj-err.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2007, Free Software Foundation, Inc. --
-- Copyright (C) 2002-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -68,4 +68,53 @@ package body Prj.Err is
end if;
end Post_Scan;
---------------
-- Error_Msg --
---------------
procedure Error_Msg
(Flags : Processing_Flags;
Msg : String;
Location : Source_Ptr := No_Location;
Project : Project_Id := null)
is
Real_Location : Source_Ptr := Location;
begin
-- Display the error message in the traces so that it appears in the
-- correct location in the traces (otherwise error messages are only
-- displayed at the end and it is difficult to see when they were
-- triggered)
if Current_Verbosity = High then
Write_Line ("ERROR: " & Msg);
end if;
-- If location of error is unknown, use the location of the project
if Real_Location = No_Location
and then Project /= null
then
Real_Location := Project.Location;
end if;
if Real_Location = No_Location then
-- If still null, we are parsing a project that was created in-memory
-- so we shouldn't report errors for projects that the user has no
-- access to in any case.
return;
end if;
-- Report the error through Errutil, so that duplicate errors are
-- properly removed, messages are sorted, and correctly interpreted,...
Errutil.Error_Msg (Msg, Real_Location);
-- Let the application know there was an error
if Flags.Report_Error /= null then
Flags.Report_Error (Project, Is_Warning => Msg (Msg'First) = '?');
end if;
end Error_Msg;
end Prj.Err;
gcc/ada/prj-err.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2002-2007, Free Software Foundation, Inc. --
-- Copyright (C) 2002-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -28,6 +28,14 @@
-- the GNAT tree packages (Atree, Sinfo, ...). It uses exactly the same global
-- variables as Errout, located in package Err_Vars. Like Errout, it also uses
-- the common variables and routines in package Erroutc.
--
-- Parameters are set through Err_Vars.Error_Msg_File_* or
-- Err_Vars.Error_Msg_Name_*, and replaced automatically in the messages
-- ("{{" for files, "%%" for names).
--
-- However, in this package you can configure the error messages to be sent
-- to your own callback by setting Report_Error in the flags. This ensures
-- that applications can control where error messages are displayed.
with Scng;
with Errutil;
......@@ -59,29 +67,22 @@ package Prj.Err is
-- Finalize processing of error messages for one file and output message
-- indicating the number of detected errors.
procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr)
renames Errutil.Error_Msg;
-- Output a message at specified location
procedure Error_Msg_S (Msg : String) renames Errutil.Error_Msg_S;
-- Output a message at current scan pointer location
procedure Error_Msg_SC (Msg : String) renames Errutil.Error_Msg_SC;
-- Output a message at the start of the current token, unless we are at
-- the end of file, in which case we always output the message after the
-- last real token in the file.
procedure Error_Msg_SP (Msg : String) renames Errutil.Error_Msg_SP;
-- Output a message at the start of the previous token
procedure Error_Msg
(Flags : Processing_Flags;
Msg : String;
Location : Source_Ptr := No_Location;
Project : Project_Id := null);
-- Output an error message, either through Flags.Error_Report or through
-- Errutil. The location defaults to the project's location ("project" in
-- the source code).
-- If Msg starts with "?", this is a warning, and Warning: is added at the
-- beginning. If Msg starts with "<", see comment for
-- Err_Vars.Error_Msg_Warn
-------------
-- Scanner --
-------------
package Style renames Errutil.Style;
-- Instantiation of the generic style package, needed for the instantiation
-- of the generic scanner below.
procedure Obsolescent_Check (S : Source_Ptr);
-- Dummy null procedure for Scng instantiation
......@@ -90,12 +91,12 @@ package Prj.Err is
package Scanner is new Scng
(Post_Scan => Post_Scan,
Error_Msg => Error_Msg,
Error_Msg_S => Error_Msg_S,
Error_Msg_SC => Error_Msg_SC,
Error_Msg_SP => Error_Msg_SP,
Error_Msg => Errutil.Error_Msg,
Error_Msg_S => Errutil.Error_Msg_S,
Error_Msg_SC => Errutil.Error_Msg_SC,
Error_Msg_SP => Errutil.Error_Msg_SP,
Obsolescent_Check => Obsolescent_Check,
Style => Style);
Style => Errutil.Style);
-- Instantiation of the generic scanner
end Prj.Err;
gcc/ada/prj-makr.adb
......@@ -766,7 +766,8 @@ package body Prj.Makr is
(File_Path : String;
Project_File : Boolean;
Preproc_Switches : Argument_List;
Very_Verbose : Boolean)
Very_Verbose : Boolean;
Flags : Processing_Flags)
is
begin
Makr.Very_Verbose := Initialize.Very_Verbose;
......@@ -846,6 +847,7 @@ package body Prj.Makr is
Always_Errout_Finalize => False,
Store_Comments => True,
Is_Config_File => False,
Flags => Flags,
Current_Directory => Get_Current_Dir,
Packages_To_Check => Packages_To_Check_By_Gnatname);
......
gcc/ada/prj-makr.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -36,7 +36,8 @@ package Prj.Makr is
(File_Path : String;
Project_File : Boolean;
Preproc_Switches : Argument_List;
Very_Verbose : Boolean);
Very_Verbose : Boolean;
Flags : Processing_Flags);
-- Start the creation of a configuration pragmas file or the creation or
-- modification of a project file, for gnatname.
--
......
gcc/ada/prj-pars.adb
......@@ -68,6 +68,7 @@ package body Prj.Pars is
Always_Errout_Finalize => False,
Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Dir,
Flags => Flags,
Is_Config_File => False);
-- If there were no error, process the tree
......
gcc/ada/prj-part.ads
......@@ -37,7 +37,8 @@ package Prj.Part is
Packages_To_Check : String_List_Access := All_Packages;
Store_Comments : Boolean := False;
Current_Directory : String := "";
Is_Config_File : Boolean);
Is_Config_File : Boolean;
Flags : Processing_Flags);
-- Parse project file and all its imported project files and create a tree.
-- Return the node for the project (or Empty_Node if parsing failed). If
-- Always_Errout_Finalize is True, Errout.Finalize is called in all cases,
......
gcc/ada/prj-strt.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -31,7 +31,8 @@ private package Prj.Strt is
procedure Parse_String_Type_List
(In_Tree : Project_Node_Tree_Ref;
First_String : out Project_Node_Id);
First_String : out Project_Node_Id;
Flags : Processing_Flags);
-- Get the list of literal strings that are allowed for a typed string.
-- On entry, the current token is the first literal string following
-- a left parenthesis in a string type declaration such as:
......@@ -58,7 +59,8 @@ private package Prj.Strt is
procedure End_Case_Construction
(Check_All_Labels : Boolean;
Case_Location : Source_Ptr);
Case_Location : Source_Ptr;
Flags : Processing_Flags);
-- This procedure is called at the end of a case construction
-- to remove the case labels and to restore the previous state.
-- In particular, in the case of nested case constructions,
......@@ -69,7 +71,8 @@ private package Prj.Strt is
procedure Parse_Choice_List
(In_Tree : Project_Node_Tree_Ref;
First_Choice : out Project_Node_Id);
First_Choice : out Project_Node_Id;
Flags : Processing_Flags);
-- Get the label for a choice list.
-- Report an error if
-- - a case label is not a literal string
......@@ -81,7 +84,8 @@ private package Prj.Strt is
Expression : out Project_Node_Id;
Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id;
Optional_Index : Boolean);
Optional_Index : Boolean;
Flags : Processing_Flags);
-- Parse a simple string expression or a string list expression.
-- Current_Project is the node of the project file being parsed.
-- Current_Package is the node of the package being parsed,
......@@ -93,7 +97,8 @@ private package Prj.Strt is
(In_Tree : Project_Node_Tree_Ref;
Variable : out Project_Node_Id;
Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id);
Current_Package : Project_Node_Id;
Flags : Processing_Flags);
-- Parse a variable or attribute reference.
-- Used internally (in expressions) and for case variables (in Prj.Dect).
-- Current_Package is the node of the package being parsed,
......
gcc/ada/prj.adb
......@@ -299,7 +299,8 @@ package body Prj is
procedure Expect (The_Token : Token_Type; Token_Image : String) is
begin
if Token /= The_Token then
Error_Msg (Token_Image & " expected", Token_Ptr);
-- ??? Should pass user flags here instead
Error_Msg (Gnatmake_Flags, Token_Image & " expected", Token_Ptr);
end if;
end Expect;
......@@ -1179,7 +1180,7 @@ package body Prj is
------------------
function Create_Flags
(Report_Error : Put_Line_Access;
(Report_Error : Error_Handler;
When_No_Sources : Error_Warning;
Require_Sources_Other_Lang : Boolean := True;
Allow_Duplicate_Basenames : Boolean := True;
......
gcc/ada/prj.ads
......@@ -96,16 +96,6 @@ package Prj is
-- constants, because Canonical_Case_File_Name is called on these variables
-- in the body of Prj.
type Error_Warning is (Silent, Warning, Error);
-- Severity of some situations, such as: no Ada sources in a project where
-- Ada is one of the language.
--
-- When the situation occurs, the behaviour depends on the setting:
--
-- - Silent: no action
-- - Warning: issue a warning, does not cause the tool to fail
-- - Error: issue an error, causes the tool to fail
function Empty_File return File_Name_Type;
function Empty_String return Name_Id;
-- Return the id for an empty string ""
......@@ -1290,12 +1280,6 @@ package Prj is
end record;
-- Data for a project tree
type Put_Line_Access is access procedure
(Line : String;
Project : Project_Id;
In_Tree : Project_Tree_Ref);
-- Use to customize error reporting in Prj.Proc and Prj.Nmsc
procedure Expect (The_Token : Token_Type; Token_Image : String);
-- Check that the current token is The_Token. If it is not, then output
-- an error message.
......@@ -1308,47 +1292,6 @@ package Prj is
-- This procedure resets all the tables that are used when processing a
-- project file tree. Initialize must be called before the call to Reset.
type Processing_Flags is private;
-- Flags used while parsing and processing a project tree to configure the
-- behavior of the parser, and indicate how to report error messages. This
-- structure does not allocate memory and never needs to be freed
function Create_Flags
(Report_Error : Put_Line_Access;
When_No_Sources : Error_Warning;
Require_Sources_Other_Lang : Boolean := True;
Allow_Duplicate_Basenames : Boolean := True;
Compiler_Driver_Mandatory : Boolean := False;
Error_On_Unknown_Language : Boolean := True) return Processing_Flags;
-- Function used to create Processing_Flags structure
--
-- If Allow_Duplicate_Basenames, then files with the same base names are
-- authorized within a project for source-based languages (never for unit
-- based languages).
--
-- If Compiler_Driver_Mandatory is true, then a Compiler.Driver attribute
-- for each language must be defined, or we will not look for its source
-- files.
--
-- When_No_Sources indicates what should be done when no sources of a
-- language are found in a project where this language is declared.
-- If Require_Sources_Other_Lang is true, then all languages must have at
-- least one source file, or an error is reported via When_No_Sources. If
-- it is false, this is only required for Ada (and only if it is a language
-- of the project). When this parameter is set to False, we do not check
-- that a proper naming scheme is defined for languages other than Ada.
--
-- If Report_Error is null, use the standard error reporting mechanism
-- (Errout). Otherwise, report errors using Report_Error.
--
-- If Error_On_Unknown_Language is true, an error is displayed if some of
-- the source files listed in the project do not match any naming scheme
Gprbuild_Flags : constant Processing_Flags;
Gnatmake_Flags : constant Processing_Flags;
-- Flags used by the various tools. They all display the error messages
-- through Prj.Err.
package Project_Boolean_Htable is new Simple_HTable
(Header_Num => Header_Num,
Element => Boolean,
......@@ -1399,6 +1342,69 @@ package Prj is
(Source_File_Name : File_Name_Type) return File_Name_Type;
-- Returns the switches file name corresponding to a source file name
-----------
-- Flags --
-----------
type Processing_Flags is private;
-- Flags used while parsing and processing a project tree to configure the
-- behavior of the parser, and indicate how to report error messages. This
-- structure does not allocate memory and never needs to be freed
type Error_Warning is (Silent, Warning, Error);
-- Severity of some situations, such as: no Ada sources in a project where
-- Ada is one of the language.
--
-- When the situation occurs, the behaviour depends on the setting:
--
-- - Silent: no action
-- - Warning: issue a warning, does not cause the tool to fail
-- - Error: issue an error, causes the tool to fail
type Error_Handler is access procedure
(Project : Project_Id; Is_Warning : Boolean);
-- This warngs when an error was found when parsing a project. The error
-- itself is handled through Prj.Err (and you should call
-- Prj.Err.Finalize to actually print the error). This ensures that
-- duplicate error messages are always correctly removed, that errors msgs
-- are sorted, and that all tools will report the same error to the user.
function Create_Flags
(Report_Error : Error_Handler;
When_No_Sources : Error_Warning;
Require_Sources_Other_Lang : Boolean := True;
Allow_Duplicate_Basenames : Boolean := True;
Compiler_Driver_Mandatory : Boolean := False;
Error_On_Unknown_Language : Boolean := True) return Processing_Flags;
-- Function used to create Processing_Flags structure
--
-- If Allow_Duplicate_Basenames, then files with the same base names are
-- authorized within a project for source-based languages (never for unit
-- based languages).
--
-- If Compiler_Driver_Mandatory is true, then a Compiler.Driver attribute
-- for each language must be defined, or we will not look for its source
-- files.
--
-- When_No_Sources indicates what should be done when no sources of a
-- language are found in a project where this language is declared.
-- If Require_Sources_Other_Lang is true, then all languages must have at
-- least one source file, or an error is reported via When_No_Sources. If
-- it is false, this is only required for Ada (and only if it is a language
-- of the project). When this parameter is set to False, we do not check
-- that a proper naming scheme is defined for languages other than Ada.
--
-- If Report_Error is null, use the standard error reporting mechanism
-- (Errout). Otherwise, report errors using Report_Error.
--
-- If Error_On_Unknown_Language is true, an error is displayed if some of
-- the source files listed in the project do not match any naming scheme
Gprbuild_Flags : constant Processing_Flags;
Gnatmake_Flags : constant Processing_Flags;
-- Flags used by the various tools. They all display the error messages
-- through Prj.Err.
----------------
-- Temp Files --
----------------
......@@ -1494,7 +1500,7 @@ private
type Processing_Flags is record
Require_Sources_Other_Lang : Boolean;
Report_Error : Put_Line_Access;
Report_Error : Error_Handler;
When_No_Sources : Error_Warning;
Allow_Duplicate_Basenames : Boolean;
Compiler_Driver_Mandatory : Boolean;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment