diff --git a/source/ada/lsp-ada_contexts.adb b/source/ada/lsp-ada_contexts.adb index 848f15437..c181d355f 100644 --- a/source/ada/lsp-ada_contexts.adb +++ b/source/ada/lsp-ada_contexts.adb @@ -78,10 +78,10 @@ package body LSP.Ada_Contexts is -- Return the charset with which the context was initialized procedure Find_All_References_In_Hierarchy - (Self : Context; - Decl : Libadalang.Analysis.Basic_Decl; - Imprecise : in out Libadalang.Common.Ref_Result_Kind; - Callback : not null access procedure + (Self : Context; + Decl : Libadalang.Analysis.Basic_Decl; + Result_Kind : in out Libadalang.Common.Ref_Result_Kind; + Callback : not null access procedure (Base_Id : Libadalang.Analysis.Base_Id; Kind : Libadalang.Common.Ref_Result_Kind; Cancel : in out Boolean)); @@ -208,15 +208,15 @@ package body LSP.Ada_Contexts is ------------------------ function Find_All_Overrides - (Self : Context; - Decl : Libadalang.Analysis.Basic_Decl; - Imprecise_Results : out Libadalang.Common.Ref_Result_Kind) + (Self : Context; + Decl : Libadalang.Analysis.Basic_Decl; + Result_Kind : out Libadalang.Common.Ref_Result_Kind) return Libadalang.Analysis.Basic_Decl_Array is Units : constant Libadalang.Analysis.Analysis_Unit_Array := Self.Analysis_Units; begin - Imprecise_Results := Libadalang.Common.Precise; + Result_Kind := Libadalang.Common.Precise; if Decl.Is_Null then return (1 .. 0 => <>); @@ -228,13 +228,14 @@ package body LSP.Ada_Contexts is return Decl.P_Find_All_Overrides (Units); exception when E : Libadalang.Common.Property_Error => - Imprecise_Results := Libadalang.Common.Imprecise; + Result_Kind := Libadalang.Common.Imprecise; Self.Tracer.Trace_Exception (E, "in Find_All_Overrides (precise)"); return Decl.P_Find_All_Overrides (Units, Imprecise_Fallback => True); end; exception when E : Libadalang.Common.Property_Error => + Result_Kind := Libadalang.Common.Error; Self.Tracer.Trace_Exception (E, "in Find_All_Overrides (imprecise)"); return (1 .. 0 => <>); end Find_All_Overrides; @@ -244,9 +245,9 @@ package body LSP.Ada_Contexts is -------------------------------- function Find_All_Base_Declarations - (Self : Context; - Decl : Libadalang.Analysis.Basic_Decl; - Imprecise_Results : out Libadalang.Common.Ref_Result_Kind) + (Self : Context; + Decl : Libadalang.Analysis.Basic_Decl; + Result_Kind : out Libadalang.Common.Ref_Result_Kind) return Libadalang.Analysis.Basic_Decl_Array is use Libadalang.Analysis; @@ -259,7 +260,7 @@ package body LSP.Ada_Contexts is Langkit_Support.Slocs.Start_Sloc (Left.Sloc_Range) = Langkit_Support.Slocs.Start_Sloc (Right.Sloc_Range)); begin - Imprecise_Results := Libadalang.Common.Precise; + Result_Kind := Libadalang.Common.Precise; if Decl.Is_Null then return (1 .. 0 => <>); @@ -293,7 +294,7 @@ package body LSP.Ada_Contexts is exception when E : Libadalang.Common.Property_Error => Self.Tracer.Trace_Exception (E, "in Find_All_Base_Declarations"); - Imprecise_Results := Libadalang.Common.Imprecise; + Result_Kind := Libadalang.Common.Error; return (1 .. 0 => <>); end Find_All_Base_Declarations; @@ -302,10 +303,10 @@ package body LSP.Ada_Contexts is -------------------------------------- procedure Find_All_References_In_Hierarchy - (Self : Context; - Decl : Libadalang.Analysis.Basic_Decl; - Imprecise : in out Libadalang.Common.Ref_Result_Kind; - Callback : not null access procedure + (Self : Context; + Decl : Libadalang.Analysis.Basic_Decl; + Result_Kind : in out Libadalang.Common.Ref_Result_Kind; + Callback : not null access procedure (Base_Id : Libadalang.Analysis.Base_Id; Kind : Libadalang.Common.Ref_Result_Kind; Cancel : in out Boolean)) @@ -323,31 +324,44 @@ package body LSP.Ada_Contexts is else Decl); + Overriding_Result_Kind : Libadalang.Common.Ref_Result_Kind; + Bases_Result_Kind : Libadalang.Common.Ref_Result_Kind; + Overriding_Decls : constant Libadalang.Analysis.Basic_Decl_Array := Self.Find_All_Overrides (Subp_Decl, - Imprecise_Results => Imprecise); + Result_Kind => Overriding_Result_Kind); Base_Decls : constant Libadalang.Analysis.Basic_Decl_Array := Self.Find_All_Base_Declarations (Subp_Decl, - Imprecise_Results => Imprecise); - - Hierarchy : constant Libadalang.Analysis.Basic_Decl_Array := - Overriding_Decls & Base_Decls; + Result_Kind => Bases_Result_Kind); begin - if Is_Param then - LSP.Ada_Id_Iterators.Find_All_Param_References_In_Hierarchy - (Param => Decl.As_Param_Spec, - Hierarchy => Hierarchy, - Units => Self.Analysis_Units, - Callback => Callback); - else - LSP.Ada_Id_Iterators.Find_All_Subp_References_In_Hierarchy - (Hierarchy => Hierarchy, - Tracer => Self.Tracer.all, - Callback => Callback); + if Overriding_Result_Kind in Libadalang.Common.Error + or else Bases_Result_Kind in Libadalang.Common.Error + then + Result_Kind := Libadalang.Common.Error; + return; end if; + + declare + Hierarchy : constant Libadalang.Analysis.Basic_Decl_Array := + Overriding_Decls & Base_Decls; + begin + + if Is_Param then + LSP.Ada_Id_Iterators.Find_All_Param_References_In_Hierarchy + (Param => Decl.As_Param_Spec, + Hierarchy => Hierarchy, + Units => Self.Analysis_Units, + Callback => Callback); + else + LSP.Ada_Id_Iterators.Find_All_Subp_References_In_Hierarchy + (Hierarchy => Hierarchy, + Tracer => Self.Tracer.all, + Callback => Callback); + end if; + end; end Find_All_References_In_Hierarchy; -------------------- diff --git a/source/ada/lsp-ada_contexts.ads b/source/ada/lsp-ada_contexts.ads index 0e057776f..6b2772523 100644 --- a/source/ada/lsp-ada_contexts.ads +++ b/source/ada/lsp-ada_contexts.ads @@ -98,26 +98,26 @@ package LSP.Ada_Contexts is -- context. function Find_All_Overrides - (Self : Context; - Decl : Libadalang.Analysis.Basic_Decl; - Imprecise_Results : out Libadalang.Common.Ref_Result_Kind) + (Self : Context; + Decl : Libadalang.Analysis.Basic_Decl; + Result_Kind : out Libadalang.Common.Ref_Result_Kind) return Libadalang.Analysis.Basic_Decl_Array; -- Finds all overriding subprograms of the given basic declaration. -- This is used to propose all the implementations of a given subprogram -- when textDocument/definition requests happen on dispatching calls. - -- Imprecise_Results is set to True if we don't know whether the results - -- are precise. + -- Result_Kind indicates if LAL encountered an Error or if the result are + -- Imprecise. -- Returns an empty array if Decl is null. function Find_All_Base_Declarations - (Self : Context; - Decl : Libadalang.Analysis.Basic_Decl; - Imprecise_Results : out Libadalang.Common.Ref_Result_Kind) + (Self : Context; + Decl : Libadalang.Analysis.Basic_Decl; + Result_Kind : out Libadalang.Common.Ref_Result_Kind) return Libadalang.Analysis.Basic_Decl_Array; -- Given a subprogram declaration in Decl, find all the base subprograms -- that it inherits, not including self. - -- Imprecise_Results is set to True if we don't know whether the results - -- are precise. + -- Result_Kind indicates if LAL encountered an Error or if the result are + -- Imprecise. -- Returns an empty array if Decl is null. procedure Find_All_Calls diff --git a/source/ada/lsp-ada_declaration.adb b/source/ada/lsp-ada_declaration.adb index 687c8f9f3..0cc297635 100644 --- a/source/ada/lsp-ada_declaration.adb +++ b/source/ada/lsp-ada_declaration.adb @@ -139,7 +139,8 @@ package body LSP.Ada_Declaration is On_Defining_Name : Boolean := False; -- Set to True if we are on a denfining name node - Ignore : Libadalang.Common.Ref_Result_Kind; + Imprecise_Ignore : Boolean; + Result_Kind : Libadalang.Common.Ref_Result_Kind; begin if Self.Contexts.Is_Empty then -- No more contexts to process, sort and return collected results @@ -172,12 +173,13 @@ package body LSP.Ada_Declaration is if Definition.Is_Null then -- If we aren't on a defining_name already then try to resolve - Definition := Laltools.Common.Resolve_Name (Name_Node, Trace, Ignore); + Definition := Laltools.Common.Resolve_Name + (Name_Node, Trace, Result_Kind); else On_Defining_Name := True; end if; - if Definition.Is_Null then + if Result_Kind in Libadalang.Common.Error or else Definition.Is_Null then return; -- Name resolution fails, nothing to do. end if; @@ -228,16 +230,25 @@ package body LSP.Ada_Declaration is if not Decl_For_Find_Overrides.Is_Null then declare + Overriding_Result_Kind : Libadalang.Common.Ref_Result_Kind; + Bases_Result_Kind : Libadalang.Common.Ref_Result_Kind; Overridings : constant Libadalang.Analysis.Basic_Decl_Array := Context.Find_All_Overrides (Decl_For_Find_Overrides, - Imprecise_Results => Ignore); + Result_Kind => Overriding_Result_Kind); Bases : constant Libadalang.Analysis.Basic_Decl_Array := Context.Find_All_Base_Declarations (Decl_For_Find_Overrides, - Imprecise_Results => Ignore); + Result_Kind => Bases_Result_Kind); begin + if Overriding_Result_Kind in Libadalang.Common.Error + or else Bases_Result_Kind in Libadalang.Common.Error + then + -- Abort + return; + end if; + for Subp of Bases loop Self.Parent.Context.Append_Location (Self.Response, diff --git a/source/ada/lsp-ada_definition.adb b/source/ada/lsp-ada_definition.adb index ca37f9f12..9a961b5de 100644 --- a/source/ada/lsp-ada_definition.adb +++ b/source/ada/lsp-ada_definition.adb @@ -123,9 +123,6 @@ package body LSP.Ada_Definition is Definition_Node : Libadalang.Analysis.Basic_Decl; Decl_For_Find_Overrides : Libadalang.Analysis.Basic_Decl; Entry_Decl_Node : Libadalang.Analysis.Entry_Decl; - - Imprecise_Ignore : Libadalang.Common.Ref_Result_Kind; - begin if Self.Contexts.Is_Empty then -- No more contexts to process, sort and return collected results @@ -239,16 +236,25 @@ package body LSP.Ada_Definition is if not Decl_For_Find_Overrides.Is_Null then declare + Overriding_Result_Kind : Libadalang.Common.Ref_Result_Kind; + Bases_Result_Kind : Libadalang.Common.Ref_Result_Kind; Overridings : constant Libadalang.Analysis.Basic_Decl_Array := Context.Find_All_Overrides (Decl_For_Find_Overrides, - Imprecise_Results => Imprecise_Ignore); + Result_Kind => Overriding_Result_Kind); Bases : constant Libadalang.Analysis.Basic_Decl_Array := Context.Find_All_Base_Declarations (Decl_For_Find_Overrides, - Imprecise_Results => Imprecise_Ignore); + Result_Kind => Bases_Result_Kind); begin + if Overriding_Result_Kind in Libadalang.Common.Error + or else Bases_Result_Kind in Libadalang.Common.Error + then + -- Abort + return; + end if; + for Subp of Bases loop Self.Parent.Context.Append_Location (Self.Response, diff --git a/source/ada/lsp-ada_handlers.adb b/source/ada/lsp-ada_handlers.adb index 1e94f81c6..7a05cda43 100644 --- a/source/ada/lsp-ada_handlers.adb +++ b/source/ada/lsp-ada_handlers.adb @@ -136,11 +136,11 @@ package body LSP.Ada_Handlers is -- Save method in/out in a log file function Resolve_Name - (Self : in out Message_Handler; - Id : LSP.Structures.Integer_Or_Virtual_String; - Context : LSP.Ada_Contexts.Context; - Name_Node : Libadalang.Analysis.Name; - Imprecise : out Libadalang.Common.Ref_Result_Kind) + (Self : in out Message_Handler; + Id : LSP.Structures.Integer_Or_Virtual_String; + Context : LSP.Ada_Contexts.Context; + Name_Node : Libadalang.Analysis.Name; + Result_Kind : out Libadalang.Common.Ref_Result_Kind) return Libadalang.Analysis.Defining_Name; -- Toplayer Resolve_Name based on Laltools.Common.Resolve_Name. -- This function is handling Imprecise and Error results during Nameres by @@ -353,9 +353,9 @@ package body LSP.Ada_Handlers is Name_Node : Libadalang.Analysis.Name) return Libadalang.Analysis.Defining_Name is - Trace : constant GNATCOLL.Traces.Trace_Handle := + Trace : constant GNATCOLL.Traces.Trace_Handle := LSP.GNATCOLL_Tracers.Handle (Self.Tracer.all); - Ref_Kind : Libadalang.Common.Ref_Result_Kind; + Result_Kind : Libadalang.Common.Ref_Result_Kind; begin if Name_Node.Is_Null then return Libadalang.Analysis.No_Defining_Name; @@ -364,7 +364,7 @@ package body LSP.Ada_Handlers is return Laltools.Common.Resolve_Name (Name_Node, Trace, - Ref_Kind => Ref_Kind); + Ref_Kind => Result_Kind); end Imprecise_Resolve_Name; --------------------------------- @@ -2580,33 +2580,30 @@ package body LSP.Ada_Handlers is end loop; end Update_Response; - Definition : Libadalang.Analysis.Defining_Name; - Decl : Libadalang.Analysis.Basic_Decl; - - Imprecise_Ignore : Libadalang.Common.Ref_Result_Kind := + Definition : Libadalang.Analysis.Defining_Name; + Decl : Libadalang.Analysis.Basic_Decl; + Result_Kind : Libadalang.Common.Ref_Result_Kind := Libadalang.Common.No_Ref; - begin if Name_Node.Is_Null then return; end if; Definition := Resolve_Name - (Self => Self, - Id => Id, - Context => C.all, - Name_Node => Name_Node, - Imprecise => Imprecise_Ignore); + (Self => Self, + Id => Id, + Context => C.all, + Name_Node => Name_Node, + Result_Kind => Result_Kind); -- If we didn't find a definition, give up for this context - if Definition.Is_Null then + if Result_Kind in Error or else Definition.Is_Null then return; end if; -- First list the bodies of this definition Update_Response - (Laltools.Common.List_Bodies_Of - (Definition, Trace, Imprecise_Ignore), + (Laltools.Common.List_Bodies_Of (Definition, Trace, Result_Kind), LSP.Constants.Empty); -- Then list the bodies of the parent implementations @@ -2619,19 +2616,18 @@ package body LSP.Ada_Handlers is (Display_Method_Policy = Usage_And_Abstract_Only and then Decl.Kind in Ada_Abstract_Subp_Decl_Range) then - for Subp of C.Find_All_Base_Declarations (Decl, Imprecise_Ignore) - loop + for Subp of C.Find_All_Base_Declarations (Decl, Result_Kind) loop Update_Response (Laltools.Common.List_Bodies_Of - (Subp.P_Defining_Name, Trace, Imprecise_Ignore), + (Subp.P_Defining_Name, Trace, Result_Kind), Is_Parent); end loop; -- And finally the bodies of child implementations - for Subp of C.Find_All_Overrides (Decl, Imprecise_Ignore) loop + for Subp of C.Find_All_Overrides (Decl, Result_Kind) loop Update_Response (Laltools.Common.List_Bodies_Of - (Subp.P_Defining_Name, Trace, Imprecise_Ignore), + (Subp.P_Defining_Name, Trace, Result_Kind), Is_Child); end loop; end if; @@ -3152,24 +3148,27 @@ package body LSP.Ada_Handlers is Defining_Name : Libadalang.Analysis.Defining_Name; - Imprecise : Libadalang.Common.Ref_Result_Kind := + Result_Kind : Libadalang.Common.Ref_Result_Kind := Libadalang.Common.No_Ref; use type Libadalang.Common.Ref_Result_Kind; - begin if not Name_Node.Is_Null then Defining_Name := Resolve_Name - (Self => Self, - Id => Id, - Context => Context.all, - Name_Node => Name_Node, - Imprecise => Imprecise); + (Self => Self, + Id => Id, + Context => Context.all, + Name_Node => Name_Node, + Result_Kind => Result_Kind); + end if; + + if Result_Kind in Libadalang.Common.Error then + return; end if; if not Name_Node.Is_Null and then not Defining_Name.Is_Null - and then Imprecise in Libadalang.Common.Precise + and then Result_Kind in Libadalang.Common.Precise then -- Success only if the node is a name and can be resolved precisely Response := @@ -3766,12 +3765,9 @@ package body LSP.Ada_Handlers is Value : LSP.Structures.TypeDefinitionParams) is - Response : LSP.Structures.Definition_Result (LSP.Structures.Variant_1); - Vector : LSP.Structures.Location_Vector renames Response.Variant_1; - Filter : LSP.Locations.File_Span_Sets.Set; - - Imprecise_Ignore : Libadalang.Common.Ref_Result_Kind := - Libadalang.Common.No_Ref; + Response : LSP.Structures.Definition_Result (LSP.Structures.Variant_1); + Vector : LSP.Structures.Location_Vector renames Response.Variant_1; + Filter : LSP.Locations.File_Span_Sets.Set; procedure Resolve_In_Context (C : LSP.Ada_Context_Sets.Context_Access); -- Utility function to gather results on one context @@ -3781,7 +3777,7 @@ package body LSP.Ada_Handlers is ------------------------ procedure Resolve_In_Context (C : LSP.Ada_Context_Sets.Context_Access) is - Name_Node : constant Libadalang.Analysis.Name := + Name_Node : constant Libadalang.Analysis.Name := Laltools.Common.Get_Node_As_Name (Self.Get_Node_At (C.all, Value)); Definition : Libadalang.Analysis.Defining_Name; @@ -3795,20 +3791,25 @@ package body LSP.Ada_Handlers is -- Special case if Name_Node is defining, for instance on the X in -- X : My_Type; declare - Def_Name : constant Libadalang.Analysis.Defining_Name := + Def_Name : constant Libadalang.Analysis.Defining_Name := Name_Node.P_Enclosing_Defining_Name; - - Type_Expr : constant Libadalang.Analysis.Type_Expr := + Type_Expr : constant Libadalang.Analysis.Type_Expr := Def_Name.P_Basic_Decl.P_Type_Expression; + Result_Kind : Libadalang.Common.Ref_Result_Kind := + Libadalang.Common.No_Ref; begin if not Type_Expr.Is_Null then Definition := Resolve_Name - (Self => Self, - Id => Id, - Context => C.all, - Name_Node => Type_Expr.P_Type_Name, - Imprecise => Imprecise_Ignore); + (Self => Self, + Id => Id, + Context => C.all, + Name_Node => Type_Expr.P_Type_Name, + Result_Kind => Result_Kind); + + if Result_Kind in Libadalang.Common.Error then + return; + end if; end if; end; else @@ -3908,11 +3909,11 @@ package body LSP.Ada_Handlers is ------------------ function Resolve_Name - (Self : in out Message_Handler; - Id : LSP.Structures.Integer_Or_Virtual_String; - Context : LSP.Ada_Contexts.Context; - Name_Node : Libadalang.Analysis.Name; - Imprecise : out Libadalang.Common.Ref_Result_Kind) + (Self : in out Message_Handler; + Id : LSP.Structures.Integer_Or_Virtual_String; + Context : LSP.Ada_Contexts.Context; + Name_Node : Libadalang.Analysis.Name; + Result_Kind : out Libadalang.Common.Ref_Result_Kind) return Libadalang.Analysis.Defining_Name is Definition : Libadalang.Analysis.Defining_Name; @@ -3923,7 +3924,7 @@ package body LSP.Ada_Handlers is then Id.Integer'Image else VSS.Strings.Conversions.To_UTF_8_String (Id.Virtual_String)); begin - Imprecise := Libadalang.Common.No_Ref; + Result_Kind := Libadalang.Common.No_Ref; if Name_Node.Is_Null then -- Internal tracing of resolve on null node @@ -3933,9 +3934,9 @@ package body LSP.Ada_Handlers is -- Find the definition Definition := Laltools.Common.Resolve_Name - (Name_Node, Trace, Imprecise); + (Name_Node, Trace, Result_Kind); - if Imprecise in Libadalang.Common.Error then + if Result_Kind in Libadalang.Common.Error then declare Err_Msg : constant String := "Failed to resolve " & Name_Node.Image; @@ -3975,17 +3976,10 @@ package body LSP.Ada_Handlers is Diag_Params.diagnostics.Append (Diagnostic); Self.Sender.On_PublishDiagnostics_Notification (Diag_Params); - -- Inform the client that the request failed - Self.Sender.On_Error_Response - (Id, - (code => LSP.Enumerations.InternalError, - message => VSS.Strings.Conversions.To_Virtual_String - (Err_Msg))); - return Libadalang.Analysis.No_Defining_Name; end; - elsif Imprecise in Libadalang.Common.Imprecise then + elsif Result_Kind in Libadalang.Common.Imprecise then -- Internal tracing of imprecise resolving Self.Tracer.Trace ("Imprecise result when resolving "