mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 19:51:34 +08:00
Code Issues Packages Projects Releases Wiki Activity

prj.ads (Error_Warning): New enumeration type

Browse Source 
2006-02-13  Vincent Celier  <celier@adacore.com>

	* prj.ads (Error_Warning): New enumeration type

	* prj-nmsc.ads, prj-nmsc.adb (Error_Msg): If location parameter is
	unknown, use the location of the project to report the error.
	(When_No_Sources): New global variable
	(Report_No_Ada_Sources): New procedure
	(Check): New parameter When_No_Sources. Set value of global variable
	When_No_Sources,
	(Find_Sources): Call Report_No_Ada_Sources when appropriate
	(Get_Sources_From_File): Ditto
	(Warn_If_Not_Sources): Better warning messages indicating the unit name
	and the file name.

	* prj-pars.ads, prj-pars.adb (Parse): New parameter When_No_Sources.
	Call Prj.Proc.Process with parameter When_No_Sources.

	* prj-proc.ads, prj-proc.adb (Check): New parameter When_No_Sources.
	Call Recursive_Check with parameter When_No_Sources.
	(Recursive_Check): New parameter When_No_Sources. Call itself and
	Prj.Nmsc.Check with parameter When_No_Sources.
	(Process): New parameter When_No_Sources. Call Check with parameter
	When_No_Sources.
	(Copy_Package_Declarations): New procedure to copy renamed parameters
	and setting the location of the declared attributes to the location
	of the renamed package.
	(Process_Declarative_Items): Call Copy_Package_Declarations for renamed
	packages.

From-SVN: r111084
This commit is contained in:
Vincent Celier 2006-02-15 10:43:00 +01:00 committed by Arnaud Charlet
parent 795b06b102
commit 97b7ca6fff
7 changed files with 266 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
gcc/ada/prj-nmsc.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2000-2005, Free Software Foundation, Inc. --
-- Copyright (C) 2000-2006, 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- --
@ -27,11 +27,10 @@
with Err_Vars; use Err_Vars;
with Fmap; use Fmap;
with Hostparm;
with MLib.Tgt;
with MLib.Tgt; use MLib.Tgt;
with Namet; use Namet;
with Osint; use Osint;
with Output; use Output;
with MLib.Tgt; use MLib.Tgt;
with Prj.Env; use Prj.Env;
with Prj.Err;
with Prj.Util; use Prj.Util;
@ -54,6 +53,10 @@ package body Prj.Nmsc is
Error_Report : Put_Line_Access := null;
-- Set to point to error reporting procedure
When_No_Sources : Error_Warning := Error;
-- Indicates what should be done when there is no Ada sources in a non
-- extending Ada project.
ALI_Suffix : constant String := ".ali";
-- File suffix for ali files
@ -352,6 +355,12 @@ package body Prj.Nmsc is
-- When Naming_Exceptions is True, mark the found sources as such, to
-- later remove those that are not named in a list of sources.
procedure Report_No_Ada_Sources
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Location : Source_Ptr);
-- Report an error or a warning depending on the value of When_No_Sources
procedure Show_Source_Dirs
(Project : Project_Id; In_Tree : Project_Tree_Ref);
-- List all the source directories of a project
@ -398,15 +407,17 @@ package body Prj.Nmsc is
-----------
procedure Check
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Report_Error : Put_Line_Access;
Follow_Links : Boolean)
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Report_Error : Put_Line_Access;
Follow_Links : Boolean;
When_No_Sources : Error_Warning)
is
Data : Project_Data := In_Tree.Projects.Table (Project);
Extending : Boolean := False;
begin
Nmsc.When_No_Sources := When_No_Sources;
Error_Report := Report_Error;
Recursive_Dirs.Reset;
@ -2793,6 +2804,7 @@ package body Prj.Nmsc is
Msg : String;
Flag_Location : Source_Ptr)
is
Real_Location : Source_Ptr := Flag_Location;
Error_Buffer : String (1 .. 5_000);
Error_Last : Natural := 0;
Msg_Name : Natural := 0;
@ -2832,8 +2844,14 @@ package body Prj.Nmsc is
-- Start of processing for Error_Msg
begin
-- If location of error is unknown, use the location of the project
if Real_Location = No_Location then
Real_Location := In_Tree.Projects.Table (Project).Location;
end if;
if Error_Report = null then
Prj.Err.Error_Msg (Msg, Flag_Location);
Prj.Err.Error_Msg (Msg, Real_Location);
return;
end if;
@ -3024,10 +3042,7 @@ package body Prj.Nmsc is
Data.Ada_Sources_Present := True;
elsif Data.Extends = No_Project then
Error_Msg
(Project, In_Tree,
"there are no Ada sources in this project",
Data.Location);
Report_No_Ada_Sources (Project, In_Tree, Data.Location);
end if;
end if;
end Find_Sources;
@ -4243,12 +4258,10 @@ package body Prj.Nmsc is
Get_Path_Names_And_Record_Sources (Follow_Links);
-- We should have found at least one source.
-- If not, report an error.
-- If not, report an error/warning.
if Data.Sources = Nil_String then
Error_Msg (Project, In_Tree,
"there are no Ada sources in this project",
Location);
Report_No_Ada_Sources (Project, In_Tree, Location);
end if;
end Get_Sources_From_File;
@ -5304,6 +5317,30 @@ package body Prj.Nmsc is
end if;
end Record_Other_Sources;
---------------------------
-- Report_No_Ada_Sources --
---------------------------
procedure Report_No_Ada_Sources
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Location : Source_Ptr)
is
begin
case When_No_Sources is
when Silent =>
null;
when Warning | Error =>
Error_Msg_Warn := When_No_Sources = Warning;
Error_Msg
(Project, In_Tree,
"<there are no Ada sources in this project",
Location);
end case;
end Report_No_Ada_Sources;
----------------------
-- Show_Source_Dirs --
----------------------
@ -5413,6 +5450,8 @@ package body Prj.Nmsc is
else
The_Unit_Data := In_Tree.Units.Table (The_Unit_Id);
Error_Msg_Name_2 :=
In_Tree.Array_Elements.Table (Conv).Value.Value;
if Specs then
if not Check_Project
@ -5421,7 +5460,8 @@ package body Prj.Nmsc is
then
Error_Msg
(Project, In_Tree,
"?unit{ has no spec in this project",
"?source of spec of unit { ({)" &
" cannot be found in this project",
Location);
end if;
@ -5432,7 +5472,8 @@ package body Prj.Nmsc is
then
Error_Msg
(Project, In_Tree,
"?unit{ has no body in this project",
"?source of body of unit { ({)" &
" cannot be found in this project",
Location);
end if;
end if;

12
gcc/ada/prj-nmsc.ads
View File

@ -33,10 +33,11 @@ private package Prj.Nmsc is
-- language summary of the implementation ???
procedure Check
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Report_Error : Put_Line_Access;
Follow_Links : Boolean);
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Report_Error : Put_Line_Access;
Follow_Links : Boolean;
When_No_Sources : Error_Warning);
-- Check the object directory and the source directories
--
-- Check the library attributes, including the library directory if any
@ -57,5 +58,8 @@ private package Prj.Nmsc is
-- any file duplicated through symbolic links (although the latter are
-- still valid if they point to a file which is outside of the project),
-- and that no directory has a name which is a valid source name.
--
-- When_No_Ada_Sources indicates what should be done when no Ada sources
-- are found in a project where Ada is a language.
end Prj.Nmsc;

10
gcc/ada/prj-pars.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2005, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2006, 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- --
@ -43,7 +43,8 @@ package body Prj.Pars is
(In_Tree : Project_Tree_Ref;
Project : out Project_Id;
Project_File_Name : String;
Packages_To_Check : String_List_Access := All_Packages)
Packages_To_Check : String_List_Access := All_Packages;
When_No_Sources : Error_Warning := Error)
is
Project_Node_Tree : constant Project_Node_Tree_Ref :=
new Project_Node_Tree_Data;
@ -73,7 +74,8 @@ package body Prj.Pars is
From_Project_Node => Project_Node,
From_Project_Node_Tree => Project_Node_Tree,
Report_Error => null,
Follow_Links => Opt.Follow_Links);
Follow_Links => Opt.Follow_Links,
When_No_Sources => When_No_Sources);
Prj.Err.Finalize;
if not Success then
@ -99,7 +101,7 @@ package body Prj.Pars is
-- Set_Verbosity --
-------------------
procedure Set_Verbosity (To : in Verbosity) is
procedure Set_Verbosity (To : Verbosity) is
begin
Current_Verbosity := To;
end Set_Verbosity;

6
gcc/ada/prj-pars.ads
View File

@ -35,7 +35,8 @@ package Prj.Pars is
(In_Tree : Project_Tree_Ref;
Project : out Project_Id;
Project_File_Name : String;
Packages_To_Check : String_List_Access := All_Packages);
Packages_To_Check : String_List_Access := All_Packages;
When_No_Sources : Error_Warning := Error);
-- Parse a project files and all its imported project files, in the
-- project tree In_Tree.
--
@ -46,5 +47,8 @@ package Prj.Pars is
-- Packages_To_Check indicates the packages where any unknown attribute
-- produces an error. For other packages, an unknown attribute produces
-- a warning.
--
-- When_No_Sources indicates what should be done when no sources
-- are found in a project for a specified or implied language.
end Prj.Pars;

195
gcc/ada/prj-proc.adb
View File

@ -65,12 +65,21 @@ package body Prj.Proc is
-- values to the package or project with declarations Decl.
procedure Check
(In_Tree : Project_Tree_Ref;
Project : in out Project_Id;
Follow_Links : Boolean);
(In_Tree : Project_Tree_Ref;
Project : in out Project_Id;
Follow_Links : Boolean;
When_No_Sources : Error_Warning);
-- Set all projects to not checked, then call Recursive_Check for the
-- main project Project. Project is set to No_Project if errors occurred.
procedure Copy_Package_Declarations
(From : Declarations;
To : in out Declarations;
New_Loc : Source_Ptr;
In_Tree : Project_Tree_Ref);
-- Copy a package declaration From to To for a renamed package. Change the
-- locations of all the attributes to New_Loc.
function Expression
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
@ -119,9 +128,10 @@ package body Prj.Proc is
-- Then process the declarative items of the project.
procedure Recursive_Check
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Follow_Links : Boolean);
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Follow_Links : Boolean;
When_No_Sources : Error_Warning);
-- If Project is not marked as checked, mark it as checked, call
-- Check_Naming_Scheme for the project, then call itself for a
-- possible extended project and all the imported projects of Project.
@ -225,9 +235,10 @@ package body Prj.Proc is
-----------
procedure Check
(In_Tree : Project_Tree_Ref;
Project : in out Project_Id;
Follow_Links : Boolean)
(In_Tree : Project_Tree_Ref;
Project : in out Project_Id;
Follow_Links : Boolean;
When_No_Sources : Error_Warning)
is
begin
-- Make sure that all projects are marked as not checked
@ -238,9 +249,136 @@ package body Prj.Proc is
In_Tree.Projects.Table (Index).Checked := False;
end loop;
Recursive_Check (Project, In_Tree, Follow_Links);
Recursive_Check (Project, In_Tree, Follow_Links, When_No_Sources);
end Check;
-------------------------------
-- Copy_Package_Declarations --
-------------------------------
procedure Copy_Package_Declarations
(From : Declarations;
To : in out Declarations;
New_Loc : Source_Ptr;
In_Tree : Project_Tree_Ref)
is
V1 : Variable_Id := From.Attributes;
V2 : Variable_Id := No_Variable;
Var : Variable;
A1 : Array_Id := From.Arrays;
A2 : Array_Id := No_Array;
Arr : Array_Data;
E1 : Array_Element_Id;
E2 : Array_Element_Id := No_Array_Element;
Elm : Array_Element;
begin
-- To avoid references in error messages to attribute declarations in
-- an original package that has been renamed, copy all the attribute
-- declarations of the package and change all locations to New_Loc,
-- the location of the renamed package.
-- First single attributes
while V1 /= No_Variable loop
-- Copy the attribute
Var := In_Tree.Variable_Elements.Table (V1);
V1 := Var.Next;
-- Remove the Next component
Var.Next := No_Variable;
-- Change the location to New_Loc
Var.Value.Location := New_Loc;
Variable_Element_Table.Increment_Last (In_Tree.Variable_Elements);
-- Put in new declaration
if To.Attributes = No_Variable then
To.Attributes :=
Variable_Element_Table.Last (In_Tree.Variable_Elements);
else
In_Tree.Variable_Elements.Table (V2).Next :=
Variable_Element_Table.Last (In_Tree.Variable_Elements);
end if;
V2 := Variable_Element_Table.Last (In_Tree.Variable_Elements);
In_Tree.Variable_Elements.Table (V2) := Var;
end loop;
-- Then the associated array attributes
while A1 /= No_Array loop
-- Copy the array
Arr := In_Tree.Arrays.Table (A1);
A1 := Arr.Next;
-- Remove the Next component
Arr.Next := No_Array;
Array_Table.Increment_Last (In_Tree.Arrays);
-- Create new Array declaration
if To.Arrays = No_Array then
To.Arrays := Array_Table.Last (In_Tree.Arrays);
else
In_Tree.Arrays.Table (A2).Next :=
Array_Table.Last (In_Tree.Arrays);
end if;
A2 := Array_Table.Last (In_Tree.Arrays);
-- Don't store the array, as its first element has not been set yet
-- Copy the array elements of the array
E1 := Arr.Value;
Arr.Value := No_Array_Element;
while E1 /= No_Array_Element loop
-- Copy the array element
Elm := In_Tree.Array_Elements.Table (E1);
E1 := Elm.Next;
-- Remove the Next component
Elm.Next := No_Array_Element;
-- Change the location
Elm.Value.Location := New_Loc;
Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
-- Create new array element
if Arr.Value = No_Array_Element then
Arr.Value := Array_Element_Table.Last (In_Tree.Array_Elements);
else
In_Tree.Array_Elements.Table (E2).Next :=
Array_Element_Table.Last (In_Tree.Array_Elements);
end if;
E2 := Array_Element_Table.Last (In_Tree.Array_Elements);
In_Tree.Array_Elements.Table (E2) := Elm;
end loop;
-- Finally, store the new array
In_Tree.Arrays.Table (A2) := Arr;
end loop;
end Copy_Package_Declarations;
----------------
-- Expression --
----------------
@ -998,7 +1136,8 @@ package body Prj.Proc is
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access;
Follow_Links : Boolean := True)
Follow_Links : Boolean := True;
When_No_Sources : Error_Warning := Error)
is
Obj_Dir : Name_Id;
Extending : Project_Id;
@ -1024,7 +1163,7 @@ package body Prj.Proc is
Extended_By => No_Project);
if Project /= No_Project then
Check (In_Tree, Project, Follow_Links);
Check (In_Tree, Project, Follow_Links, When_No_Sources);
end if;
-- If main project is an extending all project, set the object
@ -1233,11 +1372,20 @@ package body Prj.Proc is
From_Project_Node_Tree));
begin
-- For a renamed package, set declarations to
-- the declarations of the renamed package.
-- For a renamed package, copy the declarations of
-- the renamed package, but set all the locations
-- to the location of the package name in the
-- renaming declaration.
In_Tree.Packages.Table (New_Pkg).Decl :=
In_Tree.Packages.Table (Renamed_Package).Decl;
Copy_Package_Declarations
(From =>
In_Tree.Packages.Table (Renamed_Package).Decl,
To =>
In_Tree.Packages.Table (New_Pkg).Decl,
New_Loc =>
Location_Of
(Current_Item, From_Project_Node_Tree),
In_Tree => In_Tree);
end;
-- Standard package declaration, not renaming
@ -2106,9 +2254,10 @@ package body Prj.Proc is
---------------------
procedure Recursive_Check
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Follow_Links : Boolean)
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Follow_Links : Boolean;
When_No_Sources : Error_Warning)
is
Data : Project_Data;
Imported_Project_List : Project_List := Empty_Project_List;
@ -2130,7 +2279,8 @@ package body Prj.Proc is
-- Call itself for a possible extended project.
-- (if there is no extended project, then nothing happens).
Recursive_Check (Data.Extends, In_Tree, Follow_Links);
Recursive_Check
(Data.Extends, In_Tree, Follow_Links, When_No_Sources);
-- Call itself for all imported projects
@ -2139,7 +2289,7 @@ package body Prj.Proc is
Recursive_Check
(In_Tree.Project_Lists.Table
(Imported_Project_List).Project,
In_Tree, Follow_Links);
In_Tree, Follow_Links, When_No_Sources);
Imported_Project_List :=
In_Tree.Project_Lists.Table
(Imported_Project_List).Next;
@ -2151,7 +2301,8 @@ package body Prj.Proc is
Write_Line ("""");
end if;
Prj.Nmsc.Check (Project, In_Tree, Error_Report, Follow_Links);
Prj.Nmsc.Check
(Project, In_Tree, Error_Report, Follow_Links, When_No_Sources);
end if;
end Recursive_Check;

6
gcc/ada/prj-proc.ads
View File

@ -39,7 +39,8 @@ package Prj.Proc is
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access;
Follow_Links : Boolean := True);
Follow_Links : Boolean := True;
When_No_Sources : Error_Warning := Error);
-- Process a project file tree into project file data structures. If
-- Report_Error is null, use the error reporting mechanism. Otherwise,
-- report errors using Report_Error.
@ -49,6 +50,9 @@ package Prj.Proc is
-- still valid if they point to a file which is outside of the project),
-- and that no directory has a name which is a valid source name.
--
-- When_No_Sources indicates what should be done when no sources
-- are found in a project for a specified or implied language.
--
-- Process is a bit of a junk name, how about Process_Project_Tree???
end Prj.Proc;

10
gcc/ada/prj.ads
View File

@ -72,6 +72,16 @@ package Prj is
-- The standard project file name extension. It is not a constant, because
-- Canonical_Case_File_Name is called on this variable 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
-----------------------------------------------------
-- Multi-language Stuff That Will be Modified Soon --
-----------------------------------------------------