V701-011: Fix precedence of pretty printer options

Options explicitly set in the project file should have precedence
over LSP options set by the client.

Author: AnthonyLeonardoGracio

source/ada/lsp-ada_contexts.adb

@@ -39,7 +39,9 @@ with Utils.Command_Lines.Common;
 
 package body LSP.Ada_Contexts is
 
-   Indexing_Trace : constant Trace_Handle := Create ("ALS.INDEXING", Off);
+   Indexing_Trace   : constant Trace_Handle := Create ("ALS.INDEXING", Off);
+
+   Formatting_Trace : constant Trace_Handle := Create ("ALS.FORMATTING", On);
 
    use type Libadalang.Analysis.Analysis_Unit;
 
@@ -68,8 +70,16 @@ package body LSP.Ada_Contexts is
    function URI_To_File
      (Self : Context;
       URI  : LSP.Types.LSP_URI)
-      return GNATCOLL.VFS.Virtual_File is
-        (GNATCOLL.VFS.Create_From_UTF8 (Self.URI_To_File (URI)));
+      return GNATCOLL.VFS.Virtual_File
+   is
+     (GNATCOLL.VFS.Create_From_UTF8 (Self.URI_To_File (URI)));
+
+   procedure Update_Pp_Formatting_Options
+     (Pp_Options  : in out Utils.Command_Lines.Command_Line;
+      LSP_Options : LSP.Messages.FormattingOptions);
+   --  Update the gnatpp formatting options using the LSP ones.
+   --  Options that are explicitly specified in the .gpr file take precedence
+   --  over LSP options.
 
    -------------------------
    -- Append_Declarations --
@@ -763,6 +773,55 @@ package body LSP.Ada_Contexts is
       --  Tab stop is set 1 to disable "visible character guessing" by LAL.
    end Reload;
 
+   ----------------------------------
+   -- Update_Pp_Formatting_Options --
+   ----------------------------------
+
+   procedure Update_Pp_Formatting_Options
+     (Pp_Options  : in out Utils.Command_Lines.Command_Line;
+      LSP_Options : LSP.Messages.FormattingOptions)
+   is
+      Pp_Indentation : constant Natural :=
+        Pp.Command_Lines.Pp_Nat_Switches.Arg
+          (Pp_Options, Pp.Command_Lines.Indentation);
+      Pp_No_Tab      : constant Boolean :=
+        Pp.Command_Lines.Pp_Flag_Switches.Arg
+          (Pp_Options, Pp.Command_Lines.No_Tab);
+   begin
+      --  Check if intentation and 'no tab' policy options have been explictly
+      --  set in the project.
+      --  If it's not the case, use the LSP options.
+
+      if not Pp.Command_Lines.Pp_Nat_Switches.Explicit
+        (Pp_Options, Pp.Command_Lines.Indentation)
+      then
+         Pp.Command_Lines.Pp_Nat_Switches.Set_Arg
+           (Pp_Options,
+            Pp.Command_Lines.Indentation,
+            Natural (LSP_Options.tabSize));
+
+      elsif Pp_Indentation /= Natural (LSP_Options.tabSize) then
+         Formatting_Trace.Trace
+           ("Project file defines an indentation "
+            & "of" & Pp_Indentation'Img & ", while LSP defines an "
+            & "indentation of" & LSP_Options.tabSize'Img & ".");
+      end if;
+
+      if not Pp.Command_Lines.Pp_Flag_Switches.Explicit
+        (Pp_Options, Pp.Command_Lines.No_Tab)
+      then
+         Pp.Command_Lines.Pp_Flag_Switches.Set_Arg
+           (Pp_Options,
+            Pp.Command_Lines.No_Tab,
+            LSP_Options.insertSpaces);
+
+      elsif Pp_No_Tab /= LSP_Options.insertSpaces then
+         Formatting_Trace.Trace
+           ("Project file no tab policy is set to " & Pp_No_Tab'Img
+            & ", while LSP is set to " & LSP_Options.insertSpaces'Img);
+      end if;
+   end Update_Pp_Formatting_Options;
+
    ------------
    -- Format --
    ------------
@@ -774,18 +833,14 @@ package body LSP.Ada_Contexts is
       Options  : LSP.Messages.FormattingOptions;
       Edit     : out LSP.Messages.TextEdit_Vector;
       Success  : out Boolean;
-      Messages : out VSS.String_Vectors.Virtual_String_Vector)
-   is
+      Messages : out VSS.String_Vectors.Virtual_String_Vector) is
    begin
-      Pp.Command_Lines.Pp_Nat_Switches.Set_Arg
-        (Self.PP_Options,
-         Pp.Command_Lines.Indentation,
-         Natural (Options.tabSize));
+      --  Take into account the options set by the request only if the
+      --  corresponding GPR switches are not explicitly set.
 
-      Pp.Command_Lines.Pp_Flag_Switches.Set_Arg
-        (Self.PP_Options,
-         Pp.Command_Lines.No_Tab,
-         Options.insertSpaces);
+      Update_Pp_Formatting_Options
+        (Pp_Options  => Self.PP_Options,
+         LSP_Options => Options);
 
       Success := Document.Formatting
         (Context  => Self,
@@ -808,15 +863,12 @@ package body LSP.Ada_Contexts is
       Success  : out Boolean;
       Messages : out VSS.String_Vectors.Virtual_String_Vector) is
    begin
-      Pp.Command_Lines.Pp_Nat_Switches.Set_Arg
-        (Self.PP_Options,
-         Pp.Command_Lines.Indentation,
-         Natural (Options.tabSize));
-
-      Pp.Command_Lines.Pp_Flag_Switches.Set_Arg
-        (Self.PP_Options,
-         Pp.Command_Lines.No_Tab,
-         Options.insertSpaces);
+      --  Take into account the options set by the request only if the
+      --  corresponding GPR switches are not explicitly set.
+
+      Update_Pp_Formatting_Options
+        (Pp_Options  => Self.PP_Options,
+         LSP_Options => Options);
 
       Success := Document.Range_Formatting
         (Context    => Self,

source/ada/lsp-ada_handlers.adb

@@ -230,7 +230,8 @@ package body LSP.Ada_Handlers is
      (Self     : in out LSP.Ada_Contexts.Context;
       Document : LSP.Ada_Documents.Document_Access;
       Span     : LSP.Messages.Span;
-      Options  : LSP.Messages.FormattingOptions)
+      Options  : LSP.Messages.FormattingOptions;
+      Handler  : access Message_Handler)
       return LSP.Messages.Server_Responses.Formatting_Response;
    --  Format the text of the given document in the given range (span).
 
@@ -813,7 +814,8 @@ package body LSP.Ada_Handlers is
      (Self     : in out LSP.Ada_Contexts.Context;
       Document : LSP.Ada_Documents.Document_Access;
       Span     : LSP.Messages.Span;
-      Options  : LSP.Messages.FormattingOptions)
+      Options  : LSP.Messages.FormattingOptions;
+      Handler  : access Message_Handler)
       return LSP.Messages.Server_Responses.Formatting_Response
    is
       Response : LSP.Messages.Server_Responses.Formatting_Response
@@ -849,6 +851,15 @@ package body LSP.Ada_Handlers is
                 data    => <>));
             return Response;
          end;
+      else
+         --  If the formntting succeeded, still display messages in the client
+         --  if any.
+         for Msg of Messages loop
+            Show_Message
+              (Self => Handler,
+               Text => Msg,
+               Mode => LSP.Messages.Info);
+         end loop;
       end if;
 
       return Response;
@@ -5508,7 +5519,8 @@ package body LSP.Ada_Handlers is
              (Self     => Context.all,
               Document => Document,
               Span     => LSP.Messages.Empty_Span,
-              Options  => Request.params.options);
+              Options  => Request.params.options,
+              Handler  => Self);
       begin
          return Response;
       end;
@@ -5907,7 +5919,8 @@ package body LSP.Ada_Handlers is
                 (Self     => Context.all,
                  Document => Document,
                  Span     => Request.params.span,
-                 Options  => Request.params.options));
+                 Options  => Request.params.options,
+                 Handler  => Self));
          Response : Server_Responses.Range_Formatting_Response
            (Is_Error => Result.Is_Error);
       begin

testsuite/ada_lsp/V701-011.formatting.options_precedence/default.gpr

@@ -0,0 +1,9 @@
+project Default is
+
+   for Main use ("main.adb");
+
+   package Pretty_Printer is
+      for Default_Switches ("Ada") use ("--indentation=10");
+   end Pretty_Printer;
+
+end Default;

testsuite/ada_lsp/V701-011.formatting.options_precedence/main.adb

@@ -0,0 +1,13 @@
+with Ada.Unchecked_Deallocation;
+
+procedure Main is
+
+    type My_Type is new Integer;
+    type My_Type_Access is access all My_Type;
+
+    procedure Free is new Ada.Unchecked_Deallocation (My_Type, My_Type_Access);
+
+    A : My_Type_Access := new My_Type'(3);
+begin
+    Free (A);
+end Main;