Skip to content

Commit

Permalink
Merge remote branch 'origin/master' into edge
Browse files Browse the repository at this point in the history
  • Loading branch information
automatic-merge committed Sep 6, 2023
2 parents d6bd568 + 7b9e69e commit 42f6ca9
Show file tree
Hide file tree
Showing 8 changed files with 508 additions and 695 deletions.
8 changes: 6 additions & 2 deletions Makefile
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,10 @@ ROOTDIR=$(shell pwd)

# ALS version
VERSION ?=

# ALS build date
BUILD_DATE ?=

# Location of home dir for tests
export ALS_HOME=$(ROOTDIR)/testsuite

Expand Down Expand Up @@ -91,7 +95,7 @@ all: coverage-instrument
$(GPRBUILD) -P gnat/tester.gpr -p $(BUILD_FLAGS)
$(GPRBUILD) -d -ws -c -u -P gnat/lsp_server.gpr -p $(BUILD_FLAGS) s-memory.adb
$(GPRBUILD) -P gnat/lsp_server.gpr -p $(COVERAGE_BUILD_FLAGS) \
-XVERSION=$(VERSION)
-XVERSION=$(VERSION) -XBUILD_DATE=$(BUILD_DATE)
$(GPRBUILD) -P gnat/codec_test.gpr -p $(COVERAGE_BUILD_FLAGS)
$(GPRBUILD) -P gnat/lsp_client.gpr -p $(COVERAGE_BUILD_FLAGS) \
-XVERSION=$(VERSION)
Expand All @@ -111,7 +115,7 @@ ifneq ($(COVERAGE),)
# Remove artifacts from previous instrumentations, so that stale units that
# are not overriden by new ones don't get in our way.
rm -rf .obj/*/gnatcov-instr
$(COVERAGE_INSTR) -XVERSION=$(VERSION) \
$(COVERAGE_INSTR) -XVERSION=$(VERSION) XBUILD_DATE=$(BUILD_DATE) \
-Pgnat/lsp_server.gpr --projects lsp_server --projects lsp
$(COVERAGE_INSTR) -Pgnat/tester.gpr --projects lsp
$(COVERAGE_INSTR) -Pgnat/codec_test.gpr --projects lsp
Expand Down
5 changes: 4 additions & 1 deletion gnat/lsp_server.gpr
Original file line number Diff line number Diff line change
Expand Up @@ -29,6 +29,8 @@ project LSP_Server is

VERSION := external ("VERSION", "latest");

BUILD_DATE := external ("BUILD_DATE", "unknown");

type Library_Kind is ("static", "static-pic", "relocatable");
Library_Type : Library_Kind := external("ALS_LIBRARY_TYPE",
external("LIBRARY_TYPE", "relocatable"));
Expand All @@ -50,7 +52,8 @@ project LSP_Server is
package Compiler is
for Default_Switches ("Ada") use LSP.Compiler'Default_Switches ("Ada");
for Switches ("lsp-ada_driver.adb") use
LSP.Compiler'Default_Switches ("Ada") & ("-gnateDVERSION=""" & VERSION & """");
LSP.Compiler'Default_Switches ("Ada") &
("-gnateDVERSION=""" & VERSION & """", "-gnateDBUILD_DATE=""" & BUILD_DATE & """");
for Switches ("s-memory.adb") use ("-g", "-O2", "-gnatpg");
for Local_Configuration_Pragmas use "gnat.adc";
end Compiler;
Expand Down
9 changes: 5 additions & 4 deletions source/ada/lsp-ada_driver.adb
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,7 @@ with LSP.Ada_Handlers;
with LSP.Ada_Handlers.Named_Parameters_Commands;
with LSP.Ada_Handlers.Other_File_Commands;
with LSP.Ada_Handlers.Project_Reload_Commands;
with LSP.Ada_Handlers.Refactor.Imports_Commands;
with LSP.Ada_Handlers.Refactor.Auto_Import;
with LSP.Ada_Handlers.Refactor.Add_Parameter;
with LSP.Ada_Handlers.Refactor.Remove_Parameter;
with LSP.Ada_Handlers.Refactor.Move_Parameter;
Expand Down Expand Up @@ -148,7 +148,7 @@ procedure LSP.Ada_Driver is
LSP.Commands.Register
(LSP.Ada_Handlers.Named_Parameters_Commands.Command'Tag);
LSP.Commands.Register
(LSP.Ada_Handlers.Refactor.Imports_Commands.Command'Tag);
(LSP.Ada_Handlers.Refactor.Auto_Import.Command'Tag);
LSP.Commands.Register
(LSP.Ada_Handlers.Refactor.Suppress_Seperate.Command'Tag);
LSP.Commands.Register
Expand Down Expand Up @@ -243,7 +243,8 @@ begin
VSS.Command_Line.Process; -- Will exit if errors or help requested.

if VSS.Command_Line.Is_Specified (Version_Option) then
Ada.Text_IO.Put_Line ("ALS version: " & $VERSION);
Ada.Text_IO.Put_Line
("ALS version: " & $VERSION & " (" & $BUILD_DATE & ")");
GNAT.OS_Lib.OS_Exit (0);
end if;

Expand Down Expand Up @@ -316,7 +317,7 @@ begin
end;
end if;

Server_Trace.Trace ("ALS version: " & $VERSION);
Server_Trace.Trace ("ALS version: " & $VERSION & " (" & $BUILD_DATE & ")");

Server_Trace.Trace ("Initializing server ...");

Expand Down
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
------------------------------------------------------------------------------
-- Language Server Protocol --
-- --
-- Copyright (C) 2020-2022, AdaCore --
-- Copyright (C) 2020-2023, AdaCore --
-- --
-- This is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Expand All @@ -16,22 +16,18 @@
------------------------------------------------------------------------------

with Ada.Strings.UTF_Encoding;
with Ada.Strings.Unbounded;
with Ada.Strings.Wide_Wide_Unbounded;

with Langkit_Support.Text;

with Libadalang.Analysis;
with Libadalang.Common;

with Laltools.Common;

with LSP.Commands;
with LSP.Messages;

with VSS.Strings.Conversions;
with LSP.Commands;

package body LSP.Ada_Handlers.Refactor.Imports_Commands is
package body LSP.Ada_Handlers.Refactor.Auto_Import is

----------------
-- Initialize --
Expand All @@ -46,8 +42,11 @@ package body LSP.Ada_Handlers.Refactor.Imports_Commands is
begin
Self.Context := Context.Id;
Self.Where := Where;
Self.With_Clause := With_Clause;
Self.Prefix := Prefix;
Self.Suggestion :=
(Import =>
VSS.Strings.Conversions.To_Unbounded_Wide_Wide_String (With_Clause),
Qualifier =>
VSS.Strings.Conversions.To_Unbounded_Wide_Wide_String (Prefix));
end Initialize;

------------
Expand All @@ -74,10 +73,25 @@ package body LSP.Ada_Handlers.Refactor.Imports_Commands is
LSP.Types.Read_String (JS, V.Context);
elsif Key = "where" then
LSP.Messages.TextDocumentPositionParams'Read (JS, V.Where);
elsif Key = "with_clause" then
LSP.Types.Read_String (JS, V.With_Clause);
elsif Key = "prefix" then
LSP.Types.Read_String (JS, V.Prefix);
elsif Key = "import" then
declare
Import : VSS.Strings.Virtual_String;
begin
LSP.Types.Read_String (JS, Import);
V.Suggestion.Import :=
VSS.Strings.Conversions.To_Unbounded_Wide_Wide_String
(Import);
end;

elsif Key = "qualifier" then
declare
Qualififer : VSS.Strings.Virtual_String;
begin
LSP.Types.Read_String (JS, Qualififer);
V.Suggestion.Qualifier :=
VSS.Strings.Conversions.To_Unbounded_Wide_Wide_String
(Qualififer);
end;
else
JS.Skip_Value;
end if;
Expand All @@ -96,13 +110,13 @@ package body LSP.Ada_Handlers.Refactor.Imports_Commands is
Context : Context_Access;
Where : LSP.Messages.Location;
Commands_Vector : in out LSP.Messages.CodeAction_Vector;
Suggestion : LAL_Refactor.Refactor_Imports.Import_Suggestion)
Suggestion : LAL_Refactor.Auto_Import.Import_Type)
is
Pointer : LSP.Commands.Command_Pointer;
Item : LSP.Messages.CodeAction;

function Create_Suggestion_Title
(Suggestion : LAL_Refactor.Refactor_Imports.Import_Suggestion)
(Suggestion : LAL_Refactor.Auto_Import.Import_Type)
return VSS.Strings.Virtual_String;
-- Creates the suggestion text that will be shown by the client to
-- to the developer. The text is costumized based on the need of
Expand All @@ -112,42 +126,17 @@ package body LSP.Ada_Handlers.Refactor.Imports_Commands is
-- Create_Suggestions_Title --
------------------------------
function Create_Suggestion_Title
(Suggestion : LAL_Refactor.Refactor_Imports.Import_Suggestion)
(Suggestion : LAL_Refactor.Auto_Import.Import_Type)
return VSS.Strings.Virtual_String
is
Title : Ada.Strings.Wide_Wide_Unbounded.
Unbounded_Wide_Wide_String
:= Ada.Strings.Wide_Wide_Unbounded.
Null_Unbounded_Wide_Wide_String;
use type Ada.Strings.Wide_Wide_Unbounded.
Unbounded_Wide_Wide_String;
use Ada.Strings.Wide_Wide_Unbounded;

Title : constant Langkit_Support.Text.Unbounded_Text_Type :=
"Qualify with " & Suggestion.Qualifier;
begin
if Suggestion.With_Clause_Text /= "" then
if Suggestion.Prefix_Text /= "" then
-- Add with clause and prefix
Title :=
Title
& "Add 'with' clause for "
& Suggestion.With_Clause_Text
& " and prefix the object with "
& Suggestion.Prefix_Text;

else
-- Add with clause and leave the prefix as it is
Title :=
Title
& "Add 'with' clause for "
& Suggestion.With_Clause_Text;
end if;
else
-- Only add prefix

Title := Title & "Prefix the object with "
& Suggestion.Prefix_Text;
end if;
return VSS.Strings.To_Virtual_String
(Langkit_Support.Text.To_Text (Title));
return
VSS.Strings.To_Virtual_String
(Langkit_Support.Text.To_Text (Title));
end Create_Suggestion_Title;

begin
Expand All @@ -157,15 +146,15 @@ package body LSP.Ada_Handlers.Refactor.Imports_Commands is
Where.span.first),
With_Clause =>
VSS.Strings.Conversions.To_Virtual_String
(Suggestion.With_Clause_Text),
(Suggestion.Import),
Prefix =>
VSS.Strings.Conversions.To_Virtual_String
(Suggestion.Prefix_Text));
(Suggestion.Qualifier));
Pointer.Set (Self);
Item :=
(title => Create_Suggestion_Title (Suggestion),
kind => (Is_Set => True,
Value => LSP.Messages.RefactorRewrite),
Value => LSP.Messages.QuickFix),
diagnostics => (Is_Set => False),
disabled => (Is_Set => False),
edit => (Is_Set => False),
Expand All @@ -188,119 +177,20 @@ package body LSP.Ada_Handlers.Refactor.Imports_Commands is
Document : LSP.Ada_Documents.Document_Access)
return LAL_Refactor.Refactoring_Edits
is
use Langkit_Support.Text;
use Libadalang.Analysis;
use Libadalang.Common;
use Libadalang.Slocs;
use LAL_Refactor;
use VSS.Strings;
use VSS.Strings.Conversions;
use LAL_Refactor.Auto_Import;

Node : Ada_Node :=
Document.Get_Node_At (Context, Self.Where.position);
Name : constant Libadalang.Analysis.Name :=
Document.Get_Node_At (Context, Self.Where.position).As_Name;

Edits : LAL_Refactor.Refactoring_Edits;
function Units return Analysis_Unit_Array is ([]);

begin
-- Add prefix

if not Self.Prefix.Is_Empty
and then Node.Kind in Ada_Identifier
then
-- If this is a DottedName them remove the current prefix and replace
-- it by the suggested one. Otherwise, just add the prepend the
-- prefix

while Node.Parent.Kind in Ada_Dotted_Name_Range loop
Node := Node.Parent;
end loop;

if Node.Kind in Ada_Dotted_Name_Range then
Node := Node.As_Dotted_Name.F_Suffix.As_Ada_Node;
end if;

if Node.Parent.Kind = Ada_Dotted_Name then
-- Node.Parent is the full Dotted Name: this includes the
-- current prefixes and the identifier. Using this SLOC instead
-- of only the current prefixes SLOC is better since this covers
-- cases when the Dotted Name is splitted in multiple lines.

Safe_Insert
(Edits => Edits.Text_Edits,
File_Name => Node.Unit.Get_Filename,
Edit =>
Text_Edit'
(Location =>
Make_Range
(Start_Sloc
(Node.Parent.As_Dotted_Name.F_Prefix.Sloc_Range),
Start_Sloc (Node.Sloc_Range)),
Text =>
Ada.Strings.Unbounded.To_Unbounded_String
(To_UTF8 (To_Wide_Wide_String (Self.Prefix)))));

else
Safe_Insert
(Edits => Edits.Text_Edits,
File_Name => Node.Unit.Get_Filename,
Edit =>
Text_Edit'
(Location =>
Make_Range
(Start_Sloc (Node.Sloc_Range),
Start_Sloc (Node.Sloc_Range)),
Text =>
Ada.Strings.Unbounded.To_Unbounded_String
(To_UTF8 (To_Wide_Wide_String (Self.Prefix)))));
end if;
end if;

-- Add with clause

if not Self.With_Clause.Is_Empty then
declare
Last : Boolean;
S : constant Libadalang.Slocs.Source_Location :=
Laltools.Common.Get_Insert_With_Location
(Node => Laltools.Common.Get_Compilation_Unit (Node),
Pack_Name =>
VSS.Strings.Conversions.To_Wide_Wide_String
(Self.With_Clause),
Last => Last);
begin
if S /= Libadalang.Slocs.No_Source_Location then
if Last then
Safe_Insert
(Edits => Edits.Text_Edits,
File_Name => Node.Unit.Get_Filename,
Edit =>
Text_Edit'
(Location => Make_Range (S, S),
Text =>
Ada.Strings.Unbounded.To_Unbounded_String
(To_UTF8 (To_Wide_Wide_String
(Document.Line_Terminator
& "with " & Self.With_Clause & ";")))));

else
Safe_Insert
(Edits => Edits.Text_Edits,
File_Name => Node.Unit.Get_Filename,
Edit =>
Text_Edit'
(Location => Make_Range (S, S),
Text =>
Ada.Strings.Unbounded.To_Unbounded_String
(To_UTF8 (To_Wide_Wide_String
("with " & Self.With_Clause & ";"
& Document.Line_Terminator)))));
end if;

end if;
end;
end if;

return Edits;
return
Create_Auto_Importer
(Name,
Self.Suggestion)
.Refactor (Units'Access);
end Command_To_Refactoring_Edits;

--------------
Expand Down Expand Up @@ -345,11 +235,15 @@ package body LSP.Ada_Handlers.Refactor.Imports_Commands is
LSP.Types.Write_String (S, V.Context);
JS.Key ("where");
LSP.Messages.TextDocumentPositionParams'Write (S, V.Where);
JS.Key ("with_clause");
LSP.Types.Write_String (S, V.With_Clause);
JS.Key ("prefix");
LSP.Types.Write_String (S, V.Prefix);
JS.Key ("import");
LSP.Types.Write_String
(S,
VSS.Strings.Conversions.To_Virtual_String (V.Suggestion.Import));
JS.Key ("qualifier");
LSP.Types.Write_String
(S,
VSS.Strings.Conversions.To_Virtual_String (V.Suggestion.Qualifier));
JS.End_Object;
end Write_Command;

end LSP.Ada_Handlers.Refactor.Imports_Commands;
end LSP.Ada_Handlers.Refactor.Auto_Import;
Loading

0 comments on commit 42f6ca9

Please sign in to comment.