Skip to content

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

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
parent 8dd00781
Showing with 375 additions and 85 deletions
gcc/ada/ChangeLog
2011-08-04 Emmanuel Briot <briot@adacore.com> 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 * prj.adb, prj.ads, makeutl.adb, makeutl.ads, prj-env.adb
(Project_Tree_Appdata): New type. (Project_Tree_Appdata): New type.
It is now possible to associate application-specific data to a project It is now possible to associate application-specific data to a project
......
gcc/ada/makeutl.adb
...@@ -23,6 +23,7 @@ ...@@ -23,6 +23,7 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
with ALI; use ALI; with ALI; use ALI;
with Debug; with Debug;
with Err_Vars; use Err_Vars; with Err_Vars; use Err_Vars;
...@@ -1224,6 +1225,9 @@ package body Makeutl is ...@@ -1224,6 +1225,9 @@ package body Makeutl is
Current : Natural := 0; Current : Natural := 0;
-- The index of the last main retrieved from the table -- 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 -- -- Add_Main --
-------------- --------------
...@@ -1236,6 +1240,12 @@ package body Makeutl is ...@@ -1236,6 +1240,12 @@ package body Makeutl is
Tree : Project_Tree_Ref := null) Tree : Project_Tree_Ref := null)
is is
begin begin
if Current_Verbosity = High then
Debug_Output ("Add_Main """ & Name & """ " & Index'Img
& " with_tree? "
& Boolean'Image (Tree /= null));
end if;
Name_Len := 0; Name_Len := 0;
Add_Str_To_Name_Buffer (Name); Add_Str_To_Name_Buffer (Name);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
...@@ -1243,6 +1253,14 @@ package body Makeutl is ...@@ -1243,6 +1253,14 @@ package body Makeutl is
Names.Increment_Last; Names.Increment_Last;
Names.Table (Names.Last) := Names.Table (Names.Last) :=
(Name_Find, Index, Location, No_Source, Project, Tree); (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; end Add_Main;
-------------------------- --------------------------
...@@ -1281,70 +1299,31 @@ package body Makeutl is ...@@ -1281,70 +1299,31 @@ package body Makeutl is
Mains.Reset; Mains.Reset;
end Delete; end Delete;
----------------------- --------------------
-- FIll_From_Project -- -- Complete_Mains --
----------------------- --------------------
procedure Fill_From_Project procedure Complete_Mains
(Root_Project : Project_Id; (Root_Project : Project_Id;
Project_Tree : Project_Tree_Ref) Project_Tree : Project_Tree_Ref)
is is
procedure Add_Mains_From_Project procedure Do_Complete (Project : Project_Id; Tree : Project_Tree_Ref);
(Project : Project_Id; Tree : Project_Tree_Ref); -- Check the mains for this specific project
-- Add the main units from this project into Mains
procedure Add_Mains_From_Project procedure Complete_All is new For_Project_And_Aggregated
(Project : Project_Id; (Do_Complete);
Tree : Project_Tree_Ref)
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;
end loop;
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;
end Add_Mains_From_Project;
procedure Do_Complete
(Project : Project_Id; Tree : Project_Tree_Ref) is
begin begin
if Number_Of_Mains = 0 then if Mains.Number_Of_Mains (Tree) > 0
Add_Mains_From_Project (Root_Project, Project_Tree); or else Mains.Count_Of_Mains_With_No_Tree > 0
end if; then
-- 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 for J in Names.First .. Names.Last loop
declare declare
File : Main_Info := Names.Table (J); File : Main_Info := Names.Table (J);
Main_Id : File_Name_Type := File.File; Main_Id : File_Name_Type := File.File;
Main : constant String := Get_Name_String (Main_Id); Main : constant String := Get_Name_String (Main_Id);
Project : Project_Id;
Source : Prj.Source_Id := No_Source; Source : Prj.Source_Id := No_Source;
Suffix : File_Name_Type; Suffix : File_Name_Type;
Iter : Source_Iterator; Iter : Source_Iterator;
...@@ -1353,29 +1332,30 @@ package body Makeutl is ...@@ -1353,29 +1332,30 @@ package body Makeutl is
if Base_Name (Main) /= Main then if Base_Name (Main) /= Main then
if Is_Absolute_Path (Main) then if Is_Absolute_Path (Main) then
Main_Id := Create_Name (Base_Name (Main)); Main_Id := Create_Name (Base_Name (Main));
else else
Fail_Program Fail_Program
(Project_Tree, (Tree,
"mains cannot include directory information (""" & "mains cannot include directory information ("""
Main & """)"); & Main & """)");
end if; end if;
end if; end if;
-- If no project or tree was specified for the main, it came -- If no project or tree was specified for the main, it
-- from the command line. In this case, it needs to belong -- came from the command line. In this case, it needs to
-- to the root project. -- belong to the root project.
-- Note that the assignments below will not modify inside -- Note that the assignments below will not modify inside
-- the table itself. -- the table itself.
if File.Project = null then if File.Project = null then
File.Project := Root_Project; File.Project := Project;
end if; end if;
if File.Tree = null then if File.Tree = null then
File.Tree := Project_Tree; File.Tree := Project_Tree;
end if; end if;
if File.Source = null then
-- First, look for the main as specified. -- First, look for the main as specified.
Source := Find_Source Source := Find_Source
...@@ -1389,7 +1369,9 @@ package body Makeutl is ...@@ -1389,7 +1369,9 @@ package body Makeutl is
declare declare
-- Main already has a canonical casing -- Main already has a canonical casing
Main : constant String := Get_Name_String (Main_Id); Main : constant String :=
Get_Name_String (Main_Id);
Project : Project_Id;
begin begin
Project := File.Project; Project := File.Project;
while Source = No_Source while Source = No_Source
...@@ -1406,16 +1388,17 @@ package body Makeutl is ...@@ -1406,16 +1388,17 @@ package body Makeutl is
Get_Name_String (Source.File); Get_Name_String (Source.File);
if Name_Len > Main'Length if Name_Len > Main'Length
and then and then Name_Buffer
Name_Buffer (1 .. Main'Length) = Main (1 .. Main'Length) = Main
then then
Suffix := Suffix :=
Source.Language Source.Language
.Config.Naming_Data.Body_Suffix; .Config.Naming_Data.Body_Suffix;
exit when Suffix /= No_File and then exit when Suffix /= No_File and then
Name_Buffer (Main'Length + 1 .. Name_Len) Name_Buffer
= Get_Name_String (Suffix); (Main'Length + 1 .. Name_Len) =
Get_Name_String (Suffix);
end if; end if;
end if; end if;
...@@ -1428,31 +1411,110 @@ package body Makeutl is ...@@ -1428,31 +1411,110 @@ package body Makeutl is
end if; end if;
if Source /= No_Source then if Source /= No_Source then
Debug_Output ("Found main in project",
Name_Id (Source.File));
Names.Table (J).File := Source.File; Names.Table (J).File := Source.File;
Names.Table (J).Project := File.Project; Names.Table (J).Project := File.Project;
if Names.Table (J).Tree = null then
Names.Table (J).Tree := File.Tree; 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; Names.Table (J).Source := Source;
elsif File.Location /= No_Location then elsif File.Location /= No_Location then
-- If the main is declared in package Builder of the -- If the main is declared in package Builder of
-- main project, report an error. If the main is on -- the main project, report an error. If the main
-- the command line, it may be a main from another -- is on the command line, it may be a main from
-- project, so do nothing: if the main does not exist -- another project, so do nothing: if the main does
-- in another project, an error will be reported -- not exist in another project, an error will be
-- later. -- reported later.
Error_Msg_File_1 := Main_Id; Error_Msg_File_1 := Main_Id;
Error_Msg_Name_1 := Root_Project.Name; Error_Msg_Name_1 := Root_Project.Name;
Errutil.Error_Msg ("{ is not a source of project %%", Errutil.Error_Msg
("{ is not a source of project %%",
File.Location); File.Location);
end if; end if;
end if;
end; end;
end loop; end loop;
end if; end if;
if Total_Errors_Detected > 0 then if Total_Errors_Detected > 0 then
Fail_Program (Project_Tree, "problems with main sources"); 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 --
-----------------------
procedure Fill_From_Project
(Root_Project : Project_Id;
Project_Tree : Project_Tree_Ref)
is
procedure Add_Mains_From_Project
(Project : Project_Id; Tree : Project_Tree_Ref);
-- Add the main units from this project into Mains.
-- This takes into account the aggregated projects
procedure Add_Mains_From_Project
(Project : Project_Id;
Tree : Project_Tree_Ref)
is
List : String_List_Id;
Element : String_Element;
begin
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;
if Total_Errors_Detected > 0 then
Fail_Program (Tree, "problems with main sources");
end if; end if;
end Add_Mains_From_Project;
procedure Fill_All is new For_Project_And_Aggregated
(Add_Mains_From_Project);
begin
Fill_All (Root_Project, Project_Tree);
end Fill_From_Project; end Fill_From_Project;
--------------- ---------------
...@@ -1488,9 +1550,13 @@ package body Makeutl is ...@@ -1488,9 +1550,13 @@ package body Makeutl is
-- Number_Of_Mains -- -- Number_Of_Mains --
--------------------- ---------------------
function Number_Of_Mains return Natural is function Number_Of_Mains (Tree : Project_Tree_Ref) return Natural is
begin begin
if Tree = null then
return Names.Last; return Names.Last;
else
return Builder_Data (Tree).Number_Of_Mains;
end if;
end Number_Of_Mains; end Number_Of_Mains;
----------- -----------
...@@ -2017,7 +2083,7 @@ package body Makeutl is ...@@ -2017,7 +2083,7 @@ package body Makeutl is
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Str ("Adding """); Write_Str ("Adding """);
Debug_Display (Source); Debug_Display (Source);
Write_Line (" to the queue"); Write_Line (""" to the queue");
end if; end if;
Q.Append (New_Val => (Info => Source, Processed => False)); Q.Append (New_Val => (Info => Source, Processed => False));
...@@ -2347,12 +2413,31 @@ package body Makeutl is ...@@ -2347,12 +2413,31 @@ package body Makeutl is
(Project : Project_Id; (Project : Project_Id;
Project_Tree : Project_Tree_Ref; Project_Tree : Project_Tree_Ref;
All_Projects : Boolean; All_Projects : Boolean;
Unit_Based : Boolean) Unique_Compile : Boolean)
is is
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.
Iter : Source_Iterator; Iter : Source_Iterator;
Source : Prj.Source_Id; Source : Prj.Source_Id;
begin begin
Iter := For_Each_Source (Project_Tree); -- 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
return;
end if;
Iter := For_Each_Source (Tree);
loop loop
Source := Prj.Element (Iter); Source := Prj.Element (Iter);
exit when Source = No_Source; exit when Source = No_Source;
...@@ -2385,7 +2470,7 @@ package body Makeutl is ...@@ -2385,7 +2470,7 @@ package body Makeutl is
then then
Queue.Insert Queue.Insert
(Source => (Format => Format_Gprbuild, (Source => (Format => Format_Gprbuild,
Tree => Project_Tree, Tree => Tree,
Id => Source)); Id => Source));
end if; end if;
end if; end if;
...@@ -2393,6 +2478,12 @@ package body Makeutl is ...@@ -2393,6 +2478,12 @@ package body Makeutl is
Next (Iter); Next (Iter);
end loop; 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; end Insert_Project_Sources;
------------------------------- -------------------------------
...@@ -2480,4 +2571,97 @@ package body Makeutl is ...@@ -2480,4 +2571,97 @@ package body Makeutl is
end Insert_Withed_Sources_For; end Insert_Withed_Sources_For;
end Queue; 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; end Makeutl;
gcc/ada/makeutl.ads
...@@ -233,6 +233,66 @@ package Makeutl is ...@@ -233,6 +233,66 @@ package Makeutl is
-- according to Fatal. -- according to Fatal.
-- This properly removes all temporary files -- 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 -- -- Mains --
----------- -----------
...@@ -295,8 +355,9 @@ package Makeutl is ...@@ -295,8 +355,9 @@ package Makeutl is
-- Moves the cursor forward and returns the new current entry. -- Moves the cursor forward and returns the new current entry.
-- Returns No_File_And_Loc if there are no more mains in the table. -- Returns No_File_And_Loc if there are no more mains in the table.
function Number_Of_Mains return Natural; function Number_Of_Mains (Tree : Project_Tree_Ref) return Natural;
-- Returns the number of mains in the table. -- 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 procedure Fill_From_Project
(Root_Project : Project_Id; (Root_Project : Project_Id;
...@@ -304,7 +365,10 @@ package Makeutl is ...@@ -304,7 +365,10 @@ package Makeutl is
-- If no main was already added (presumably from the command line), add -- 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 -- the main units from root_project (or in the case of an aggregate
-- project from all the aggregated projects). -- 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 -- 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 -- 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 -- full paths rather than (partial) base names (e.g. no body suffix was
...@@ -385,13 +449,16 @@ package Makeutl is ...@@ -385,13 +449,16 @@ package Makeutl is
(Project : Project_Id; (Project : Project_Id;
Project_Tree : Project_Tree_Ref; Project_Tree : Project_Tree_Ref;
All_Projects : Boolean; All_Projects : Boolean;
Unit_Based : Boolean); Unique_Compile : Boolean);
-- Insert all the compilable sources of the project in the queue. If -- Insert all the compilable sources of the project in the queue. If
-- All_Project is true, then all sources from imported projects are also -- All_Project is true, then all sources from imported projects are also
-- inserted. -- inserted.
-- When Unit_Based is True, put in the queue all compilable sources -- Unique_Compile should be true if "-u" was specified on the command
-- including the unit based (Ada) one. When Unit_Based is False, put the -- line: if True and some files were given on the command line), only
-- Ada sources only when they are in a library project. -- 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 procedure Insert_Withed_Sources_For
(The_ALI : ALI.ALI_Id; (The_ALI : ALI.ALI_Id;
......
gcc/ada/prj.adb
...@@ -1508,6 +1508,27 @@ package body Prj is ...@@ -1508,6 +1508,27 @@ package body Prj is
null; null;
end Free; 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 begin
-- Make sure that the standard config and user project file extensions are -- Make sure that the standard config and user project file extensions are
-- compatible with canonical case file naming. -- compatible with canonical case file naming.
......
gcc/ada/prj.ads
...@@ -1524,6 +1524,14 @@ package Prj is ...@@ -1524,6 +1524,14 @@ package Prj is
-- whether a project was already processed for instance. -- whether a project was already processed for instance.
generic 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; type State is limited private;
with procedure Action with procedure Action
(Project : Project_Id; (Project : Project_Id;
......
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