-- ASIS_Call_Tree_Example -- Use to build call tree -- This example prints call tree information (i.e., a list of all procedure, -- function, and entry calls made within a compilation unit) for each compilation -- unit in the context. The output format is of the form: -- (calls) at line -- where: -- is the Expanded Name of the Unit making the call -- is the name of the program unit being called -- is the first line number of the call in the source file with Asis; -- 3.0 with Asis.Errors; -- 4.0 with Asis.Exceptions; -- 5.0 with Asis.Implementation; -- 6.0 with Asis.Ada_Environments; -- 8.0 with Asis.Compilation_Units; -- 10.0 with Asis.Elements; -- 13.0 with Asis.Iterator; -- 14.0 with Asis.Declarations; -- 15.0 with Asis.Expressions; -- 17.0 with Asis.Statements; -- 18.0 with Asis.Text; -- 20.0 with Ada.Wide_Text_Io; use Ada.Wide_Text_Io; procedure ASIS_Call_Tree_Example is My_Context : Asis.Context; -- 3.7 procedure No_Op (Elem : in Asis.Element; -- 3.6 Control : in out Asis.Traverse_Control; -- 3.13 State : in out Boolean); procedure Report_Calls (An_Element: in Asis.Element; -- 3.6 Control : in out Asis.Traverse_Control; -- 3.13 State : in out Boolean); procedure Print_Call_Tree is new Asis.Iterator.Traverse_Element -- 14.1 (Boolean, Report_Calls, No_Op); procedure No_Op (Elem : in Asis.Element; -- 3.6 Control : in out Asis.Traverse_Control; -- 3.13 State : in out Boolean) is begin null; end No_Op; procedure Output_Call (Caller : Asis.Element; -- 3.6 Callee : Asis.Declaration) is -- 3.8 Calling_Cu : Asis.Compilation_Unit; -- 3.10 Calling_Unit : Asis.Declaration; -- 3.8 begin -- Output_Call Calling_Cu := Asis.Elements.Enclosing_Compilation_Unit (Caller); -- 13.2 if Asis.Compilation_Units.Is_Nil (Calling_Cu) then -- 10.15 Put ("An_Unknown_Unit"); else Put (Asis.Compilation_Units.Unit_Full_Name (Calling_Cu)); -- 10.19 end if; Put (" (calls) "); Put (Asis.Declarations.Defining_Name_Image -- 15.2 (Asis.Declarations.Names (Callee) (1))); -- 15.1 Put (" at line "); Put (Asis.Text.Line_Number'Wide_Image -- 20.2 (Asis.Text.First_Line_Number (Caller))); -- 20.8 New_Line; end Output_Call; procedure Report_Calls (An_Element : in Asis.Element; -- 3.6 Control : in out Asis.Traverse_Control; -- 3.13 State : in out Boolean) is Callee : Asis.Declaration; -- 3.8 begin -- Report_Calls case Asis.Elements.Element_Kind (An_Element) is -- 13.6 when Asis.An_Expression => -- 3.9.1 case Asis.Elements.Expression_Kind (An_Element) is -- 13.21 when Asis.A_Function_Call => -- 3.9.17 Callee := Asis.Expressions.Corresponding_Called_Function (An_Element); -- 17.29 if not Asis.Elements.Is_Nil (Callee) then -- 13.29 Output_Call (An_Element, Callee); end if; when others => null; end case; when Asis.A_Statement => -- 3.9.1 case Asis.Elements.Statement_Kind (An_Element) is -- 13.25 when Asis.A_Procedure_Call_Statement | -- 3.9.20 Asis.An_Entry_Call_Statement => -- 3.9.20 Callee := Asis.Statements.Corresponding_Called_Entity (An_Element); -- 18.25 if not Asis.Elements.Is_Nil (Callee) then -- 13.29 Output_Call (An_Element, Callee); end if; when others => null; end case; when others => null; end case; end Report_Calls; procedure Process_Units (Unit_List : in Asis.Compilation_Unit_List) is -- 3.11 Control : Asis.Traverse_Control := Asis.Continue; -- 3.13 State : Boolean := True; begin for I in Unit_List'Range loop case Asis.Compilation_Units.Unit_Origin (Unit_List (I)) is -- 10.3 when Asis.An_Application_Unit => -- 3.12.3 New_Line; Put_Line ("Processing Unit: " & Asis.Compilation_Units.Unit_Full_Name (Unit_List (I))); -- 10.19 Print_Call_Tree (Asis.Elements.Unit_Declaration -- 13.1 (Unit_List (I)), Control, State); when others => null; end case; end loop; end Process_Units; begin -- ASIS_Call_Tree_Example Asis.Implementation.Initialize; -- 6.6 Asis.Ada_Environments.Associate (My_Context, "My Context"); -- 8.3 Asis.Ada_Environments.Open (My_Context); -- 8.4 Process_Units (Asis.Compilation_Units.Compilation_Units (My_Context)); -- 10.10 Asis.Ada_Environments.Close (My_Context); -- 8.5 Asis.Ada_Environments.Dissociate (My_Context); -- 8.6 Asis.Implementation.Finalize; -- 6.8 exception when Asis.Exceptions.ASIS_Inappropriate_Context -- 5.0 | Asis.Exceptions.ASIS_Inappropriate_Container -- 5.0 | Asis.Exceptions.ASIS_Inappropriate_Compilation_Unit -- 5.0 | Asis.Exceptions.ASIS_Inappropriate_Element -- 5.0 | Asis.Exceptions.ASIS_Inappropriate_Line -- 5.0 | Asis.Exceptions.ASIS_Inappropriate_Line_Number -- 5.0 | Asis.Exceptions.ASIS_Failed -- 5.0 => Put (Asis.Implementation.Diagnosis); -- 6.10 New_Line; Put ("Status Value is "); Put (Asis.Errors.Error_Kinds'Wide_Image -- 4.1 (Asis.Implementation.Status)); -- 6.9 New_Line; when others => Put_Line ("Asis Application failed because of non-ASIS reasons"); end ASIS_Call_Tree_Example; -- The ASIS_Call_Tree_Example is demonstrated using a context containing the -- following compilation units: -- package P is -- -- procedure P1; -- procedure P2; -- procedure P3(X : integer); -- function F1 return integer; -- -- end; -- package body P is -- -- procedure P1 is separate; -- procedure P2 is separate; -- procedure P3(X : integer) is separate; -- function F1 return integer is separate; -- -- begin -- P1; -- end; -- -- separate (P) -- function F1 return integer is -- begin -- return 0; -- end; -- -- separate (P) -- procedure P1 is -- x : integer := F1; -- begin -- P2; -- P3(x); -- end; -- -- separate (P) -- procedure P2 is -- begin -- P3(F1); -- end; -- -- separate (P) -- procedure P3(X : integer) is -- begin -- null; -- end; -- Given a context containing the above set of compilation units, the sample -- output resulting from the execution of ASIS_Call_Tree_Example is: -- Processing Unit: P -- -- Processing Unit: P -- P (calls) P1 at line 9 -- -- Processing Unit: P.F1 -- -- Processing Unit: P.P1 -- P.P1 (calls) F1 at line 3 -- P.P1 (calls) P2 at line 5 -- P.P1 (calls) P3 at line 6 -- -- Processing Unit: P.P2 -- P.P2 (calls) P3 at line 4 -- P.P2 (calls) F1 at line 4 -- -- Processing Unit: P.P3