prj.adb, [...] (Complete_Mains, [...]): new subprogram.
2011-08-04 Emmanuel Briot <briot@adacore.com> * prj.adb, prj.ads, makeutl.adb, makeutl.ads (Complete_Mains, Compute_Compilation_Phases): new subprogram. (Builder_Data, Builder_Project_Tree_Data): new subprogram and type The number of mains as well as the various compilation phases that need to be run are now project tree specific, since various aggregated trees might have different requirements. In particular, they do not all require bind or link phases. From-SVN: r177317
This commit is contained in:
Emmanuel Briot
Arnaud Charlet
parent
8dd00781e1
commit
316d9d4f9f
|
|
@ -1,3 +1,13 @@
|
|||
2011-08-04 Emmanuel Briot <briot@adacore.com>
|
||||
|
||||
* prj.adb, prj.ads, makeutl.adb, makeutl.ads (Complete_Mains,
|
||||
Compute_Compilation_Phases): new subprogram.
|
||||
(Builder_Data, Builder_Project_Tree_Data): new subprogram and type
|
||||
The number of mains as well as the various compilation phases that
|
||||
need to be run are now project tree specific, since various
|
||||
aggregated trees might have different requirements. In particular,
|
||||
they do not all require bind or link phases.
|
||||
|
||||
2011-08-04 Emmanuel Briot <briot@adacore.com>
|
||||
|
||||
* prj.adb, prj.ads, makeutl.adb, makeutl.ads, prj-env.adb
|
||||
|
|
|
|||
|
|
@ -23,6 +23,7 @@
|
|||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.Unchecked_Deallocation;
|
||||
with ALI; use ALI;
|
||||
with Debug;
|
||||
with Err_Vars; use Err_Vars;
|
||||
|
|
@ -1224,6 +1225,9 @@ package body Makeutl is
|
|||
Current : Natural := 0;
|
||||
-- The index of the last main retrieved from the table
|
||||
|
||||
Count_Of_Mains_With_No_Tree : Natural := 0;
|
||||
-- Number of main units for which we do not know the project tree
|
||||
|
||||
--------------
|
||||
-- Add_Main --
|
||||
--------------
|
||||
|
|
@ -1236,6 +1240,12 @@ package body Makeutl is
|
|||
Tree : Project_Tree_Ref := null)
|
||||
is
|
||||
begin
|
||||
if Current_Verbosity = High then
|
||||
Debug_Output ("Add_Main """ & Name & """ " & Index'Img
|
||||
& " with_tree? "
|
||||
& Boolean'Image (Tree /= null));
|
||||
end if;
|
||||
|
||||
Name_Len := 0;
|
||||
Add_Str_To_Name_Buffer (Name);
|
||||
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
|
||||
|
|
@ -1243,6 +1253,14 @@ package body Makeutl is
|
|||
Names.Increment_Last;
|
||||
Names.Table (Names.Last) :=
|
||||
(Name_Find, Index, Location, No_Source, Project, Tree);
|
||||
|
||||
if Tree /= null then
|
||||
Builder_Data (Tree).Number_Of_Mains :=
|
||||
Builder_Data (Tree).Number_Of_Mains + 1;
|
||||
else
|
||||
Mains.Count_Of_Mains_With_No_Tree :=
|
||||
Mains.Count_Of_Mains_With_No_Tree + 1;
|
||||
end if;
|
||||
end Add_Main;
|
||||
|
||||
--------------------------
|
||||
|
|
@ -1281,6 +1299,162 @@ package body Makeutl is
|
|||
Mains.Reset;
|
||||
end Delete;
|
||||
|
||||
--------------------
|
||||
-- Complete_Mains --
|
||||
--------------------
|
||||
|
||||
procedure Complete_Mains
|
||||
(Root_Project : Project_Id;
|
||||
Project_Tree : Project_Tree_Ref)
|
||||
is
|
||||
procedure Do_Complete (Project : Project_Id; Tree : Project_Tree_Ref);
|
||||
-- Check the mains for this specific project
|
||||
|
||||
procedure Complete_All is new For_Project_And_Aggregated
|
||||
(Do_Complete);
|
||||
|
||||
procedure Do_Complete
|
||||
(Project : Project_Id; Tree : Project_Tree_Ref) is
|
||||
begin
|
||||
if Mains.Number_Of_Mains (Tree) > 0
|
||||
or else Mains.Count_Of_Mains_With_No_Tree > 0
|
||||
then
|
||||
for J in Names.First .. Names.Last loop
|
||||
declare
|
||||
File : Main_Info := Names.Table (J);
|
||||
Main_Id : File_Name_Type := File.File;
|
||||
Main : constant String := Get_Name_String (Main_Id);
|
||||
Source : Prj.Source_Id := No_Source;
|
||||
Suffix : File_Name_Type;
|
||||
Iter : Source_Iterator;
|
||||
|
||||
begin
|
||||
if Base_Name (Main) /= Main then
|
||||
if Is_Absolute_Path (Main) then
|
||||
Main_Id := Create_Name (Base_Name (Main));
|
||||
else
|
||||
Fail_Program
|
||||
(Tree,
|
||||
"mains cannot include directory information ("""
|
||||
& Main & """)");
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- If no project or tree was specified for the main, it
|
||||
-- came from the command line. In this case, it needs to
|
||||
-- belong to the root project.
|
||||
-- Note that the assignments below will not modify inside
|
||||
-- the table itself.
|
||||
|
||||
if File.Project = null then
|
||||
File.Project := Project;
|
||||
end if;
|
||||
|
||||
if File.Tree = null then
|
||||
File.Tree := Project_Tree;
|
||||
end if;
|
||||
|
||||
if File.Source = null then
|
||||
|
||||
-- First, look for the main as specified.
|
||||
|
||||
Source := Find_Source
|
||||
(In_Tree => File.Tree,
|
||||
Project => File.Project,
|
||||
Base_Name => File.File,
|
||||
Index => File.Index);
|
||||
|
||||
if Source = No_Source then
|
||||
-- Now look for the main with a body suffix
|
||||
|
||||
declare
|
||||
-- Main already has a canonical casing
|
||||
Main : constant String :=
|
||||
Get_Name_String (Main_Id);
|
||||
Project : Project_Id;
|
||||
begin
|
||||
Project := File.Project;
|
||||
while Source = No_Source
|
||||
and then Project /= No_Project
|
||||
loop
|
||||
Iter := For_Each_Source (File.Tree, Project);
|
||||
loop
|
||||
Source := Prj.Element (Iter);
|
||||
exit when Source = No_Source;
|
||||
|
||||
-- Only consider bodies
|
||||
|
||||
if Source.Kind = Impl then
|
||||
Get_Name_String (Source.File);
|
||||
|
||||
if Name_Len > Main'Length
|
||||
and then Name_Buffer
|
||||
(1 .. Main'Length) = Main
|
||||
then
|
||||
Suffix :=
|
||||
Source.Language
|
||||
.Config.Naming_Data.Body_Suffix;
|
||||
|
||||
exit when Suffix /= No_File and then
|
||||
Name_Buffer
|
||||
(Main'Length + 1 .. Name_Len) =
|
||||
Get_Name_String (Suffix);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Next (Iter);
|
||||
end loop;
|
||||
|
||||
Project := Project.Extends;
|
||||
end loop;
|
||||
end;
|
||||
end if;
|
||||
|
||||
if Source /= No_Source then
|
||||
Debug_Output ("Found main in project",
|
||||
Name_Id (Source.File));
|
||||
Names.Table (J).File := Source.File;
|
||||
Names.Table (J).Project := File.Project;
|
||||
|
||||
if Names.Table (J).Tree = null then
|
||||
Names.Table (J).Tree := File.Tree;
|
||||
|
||||
Builder_Data (File.Tree).Number_Of_Mains :=
|
||||
Builder_Data (File.Tree).Number_Of_Mains + 1;
|
||||
Mains.Count_Of_Mains_With_No_Tree :=
|
||||
Mains.Count_Of_Mains_With_No_Tree - 1;
|
||||
end if;
|
||||
|
||||
Names.Table (J).Source := Source;
|
||||
|
||||
elsif File.Location /= No_Location then
|
||||
-- If the main is declared in package Builder of
|
||||
-- the main project, report an error. If the main
|
||||
-- is on the command line, it may be a main from
|
||||
-- another project, so do nothing: if the main does
|
||||
-- not exist in another project, an error will be
|
||||
-- reported later.
|
||||
|
||||
Error_Msg_File_1 := Main_Id;
|
||||
Error_Msg_Name_1 := Root_Project.Name;
|
||||
Errutil.Error_Msg
|
||||
("{ is not a source of project %%",
|
||||
File.Location);
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
if Total_Errors_Detected > 0 then
|
||||
Fail_Program (Tree, "problems with main sources");
|
||||
end if;
|
||||
end Do_Complete;
|
||||
|
||||
begin
|
||||
Complete_All (Root_Project, Project_Tree);
|
||||
end Complete_Mains;
|
||||
|
||||
-----------------------
|
||||
-- FIll_From_Project --
|
||||
-----------------------
|
||||
|
|
@ -1291,7 +1465,8 @@ package body Makeutl is
|
|||
is
|
||||
procedure Add_Mains_From_Project
|
||||
(Project : Project_Id; Tree : Project_Tree_Ref);
|
||||
-- Add the main units from this project into Mains
|
||||
-- Add the main units from this project into Mains.
|
||||
-- This takes into account the aggregated projects
|
||||
|
||||
procedure Add_Mains_From_Project
|
||||
(Project : Project_Id;
|
||||
|
|
@ -1299,160 +1474,47 @@ package body Makeutl is
|
|||
is
|
||||
List : String_List_Id;
|
||||
Element : String_Element;
|
||||
Agg : Aggregated_Project_List;
|
||||
begin
|
||||
Debug_Output ("Add_Mains_From_Project", Project.Name);
|
||||
case Project.Qualifier is
|
||||
when Aggregate =>
|
||||
Agg := Project.Aggregated_Projects;
|
||||
while Agg /= null loop
|
||||
Add_Mains_From_Project (Agg.Project, Agg.Tree);
|
||||
Agg := Agg.Next;
|
||||
if Number_Of_Mains (Tree) = 0
|
||||
and then Mains.Count_Of_Mains_With_No_Tree = 0
|
||||
then
|
||||
Debug_Output ("Add_Mains_From_Project", Project.Name);
|
||||
List := Project.Mains;
|
||||
if List /= Prj.Nil_String then
|
||||
-- The attribute Main is not an empty list.
|
||||
-- Get the mains in the list
|
||||
|
||||
while List /= Prj.Nil_String loop
|
||||
Element := Tree.Shared.String_Elements.Table (List);
|
||||
Debug_Output ("Add_Main", Element.Value);
|
||||
|
||||
if Project.Library then
|
||||
Fail_Program
|
||||
(Tree,
|
||||
"cannot specify a main program " &
|
||||
"for a library project file");
|
||||
end if;
|
||||
|
||||
Add_Main (Name => Get_Name_String (Element.Value),
|
||||
Index => Element.Index,
|
||||
Location => Element.Location,
|
||||
Project => Project,
|
||||
Tree => Tree);
|
||||
List := Element.Next;
|
||||
end loop;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
when others =>
|
||||
List := Project.Mains;
|
||||
if List /= Prj.Nil_String then
|
||||
-- The attribute Main is not an empty list.
|
||||
-- Get the mains in the list
|
||||
|
||||
while List /= Prj.Nil_String loop
|
||||
Element := Tree.Shared.String_Elements.Table (List);
|
||||
Debug_Output ("Add_Main", Element.Value);
|
||||
Add_Main (Name => Get_Name_String (Element.Value),
|
||||
Index => Element.Index,
|
||||
Location => Element.Location,
|
||||
Project => Project,
|
||||
Tree => Tree);
|
||||
List := Element.Next;
|
||||
end loop;
|
||||
end if;
|
||||
end case;
|
||||
if Total_Errors_Detected > 0 then
|
||||
Fail_Program (Tree, "problems with main sources");
|
||||
end if;
|
||||
end Add_Mains_From_Project;
|
||||
|
||||
procedure Fill_All is new For_Project_And_Aggregated
|
||||
(Add_Mains_From_Project);
|
||||
|
||||
begin
|
||||
if Number_Of_Mains = 0 then
|
||||
Add_Mains_From_Project (Root_Project, Project_Tree);
|
||||
end if;
|
||||
|
||||
-- If there are mains, check that they are sources of the main
|
||||
-- project
|
||||
|
||||
if Mains.Number_Of_Mains > 0 then
|
||||
for J in Names.First .. Names.Last loop
|
||||
declare
|
||||
File : Main_Info := Names.Table (J);
|
||||
Main_Id : File_Name_Type := File.File;
|
||||
Main : constant String := Get_Name_String (Main_Id);
|
||||
Project : Project_Id;
|
||||
Source : Prj.Source_Id := No_Source;
|
||||
Suffix : File_Name_Type;
|
||||
Iter : Source_Iterator;
|
||||
|
||||
begin
|
||||
if Base_Name (Main) /= Main then
|
||||
if Is_Absolute_Path (Main) then
|
||||
Main_Id := Create_Name (Base_Name (Main));
|
||||
|
||||
else
|
||||
Fail_Program
|
||||
(Project_Tree,
|
||||
"mains cannot include directory information (""" &
|
||||
Main & """)");
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- If no project or tree was specified for the main, it came
|
||||
-- from the command line. In this case, it needs to belong
|
||||
-- to the root project.
|
||||
-- Note that the assignments below will not modify inside
|
||||
-- the table itself.
|
||||
|
||||
if File.Project = null then
|
||||
File.Project := Root_Project;
|
||||
end if;
|
||||
|
||||
if File.Tree = null then
|
||||
File.Tree := Project_Tree;
|
||||
end if;
|
||||
|
||||
-- First, look for the main as specified.
|
||||
|
||||
Source := Find_Source
|
||||
(In_Tree => File.Tree,
|
||||
Project => File.Project,
|
||||
Base_Name => File.File,
|
||||
Index => File.Index);
|
||||
|
||||
if Source = No_Source then
|
||||
-- Now look for the main with a body suffix
|
||||
|
||||
declare
|
||||
-- Main already has a canonical casing
|
||||
Main : constant String := Get_Name_String (Main_Id);
|
||||
begin
|
||||
Project := File.Project;
|
||||
while Source = No_Source
|
||||
and then Project /= No_Project
|
||||
loop
|
||||
Iter := For_Each_Source (File.Tree, Project);
|
||||
loop
|
||||
Source := Prj.Element (Iter);
|
||||
exit when Source = No_Source;
|
||||
|
||||
-- Only consider bodies
|
||||
|
||||
if Source.Kind = Impl then
|
||||
Get_Name_String (Source.File);
|
||||
|
||||
if Name_Len > Main'Length
|
||||
and then
|
||||
Name_Buffer (1 .. Main'Length) = Main
|
||||
then
|
||||
Suffix :=
|
||||
Source.Language
|
||||
.Config.Naming_Data.Body_Suffix;
|
||||
|
||||
exit when Suffix /= No_File and then
|
||||
Name_Buffer (Main'Length + 1 .. Name_Len)
|
||||
= Get_Name_String (Suffix);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Next (Iter);
|
||||
end loop;
|
||||
|
||||
Project := Project.Extends;
|
||||
end loop;
|
||||
end;
|
||||
end if;
|
||||
|
||||
if Source /= No_Source then
|
||||
Names.Table (J).File := Source.File;
|
||||
Names.Table (J).Project := File.Project;
|
||||
Names.Table (J).Tree := File.Tree;
|
||||
Names.Table (J).Source := Source;
|
||||
|
||||
elsif File.Location /= No_Location then
|
||||
-- If the main is declared in package Builder of the
|
||||
-- main project, report an error. If the main is on
|
||||
-- the command line, it may be a main from another
|
||||
-- project, so do nothing: if the main does not exist
|
||||
-- in another project, an error will be reported
|
||||
-- later.
|
||||
|
||||
Error_Msg_File_1 := Main_Id;
|
||||
Error_Msg_Name_1 := Root_Project.Name;
|
||||
Errutil.Error_Msg ("{ is not a source of project %%",
|
||||
File.Location);
|
||||
end if;
|
||||
end;
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
if Total_Errors_Detected > 0 then
|
||||
Fail_Program (Project_Tree, "problems with main sources");
|
||||
end if;
|
||||
Fill_All (Root_Project, Project_Tree);
|
||||
end Fill_From_Project;
|
||||
|
||||
---------------
|
||||
|
|
@ -1488,9 +1550,13 @@ package body Makeutl is
|
|||
-- Number_Of_Mains --
|
||||
---------------------
|
||||
|
||||
function Number_Of_Mains return Natural is
|
||||
function Number_Of_Mains (Tree : Project_Tree_Ref) return Natural is
|
||||
begin
|
||||
return Names.Last;
|
||||
if Tree = null then
|
||||
return Names.Last;
|
||||
else
|
||||
return Builder_Data (Tree).Number_Of_Mains;
|
||||
end if;
|
||||
end Number_Of_Mains;
|
||||
|
||||
-----------
|
||||
|
|
@ -2017,7 +2083,7 @@ package body Makeutl is
|
|||
if Current_Verbosity = High then
|
||||
Write_Str ("Adding """);
|
||||
Debug_Display (Source);
|
||||
Write_Line (" to the queue");
|
||||
Write_Line (""" to the queue");
|
||||
end if;
|
||||
|
||||
Q.Append (New_Val => (Info => Source, Processed => False));
|
||||
|
|
@ -2344,55 +2410,80 @@ package body Makeutl is
|
|||
----------------------------
|
||||
|
||||
procedure Insert_Project_Sources
|
||||
(Project : Project_Id;
|
||||
Project_Tree : Project_Tree_Ref;
|
||||
All_Projects : Boolean;
|
||||
Unit_Based : Boolean)
|
||||
(Project : Project_Id;
|
||||
Project_Tree : Project_Tree_Ref;
|
||||
All_Projects : Boolean;
|
||||
Unique_Compile : Boolean)
|
||||
is
|
||||
Iter : Source_Iterator;
|
||||
Source : Prj.Source_Id;
|
||||
begin
|
||||
Iter := For_Each_Source (Project_Tree);
|
||||
loop
|
||||
Source := Prj.Element (Iter);
|
||||
exit when Source = No_Source;
|
||||
procedure Do_Insert (Project : Project_Id; Tree : Project_Tree_Ref);
|
||||
procedure Do_Insert (Project : Project_Id; Tree : Project_Tree_Ref) is
|
||||
Unit_Based : constant Boolean :=
|
||||
Unique_Compile
|
||||
or else not Builder_Data (Tree).Closure_Needed;
|
||||
-- When Unit_Based is True, put in the queue all compilable
|
||||
-- sources including the unit based (Ada) one. When Unit_Based is
|
||||
-- False, put the Ada sources only when they are in a library
|
||||
-- project.
|
||||
|
||||
if Is_Compilable (Source)
|
||||
and then
|
||||
(All_Projects
|
||||
or else Is_Extending (Project, Source.Project))
|
||||
and then not Source.Locally_Removed
|
||||
and then Source.Replaced_By = No_Source
|
||||
and then
|
||||
(not Source.Project.Externally_Built
|
||||
or else
|
||||
(Is_Extending (Project, Source.Project)
|
||||
and then not Project.Externally_Built))
|
||||
and then Source.Kind /= Sep
|
||||
and then Source.Path /= No_Path_Information
|
||||
Iter : Source_Iterator;
|
||||
Source : Prj.Source_Id;
|
||||
begin
|
||||
-- Nothing to do when "-u" was specified and some files were
|
||||
-- specified on the command line
|
||||
|
||||
if Unique_Compile
|
||||
and then Mains.Number_Of_Mains (Tree) > 0
|
||||
then
|
||||
if Source.Kind = Impl
|
||||
or else (Source.Unit /= No_Unit_Index
|
||||
and then Source.Kind = Spec
|
||||
and then (Other_Part (Source) = No_Source
|
||||
or else
|
||||
Other_Part (Source).Locally_Removed))
|
||||
then
|
||||
if (Unit_Based
|
||||
or else Source.Unit = No_Unit_Index
|
||||
or else Source.Project.Library)
|
||||
and then not Is_Subunit (Source)
|
||||
then
|
||||
Queue.Insert
|
||||
(Source => (Format => Format_Gprbuild,
|
||||
Tree => Project_Tree,
|
||||
Id => Source));
|
||||
end if;
|
||||
end if;
|
||||
return;
|
||||
end if;
|
||||
|
||||
Next (Iter);
|
||||
end loop;
|
||||
Iter := For_Each_Source (Tree);
|
||||
loop
|
||||
Source := Prj.Element (Iter);
|
||||
exit when Source = No_Source;
|
||||
|
||||
if Is_Compilable (Source)
|
||||
and then
|
||||
(All_Projects
|
||||
or else Is_Extending (Project, Source.Project))
|
||||
and then not Source.Locally_Removed
|
||||
and then Source.Replaced_By = No_Source
|
||||
and then
|
||||
(not Source.Project.Externally_Built
|
||||
or else
|
||||
(Is_Extending (Project, Source.Project)
|
||||
and then not Project.Externally_Built))
|
||||
and then Source.Kind /= Sep
|
||||
and then Source.Path /= No_Path_Information
|
||||
then
|
||||
if Source.Kind = Impl
|
||||
or else (Source.Unit /= No_Unit_Index
|
||||
and then Source.Kind = Spec
|
||||
and then (Other_Part (Source) = No_Source
|
||||
or else
|
||||
Other_Part (Source).Locally_Removed))
|
||||
then
|
||||
if (Unit_Based
|
||||
or else Source.Unit = No_Unit_Index
|
||||
or else Source.Project.Library)
|
||||
and then not Is_Subunit (Source)
|
||||
then
|
||||
Queue.Insert
|
||||
(Source => (Format => Format_Gprbuild,
|
||||
Tree => Tree,
|
||||
Id => Source));
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Next (Iter);
|
||||
end loop;
|
||||
end Do_Insert;
|
||||
|
||||
procedure Insert_All is new For_Project_And_Aggregated (Do_Insert);
|
||||
|
||||
begin
|
||||
Insert_All (Project, Project_Tree);
|
||||
end Insert_Project_Sources;
|
||||
|
||||
-------------------------------
|
||||
|
|
@ -2480,4 +2571,97 @@ package body Makeutl is
|
|||
end Insert_Withed_Sources_For;
|
||||
end Queue;
|
||||
|
||||
----------
|
||||
-- Free --
|
||||
----------
|
||||
|
||||
procedure Free (Data : in out Builder_Project_Tree_Data) is
|
||||
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
|
||||
(Binding_Data_Record, Binding_Data);
|
||||
|
||||
TmpB, Binding : Binding_Data := Data.Binding;
|
||||
begin
|
||||
while Binding /= null loop
|
||||
TmpB := Binding.Next;
|
||||
Unchecked_Free (Binding);
|
||||
Binding := TmpB;
|
||||
end loop;
|
||||
end Free;
|
||||
|
||||
------------------
|
||||
-- Builder_Data --
|
||||
------------------
|
||||
|
||||
function Builder_Data
|
||||
(Tree : Project_Tree_Ref) return Builder_Data_Access
|
||||
is
|
||||
begin
|
||||
if Tree.Appdata = null then
|
||||
Tree.Appdata := new Builder_Project_Tree_Data;
|
||||
end if;
|
||||
|
||||
return Builder_Data_Access (Tree.Appdata);
|
||||
end Builder_Data;
|
||||
|
||||
--------------------------------
|
||||
-- Compute_Compilation_Phases --
|
||||
--------------------------------
|
||||
|
||||
procedure Compute_Compilation_Phases
|
||||
(Tree : Project_Tree_Ref;
|
||||
Root_Project : Project_Id;
|
||||
Option_Unique_Compile : Boolean := False; -- Was "-u" specified ?
|
||||
Option_Compile_Only : Boolean := False; -- Was "-c" specified ?
|
||||
Option_Bind_Only : Boolean := False;
|
||||
Option_Link_Only : Boolean := False)
|
||||
is
|
||||
procedure Do_Compute (Project : Project_Id; Tree : Project_Tree_Ref);
|
||||
|
||||
procedure Do_Compute (Project : Project_Id; Tree : Project_Tree_Ref) is
|
||||
Data : constant Builder_Data_Access := Builder_Data (Tree);
|
||||
All_Phases : constant Boolean :=
|
||||
not Option_Compile_Only
|
||||
and then not Option_Bind_Only
|
||||
and then not Option_Link_Only;
|
||||
-- Whether the command line asked for all three phases. Depending on
|
||||
-- the project settings, we might still disable some of the phases.
|
||||
|
||||
Has_Mains : constant Boolean := Data.Number_Of_Mains > 0;
|
||||
-- Whether there are some main units defined for this project tree
|
||||
-- (either from one of the projects, or from the command line)
|
||||
|
||||
begin
|
||||
if Option_Unique_Compile then
|
||||
-- If -u or -U is specified on the command line, disregard any -c,
|
||||
-- -b or -l switch: only perform compilation.
|
||||
|
||||
Data.Closure_Needed := False;
|
||||
Data.Need_Compilation := True;
|
||||
Data.Need_Binding := False;
|
||||
Data.Need_Linking := False;
|
||||
|
||||
else
|
||||
Data.Closure_Needed := Has_Mains;
|
||||
Data.Need_Compilation := All_Phases or Option_Compile_Only;
|
||||
Data.Need_Binding := All_Phases or Option_Bind_Only;
|
||||
Data.Need_Linking := (All_Phases or Option_Link_Only)
|
||||
and then Has_Mains;
|
||||
end if;
|
||||
|
||||
if Current_Verbosity = High then
|
||||
Debug_Output ("Compilation phases: "
|
||||
& " compile=" & Data.Need_Compilation'Img
|
||||
& " bind=" & Data.Need_Binding'Img
|
||||
& " link=" & Data.Need_Linking'Img
|
||||
& " closure=" & Data.Closure_Needed'Img
|
||||
& " mains=" & Data.Number_Of_Mains'Img,
|
||||
Project.Name);
|
||||
end if;
|
||||
end Do_Compute;
|
||||
|
||||
procedure Compute_All is new For_Project_And_Aggregated (Do_Compute);
|
||||
begin
|
||||
Compute_All (Root_Project, Tree);
|
||||
end Compute_Compilation_Phases;
|
||||
|
||||
end Makeutl;
|
||||
|
|
|
|||
|
|
@ -233,6 +233,66 @@ package Makeutl is
|
|||
-- according to Fatal.
|
||||
-- This properly removes all temporary files
|
||||
|
||||
-----------------------
|
||||
-- Project_Tree data --
|
||||
-----------------------
|
||||
-- The following types are specific to builders, and associated with each
|
||||
-- of the loaded project trees.
|
||||
|
||||
type Binding_Data_Record;
|
||||
type Binding_Data is access Binding_Data_Record;
|
||||
type Binding_Data_Record is record
|
||||
Language : Language_Ptr;
|
||||
Language_Name : Name_Id;
|
||||
Binder_Driver_Name : File_Name_Type;
|
||||
Binder_Driver_Path : String_Access;
|
||||
Binder_Prefix : Name_Id;
|
||||
Next : Binding_Data;
|
||||
end record;
|
||||
-- Data for a language that have a binder driver
|
||||
|
||||
type Builder_Project_Tree_Data is new Project_Tree_Appdata with record
|
||||
Binding : Binding_Data;
|
||||
|
||||
There_Are_Binder_Drivers : Boolean := False;
|
||||
-- True when there is a binder driver. Set by Get_Configuration when
|
||||
-- an attribute Language_Processing'Binder_Driver is declared.
|
||||
-- Reset to False if there are no sources of the languages with binder
|
||||
-- drivers.
|
||||
|
||||
Number_Of_Mains : Natural := 0;
|
||||
-- Number of main units in this project tree
|
||||
|
||||
Closure_Needed : Boolean := False;
|
||||
-- If True, we need to add the closure of the file we just compiled to
|
||||
-- the queue. If False, it is assumed that all files are already on the
|
||||
-- queue so we do not waste time computing the closure.
|
||||
|
||||
Need_Compilation : Boolean := True;
|
||||
Need_Binding : Boolean := True;
|
||||
Need_Linking : Boolean := True;
|
||||
-- Which of the compilation phases are needed for this project tree.
|
||||
end record;
|
||||
type Builder_Data_Access is access all Builder_Project_Tree_Data;
|
||||
|
||||
procedure Free (Data : in out Builder_Project_Tree_Data);
|
||||
-- Free all memory allocated for Data
|
||||
|
||||
function Builder_Data (Tree : Project_Tree_Ref) return Builder_Data_Access;
|
||||
-- Return (allocate if needed) tree-specific data
|
||||
|
||||
procedure Compute_Compilation_Phases
|
||||
(Tree : Project_Tree_Ref;
|
||||
Root_Project : Project_Id;
|
||||
Option_Unique_Compile : Boolean := False; -- Was "-u" specified ?
|
||||
Option_Compile_Only : Boolean := False; -- Was "-c" specified ?
|
||||
Option_Bind_Only : Boolean := False;
|
||||
Option_Link_Only : Boolean := False);
|
||||
-- Compute which compilation phases will be needed for Tree. This also
|
||||
-- does the computation for aggregated trees.
|
||||
-- This also check whether we'll need to check the closure of the files we
|
||||
-- have just compiled to add them to the queue.
|
||||
|
||||
-----------
|
||||
-- Mains --
|
||||
-----------
|
||||
|
|
@ -295,8 +355,9 @@ package Makeutl is
|
|||
-- Moves the cursor forward and returns the new current entry.
|
||||
-- Returns No_File_And_Loc if there are no more mains in the table.
|
||||
|
||||
function Number_Of_Mains return Natural;
|
||||
-- Returns the number of mains in the table.
|
||||
function Number_Of_Mains (Tree : Project_Tree_Ref) return Natural;
|
||||
-- Returns the number of mains in this project tree (if Tree is null,
|
||||
-- it returns the total number of project trees)
|
||||
|
||||
procedure Fill_From_Project
|
||||
(Root_Project : Project_Id;
|
||||
|
|
@ -304,7 +365,10 @@ package Makeutl is
|
|||
-- If no main was already added (presumably from the command line), add
|
||||
-- the main units from root_project (or in the case of an aggregate
|
||||
-- project from all the aggregated projects).
|
||||
--
|
||||
|
||||
procedure Complete_Mains
|
||||
(Root_Project : Project_Id;
|
||||
Project_Tree : Project_Tree_Ref);
|
||||
-- If some main units were already added from the command line, check
|
||||
-- that they all belong to the root project, and that they are full
|
||||
-- full paths rather than (partial) base names (e.g. no body suffix was
|
||||
|
|
@ -382,16 +446,19 @@ package Makeutl is
|
|||
-- stored in the corresponding Source_Id for later reuse by the binder.
|
||||
|
||||
procedure Insert_Project_Sources
|
||||
(Project : Project_Id;
|
||||
Project_Tree : Project_Tree_Ref;
|
||||
All_Projects : Boolean;
|
||||
Unit_Based : Boolean);
|
||||
(Project : Project_Id;
|
||||
Project_Tree : Project_Tree_Ref;
|
||||
All_Projects : Boolean;
|
||||
Unique_Compile : Boolean);
|
||||
-- Insert all the compilable sources of the project in the queue. If
|
||||
-- All_Project is true, then all sources from imported projects are also
|
||||
-- inserted.
|
||||
-- When Unit_Based is True, put in the queue all compilable sources
|
||||
-- including the unit based (Ada) one. When Unit_Based is False, put the
|
||||
-- Ada sources only when they are in a library project.
|
||||
-- Unique_Compile should be true if "-u" was specified on the command
|
||||
-- line: if True and some files were given on the command line), only
|
||||
-- those files will be compiled (so Insert_Project_Sources will do
|
||||
-- nothing). If True and no file was specified on the command line, all
|
||||
-- files of the project(s) will be compiled.
|
||||
-- This procedure also processed aggregated projects.
|
||||
|
||||
procedure Insert_Withed_Sources_For
|
||||
(The_ALI : ALI.ALI_Id;
|
||||
|
|
|
|||
|
|
@ -1508,6 +1508,27 @@ package body Prj is
|
|||
null;
|
||||
end Free;
|
||||
|
||||
--------------------------------
|
||||
-- For_Project_And_Aggregated --
|
||||
--------------------------------
|
||||
|
||||
procedure For_Project_And_Aggregated
|
||||
(Root_Project : Project_Id;
|
||||
Root_Tree : Project_Tree_Ref)
|
||||
is
|
||||
Agg : Aggregated_Project_List;
|
||||
begin
|
||||
Action (Root_Project, Root_Tree);
|
||||
|
||||
if Root_Project.Qualifier = Aggregate then
|
||||
Agg := Root_Project.Aggregated_Projects;
|
||||
while Agg /= null loop
|
||||
For_Project_And_Aggregated (Agg.Project, Agg.Tree);
|
||||
Agg := Agg.Next;
|
||||
end loop;
|
||||
end if;
|
||||
end For_Project_And_Aggregated;
|
||||
|
||||
begin
|
||||
-- Make sure that the standard config and user project file extensions are
|
||||
-- compatible with canonical case file naming.
|
||||
|
|
|
|||
|
|
@ -1523,6 +1523,14 @@ package Prj is
|
|||
-- A table that associates a project to a boolean. This is used to detect
|
||||
-- whether a project was already processed for instance.
|
||||
|
||||
generic
|
||||
with procedure Action (Project : Project_Id; Tree : Project_Tree_Ref);
|
||||
procedure For_Project_And_Aggregated
|
||||
(Root_Project : Project_Id;
|
||||
Root_Tree : Project_Tree_Ref);
|
||||
-- Execute Action for Root_Project and all its aggregated projects
|
||||
-- recursively.
|
||||
|
||||
generic
|
||||
type State is limited private;
|
||||
with procedure Action
|
||||
|
|
|
|||
Loading…
Reference in New Issue