Merge remote branch 'origin/master' into edge

Author: automatic-merge

.gitlab-ci.yml

@@ -9,18 +9,34 @@ stages:
 # Build and test with ANOD
 # TODO: add a build and test based on Alire in parallel to this.
 build_and_test:
+  rules:
+    # Let's do the job only for merge request events: that's
+    # when we know whether the target branch is 'edge'.
+    - if: $CI_PIPELINE_SOURCE == 'merge_request_event'
   services:
      - image:sandbox
      - cpu:8
      - mem:16
   stage: build_and_test
+  interruptible: true
   script:
     - . ~/.aws_container_credentials
     - export PATH=/it/e3/bin:$PATH
 
+    # Check whether we're in an MR targeting 'edge' and setup some
+    # variables if so.
+    - TARGET_BRANCH="master"
+    - if [ "$CI_MERGE_REQUEST_TARGET_BRANCH_NAME" = "edge" ]; then
+          echo "Targeting the edge branch." ;
+          REPO_SUFFIX="-edge" ;
+          BUILD_SPACE_SUFFIX="_edge" ;
+          QUALIFIER="edge" ;
+          TARGET_BRANCH="edge" ;
+      fi
+
     # Setup the 'anod vcs' for this repo
     - cd /it/wave
-    - anod vcs --add-repo ada_language_server $CI_PROJECT_DIR
+    - anod vcs --add-repo ada_language_server${REPO_SUFFIX} $CI_PROJECT_DIR
 
     # Figure out if we're on a sync branch
     - BRANCH=master
@@ -32,29 +48,32 @@ build_and_test:
 
     # Setup the 'anod vcs' for the other repos, if we're on
     # a "sync" branch.
-    - if [ $BRANCH != master ]; then
-      for subproject in vss spawn gnatdoc ; do
+    - for subproject in vss spawn gnatdoc ; do
+         echo "for subproject $subproject ..." ;
          cd /tmp ;
          git clone $GIT_CLONE_BASE/eng/ide/$subproject ;
          cd $subproject ;
          if `git show-ref $BRANCH > /dev/null` ; then
+             echo "... checking out $BRANCH"
              git checkout $BRANCH ;
              cd /it/wave ;
              anod vcs --add-repo $subproject /tmp/$subproject ;
+         else
+             echo "... checking out $TARGET_BRANCH"
+             git checkout $TARGET_BRANCH ;
          fi ;
       done ;
-      fi
 
     # Build & test using anod
     - cd /it/wave
-    - anod build als --minimal
-    - anod test als --minimal
+    - anod build als --qualifier=$QUALIFIER --minimal
+    - anod test als  --qualifier=$QUALIFIER --minimal
 
     # Process the report
     - e3-testsuite-report
        --failure-exit-code 1
        --xunit-output $CI_PROJECT_DIR/xunit_output.xml
-       x86_64-linux/als-test/results/new/ || FAILED=true
+       x86_64-linux/als${BUILD_SPACE_SUFFIX}-test/results/new/ || FAILED=true
 
     - if [ ! -z ${FAILED+x} ]; then echo "There was at least one testcase failure" && exit 1; fi
 

source/ada/lsp-ada_driver.adb

@@ -53,6 +53,7 @@ with LSP.Ada_Handlers.Refactor_Extract_Subprogram;
 with LSP.Ada_Handlers.Refactor_Introduce_Parameter;
 with LSP.Ada_Handlers.Refactor_Pull_Up_Declaration;
 with LSP.Ada_Handlers.Refactor_Replace_Type;
+with LSP.Ada_Handlers.Refactor_Sort_Dependencies;
 with LSP.Commands;
 with LSP.Error_Decorators;
 with LSP.Fuzz_Decorators;
@@ -150,6 +151,8 @@ procedure LSP.Ada_Driver is
         (LSP.Ada_Handlers.Refactor_Pull_Up_Declaration.Command'Tag);
       LSP.Commands.Register
         (LSP.Ada_Handlers.Refactor_Replace_Type.Command'Tag);
+      LSP.Commands.Register
+        (LSP.Ada_Handlers.Refactor_Sort_Dependencies.Command'Tag);
 
       --  Refactoring - Change Subprogram Signature Commands
       LSP.Commands.Register

source/ada/lsp-ada_handlers-refactor_sort_dependencies.adb

@@ -0,0 +1,234 @@
+------------------------------------------------------------------------------
+--                         Language Server Protocol                         --
+--                                                                          --
+--                        Copyright (C) 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  This software is distributed in the hope  that it will be useful, --
+-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for  more details.  You should have  received  a copy of the GNU --
+-- General  Public  License  distributed  with  this  software;   see  file --
+-- COPYING3.  If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license.                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Strings.UTF_Encoding;
+
+with Langkit_Support.Slocs;
+
+with Libadalang.Analysis;
+
+with Laltools.Refactor.Sort_Dependencies;
+
+with LSP.Common;
+with LSP.Messages.Client_Requests;
+with LSP.Lal_Utils;
+
+with VSS.Strings.Conversions;
+
+package body LSP.Ada_Handlers.Refactor_Sort_Dependencies is
+
+   ------------------------
+   -- Append_Code_Action --
+   ------------------------
+
+   procedure Append_Code_Action
+     (Self            : in out Command;
+      Context         : Context_Access;
+      Commands_Vector : in out LSP.Messages.CodeAction_Vector;
+      Where           : LSP.Messages.Location)
+   is
+      Pointer     : LSP.Commands.Command_Pointer;
+      Code_Action : LSP.Messages.CodeAction;
+
+   begin
+      Self.Initialize
+        (Context           => Context.all,
+         Where             => Where);
+
+      Pointer.Set (Self);
+
+      Code_Action :=
+        (title       => "Sort Dependencies",
+         kind        =>
+           (Is_Set => True,
+            Value  => LSP.Messages.Refactor),
+         diagnostics => (Is_Set => False),
+         edit        => (Is_Set => False),
+         isPreferred => (Is_Set => False),
+         disabled    => (Is_Set => False),
+         command     =>
+           (Is_Set => True,
+            Value  =>
+              (Is_Unknown => False,
+               title      => <>,
+               Custom     => Pointer)));
+
+      Commands_Vector.Append (Code_Action);
+   end Append_Code_Action;
+
+   ------------
+   -- Create --
+   ------------
+
+   overriding
+   function Create
+     (JS : not null access LSP.JSON_Streams.JSON_Stream'Class)
+      return Command
+   is
+      use Ada.Strings.UTF_Encoding;
+      use LSP.Messages;
+      use LSP.Types;
+      use VSS.Strings.Conversions;
+
+   begin
+      return C : Command do
+         pragma Assert (JS.R.Is_Start_Object);
+
+         JS.R.Read_Next;
+
+         while not JS.R.Is_End_Object loop
+            pragma Assert (JS.R.Is_Key_Name);
+
+            declare
+               Key : constant UTF_8_String := To_UTF_8_String (JS.R.Key_Name);
+
+            begin
+               JS.R.Read_Next;
+
+               if Key = "context" then
+                  Read_String (JS, C.Context);
+
+               elsif Key = "where" then
+                  Location'Read (JS, C.Where);
+
+               else
+                  JS.Skip_Value;
+               end if;
+            end;
+         end loop;
+
+         JS.R.Read_Next;
+      end return;
+   end Create;
+
+   -------------
+   -- Execute --
+   -------------
+
+   overriding
+   procedure Execute
+     (Self    : Command;
+      Handler : not null access LSP.Server_Notification_Receivers.
+        Server_Notification_Receiver'Class;
+      Client  : not null access LSP.Client_Message_Receivers.
+        Client_Message_Receiver'Class;
+      Error   : in out LSP.Errors.Optional_ResponseError)
+   is
+      use Langkit_Support.Slocs;
+      use Libadalang.Analysis;
+      use Laltools.Refactor;
+      use Laltools.Refactor.Sort_Dependencies;
+      use LSP.Messages;
+      use LSP.Types;
+      use VSS.Strings.Conversions;
+
+      Message_Handler : LSP.Ada_Handlers.Message_Handler renames
+        LSP.Ada_Handlers.Message_Handler (Handler.all);
+      Context         : LSP.Ada_Contexts.Context renames
+        Message_Handler.Contexts.Get (Self.Context).all;
+
+      Apply           : Client_Requests.Workspace_Apply_Edit_Request;
+      Workspace_Edits : WorkspaceEdit renames Apply.params.edit;
+      Label           : Optional_Virtual_String renames Apply.params.label;
+
+      Analysis_Unit    : constant Libadalang.Analysis.Analysis_Unit :=
+        Context.LAL_Context.Get_From_File
+          (Context.URI_To_File (Self.Where.uri));
+      Sloc             : constant Source_Location :=
+        (Langkit_Support.Slocs.Line_Number (Self.Where.span.first.line) + 1,
+         Langkit_Support.Slocs.Column_Number (Self.Where.span.first.character)
+         + 1);
+      Compilation_Unit : constant Libadalang.Analysis.Compilation_Unit :=
+        Analysis_Unit.Root.Lookup (Sloc).P_Enclosing_Compilation_Unit;
+
+      Sorter : constant Dependencies_Sorter :=
+        Create_Dependencies_Sorter (Compilation_Unit);
+      Edits      : constant Refactoring_Edits := Sorter.Refactor (null);
+
+   begin
+      if Edits = No_Refactoring_Edits then
+         Error :=
+           (Is_Set => True,
+            Value  =>
+              (code    => LSP.Errors.UnknownErrorCode,
+               message => VSS.Strings.Conversions.To_Virtual_String
+                 ("Failed to execute the Sort Dependencies refactoring"),
+               data    => <>));
+
+      else
+         Workspace_Edits :=
+           LSP.Lal_Utils.To_Workspace_Edit
+             (Edits               => Edits,
+              Resource_Operations => Message_Handler.Resource_Operations,
+              Versioned_Documents => Message_Handler.Versioned_Documents,
+              Document_Provider   => Message_Handler'Access);
+         Label :=
+           (Is_Set => True,
+            Value  => To_Virtual_String (Command'External_Tag));
+
+         Client.On_Workspace_Apply_Edit_Request (Apply);
+      end if;
+
+   exception
+      when E : others =>
+         LSP.Common.Log (Message_Handler.Trace, E);
+         Error :=
+           (Is_Set => True,
+            Value  =>
+              (code    => LSP.Errors.UnknownErrorCode,
+               message => VSS.Strings.Conversions.To_Virtual_String
+                 ("Failed to execute the Sort Dependencies refactoring"),
+               data    => <>));
+   end Execute;
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize
+     (Self    : in out Command'Class;
+      Context : LSP.Ada_Contexts.Context;
+      Where   : LSP.Messages.Location) is
+   begin
+      Self.Context := Context.Id;
+      Self.Where   := Where;
+   end Initialize;
+
+   -------------------
+   -- Write_Command --
+   -------------------
+
+   procedure Write_Command
+     (S : access Ada.Streams.Root_Stream_Type'Class;
+      C : Command)
+   is
+      use LSP.Messages;
+      use LSP.Types;
+
+      JS : LSP.JSON_Streams.JSON_Stream'Class renames
+        LSP.JSON_Streams.JSON_Stream'Class (S.all);
+
+   begin
+      JS.Start_Object;
+      JS.Key ("context");
+      Write_String (S, C.Context);
+      JS.Key ("where");
+      Location'Write (S, C.Where);
+      JS.End_Object;
+   end Write_Command;
+
+end LSP.Ada_Handlers.Refactor_Sort_Dependencies;