with Asis.Implementation; with Asis.Ada_Environments; with Asis.Compilation_Units; with Asis.Compilation_Units.Relations; with Asis.Ada_Environments.Containers; with Asis.Report; with Ada.Text_IO; with Ada.Characters.Handling; package body Asis.Toolkit.ObjectAda.Compilation_Units is Debug : constant Boolean := Asis.Report.Debug ( "Asis.Toolkit.ObjectAda.Compilation_Units.Debug" ); procedure Show_Info(Units : in Asis.Compilation_Unit_List; Verbose : in Boolean := False) is begin for Index in Units'Range loop Ada.Text_IO.Put_Line ( Item => "Name is " & Ada.Characters.Handling.To_String (Asis.Compilation_Units.Unit_Full_Name (Units(Index)))); Ada.Text_IO.Put_Line ( Item => "Kind is " & Asis.Unit_Kinds'Image ( Asis.Compilation_Units.Unit_Kind (Units(Index)))); if Verbose then Ada.Text_IO.Put_Line ( Item => "Class is " & Asis.Unit_Classes'Image ( Asis.Compilation_Units.Unit_Class (Units(Index)))); Ada.Text_IO.Put_Line ( Item => "Origin is " & Asis.Unit_Origins'Image ( Asis.Compilation_Units.Unit_Origin (Units(Index)))); end if; Ada.Text_IO.Put_Line ( Item => "Source name is " & Ada.Characters.Handling.To_String (Asis.Compilation_Units.Text_Name (Units(Index)))); if Verbose then Ada.Text_IO.Put_Line ( Item => "Object name is " & Ada.Characters.Handling.To_String (Asis.Compilation_Units.Object_Name (Units(Index)))); Ada.Text_IO.Put_Line ( Item => "Comp options are " & Ada.Characters.Handling.To_String (Asis.Compilation_Units.Compilation_Command_Line_Options ( Units(Index)))); Ada.Text_IO.Put_Line ( Item => "Container Name is " & Ada.Characters.Handling.To_String (Asis.Ada_Environments.Containers.Name (Asis.Compilation_Units.Enclosing_Container (Units(Index))))); end if; end loop; end Show_Info; function First_Container_Units (Context : Asis.Context; All_Containers : Boolean := False; Verbose : Boolean := False; Silently : Boolean := True) return Asis.Compilation_Unit_List is Test_All_Containers: constant Boolean := Asis.Report.Debug( "All_Containers" ); use type Asis.Compilation_Unit; begin if All_Containers or Test_All_Containers then declare Units : Asis.Compilation_Unit_List := Asis.Compilation_Units.Compilation_Units (The_Context => Context); begin if not Silently or Debug then Ada.Text_IO.Put_Line ("Unit count: " & Asis.List_Index'Image(Units'Last)); Show_Info(Units, Verbose => Verbose or Debug ); end if; return Units; end; else declare Containers : constant Asis.Ada_Environments.Containers. Container_List := Asis.Ada_Environments.Containers. Defining_Containers(Context); Units : constant Asis.Compilation_Unit_List := Asis.Ada_Environments.Containers. Compilation_Units(Containers(1)); begin if not Silently or Debug then Ada.Text_IO.Put_Line ("Container Unit count: " & Asis.List_Index'Image(Units'Last)); Show_Info(Units, Verbose => Verbose or Debug ); end if; return Units; end; end if; end First_Container_Units; function Container_Units (Context : Asis.Context; Number_Of_Containers : Natural := Natural'Last; Verbose : Boolean := False; Silently : Boolean := True) return Asis.Compilation_Unit_List is use type Asis.Compilation_Unit; begin if Number_Of_Containers = Natural'First then return Asis.Nil_Compilation_Unit_List; else declare Result_Units : Asis.Compilation_Unit_List(1..10000); Result_First : Asis.Asis_Natural := 0; Result_Last : Asis.Asis_Natural := 0; Containers : constant Asis.Ada_Environments.Containers. Container_List := Asis.Ada_Environments.Containers. Defining_Containers(Context); begin for I in Containers'Range loop exit when Natural(I) > Number_Of_Containers; declare Units : constant Asis.Compilation_Unit_List := Asis.Ada_Environments.Containers. Compilation_Units(Containers(I)); begin Result_First := Result_Last + 1; Result_Last := Result_Last + Units'Length; Result_Units(Result_First..Result_Last) := Units; if not Silently or Debug then Ada.Text_IO.Put_Line ("Result Unit count: " & Asis.List_Index'Image(Units'Last)); Show_Info(Units, Verbose => Verbose or Debug); end if; end; end loop; return Result_Units(1..Result_Last); end; end if; end Container_Units; function Needed_Application_Units (Context : Asis.Context; Name : Wide_String; Verbose : Boolean := False; Silently : Boolean := True) return Asis.Compilation_Unit_List is use type Asis.Compilation_Unit; begin declare Unit : Asis.Compilation_Unit := Asis.Compilation_Units.Compilation_Unit_Body (Name => Name, The_Context => Context); Closure : constant Asis.Compilation_Units.Relations.Relationship := Asis.Compilation_Units.Relations.Semantic_Dependence_Order ((1=> Unit), Asis.Nil_Compilation_Unit_List, Context, Asis.Needed_Units); Units : constant Asis.Compilation_Unit_List := Closure.Consistent; App_Units : Asis.Compilation_Unit_List(Units'Range); App_Unit_Count : Asis_Natural := 0; begin for I in Units'Range loop case Asis.Compilation_Units.Unit_Origin(Units(I)) is -- Only return application units; filter out runtime units when Asis.An_Application_Unit => App_Unit_Count := App_Unit_Count + 1; App_Units(App_Unit_Count) := Units(I); when others => null; end case; end loop; if not Silently or Debug then Ada.Text_IO.Put_Line ("Unit count: " & Asis.List_Index'Image(App_Units'Last)); Show_Info(App_Units(1..App_Unit_Count), Verbose => Verbose or Debug); end if; return App_Units(1..App_Unit_Count); end; exception when others => return Asis.Nil_Compilation_Unit_List; end Needed_Application_Units; end Asis.Toolkit.ObjectAda.Compilation_Units;