-- --
-- 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- --
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;
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
-- 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
-----------
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;
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;
-- 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;
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;
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;
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 --
----------------------
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
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;
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;
-- 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
-- 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;
-- --
-- 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- --
(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;
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
-- Set_Verbosity --
-------------------
- procedure Set_Verbosity (To : in Verbosity) is
+ procedure Set_Verbosity (To : Verbosity) is
begin
Current_Verbosity := To;
end Set_Verbosity;
(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.
--
-- 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;
-- 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;
-- 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.
-----------
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
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 --
----------------
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;
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
From_Project_Node_Tree));
begin
- -- For a renamed package, set declarations to
- -- the declarations of the renamed package.
-
- In_Tree.Packages.Table (New_Pkg).Decl :=
- In_Tree.Packages.Table (Renamed_Package).Decl;
+ -- 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.
+
+ 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
---------------------
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;
-- 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
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;
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;
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.
-- 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;
-- 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 --
-----------------------------------------------------
projects / gcc.git / commitdiff