diff --git a/src/laltools-call_hierarchy.adb b/src/laltools-call_hierarchy.adb index 38486341..94366898 100644 --- a/src/laltools-call_hierarchy.adb +++ b/src/laltools-call_hierarchy.adb @@ -2,7 +2,7 @@ -- -- -- Libadalang Tools -- -- -- --- Copyright (C) 2021-2022, AdaCore -- +-- Copyright (C) 2021-2024, AdaCore -- -- -- -- Libadalang Tools is free software; you can redistribute it and/or modi- -- -- fy it under terms of the GNU General Public License as published by -- @@ -59,7 +59,7 @@ package body Laltools.Call_Hierarchy is Callback : not null access procedure (Subp_Call : Ada_Node'Class); Trace : GNATCOLL.Traces.Trace_Handle; - Imprecise : in out Boolean) + Imprecise : in out Ref_Result_Kind) is function Process_Body_Children (N : Ada_Node'Class) diff --git a/src/laltools-call_hierarchy.ads b/src/laltools-call_hierarchy.ads index fcb00a0a..9cac0e52 100644 --- a/src/laltools-call_hierarchy.ads +++ b/src/laltools-call_hierarchy.ads @@ -2,7 +2,7 @@ -- -- -- Libadalang Tools -- -- -- --- Copyright (C) 2021, AdaCore -- +-- Copyright (C) 2021-2024, AdaCore -- -- -- -- Libadalang Tools is free software; you can redistribute it and/or modi- -- -- fy it under terms of the GNU General Public License as published by -- @@ -58,7 +58,7 @@ package Laltools.Call_Hierarchy is Callback : not null access procedure (Subp_Call : Ada_Node'Class); Trace : GNATCOLL.Traces.Trace_Handle; - Imprecise : in out Boolean) + Imprecise : in out Ref_Result_Kind) with Pre => Is_Subprogram (Definition.P_Basic_Decl); -- Finds all outgoing calls of the subprogram given by Definition and -- calls Callback on each call that was found. diff --git a/src/laltools-common.adb b/src/laltools-common.adb index af7071c7..f4bd56e3 100644 --- a/src/laltools-common.adb +++ b/src/laltools-common.adb @@ -2,7 +2,7 @@ -- -- -- Libadalang Tools -- -- -- --- Copyright (C) 2021-2023, AdaCore -- +-- Copyright (C) 2021-2024, AdaCore -- -- -- -- Libadalang Tools is free software; you can redistribute it and/or modi- -- -- fy it under terms of the GNU General Public License as published by -- @@ -2571,7 +2571,7 @@ package body Laltools.Common is function Is_Call (Node : Ada_Node'Class; Trace : GNATCOLL.Traces.Trace_Handle; - Imprecise : in out Boolean) return Boolean is + Imprecise : in out Ref_Result_Kind) return Boolean is begin return Node.As_Ada_Node /= No_Ada_Node and then Node.Kind in Ada_Name @@ -2704,18 +2704,16 @@ package body Laltools.Common is function Is_Enum_Literal (Node : Ada_Node'Class; Trace : GNATCOLL.Traces.Trace_Handle; - Imprecise : in out Boolean) return Boolean + Imprecise : in out Ref_Result_Kind) return Boolean is Definition : Defining_Name; - Ref_Kind : Libadalang.Common.Ref_Result_Kind; + begin if Node.As_Ada_Node /= No_Ada_Node and then Node.Kind in Ada_Name then Definition := Laltools.Common.Resolve_Name - (Node.As_Name, Trace, Ref_Kind); - Imprecise := - Ref_Kind in Libadalang.Common.Error | Libadalang.Common.Imprecise; + (Node.As_Name, Trace, Imprecise); return Definition /= No_Defining_Name and then Definition.P_Basic_Decl.Kind = Ada_Enum_Literal_Decl; @@ -2821,9 +2819,9 @@ package body Laltools.Common is -------------------- function List_Bodies_Of - (Definition : Defining_Name; - Trace : GNATCOLL.Traces.Trace_Handle; - Imprecise : in out Boolean) + (Definition : Defining_Name; + Trace : GNATCOLL.Traces.Trace_Handle; + Imprecise : in out Ref_Result_Kind) return Bodies_List.List is List : Bodies_List.List; @@ -2874,7 +2872,7 @@ package body Laltools.Common is Loop_Count := Loop_Count + 1; if Loop_Count > 5 then - Imprecise := True; + Imprecise := Libadalang.Common.Imprecise; exit; end if; end loop; diff --git a/src/laltools-common.ads b/src/laltools-common.ads index 4128a978..d0693f65 100644 --- a/src/laltools-common.ads +++ b/src/laltools-common.ads @@ -2,7 +2,7 @@ -- -- -- Libadalang Tools -- -- -- --- Copyright (C) 2021-2023, AdaCore -- +-- Copyright (C) 2021-2024, AdaCore -- -- -- -- Libadalang Tools is free software; you can redistribute it and/or modi- -- -- fy it under terms of the GNU General Public License as published by -- @@ -749,7 +749,7 @@ package Laltools.Common is function Is_Call (Node : Ada_Node'Class; Trace : GNATCOLL.Traces.Trace_Handle; - Imprecise : in out Boolean) return Boolean; + Imprecise : in out Ref_Result_Kind) return Boolean; -- Check if a node is a call and an identifier. Enum literals -- in DottedName are excluded. @@ -777,7 +777,7 @@ package Laltools.Common is function Is_Enum_Literal (Node : Ada_Node'Class; Trace : GNATCOLL.Traces.Trace_Handle; - Imprecise : in out Boolean) return Boolean; + Imprecise : in out Ref_Result_Kind) return Boolean; -- Check if a node is an enum literal. function Is_Renamable (Node : Ada_Node'Class) return Boolean; @@ -816,13 +816,13 @@ package Laltools.Common is -- Returns how many Param_Spec nodes L has. function List_Bodies_Of - (Definition : Defining_Name; - Trace : GNATCOLL.Traces.Trace_Handle; - Imprecise : in out Boolean) + (Definition : Defining_Name; + Trace : GNATCOLL.Traces.Trace_Handle; + Imprecise : in out Ref_Result_Kind) return Bodies_List.List; -- List all the bodies of Definition. This does not list the bodies of the - -- parent. It sets Imprecise to True if any request returns - -- imprecise results. + -- parent. It sets Imprecise to Libadalang.Common.Imprecise if any request + -- returns imprecise results. procedure Merge (Left : in out Source_Location_Range_Map; @@ -832,7 +832,7 @@ package Laltools.Common is function Resolve_Name (Name_Node : Name; Trace : GNATCOLL.Traces.Trace_Handle; - Ref_Kind : out Libadalang.Common.Ref_Result_Kind) + Ref_Kind : out Ref_Result_Kind) return Defining_Name; -- Return the definition node (canonical part) of the given name. diff --git a/testsuite/ada_drivers/outgoing_calls/src/outgoing_calls.adb b/testsuite/ada_drivers/outgoing_calls/src/outgoing_calls.adb index 643e4805..8190b959 100644 --- a/testsuite/ada_drivers/outgoing_calls/src/outgoing_calls.adb +++ b/testsuite/ada_drivers/outgoing_calls/src/outgoing_calls.adb @@ -30,6 +30,7 @@ with GNATCOLL.Traces; with Langkit_Support.Slocs; with Libadalang.Analysis; +with Libadalang.Common; with Libadalang.Helpers; with Laltools.Common; @@ -138,8 +139,10 @@ procedure Outgoing_Calls is pragma Unreferenced (Context); Calls : Laltools.Common.References_By_Subprogram.Map; - Dummy_Trace : GNATCOLL.Traces.Trace_Handle; - Dummy_Imprecise : Boolean := False; + + Ignore_Imprecise : Libadalang.Common.Ref_Result_Kind := + Libadalang.Common.No_Ref; + Ignore_Trace : GNATCOLL.Traces.Trace_Handle; use type LALAnalysis.Defining_Name; @@ -156,9 +159,9 @@ procedure Outgoing_Calls is Laltools.Common.Get_Node_As_Name (Subp_Call.As_Ada_Node); begin -- First try to resolve the called function. - - Call_Definition := Laltools.Common.Resolve_Name - (Subp_Call_Name, Dummy_Trace, Dummy_Imprecise); + Call_Definition := + Laltools.Common.Resolve_Name + (Subp_Call_Name, Ignore_Trace, Ignore_Imprecise); if Call_Definition /= LALAnalysis.No_Defining_Name then if Calls.Contains (Call_Definition) then @@ -211,7 +214,8 @@ procedure Outgoing_Calls is end if; Node_Defining_Name := - Laltools.Common.Resolve_Name (Node_Name, Dummy_Trace, Dummy_Imprecise); + Laltools.Common.Resolve_Name + (Node_Name, Ignore_Trace, Ignore_Imprecise); if Node_Defining_Name = LALAnalysis.No_Defining_Name then Ada.Text_IO.Put_Line ("Node is not a defining name."); @@ -224,8 +228,8 @@ procedure Outgoing_Calls is Laltools.Call_Hierarchy.Find_Outgoing_Calls (Definition => Node_Defining_Name, Callback => Callback'Access, - Trace => Dummy_Trace, - Imprecise => Dummy_Imprecise); + Trace => Ignore_Trace, + Imprecise => Ignore_Imprecise); Print_References_By_Subprogram_Map (Calls); end Job_Post_Process;