S528-016 deactivate diagnostics by default

Makefile

@@ -1,8 +1,8 @@
 # Server executable file:
-export ALS=.obj/server/ada_language_server
+export ALS=$(shell pwd)/.obj/server/ada_language_server
 
 # Tester files
-TESTER=.obj/tester/tester-run
+TESTER=$(shell pwd)/.obj/tester/tester-run
 CODEC_TEST=.obj/codec_test/codec_test
 
 # Testsuite directory
@@ -72,7 +72,11 @@ vscode:
 @echo code --extensionDevelopmentPath=`pwd`/integration/vscode/ada/ `pwd`
 
 check: all
-set -e; for a in $(TD)/*/*.json; do echo $$a ; $(TESTER) $$a ; done
+set -e; \
+ for a in $(TD)/*/*.json; do \
+ echo $$a ; \
+ (cd `dirname $$a ` ; $(TESTER) `basename $$a`) ;\
+ done
 ${CODEC_TEST} < testsuite/codecs/index.txt
 
 deploy: check

source/ada/lsp-ada_contexts.adb

@@ -161,6 +161,15 @@ package body LSP.Ada_Contexts is
  return LSP.Ada_Documents.Document_Access (Object);
  end Get_Document;
 
+ -----------------
+ -- Get_Charset --
+ -----------------
+
+ function Get_Charset (Self : in out Context) return String is
+ begin
+ return Ada.Strings.Unbounded.To_String (Self.Charset);
+ end Get_Charset;
+
  ----------------
  -- Initialize --
  ----------------
@@ -198,6 +207,7 @@ package body LSP.Ada_Contexts is
  (Self : in out Context;
  File : LSP.Types.LSP_String;
  Scenario : LSP.Types.LSP_Any;
+ Charset : String;
  Errors : out LSP.Messages.ShowMessageParams)
  is
  procedure Add_Variable (Name : String; Value : GNATCOLL.JSON.JSON_Value);
@@ -235,6 +245,8 @@ package body LSP.Ada_Contexts is
  LSP.Types.To_UTF_8_String (Self.Root);
 
  begin
+ Self.Charset := Ada.Strings.Unbounded.To_Unbounded_String (Charset);
+
  -- Here, we overwrite previous content of Self.Project_Tree without
  -- freeing. That's OK because the Unit provider owns it and will free
  -- the old project tree when we renew the provider.
@@ -299,7 +311,7 @@ package body LSP.Ada_Contexts is
  Self.LAL_Context := Libadalang.Analysis.Create_Context
  (Unit_Provider => Self.Unit_Provider,
  With_Trivia => True,
- Charset => "utf-8");
+ Charset => Charset);
  end Load_Project;
 
  ------------
@@ -311,7 +323,7 @@ package body LSP.Ada_Contexts is
  Self.LAL_Context := Libadalang.Analysis.Create_Context
  (Unit_Provider => Self.Unit_Provider,
  With_Trivia => True,
- Charset => "utf-8");
+ Charset => Self.Get_Charset);
  end Reload;
 
  ---------------------

source/ada/lsp-ada_contexts.ads

@@ -18,6 +18,7 @@
 -- This package provides a context of Ada Language server.
 
 with Ada.Containers.Hashed_Maps;
+with Ada.Strings.Unbounded;
 
 private with GNATCOLL.Projects;
 with GNATCOLL.VFS;
@@ -49,11 +50,16 @@ package LSP.Ada_Contexts is
  (Self : in out Context;
  File : LSP.Types.LSP_String;
  Scenario : LSP.Types.LSP_Any;
+ Charset : String;
  Errors : out LSP.Messages.ShowMessageParams);
  -- Load given project File using given Scenario variables.
  -- In case of errors create and load default project.
+ -- Set the charset as well.
  -- Return warnings and errors in Errors parameter.
 
+ function Get_Charset (Self : in out Context) return String;
+ -- Return the charset with which the context was initialized
+
  procedure Reload (Self : in out Context);
  -- Reload the current context. This will invalidate and destroy any
  -- Libadalang related data, and recreate it from scratch.
@@ -116,6 +122,7 @@ private
 
  Project_Tree : GNATCOLL.Projects.Project_Tree_Access;
  Root : LSP.Types.LSP_String;
+ Charset : Ada.Strings.Unbounded.Unbounded_String;
 
  Documents : Document_Maps.Map;
  end record;

source/ada/lsp-ada_documents.adb

@@ -79,6 +79,7 @@ package body LSP.Ada_Documents is
  if not Change.span.Is_Set then
  Self.Unit := Self.LAL.Get_From_Buffer
  (Filename => File,
+ -- Change.text is always encoded in UTF-8, as per the protocol
  Charset => "utf-8",
  Buffer => LSP.Types.To_UTF_8_Unbounded_String (Change.text));
  end if;
@@ -271,6 +272,7 @@ package body LSP.Ada_Documents is
  begin
  Self.Unit := LAL.Get_From_Buffer
  (Filename => LSP.Types.To_UTF_8_String (File),
+ -- Change.text is always encoded in UTF-8, as per the protocol
  Charset => "utf-8",
  Buffer => LSP.Types.To_UTF_8_Unbounded_String (Item.text));
  Self.URI := Item.uri;

source/ada/lsp-ada_driver.adb

@@ -48,14 +48,18 @@ procedure LSP.Ada_Driver is
  use GNATCOLL.VFS, GNATCOLL.Traces;
  use Ada.Exceptions, GNAT.Traceback.Symbolic;
 
- ALS_Dir : constant Virtual_File := Get_Home_Directory / ".als";
- Do_Exit : Boolean := False;
+ ALS_Dir : constant Virtual_File := Get_Home_Directory / ".als";
+ GNATdebug : constant Virtual_File := Create_From_Base (".gnatdebug");
+ Do_Exit : Boolean := False;
 begin
 
- -- If we can find the .als directory in the home directory, then we want
- -- to init the traces.
+ -- Look for a .gnatdebug file locally; if it exists, use its contents as
+ -- traces config file. If not, if the ".als" directory exists in the home
+ -- directory, initialize traces there.
+ if GNATdebug.Is_Regular_File then
+ Parse_Config_File (GNATdebug);
 
- if ALS_Dir.Is_Directory then
+ elsif ALS_Dir.Is_Directory then
  -- Search for custom traces config in traces.cfg
  Parse_Config_File
  (+Virtual_File'(ALS_Dir / "traces.cfg").Full_Name);

source/ada/lsp-ada_handlers.adb

@@ -16,6 +16,7 @@
 ------------------------------------------------------------------------------
 
 with Ada.Strings.UTF_Encoding;
+with Ada.Strings.Unbounded;
 with Ada.Directories;
 
 with GNAT.Strings;
@@ -350,10 +351,13 @@ package body LSP.Ada_Handlers is
  Diag : LSP.Messages.PublishDiagnosticsParams;
  begin
  Document.Apply_Changes (Value.contentChanges);
- Document.Get_Errors (Diag.diagnostics);
 
- Diag.uri := Value.textDocument.uri;
- Self.Server.Publish_Diagnostics (Diag);
+ if Diagnostics_Trace.Active then
+ Document.Get_Errors (Diag.diagnostics);
+
+ Diag.uri := Value.textDocument.uri;
+ Self.Server.Publish_Diagnostics (Diag);
+ end if;
  end On_DidChangeTextDocument_Notification;
 
  ------------------------------------------
@@ -413,7 +417,13 @@ package body LSP.Ada_Handlers is
 
  if not Self.Context.Has_Project then
  Self.Context.Load_Project
- (Empty_LSP_String, GNATCOLL.JSON.JSON_Null, Errors);
+ (Empty_LSP_String, GNATCOLL.JSON.JSON_Null,
+
+ -- We're loading a default project: set the default charset
+ -- to latin-1, since this is the GNAT default.
+ "iso-8859-1",
+
+ Errors);
 
  if not LSP.Types.Is_Empty (Errors.message) then
  Self.Server.Show_Message (Errors);
@@ -701,7 +711,8 @@ package body LSP.Ada_Handlers is
  begin
  for N in Sources'Range loop
  Source_Units (N) := Context.Get_From_File
- (Sources (N).Display_Full_Name);
+ (Sources (N).Display_Full_Name,
+ Charset => Self.Context.Get_Charset);
  end loop;
 
  declare
@@ -824,6 +835,11 @@ package body LSP.Ada_Handlers is
 
  projectFile : constant String := "projectFile";
  scenarioVariables : constant String := "scenarioVariables";
+ defaultCharset : constant String := "defaultCharset";
+
+ -- Default the charset to iso-8859-1, since this is the GNAT default
+ Charset : Ada.Strings.Unbounded.Unbounded_String :=
+ Ada.Strings.Unbounded.To_Unbounded_String ("iso-8859-1");
 
  Ada : constant LSP.Types.LSP_Any := Value.settings.Get ("ada");
  File : LSP.Types.LSP_String;
@@ -845,9 +861,16 @@ package body LSP.Ada_Handlers is
  then
  Variables := Ada.Get (scenarioVariables);
  end if;
+
+ if Ada.Has_Field (defaultCharset) then
+ Charset := Ada.Get (defaultCharset);
+ end if;
  end if;
 
- Self.Context.Load_Project (File, Variables, Errors);
+ Self.Context.Load_Project
+ (File, Variables,
+ Standard.Ada.Strings.Unbounded.To_String (Charset),
+ Errors);
 
  if not LSP.Types.Is_Empty (Errors.message) then
  Self.Server.Show_Message (Errors);

source/ada/lsp-ada_unit_providers.adb

@@ -90,13 +90,16 @@ package body LSP.Ada_Unit_Providers is
  declare
  Path : constant GNATCOLL.VFS.Virtual_File :=
  Self.Project_Tree.Create (File);
- -- Sometimes Path contains double directory separators
- -- like '/path//file' or 'C:\path\\file'. This prevents correct
- -- file identification in Libadalang. Let's normalize Path:
- Full_Path : constant String :=
- Ada.Directories.Full_Name (+Full_Name (Path));
+ Full_Path : constant String := +Full_Name (Path);
  begin
- return Full_Path;
+ if Full_Path = "" then
+ return Full_Path;
+ else
+ -- Sometimes Path contains double directory separators
+ -- like '/path//file' or 'C:\path\\file'. This prevents correct
+ -- file identification in Libadalang. Let's normalize Path:
+ return Ada.Directories.Full_Name (Full_Path);
+ end if;
  end;
  end Get_Unit_Filename;
 

source/protocol/lsp.ads

@@ -24,4 +24,12 @@ package LSP is
  In_Trace : Trace_Handle := Create ("ALS.IN", Off);
  Out_Trace : Trace_Handle := Create ("ALS.OUT", Off);
  -- Traces that logs all input & output. For debugging purposes.
+
+ -----------------------------
+ -- Feature-specific traces --
+ -----------------------------
+
+ Diagnostics_Trace : Trace_Handle := Create ("ALS.DIAGNOSTICS", Off);
+ -- Whether to enable the diagnostics
+
 end LSP;

testsuite/ada_lsp/S516-013.no_file/no_file.json

@@ -0,0 +1,98 @@
+[
+ {
+ "comment": "Check no exception on hover at non-existing unit"
+ },
+ {
+ "start": {
+ "cmd": ["${ALS}"]
+ }
+ }, {
+ "send": {
+ "request": {"jsonrpc":"2.0","id":0,"method":"initialize","params":{
+ "processId":1,
+ "rootUri":"$URI{.}",
+ "capabilities":{}}
+ },
+ "wait":[{ "id": 0,
+ "result":{
+ "capabilities":{
+ "textDocumentSync":1,
+ "hoverProvider":true
+ }
+ }
+ }]
+ }
+ }, {
+ "send": {
+ "request": {
+ "jsonrpc":"2.0",
+ "method":"workspace/didChangeConfiguration",
+ "params":{
+ "settings":{
+ "ada":{
+ }
+ }
+ }
+ },
+ "wait":[]
+ }
+ }, {
+ "send": {
+ "request": {
+ "jsonrpc":"2.0",
+ "method":"textDocument/didOpen",
+ "params":{
+ "textDocument": {
+ "uri": "$URI{aaa.adb}",
+ "languageId": "ada",
+ "version": 1,
+ "text": "with Ada.Non_Existing;\nprocedure Aaa is\nbegin\n Ada.Non_Existing;\nend Aaa;"
+ }
+ }
+ },
+ "wait":[]
+ }
+ }, {
+ "send": {
+ "request": {
+ "jsonrpc":"2.0",
+ "id":"hover",
+ "method":"textDocument/hover",
+ "params":{
+ "textDocument": {
+ "uri": "$URI{aaa.adb}"
+ },
+ "position": {
+ "line": 3,
+ "character": 15
+ }
+ }
+ },
+ "wait":[{
+ "id": "hover",
+ "result": {
+ "contents": []
+ }
+ }]
+ }
+ }, {
+ "send": {
+ "request": {
+ "jsonrpc":"2.0",
+ "id": "shutdown",
+ "method":"shutdown",
+ "params":null
+ },
+ "wait":[{ "id": "shutdown" }]
+ }
+ }, {
+ "send": {
+ "request": {"jsonrpc":"2.0", "method":"exit", "params":{}},
+ "wait":[]
+ }
+ }, {
+ "stop": {
+ "exit_code": 0
+ }
+ }
+]

testsuite/ada_lsp/S516-013.no_file/test.yaml

@@ -0,0 +1 @@
+title: 'S516-013.no_file'

testsuite/ada_lsp/publish_diag/.gnatdebug

@@ -0,0 +1 @@
+ALS.DIAGNOSTICS=yes