diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2011-08-04 07:41:38 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2011-08-04 07:41:38 +0000 |
commit | 489286f57a19e74a39775cb8f8fb98df70695a4c (patch) | |
tree | 90615aa381b47974f7c25d6c41437a8b2f3a956e /gcc/ada/makeutl.adb | |
parent | b7831f3eee8c0cabc6b1c6ff1b64e93c26e1834f (diff) | |
download | gcc-489286f57a19e74a39775cb8f8fb98df70695a4c.tar.gz |
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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177317 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/makeutl.adb')
-rw-r--r-- | gcc/ada/makeutl.adb | 566 |
1 files changed, 375 insertions, 191 deletions
diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 44575ba29e7..2c821dc1c92 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.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; - 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; - - begin - if Number_Of_Mains = 0 then - Add_Mains_From_Project (Root_Project, Project_Tree); - end if; + 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 - -- 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)); + while List /= Prj.Nil_String loop + Element := Tree.Shared.String_Elements.Table (List); + Debug_Output ("Add_Main", Element.Value); - else + if Project.Library then Fail_Program - (Project_Tree, - "mains cannot include directory information (""" & - Main & """)"); + (Tree, + "cannot specify a main program " & + "for a library project file"); 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; + 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; - Project := Project.Extends; - end loop; - end; - end if; + if Total_Errors_Detected > 0 then + Fail_Program (Tree, "problems with main sources"); + end if; + end Add_Mains_From_Project; - 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; + procedure Fill_All is new For_Project_And_Aggregated + (Add_Mains_From_Project); - if Total_Errors_Detected > 0 then - Fail_Program (Project_Tree, "problems with main sources"); - end if; + begin + 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; - - 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 + 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; + 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)) + return; + end if; + + 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 (Unit_Based - or else Source.Unit = No_Unit_Index - or else Source.Project.Library) - and then not Is_Subunit (Source) + 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 - Queue.Insert - (Source => (Format => Format_Gprbuild, - Tree => Project_Tree, - Id => Source)); + 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; - end if; - Next (Iter); - end loop; + 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; |