Merge remote branch 'origin/master' into edge

(no-precommit-check no-tn-check)

Author: mergerepo

integration/vscode/Code Samples/README.md

@@ -6,3 +6,4 @@ Here is some code samples for the Ada Language Server and the VS Code extension.
 * [Docker](docker/) - example using Ada with Remote/Container VS Code feature
 * [Gnatprove](gnatprove/) - SPARK/gnatprove integration example
 * [Refactoring demos](refactoring_demos/) - sample code to check refactoring capabilities
+* [Custom worspace-specific environment](custom_env/) - example showing how to set workspace-specific environment variables

source/ada/lsp-ada_completions-generic_assoc.adb

@@ -48,6 +48,10 @@ package body LSP.Ada_Completions.Generic_Assoc is
       --  Empty if we already have a whitespace before a ","
 
       Designators       : Laltools.Common.Node_Vectors.Vector;
+      --  Current list of designators
+
+      Unnamed_Params    : Natural;
+      --  The number of parameters without designators already present
 
       Prefix      : VSS.Strings.Virtual_String;
       --  The whole string before the snippet (including whitespaces)
@@ -133,6 +137,13 @@ package body LSP.Ada_Completions.Generic_Assoc is
            or else (Limit > 0
                     and then (Snippet_Index = 1
                               or else Snippet_Index >= Limit));
+
+         Nb_Params          : Natural := Unnamed_Params;
+         --  We already have Skip params
+
+         Total_Params       : constant Natural :=
+           Natural (Spec_Designators.Length);
+         --  The maximum number of params
       begin
          if Match_Designators (Designators, Spec_Designators) then
 
@@ -233,6 +244,9 @@ package body LSP.Ada_Completions.Generic_Assoc is
                   end if;
                   Snippet_Index := Snippet_Index - 1;
                end;
+
+               Nb_Params := Nb_Params + 1;
+               exit when Nb_Params = Total_Params;
             end loop;
 
             --  If the string is empty => nothing to do
@@ -303,7 +317,7 @@ package body LSP.Ada_Completions.Generic_Assoc is
       Prefix := Self.Document.Get_Text_At
         (Prefix_Span.first, Prefix_Span.last);
 
-      Designators := Get_Designators (Elem_Node);
+      Designators := Get_Designators (Elem_Node, Sloc, Unnamed_Params);
 
       if Token_Kind = Ada_Whitespace then
          Token_Kind := Kind (Data (Previous (Token, Exclude_Trivia => True)));
@@ -320,13 +334,18 @@ package body LSP.Ada_Completions.Generic_Assoc is
            (E       => Elem_Node,
             Context => Self.Context)
          loop
-            Generate_Snippets
-              (Spec_Designators  => Spec.Param_Vector,
-               Param_Types       => Spec.Param_Types,
-               Decl              => Spec.Decl,
-               Title             => Spec.Title,
-               Snippet_Prefix    => Spec.Prefix,
-               Completion_Prefix => Completion_Prefix);
+            --  Too many params to match Spec
+            if Natural (Spec.Param_Vector.Length)
+              > Natural (Designators.Length) + Unnamed_Params
+            then
+               Generate_Snippets
+                 (Spec_Designators  => Spec.Param_Vector,
+                  Param_Types       => Spec.Param_Types,
+                  Decl              => Spec.Decl,
+                  Title             => Spec.Title,
+                  Snippet_Prefix    => Spec.Prefix,
+                  Completion_Prefix => Completion_Prefix);
+            end if;
          end loop;
       end;
    end Propose_Completion;

source/ada/lsp-ada_completions-generic_assoc.ads

@@ -37,8 +37,13 @@ generic
    --  Return Null_Element if there is no such Element.
 
    with function Get_Designators
-     (E : Element) return Laltools.Common.Node_Vectors.Vector;
-   --  Return the current list of Designators for E
+     (E              : Element;
+      Sloc           : Langkit_Support.Slocs.Source_Location;
+      Unnamed_Params : out Natural)
+      return Laltools.Common.Node_Vectors.Vector;
+   --  Return the current list of Designators for E.
+   --  Unnamed_Params correspond to the number of parameters without
+   --  designators before Sloc.
 
    with function Get_Spec_Designators
      (E       : Element;

source/ada/lsp-ada_completions-parameters.adb

@@ -55,7 +55,9 @@ package body LSP.Ada_Completions.Parameters is
      (N : Libadalang.Analysis.Ada_Node'Class)
       return Libadalang.Analysis.Aggregate;
    function Get_Designators
-     (A : Libadalang.Analysis.Aggregate)
+     (A              : Libadalang.Analysis.Aggregate;
+      Sloc           : Langkit_Support.Slocs.Source_Location;
+      Unnamed_Params : out Natural)
       return Laltools.Common.Node_Vectors.Vector;
    function Get_Spec_Aggregate_Designators
      (A       : Libadalang.Analysis.Aggregate;
@@ -80,7 +82,9 @@ package body LSP.Ada_Completions.Parameters is
      (N : Libadalang.Analysis.Ada_Node'Class)
       return Libadalang.Analysis.Generic_Package_Instantiation;
    function Get_Designators
-     (G : Libadalang.Analysis.Generic_Package_Instantiation)
+     (G              : Libadalang.Analysis.Generic_Package_Instantiation;
+      Sloc           : Langkit_Support.Slocs.Source_Location;
+      Unnamed_Params : out Natural)
       return Laltools.Common.Node_Vectors.Vector;
    function Get_Decl_Designators
      (G       : Libadalang.Analysis.Generic_Package_Instantiation;
@@ -185,11 +189,16 @@ package body LSP.Ada_Completions.Parameters is
    ---------------------
 
    function Get_Designators
-     (A : Libadalang.Analysis.Aggregate)
+     (A              : Libadalang.Analysis.Aggregate;
+      Sloc           : Langkit_Support.Slocs.Source_Location;
+      Unnamed_Params : out Natural)
       return Laltools.Common.Node_Vectors.Vector
    is
+      pragma Unreferenced (Sloc);
       Res : Laltools.Common.Node_Vectors.Vector;
    begin
+      Unnamed_Params := 0;
+
       for Assoc of A.F_Assocs loop
          if Assoc.Kind in Ada_Aggregate_Assoc_Range then
             for Alt of Assoc.As_Aggregate_Assoc.F_Designators loop
@@ -501,16 +510,29 @@ package body LSP.Ada_Completions.Parameters is
    ---------------------
 
    function Get_Designators
-     (G : Libadalang.Analysis.Generic_Package_Instantiation)
+     (G              : Libadalang.Analysis.Generic_Package_Instantiation;
+      Sloc           : Langkit_Support.Slocs.Source_Location;
+      Unnamed_Params : out Natural)
       return Laltools.Common.Node_Vectors.Vector
    is
+      use Langkit_Support.Slocs;
       Designator : Libadalang.Analysis.Ada_Node;
       Res        : Laltools.Common.Node_Vectors.Vector;
    begin
+      Unnamed_Params := 0;
+
       for Assoc of G.F_Params loop
          Designator := Assoc.As_Param_Assoc.F_Designator;
          if Designator /= No_Ada_Node then
             Res.Append (Designator);
+         else
+            if Res.Is_Empty
+            --  Count only the unnamed params at the start
+              and then Start_Sloc (Assoc.Sloc_Range) < Sloc
+            --  Prevent adding false parameter because of LAL recovery
+            then
+               Unnamed_Params := Unnamed_Params + 1;
+            end if;
          end if;
       end loop;
 

source/ada/lsp-lal_utils.adb

@@ -420,13 +420,18 @@ package body LSP.Lal_Utils is
    --------------------------
 
    function Get_Call_Designators
-     (Node : Libadalang.Analysis.Call_Expr)
+     (Node           : Libadalang.Analysis.Call_Expr;
+      Sloc           : Langkit_Support.Slocs.Source_Location;
+      Unnamed_Params : out Natural)
       return Laltools.Common.Node_Vectors.Vector
    is
+      use Langkit_Support.Slocs;
       Designator : Libadalang.Analysis.Ada_Node;
       Res        : Laltools.Common.Node_Vectors.Vector :=
         Laltools.Common.Node_Vectors.Empty_Vector;
    begin
+      Unnamed_Params := 0;
+
       if Node = No_Call_Expr then
          return Res;
       end if;
@@ -442,6 +447,14 @@ package body LSP.Lal_Utils is
                Designator := Assoc.As_Param_Assoc.F_Designator;
                if Designator /= No_Ada_Node then
                   Res.Append (Designator);
+               else
+                  if Res.Is_Empty
+                  --  Count only the unnamed params at the start
+                    and then Start_Sloc (Assoc.Sloc_Range) < Sloc
+                  --  Prevent adding false parameter because of LAL recovery
+                  then
+                     Unnamed_Params := Unnamed_Params + 1;
+                  end if;
                end if;
             end loop;
          end if;

source/ada/lsp-lal_utils.ads

@@ -211,9 +211,13 @@ package LSP.Lal_Utils is
    --  recovery.
 
    function Get_Call_Designators
-     (Node : Libadalang.Analysis.Call_Expr)
+     (Node           : Libadalang.Analysis.Call_Expr;
+      Sloc           : Langkit_Support.Slocs.Source_Location;
+      Unnamed_Params : out Natural)
       return Laltools.Common.Node_Vectors.Vector;
    --  Return the list of designator in the current call_expr
+   --  Unnamed_Params correspond to the number of parameters without
+   --  designators before Sloc.
 
    procedure Get_Call_Expr_Name
      (Node             : Libadalang.Analysis.Ada_Node'Class;

testsuite/ada_lsp/completion.param.no_named_notation/bar.adb

@@ -0,0 +1,22 @@
+package body Bar is
+
+   -----------
+   -- Hello --
+   -----------
+
+   procedure Hello (A : Integer; B : Float) is
+   begin
+      null;
+   end Hello;
+
+   -----------
+   -- Hello --
+   -----------
+
+   procedure Hello (M : access My_Type; A : Integer; B : Float) is
+   begin
+      null;
+   end Hello;
+
+end Bar;
+

testsuite/ada_lsp/completion.param.no_named_notation/bar.ads

@@ -0,0 +1,13 @@
+package Bar is
+
+   procedure Hello (A : Integer; B : Float);
+
+   type My_Type is tagged
+      record
+         B : Boolean;
+      end record;
+   type My_Access is access all My_Type;
+
+   procedure Hello (M : access My_Type; A : Integer; B : Float);
+
+end Bar;

testsuite/ada_lsp/completion.param.no_named_notation/default.gpr

@@ -0,0 +1,3 @@
+project Default is
+   for Main use ("foo.adb");
+end Default;

testsuite/ada_lsp/completion.param.no_named_notation/foo.adb

@@ -0,0 +1,11 @@
+with Bar; use Bar;
+
+procedure Foo is
+   M : My_Access := null;
+begin
+   Hello (1);
+
+   Bar.Hello (1, B => 1);
+
+   M.Hello (1);
+end Foo;