Skip to content

R
riscv-gcc-1
Commit a7ab2998 by Vincent Celier Committed by Arnaud Charlet
Options

make.adb (Compile_Sources): Change verbose message to minimum verbosity level… 

make.adb (Compile_Sources): Change verbose message to minimum verbosity level High for "is in an Ada...

2005-11-14  Vincent Celier  <celier@adacore.com>

	* make.adb (Compile_Sources): Change verbose message to minimum
	verbosity level High for "is in an Ada library", "is a read-only
	library" and "is an internal library",
	(Create_Binder_Mapping_File): Path name of ALI file for library project
	must include the library directory, not the object directory.
	(Scan_Make_Arg): Make sure that Switch.M.Scan_Make_Switches is called
	for new switches -vl, -vm and -vh.
	(Verbose_Msg): Add new defaulted parameter Minimum_Verbosity
	(Check): Use minimum verbosity Medium for some Verbose_Msg calls
	(Compile_Sources): Do not attempt to compile if an ALI file is missing
	in a project that is externally built.
	(Compute_All_Imported_Projects): New procedure
	(Gnatmake): Check if importing libraries should be regenerated because
	at least an imported library is more recent.
	(Initialize): For each project compute the list of the projects it
	imports directly or indirectly.
	(Add_Library_Search_Dir): New procedure, used in place of
	Add_Lib_Search_Dir in procedure Scan_Make_Arg so that absolute paths are
	put in the search paths.
	(Add_Source_Search_Dir): New procedure, used in place of
	Add_Src_Search_Dir in procedure Scan_Make_Arg so that absolute paths are
	put in the search paths.
	(Mark_Directory): Resolve the absolute path the directory before marking
	it.

	* switch-m.adb (Scan_Make_Switches): Replace "raise Bad_Switch;" with
	call to new procedure Bad_Switch. Call Scan_Pos with new parameter
	Switch. Do not handle any exception.
	(Scan_Make_Switches): Increment Ptr for new switches -vl, -vm and -vh
	so that the switch is recognized as valid.
	(Scan_Make_Switches): Implement new switches -vl, -vm and -vh.

From-SVN: r106989
parent dff0475f
Showing with 501 additions and 178 deletions
gcc/ada/make.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -250,10 +250,9 @@ package body Make is ...@@ -250,10 +250,9 @@ package body Make is
Table_Increment => 100, Table_Increment => 100,
Table_Name => "Make.Library_Projs"); Table_Name => "Make.Library_Projs");
-- Two variables to keep the last binder and linker switch index -- Two variables to keep the last binder and linker switch index in tables
-- in tables Binder_Switches and Linker_Switches, before adding -- Binder_Switches and Linker_Switches, before adding switches from the
-- switches from the project file (if any) and switches from the -- project file (if any) and switches from the command line (if any).
-- command line (if any).
Last_Binder_Switch : Integer := 0; Last_Binder_Switch : Integer := 0;
Last_Linker_Switch : Integer := 0; Last_Linker_Switch : Integer := 0;
...@@ -281,9 +280,9 @@ package body Make is ...@@ -281,9 +280,9 @@ package body Make is
-- The project id of the main project file, if any -- The project id of the main project file, if any
Project_Object_Directory : Project_Id := No_Project; Project_Object_Directory : Project_Id := No_Project;
-- The object directory of the project for the last compilation. -- The object directory of the project for the last compilation. Avoid
-- Avoid calling Change_Dir if the current working directory is already -- calling Change_Dir if the current working directory is already this
-- this directory -- directory
-- Packages of project files where unknown attributes are errors -- Packages of project files where unknown attributes are errors
...@@ -303,16 +302,30 @@ package body Make is ...@@ -303,16 +302,30 @@ package body Make is
Packages_To_Check_By_Gnatmake : constant String_List_Access := Packages_To_Check_By_Gnatmake : constant String_List_Access :=
Gnatmake_Packages'Access; Gnatmake_Packages'Access;
procedure Add_Library_Search_Dir
(Path : String;
On_Command_Line : Boolean);
-- Call Add_Lib_Search_Dir with an absolute directory path. If Path is a
-- relative path, when On_Command_Line is True, it is relative to the
-- current working directory; when On_Command_Line is False, it is relative
-- to the project directory of the main project.
procedure Add_Source_Search_Dir
(Path : String;
On_Command_Line : Boolean);
-- Call Add_Src_Search_Dir with an absolute directory path. If Path is a
-- relative path, when On_Command_Line is True, it is relative to the
-- current working directory; when On_Command_Line is False, it is relative
-- to the project directory of the main project.
procedure Add_Source_Dir (N : String); procedure Add_Source_Dir (N : String);
-- Call Add_Src_Search_Dir. -- Call Add_Src_Search_Dir (output one line when in verbose mode)
-- Output one line when in verbose mode.
procedure Add_Source_Directories is procedure Add_Source_Directories is
new Prj.Env.For_All_Source_Dirs (Action => Add_Source_Dir); new Prj.Env.For_All_Source_Dirs (Action => Add_Source_Dir);
procedure Add_Object_Dir (N : String); procedure Add_Object_Dir (N : String);
-- Call Add_Lib_Search_Dir. -- Call Add_Lib_Search_Dir (output one line when in verbose mode)
-- Output one line when in verbose mode.
procedure Add_Object_Directories is procedure Add_Object_Directories is
new Prj.Env.For_All_Object_Dirs (Action => Add_Object_Dir); new Prj.Env.For_All_Object_Dirs (Action => Add_Object_Dir);
...@@ -326,11 +339,10 @@ package body Make is ...@@ -326,11 +339,10 @@ package body Make is
Unit : Unit_Name_Type; Unit : Unit_Name_Type;
Found : Boolean; Found : Boolean;
end record; end record;
-- File is the name of the file for which a compilation failed. -- File is the name of the file for which a compilation failed. Unit is for
-- Unit is for gnatdist use in order to easily get the unit name -- gnatdist use in order to easily get the unit name of a file when its
-- of a file when its name is krunched or declared in gnat.adc. -- name is krunched or declared in gnat.adc. Found is False if the
-- Found is False if the compilation failed because the file could -- compilation failed because the file could not be found.
-- not be found.
package Bad_Compilation is new Table.Table ( package Bad_Compilation is new Table.Table (
Table_Component_Type => Bad_Compilation_Info, Table_Component_Type => Bad_Compilation_Info,
...@@ -401,7 +413,7 @@ package body Make is ...@@ -401,7 +413,7 @@ package body Make is
-- if an executable is up to date or not. -- if an executable is up to date or not.
procedure Enter_Into_Obsoleted (F : Name_Id); procedure Enter_Into_Obsoleted (F : Name_Id);
-- Enter a file name, without directory information, into the has table -- Enter a file name, without directory information, into the hash table
-- Obsoleted. -- Obsoleted.
function Is_In_Obsoleted (F : Name_Id) return Boolean; function Is_In_Obsoleted (F : Name_Id) return Boolean;
...@@ -480,12 +492,14 @@ package body Make is ...@@ -480,12 +492,14 @@ package body Make is
-- Prints out the list of all files for which the compilation failed -- Prints out the list of all files for which the compilation failed
procedure Verbose_Msg procedure Verbose_Msg
(N1 : Name_Id; (N1 : Name_Id;
S1 : String; S1 : String;
N2 : Name_Id := No_Name; N2 : Name_Id := No_Name;
S2 : String := ""; S2 : String := "";
Prefix : String := " -> "); Prefix : String := " -> ";
-- If the verbose flag (Verbose_Mode) is set then print Prefix to standard Minimum_Verbosity : Verbosity_Level_Type := Opt.Low);
-- If the verbose flag (Verbose_Mode) is set and the verbosity level is
-- at least equal to Minimum_Verbosity, then print Prefix to standard
-- output followed by N1 and S1. If N2 /= No_Name then N2 is printed after -- output followed by N1 and S1. If N2 /= No_Name then N2 is printed after
-- S1. S2 is printed last. Both N1 and N2 are printed in quotation marks. -- S1. S2 is printed last. Both N1 and N2 are printed in quotation marks.
...@@ -504,6 +518,10 @@ package body Make is ...@@ -504,6 +518,10 @@ package body Make is
Depth : Natural); Depth : Natural);
-- Compute depth of Project and of the projects it depends on -- Compute depth of Project and of the projects it depends on
procedure Compute_All_Imported_Projects (Project : Project_Id);
-- Compute, the list of the projects imported directly or indirectly by
-- project Project.
----------------------- -----------------------
-- Gnatmake Routines -- -- Gnatmake Routines --
----------------------- -----------------------
...@@ -519,19 +537,18 @@ package body Make is ...@@ -519,19 +537,18 @@ package body Make is
Ada_Lib_Dir : constant Lib_Mark_Type := 1; Ada_Lib_Dir : constant Lib_Mark_Type := 1;
-- Used to mark a directory as a GNAT lib dir -- Used to mark a directory as a GNAT lib dir
-- Note that the notion of GNAT lib dir is no longer used. The code -- Note that the notion of GNAT lib dir is no longer used. The code related
-- related to it has not been removed to give an idea on how to use -- to it has not been removed to give an idea on how to use the directory
-- the directory prefix marking mechanism. -- prefix marking mechanism.
-- An Ada library directory is a directory containing ali and object -- An Ada library directory is a directory containing ali and object files
-- files but no source files for the bodies (the specs can be in the -- but no source files for the bodies (the specs can be in the same or some
-- same or some other directory). These directories are specified -- other directory). These directories are specified in the Gnatmake
-- in the Gnatmake command line with the switch "-Adir" (to specify the -- command line with the switch "-Adir" (to specify the spec location -Idir
-- spec location -Idir cab be used). Gnatmake skips the missing sources -- cab be used). Gnatmake skips the missing sources whose ali are in Ada
-- whose ali are in Ada library directories. For an explanation of why -- library directories. For an explanation of why Gnatmake behaves that
-- Gnatmake behaves that way, see the spec of Make.Compile_Sources. -- way, see the spec of Make.Compile_Sources. The directory lookup penalty
-- The directory lookup penalty is incurred every single time this -- is incurred every single time this routine is called.
-- routine is called.
procedure Check_Steps; procedure Check_Steps;
-- Check what steps (Compile, Bind, Link) must be executed. -- Check what steps (Compile, Bind, Link) must be executed.
...@@ -542,10 +559,15 @@ package body Make is ...@@ -542,10 +559,15 @@ package body Make is
-- table for this directory. Then check if an Ada lib mark has been set. -- table for this directory. Then check if an Ada lib mark has been set.
procedure Mark_Directory procedure Mark_Directory
(Dir : String; (Dir : String;
Mark : Lib_Mark_Type); Mark : Lib_Mark_Type;
-- Store Dir in name table and set lib mark as name info to identify On_Command_Line : Boolean);
-- Ada libraries. -- Store the absolute path from Dir in name table and set lib mark as name
-- info to identify Ada libraries.
--
-- If Dir is a relative path, when On_Command_Line is True, it is relative
-- to the current working directory; when On_Command_Line is False, it is
-- relative to the project directory of the main project.
Output_Is_Object : Boolean := True; Output_Is_Object : Boolean := True;
-- Set to False when using a switch -S for the compiler -- Set to False when using a switch -S for the compiler
...@@ -561,12 +583,12 @@ package body Make is ...@@ -561,12 +583,12 @@ package body Make is
Naming : Naming_Data; Naming : Naming_Data;
In_Package : Package_Id; In_Package : Package_Id;
Allow_ALI : Boolean) return Variable_Value; Allow_ALI : Boolean) return Variable_Value;
-- Return the switches for the source file in the specified package -- Return the switches for the source file in the specified package of a
-- of a project file. If the Source_File ends with a standard GNAT -- project file. If the Source_File ends with a standard GNAT extension
-- extension (".ads" or ".adb"), try first the full name, then the -- (".ads" or ".adb"), try first the full name, then the name without the
-- name without the extension, then, if Allow_ALI is True, the name with -- extension, then, if Allow_ALI is True, the name with the extension
-- the extension ".ali". If there is no switches for either names, try the -- ".ali". If there is no switches for either names, try the default
-- default switches for Ada. If all failed, return No_Variable_Value. -- switches for Ada. If all failed, return No_Variable_Value.
function Is_In_Object_Directory function Is_In_Object_Directory
(Source_File : File_Name_Type; (Source_File : File_Name_Type;
...@@ -785,6 +807,28 @@ package body Make is ...@@ -785,6 +807,28 @@ package body Make is
Dependencies.Table (Dependencies.Last) := (S, On); Dependencies.Table (Dependencies.Last) := (S, On);
end Add_Dependency; end Add_Dependency;
----------------------------
-- Add_Library_Search_Dir --
----------------------------
procedure Add_Library_Search_Dir
(Path : String;
On_Command_Line : Boolean)
is
begin
if On_Command_Line then
Add_Lib_Search_Dir
(Normalize_Pathname (Path));
else
Get_Name_String
(Project_Tree.Projects.Table (Main_Project).Directory);
Add_Lib_Search_Dir
(Normalize_Pathname
(Path, Name_Buffer (1 .. Name_Len)));
end if;
end Add_Library_Search_Dir;
-------------------- --------------------
-- Add_Object_Dir -- -- Add_Object_Dir --
-------------------- --------------------
...@@ -817,6 +861,28 @@ package body Make is ...@@ -817,6 +861,28 @@ package body Make is
end if; end if;
end Add_Source_Dir; end Add_Source_Dir;
---------------------------
-- Add_Source_Search_Dir --
---------------------------
procedure Add_Source_Search_Dir
(Path : String;
On_Command_Line : Boolean)
is
begin
if On_Command_Line then
Add_Src_Search_Dir
(Normalize_Pathname (Path));
else
Get_Name_String
(Project_Tree.Projects.Table (Main_Project).Directory);
Add_Src_Search_Dir
(Normalize_Pathname
(Path, Name_Buffer (1 .. Name_Len)));
end if;
end Add_Source_Search_Dir;
---------------- ----------------
-- Add_Switch -- -- Add_Switch --
---------------- ----------------
...@@ -838,7 +904,7 @@ package body Make is ...@@ -838,7 +904,7 @@ package body Make is
-- Generic_Position -- -- Generic_Position --
---------------------- ----------------------
procedure Generic_Position (New_Position : out Integer) is procedure Generic_Position (New_Position : out Integer) is
begin begin
T.Increment_Last; T.Increment_Last;
...@@ -968,8 +1034,7 @@ package body Make is ...@@ -968,8 +1034,7 @@ package body Make is
if Name_Len > 0 then if Name_Len > 0 then
declare declare
Argv : constant String := Name_Buffer (1 .. Name_Len); Argv : constant String := Name_Buffer (1 .. Name_Len);
-- We need a copy, because Name_Buffer may be -- We need a copy, because Name_Buffer may be modified
-- modified.
begin begin
if Verbose_Mode then if Verbose_Mode then
...@@ -1033,8 +1098,8 @@ package body Make is ...@@ -1033,8 +1098,8 @@ package body Make is
Bind_Args (Args'Range) := Args; Bind_Args (Args'Range) := Args;
end if; end if;
-- It is completely pointless to re-check source file time stamps. -- It is completely pointless to re-check source file time stamps. This
-- This has been done already by gnatmake -- has been done already by gnatmake
Bind_Last := Bind_Last + 1; Bind_Last := Bind_Last + 1;
Bind_Args (Bind_Last) := Do_Not_Check_Flag; Bind_Args (Bind_Last) := Do_Not_Check_Flag;
...@@ -1142,9 +1207,9 @@ package body Make is ...@@ -1142,9 +1207,9 @@ package body Make is
Spec_File_Name : File_Name_Type := No_File; Spec_File_Name : File_Name_Type := No_File;
function New_Spec (Uname : Unit_Name_Type) return Boolean; function New_Spec (Uname : Unit_Name_Type) return Boolean;
-- Uname is the name of the spec or body of some ada unit. -- Uname is the name of the spec or body of some ada unit. This
-- This function returns True if the Uname is the name of a body -- function returns True if the Uname is the name of a body which has
-- which has a spec not mentioned inali file A. If True is returned -- a spec not mentioned inali file A. If True is returned
-- Spec_File_Name above is set to the name of this spec file. -- Spec_File_Name above is set to the name of this spec file.
-------------- --------------
...@@ -1262,9 +1327,9 @@ package body Make is ...@@ -1262,9 +1327,9 @@ package body Make is
begin begin
pragma Assert (Lib_File /= No_File); pragma Assert (Lib_File /= No_File);
-- If the ALI file is read-only, set temporarily -- If ALI file is read-only, temporarily set Check_Object_Consistency to
-- Check_Object_Consistency to False: we don't care if the object file -- False. We don't care if the object file is not there (presumably a
-- is not there; presumably, a library will be used for linking. -- library will be used for linking.)
if Read_Only then if Read_Only then
declare declare
...@@ -1286,9 +1351,17 @@ package body Make is ...@@ -1286,9 +1351,17 @@ package body Make is
Obj_Stamp := Current_Object_File_Stamp; Obj_Stamp := Current_Object_File_Stamp;
if Full_Lib_File = No_File then if Full_Lib_File = No_File then
Verbose_Msg (Lib_File, "being checked ...", Prefix => " "); Verbose_Msg
(Lib_File,
"being checked ...",
Prefix => " ",
Minimum_Verbosity => Opt.Medium);
else else
Verbose_Msg (Full_Lib_File, "being checked ...", Prefix => " "); Verbose_Msg
(Full_Lib_File,
"being checked ...",
Prefix => " ",
Minimum_Verbosity => Opt.Medium);
end if; end if;
ALI := No_ALI_Id; ALI := No_ALI_Id;
...@@ -1382,13 +1455,13 @@ package body Make is ...@@ -1382,13 +1455,13 @@ package body Make is
for J in 1 .. Switches_To_Check.Last loop for J in 1 .. Switches_To_Check.Last loop
-- Comparing switches is delicate because gcc reorders -- Comparing switches is delicate because gcc reorders a number
-- a number of switches, according to lang-specs.h, but -- of switches, according to lang-specs.h, but gnatmake doesn't
-- gnatmake doesn't have the sufficient knowledge to -- have the sufficient knowledge to perform the same
-- perform the same reordering. Instead, we ignore orders -- reordering. Instead, we ignore orders between different
-- between different "first letter" switches, but keep -- "first letter" switches, but keep orders between same
-- orders between same switches, e.g -O -O2 is different -- switches, e.g -O -O2 is different than -O2 -O, but -g -O is
-- than -O2 -O, but -g -O is equivalent to -O -g. -- equivalent to -O -g.
if Switches_To_Check.Table (J) (2) /= Prev_Switch (2) or else if Switches_To_Check.Table (J) (2) /= Prev_Switch (2) or else
(Prev_Switch'Length >= 6 and then (Prev_Switch'Length >= 6 and then
...@@ -1561,7 +1634,7 @@ package body Make is ...@@ -1561,7 +1634,7 @@ package body Make is
Name_Len := Name_Len - 1; Name_Len := Name_Len - 1;
end loop; end loop;
if Name_Len <= 0 then if Name_Len = 0 then
return; return;
elsif Name_Buffer (1) = '-' then elsif Name_Buffer (1) = '-' then
...@@ -2687,7 +2760,10 @@ package body Make is ...@@ -2687,7 +2760,10 @@ package body Make is
and then In_Ada_Lib_Dir (Full_Lib_File) and then In_Ada_Lib_Dir (Full_Lib_File)
then then
Verbose_Msg Verbose_Msg
(Lib_File, "is in an Ada library", Prefix => " "); (Lib_File,
"is in an Ada library",
Prefix => " ",
Minimum_Verbosity => Opt.High);
-- If the library file is a read-only library skip it, but -- If the library file is a read-only library skip it, but
-- only if, when using project files, this library file is -- only if, when using project files, this library file is
...@@ -2701,7 +2777,10 @@ package body Make is ...@@ -2701,7 +2777,10 @@ package body Make is
and then Is_In_Object_Directory (Source_File, Full_Lib_File) and then Is_In_Object_Directory (Source_File, Full_Lib_File)
then then
Verbose_Msg Verbose_Msg
(Lib_File, "is a read-only library", Prefix => " "); (Lib_File,
"is a read-only library",
Prefix => " ",
Minimum_Verbosity => Opt.High);
-- The source file that we are checking cannot be located -- The source file that we are checking cannot be located
...@@ -2724,7 +2803,10 @@ package body Make is ...@@ -2724,7 +2803,10 @@ package body Make is
end if; end if;
Verbose_Msg Verbose_Msg
(Lib_File, "is an internal library", Prefix => " "); (Lib_File,
"is an internal library",
Prefix => " ",
Minimum_Verbosity => Opt.High);
-- The source file that we are checking can be located -- The source file that we are checking can be located
...@@ -2764,52 +2846,65 @@ package body Make is ...@@ -2764,52 +2846,65 @@ package body Make is
end if; end if;
else else
-- Is this the first file we have to compile? -- Do nothing if project of source is externally built
if First_Compiled_File = No_File then if not Arguments_Collected then
First_Compiled_File := Full_Source_File; Collect_Arguments (Source_File, Source_Index, Args);
Most_Recent_Obj_File := No_File; end if;
if Do_Not_Execute then if Arguments_Project = No_Project
exit Make_Loop; or else not Project_Tree.Projects.Table
(Arguments_Project).Externally_Built
then
-- Is this the first file we have to compile?
if First_Compiled_File = No_File then
First_Compiled_File := Full_Source_File;
Most_Recent_Obj_File := No_File;
if Do_Not_Execute then
exit Make_Loop;
end if;
end if; end if;
end if;
if In_Place_Mode then if In_Place_Mode then
-- If the library file was not found, then save the -- If the library file was not found, then save
-- library file near the source file. -- the library file near the source file.
if Full_Lib_File = No_File then if Full_Lib_File = No_File then
Lib_File := Osint.Lib_File_Name Lib_File := Osint.Lib_File_Name
(Full_Source_File, Source_Index); (Full_Source_File, Source_Index);
-- If the library file was found, then save the -- If the library file was found, then save the
-- library file in the same place. -- library file in the same place.
else else
Lib_File := Full_Lib_File; Lib_File := Full_Lib_File;
end if; end if;
end if; end if;
-- Start the compilation and record it. We can do this -- Start the compilation and record it. We can do
-- because there is at least one free process. -- this because there is at least one free process.
Collect_Arguments_And_Compile (Source_File, Source_Index); Collect_Arguments_And_Compile
(Source_File, Source_Index);
-- Make sure we could successfully start the compilation -- Make sure we could successfully start
-- the Compilation.
if Process_Created then if Process_Created then
if Pid = Invalid_Pid then if Pid = Invalid_Pid then
Record_Failure (Full_Source_File, Source_Unit); Record_Failure (Full_Source_File, Source_Unit);
else else
Add_Process Add_Process
(Pid, (Pid,
Full_Source_File, Full_Source_File,
Lib_File, Lib_File,
Source_Unit, Source_Unit,
Mfile); Mfile);
end if;
end if; end if;
end if; end if;
end if; end if;
...@@ -3007,6 +3102,95 @@ package body Make is ...@@ -3007,6 +3102,95 @@ package body Make is
end Compile_Sources; end Compile_Sources;
-----------------------------------
-- Compute_All_Imported_Projects --
-----------------------------------
procedure Compute_All_Imported_Projects (Project : Project_Id) is
procedure Add_To_List (Prj : Project_Id);
-- Add a project to the list All_Imported_Projects of project Project
procedure Recursive_Add_Imported (Project : Project_Id);
-- Recursively add the projects imported by project Project, but not
-- those that are extended.
-----------------
-- Add_To_List --
-----------------
procedure Add_To_List (Prj : Project_Id) is
Element : constant Project_Element :=
(Prj, Project_Tree.Projects.Table (Project).All_Imported_Projects);
List : Project_List;
begin
Project_List_Table.Increment_Last (Project_Tree.Project_Lists);
List := Project_List_Table.Last (Project_Tree.Project_Lists);
Project_Tree.Project_Lists.Table (List) := Element;
Project_Tree.Projects.Table (Project).All_Imported_Projects := List;
end Add_To_List;
----------------------------
-- Recursive_Add_Imported --
----------------------------
procedure Recursive_Add_Imported (Project : Project_Id) is
List : Project_List;
Element : Project_Element;
Prj : Project_Id;
begin
if Project /= No_Project then
-- For all the imported projects
List := Project_Tree.Projects.Table (Project).Imported_Projects;
while List /= Empty_Project_List loop
Element := Project_Tree.Project_Lists.Table (List);
Prj := Element.Project;
-- Get the ultimate extending project
while
Project_Tree.Projects.Table (Prj).Extended_By /= No_Project
loop
Prj := Project_Tree.Projects.Table (Prj).Extended_By;
end loop;
-- If project has not yet been visited, add to list and recurse
if not Project_Tree.Projects.Table (Prj).Seen then
Project_Tree.Projects.Table (Prj).Seen := True;
Add_To_List (Prj);
Recursive_Add_Imported (Prj);
end if;
List := Element.Next;
end loop;
-- Recurse on projects being imported, if any
Recursive_Add_Imported
(Project_Tree.Projects.Table (Project).Extends);
end if;
end Recursive_Add_Imported;
begin
-- Reset the Seen flag for all projects
for Index in 1 .. Project_Table.Last (Project_Tree.Projects) loop
Project_Tree.Projects.Table (Index).Seen := False;
end loop;
-- Make sure the list is empty
Project_Tree.Projects.Table (Project).All_Imported_Projects :=
Empty_Project_List;
-- Add to the list all projects imported directly or indirectly
Recursive_Add_Imported (Project);
end Compute_All_Imported_Projects;
---------------------------------- ----------------------------------
-- Configuration_Pragmas_Switch -- -- Configuration_Pragmas_Switch --
---------------------------------- ----------------------------------
...@@ -3757,17 +3941,25 @@ package body Make is ...@@ -3757,17 +3941,25 @@ package body Make is
exit when not OK; exit when not OK;
-- Third line it the ALI path name, -- Third line it the ALI path name, concatenation
-- concatenation of the project -- of either the library directory or the object
-- directory with the ALI file name. -- directory with the ALI file name.
declare declare
ALI : constant String := ALI : constant String :=
Get_Name_String (ALI_Name); Get_Name_String (ALI_Name);
PD : Project_Data renames
Project_Tree.Projects.Table (ALI_Project);
begin begin
Get_Name_String -- For library projects, use the library directory,
(Project_Tree.Projects.Table -- for other projects, use the object directory.
(ALI_Project).Object_Directory);
if PD.Library then
Get_Name_String (PD.Library_Dir);
else
Get_Name_String (PD.Object_Directory);
end if;
if Name_Buffer (Name_Len) /= if Name_Buffer (Name_Len) /=
Directory_Separator Directory_Separator
...@@ -4797,17 +4989,51 @@ package body Make is ...@@ -4797,17 +4989,51 @@ package body Make is
if Main_Project /= No_Project if Main_Project /= No_Project
and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None
and then (Do_Bind_Step or Unique_Compile_All_Projects and then (Do_Bind_Step
or not Compile_Only) or Unique_Compile_All_Projects
or not Compile_Only)
and then (Do_Link_Step or N_File = Osint.Number_Of_Files) and then (Do_Link_Step or N_File = Osint.Number_Of_Files)
then then
Library_Projs.Init; Library_Projs.Init;
declare declare
Proj2 : Project_Id;
Depth : Natural; Depth : Natural;
Current : Natural; Current : Natural;
procedure Add_To_Library_Projs (Proj : Project_Id);
-- Add project Project to table Library_Projs
-- in decreasing depth order.
--------------------------
-- Add_To_Library_Projs --
--------------------------
procedure Add_To_Library_Projs (Proj : Project_Id) is
Prj : Project_Id;
begin
Library_Projs.Increment_Last;
Depth := Project_Tree.Projects.Table (Proj).Depth;
-- Put the projects in decreasing depth order,
-- so that if libA depends on libB, libB is first
-- in order.
Current := Library_Projs.Last;
while Current > 1 loop
Prj := Library_Projs.Table (Current - 1);
exit when Project_Tree.Projects.Table
(Prj).Depth >= Depth;
Library_Projs.Table (Current) := Prj;
Current := Current - 1;
end loop;
Library_Projs.Table (Current) := Proj;
end Add_To_Library_Projs;
-- Start of processing for ??? (should name declare block
-- or probably better, break this out as a nested proc.
begin begin
-- Put in Library_Projs table all library project -- Put in Library_Projs table all library project
-- file ids when the library need to be rebuilt. -- file ids when the library need to be rebuilt.
...@@ -4821,40 +5047,84 @@ package body Make is ...@@ -4821,40 +5047,84 @@ package body Make is
There_Are_Stand_Alone_Libraries := True; There_Are_Stand_Alone_Libraries := True;
end if; end if;
if Project_Tree.Projects.Table (Proj1).Library if Project_Tree.Projects.Table (Proj1).Library then
and then not Project_Tree.Projects.Table
(Proj1).Need_To_Build_Lib
and then not Project_Tree.Projects.Table
(Proj1).Externally_Built
then
MLib.Prj.Check_Library (Proj1, Project_Tree); MLib.Prj.Check_Library (Proj1, Project_Tree);
end if; end if;
if Project_Tree.Projects.Table if Project_Tree.Projects.Table
(Proj1).Need_To_Build_Lib (Proj1).Need_To_Build_Lib
then then
Library_Projs.Increment_Last; Add_To_Library_Projs (Proj1);
Current := Library_Projs.Last; end if;
Depth := Project_Tree.Projects.Table end loop;
(Proj1).Depth;
-- Put the projects in decreasing depth order, -- Check if importing libraries should be regenerated
-- so that if libA depends on libB, libB is first -- because at least an imported library will be
-- in order. -- regenerated or is more recent.
while Current > 1 loop for Proj1 in Project_Table.First ..
Proj2 := Library_Projs.Table (Current - 1); Project_Table.Last (Project_Tree.Projects)
exit when Project_Tree.Projects.Table loop
(Proj2).Depth >= Depth; if Project_Tree.Projects.Table (Proj1).Library
Library_Projs.Table (Current) := Proj2; and then not Project_Tree.Projects.Table
Current := Current - 1; (Proj1).Need_To_Build_Lib
end loop; and then not Project_Tree.Projects.Table
(Proj1).Externally_Built
Library_Projs.Table (Current) := Proj1; then
Project_Tree.Projects.Table declare
(Proj1).Need_To_Build_Lib := False; List : Project_List;
Element : Project_Element;
Proj2 : Project_Id;
Rebuild : Boolean := False;
Lib_Timestamp1 : constant Time_Stamp_Type :=
Project_Tree.Projects.Table
(Proj1). Library_TS;
begin
List := Project_Tree.Projects.Table (Proj1).
All_Imported_Projects;
while List /= Empty_Project_List loop
Element :=
Project_Tree.Project_Lists.Table (List);
Proj2 := Element.Project;
if
Project_Tree.Projects.Table (Proj2).Library
then
if Project_Tree.Projects.Table (Proj2).
Need_To_Build_Lib
or else
(Lib_Timestamp1 <
Project_Tree.Projects.Table
(Proj2).Library_TS)
then
Rebuild := True;
exit;
end if;
end if;
List := Element.Next;
end loop;
if Rebuild then
Project_Tree.Projects.Table
(Proj1).Need_To_Build_Lib := True;
Add_To_Library_Projs (Proj1);
end if;
end;
end if; end if;
end loop; end loop;
-- Reset the flags Need_To_Build_Lib for the next main,
-- to avoid rebuilding libraries uselessly.
for Proj1 in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
loop
Project_Tree.Projects.Table
(Proj1).Need_To_Build_Lib := False;
end loop;
end; end;
-- Build the libraries, if any need to be built -- Build the libraries, if any need to be built
...@@ -5909,6 +6179,15 @@ package body Make is ...@@ -5909,6 +6179,15 @@ package body Make is
Recursive_Compute_Depth Recursive_Compute_Depth
(Main_Project, Depth => 1); (Main_Project, Depth => 1);
-- For each project compute the list of the projects it imports
-- directly or indirectly.
for Proj in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
loop
Compute_All_Imported_Projects (Proj);
end loop;
else else
Osint.Add_Default_Search_Dirs; Osint.Add_Default_Search_Dirs;
...@@ -6389,17 +6668,51 @@ package body Make is ...@@ -6389,17 +6668,51 @@ package body Make is
-------------------- --------------------
procedure Mark_Directory procedure Mark_Directory
(Dir : String; (Dir : String;
Mark : Lib_Mark_Type) Mark : Lib_Mark_Type;
On_Command_Line : Boolean)
is is
N : Name_Id; N : Name_Id;
B : Byte; B : Byte;
begin begin
-- Dir last character is supposed to be a directory separator if On_Command_Line then
declare
Real_Path : constant String :=
Normalize_Pathname (Dir);
begin
if Real_Path'Length = 0 then
Name_Len := Dir'Length;
Name_Buffer (1 .. Name_Len) := Dir;
else
Name_Len := Real_Path'Length;
Name_Buffer (1 .. Name_Len) := Real_Path;
end if;
end;
else
declare
Real_Path : constant String :=
Normalize_Pathname
(Dir,
Get_Name_String
(Project_Tree.Projects.Table (Main_Project).Directory));
begin
if Real_Path'Length = 0 then
Name_Len := Dir'Length;
Name_Buffer (1 .. Name_Len) := Dir;
else
Name_Len := Real_Path'Length;
Name_Buffer (1 .. Name_Len) := Real_Path;
end if;
end;
end if;
Name_Len := Dir'Length; -- Last character is supposed to be a directory separator
Name_Buffer (1 .. Name_Len) := Dir;
if not Is_Directory_Separator (Name_Buffer (Name_Len)) then if not Is_Directory_Separator (Name_Buffer (Name_Len)) then
Name_Len := Name_Len + 1; Name_Len := Name_Len + 1;
...@@ -6623,11 +6936,11 @@ package body Make is ...@@ -6623,11 +6936,11 @@ package body Make is
elsif Program_Args = Compiler then elsif Program_Args = Compiler then
if Argv (3 .. Argv'Last) /= "-" then if Argv (3 .. Argv'Last) /= "-" then
Add_Src_Search_Dir (Argv (3 .. Argv'Last)); Add_Source_Search_Dir (Argv (3 .. Argv'Last), And_Save);
end if; end if;
elsif Program_Args = Binder then elsif Program_Args = Binder then
Add_Lib_Search_Dir (Argv (3 .. Argv'Last)); Add_Library_Search_Dir (Argv (3 .. Argv'Last), And_Save);
end if; end if;
end if; end if;
...@@ -6787,15 +7100,15 @@ package body Make is ...@@ -6787,15 +7100,15 @@ package body Make is
-- -Idir -- -Idir
elsif Argv (2) = 'I' then elsif Argv (2) = 'I' then
Add_Src_Search_Dir (Argv (3 .. Argv'Last)); Add_Source_Search_Dir (Argv (3 .. Argv'Last), And_Save);
Add_Lib_Search_Dir (Argv (3 .. Argv'Last)); Add_Library_Search_Dir (Argv (3 .. Argv'Last), And_Save);
Add_Switch (Argv, Compiler, And_Save => And_Save); Add_Switch (Argv, Compiler, And_Save => And_Save);
Add_Switch (Argv, Binder, And_Save => And_Save); Add_Switch (Argv, Binder, And_Save => And_Save);
-- -aIdir (to gcc this is like a -I switch) -- -aIdir (to gcc this is like a -I switch)
elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then
Add_Src_Search_Dir (Argv (4 .. Argv'Last)); Add_Source_Search_Dir (Argv (4 .. Argv'Last), And_Save);
Add_Switch ("-I" & Argv (4 .. Argv'Last), Add_Switch ("-I" & Argv (4 .. Argv'Last),
Compiler, Compiler,
And_Save => And_Save); And_Save => And_Save);
...@@ -6804,14 +7117,14 @@ package body Make is ...@@ -6804,14 +7117,14 @@ package body Make is
-- -aOdir -- -aOdir
elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
Add_Lib_Search_Dir (Argv (4 .. Argv'Last)); Add_Library_Search_Dir (Argv (4 .. Argv'Last), And_Save);
Add_Switch (Argv, Binder, And_Save => And_Save); Add_Switch (Argv, Binder, And_Save => And_Save);
-- -aLdir (to gnatbind this is like a -aO switch) -- -aLdir (to gnatbind this is like a -aO switch)
elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
Mark_Directory (Argv (4 .. Argv'Last), Ada_Lib_Dir); Mark_Directory (Argv (4 .. Argv'Last), Ada_Lib_Dir, And_Save);
Add_Lib_Search_Dir (Argv (4 .. Argv'Last)); Add_Library_Search_Dir (Argv (4 .. Argv'Last), And_Save);
Add_Switch ("-aO" & Argv (4 .. Argv'Last), Add_Switch ("-aO" & Argv (4 .. Argv'Last),
Binder, Binder,
And_Save => And_Save); And_Save => And_Save);
...@@ -6819,9 +7132,9 @@ package body Make is ...@@ -6819,9 +7132,9 @@ package body Make is
-- -Adir (to gnatbind this is like a -aO switch, to gcc like a -I) -- -Adir (to gnatbind this is like a -aO switch, to gcc like a -I)
elsif Argv (2) = 'A' then elsif Argv (2) = 'A' then
Mark_Directory (Argv (3 .. Argv'Last), Ada_Lib_Dir); Mark_Directory (Argv (3 .. Argv'Last), Ada_Lib_Dir, And_Save);
Add_Src_Search_Dir (Argv (3 .. Argv'Last)); Add_Source_Search_Dir (Argv (3 .. Argv'Last), And_Save);
Add_Lib_Search_Dir (Argv (3 .. Argv'Last)); Add_Library_Search_Dir (Argv (3 .. Argv'Last), And_Save);
Add_Switch ("-I" & Argv (3 .. Argv'Last), Add_Switch ("-I" & Argv (3 .. Argv'Last),
Compiler, Compiler,
And_Save => And_Save); And_Save => And_Save);
...@@ -7041,6 +7354,9 @@ package body Make is ...@@ -7041,6 +7354,9 @@ package body Make is
and then Argv (2 .. Argv'Last) /= "F" and then Argv (2 .. Argv'Last) /= "F"
and then Argv (2 .. Argv'Last) /= "M" and then Argv (2 .. Argv'Last) /= "M"
and then Argv (2 .. Argv'Last) /= "B" and then Argv (2 .. Argv'Last) /= "B"
and then Argv (2 .. Argv'Last) /= "vl"
and then Argv (2 .. Argv'Last) /= "vm"
and then Argv (2 .. Argv'Last) /= "vh"
and then (Argv'Length > 2 or else Argv (2) not in 'a' .. 'z') and then (Argv'Length > 2 or else Argv (2) not in 'a' .. 'z')
then then
Add_Switch (Argv, Compiler, And_Save => And_Save); Add_Switch (Argv, Compiler, And_Save => And_Save);
...@@ -7189,14 +7505,15 @@ package body Make is ...@@ -7189,14 +7505,15 @@ package body Make is
----------------- -----------------
procedure Verbose_Msg procedure Verbose_Msg
(N1 : Name_Id; (N1 : Name_Id;
S1 : String; S1 : String;
N2 : Name_Id := No_Name; N2 : Name_Id := No_Name;
S2 : String := ""; S2 : String := "";
Prefix : String := " -> ") Prefix : String := " -> ";
Minimum_Verbosity : Verbosity_Level_Type := Opt.Low)
is is
begin begin
if not Verbose_Mode then if (not Verbose_Mode) or else (Minimum_Verbosity > Verbosity_Level) then
return; return;
end if; end if;
......
gcc/ada/switch-m.adb
...@@ -491,7 +491,7 @@ package body Switch.M is ...@@ -491,7 +491,7 @@ package body Switch.M is
-- Skip past the initial character (must be the switch character) -- Skip past the initial character (must be the switch character)
if Ptr = Max then if Ptr = Max then
raise Bad_Switch; Bad_Switch (C);
else else
Ptr := Ptr + 1; Ptr := Ptr + 1;
...@@ -581,7 +581,7 @@ package body Switch.M is ...@@ -581,7 +581,7 @@ package body Switch.M is
then then
Set_Debug_Flag (C); Set_Debug_Flag (C);
else else
raise Bad_Switch; Bad_Switch (C);
end if; end if;
end loop; end loop;
...@@ -593,7 +593,7 @@ package body Switch.M is ...@@ -593,7 +593,7 @@ package body Switch.M is
Ptr := Ptr + 1; Ptr := Ptr + 1;
if Ptr > Max then if Ptr > Max then
raise Bad_Switch; Bad_Switch (C);
end if; end if;
case Switch_Chars (Ptr) is case Switch_Chars (Ptr) is
...@@ -602,7 +602,7 @@ package body Switch.M is ...@@ -602,7 +602,7 @@ package body Switch.M is
when 'I' => when 'I' =>
Ptr := Ptr + 1; Ptr := Ptr + 1;
Scan_Pos (Switch_Chars, Max, Ptr, Main_Index); Scan_Pos (Switch_Chars, Max, Ptr, Main_Index, C);
-- processing for eL switch -- processing for eL switch
...@@ -611,7 +611,7 @@ package body Switch.M is ...@@ -611,7 +611,7 @@ package body Switch.M is
Follow_Links := True; Follow_Links := True;
when others => when others =>
raise Bad_Switch; Bad_Switch (C);
end case; end case;
-- Processing for f switch -- Processing for f switch
...@@ -646,7 +646,7 @@ package body Switch.M is ...@@ -646,7 +646,7 @@ package body Switch.M is
declare declare
Max_Proc : Pos; Max_Proc : Pos;
begin begin
Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc); Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc, C);
Maximum_Processes := Positive (Max_Proc); Maximum_Processes := Positive (Max_Proc);
end; end;
...@@ -679,7 +679,7 @@ package body Switch.M is ...@@ -679,7 +679,7 @@ package body Switch.M is
Ptr := Ptr + 1; Ptr := Ptr + 1;
if Output_File_Name_Present then if Output_File_Name_Present then
raise Too_Many_Output_Files; Osint.Fail ("duplicate -o switch");
else else
Output_File_Name_Present := True; Output_File_Name_Present := True;
end if; end if;
...@@ -707,6 +707,25 @@ package body Switch.M is ...@@ -707,6 +707,25 @@ package body Switch.M is
when 'v' => when 'v' =>
Ptr := Ptr + 1; Ptr := Ptr + 1;
Verbose_Mode := True; Verbose_Mode := True;
Verbosity_Level := Opt.High;
if Ptr <= Max then
case Switch_Chars (Ptr) is
when 'l' =>
Verbosity_Level := Opt.Low;
when 'm' =>
Verbosity_Level := Opt.Medium;
when 'h' =>
Verbosity_Level := Opt.High;
when others =>
Osint.Fail ("invalid switch: ", Switch_Chars);
end case;
Ptr := Ptr + 1;
end if;
-- Processing for x switch -- Processing for x switch
...@@ -728,7 +747,7 @@ package body Switch.M is ...@@ -728,7 +747,7 @@ package body Switch.M is
-- Anything else is an error (illegal switch character) -- Anything else is an error (illegal switch character)
when others => when others =>
raise Bad_Switch; Bad_Switch (C);
end case; end case;
...@@ -738,19 +757,6 @@ package body Switch.M is ...@@ -738,19 +757,6 @@ package body Switch.M is
end Check_Switch; end Check_Switch;
exception
when Bad_Switch =>
Osint.Fail ("invalid switch: ", (1 => C));
when Bad_Switch_Value =>
Osint.Fail ("numeric value out of range for switch: ", (1 => C));
when Missing_Switch_Value =>
Osint.Fail ("missing numeric value for switch: ", (1 => C));
when Too_Many_Output_Files =>
Osint.Fail ("duplicate -o switch");
end Scan_Make_Switches; end Scan_Make_Switches;
end Switch.M; end Switch.M;
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