Merge remote branch 'origin/master' into edge

Author: automatic-merge

.github/workflows/build-binaries.yml

@@ -43,20 +43,16 @@ jobs:
       - name: Get GNAT toolchain with alire
         shell: bash
         run: |
-          # alire-project/setup-alire doesn't work for ARM64 Mac OS X for now.
-          # https://github.com/alire-project/setup-alire/pull/74
-          # Also it depends on `engineerd/configurator@v0.0.10` not approved by IT.
-          # https://github.com/alire-project/setup-alire/issues/75
-          # So we fetch Alire with curl then toolchain with Alire.
+          # alire-project/setup-alire works for ARM64 Mac OS X now. Shall we use it?
           if [[ "$RUNNER_ARCH" == ARM64 ]] ; then
-            ZIP=nightly/alr-nightly-bin-aarch64-macos.zip
+            ZIP=v2.0.2/alr-2.0.2-bin-aarch64-${RUNNER_OS}.zip
           else
-            ZIP=v2.0.1/alr-2.0.1-bin-x86_64-${RUNNER_OS}.zip
+            ZIP=v2.0.2/alr-2.0.2-bin-x86_64-${RUNNER_OS}.zip
           fi
           curl -L -O https://github.com/alire-project/alire/releases/download/$ZIP
           unzip $(basename $ZIP)
           bin/alr index --reset-community
-          bin/alr toolchain --select gnat_native^14 gprbuild
+          bin/alr toolchain --select gnat_native gprbuild
           echo $PWD/bin >> $GITHUB_PATH
       - name: Get cross GNAT toolchain (Linux)
         if: ${{ runner.os == 'Linux' }}

.github/workflows/release.sh

@@ -14,9 +14,9 @@ if [[ -z "$NODE_ARCH_PLATFORM" ]]; then
    NODE_PLATFORM=$(node -e "console.log(process.platform)")
    NODE_ARCH=$(node -e "console.log(process.arch)")
    NODE_ARCH_PLATFORM=$NODE_ARCH/$NODE_PLATFORM
-   NAME=$NODE_ARCH-$NODE_PLATFORM
+   NAME=als-$TAG-$NODE_PLATFORM-$NODE_ARCH
 else
-   NAME=${NODE_ARCH_PLATFORM%/*}-${NODE_ARCH_PLATFORM#*/}
+   NAME=als-$TAG-${NODE_ARCH_PLATFORM#*/}-${NODE_ARCH_PLATFORM%/*}
 fi
 
 function release_notes() {

source/ada/lsp-ada_definition.adb

@@ -122,7 +122,6 @@ package body LSP.Ada_Definition is
       Manual_Fallback         : Libadalang.Analysis.Defining_Name;
       Definition_Node         : Libadalang.Analysis.Basic_Decl;
       Decl_For_Find_Overrides : Libadalang.Analysis.Basic_Decl;
-      Entry_Decl_Node         : Libadalang.Analysis.Entry_Decl;
 
       Ignore : Boolean;
    begin
@@ -186,7 +185,37 @@ package body LSP.Ada_Definition is
 
          --  Search for accept statements only if we are on an entry
          if Definition_Node.Kind in Libadalang.Common.Ada_Entry_Decl_Range then
-            Entry_Decl_Node := Definition_Node.As_Entry_Decl;
+            declare
+               Entry_Decl_Node   : constant Libadalang.Analysis.Entry_Decl :=
+                 Definition_Node.As_Entry_Decl;
+               Entry_Parent_Node : constant Libadalang.Analysis.Basic_Decl :=
+                 Entry_Decl_Node.P_Parent_Basic_Decl;
+            begin
+               --  P_Accept_Stmts is only valid for entries declared in tasks
+               if Entry_Parent_Node.Kind in
+                 Libadalang.Common.Ada_Task_Type_Decl_Range
+               then
+                  for Accept_Node of Entry_Decl_Node.P_Accept_Stmts loop
+                     Self.Parent.Context.Append_Location
+                       (Self.Response,
+                        Self.Filter,
+                        Accept_Node.F_Body_Decl.F_Name);
+                  end loop;
+
+               --  Others entries are are handled as simple subprograms
+               else
+                  declare
+                     Other_Part_For_Decl : constant
+                       Libadalang.Analysis.Basic_Decl :=
+                       Laltools.Common.Find_Next_Part_For_Decl
+                         (Definition_Node, Trace);
+                  begin
+                     if not Other_Part_For_Decl.Is_Null then
+                        Other_Part := Other_Part_For_Decl.P_Defining_Name;
+                     end if;
+                  end;
+               end if;
+            end;
 
          elsif Definition_Node.Kind in
            Libadalang.Common.Ada_Single_Task_Type_Decl_Range |
@@ -265,15 +294,6 @@ package body LSP.Ada_Definition is
             end loop;
          end;
       end if;
-
-      if not Entry_Decl_Node.Is_Null then
-         for Accept_Node of Entry_Decl_Node.P_Accept_Stmts loop
-            Self.Parent.Context.Append_Location
-              (Self.Response,
-               Self.Filter,
-               Accept_Node.F_Body_Decl.F_Name);
-         end loop;
-      end if;
    end Execute_Ada_Request;
 
 end LSP.Ada_Definition;

source/ada/lsp-ada_driver.adb

@@ -230,6 +230,10 @@ procedure LSP.Ada_Driver is
      LSP.GNATCOLL_Tracers.Create ("ALS.MAIN", From_Config);
    --  Main trace for the LSP.
 
+   Server_Logger_Trace : constant LSP.GNATCOLL_Tracers.Tracer :=
+     LSP.GNATCOLL_Tracers.Create ("ALS.MAIN.LOGGER", Off);
+   --  Trace that logs all the requests/responses parameters.
+
    In_Trace  : constant LSP.GNATCOLL_Tracers.Tracer :=
      LSP.GNATCOLL_Tracers.Create ("ALS.IN", Off);
    Out_Trace : constant LSP.GNATCOLL_Tracers.Tracer :=
@@ -456,8 +460,8 @@ begin
                  & "ALS.OUT=no" & Ada.Characters.Latin_1.LF;
             begin
                W_Traces_File := Traces_File.Write_File;
-               W_Traces_File.Write (Default_Traces_File_Contents);
-               W_Traces_File.Close;
+               Write (W_Traces_File, Default_Traces_File_Contents);
+               Close (W_Traces_File);
             end;
          end if;
       end if;
@@ -499,8 +503,8 @@ begin
       end;
    end if;
 
-   In_Stream.Initialize (Trace_Handle (Server_Trace));
-   Out_Stream.Initialize (Trace_Handle (Server_Trace));
+   In_Stream.Initialize (Trace_Handle (Server_Logger_Trace));
+   Out_Stream.Initialize (Trace_Handle (Server_Logger_Trace));
 
    Tracer.Initialize (Server_Trace, In_Trace, Out_Trace);
    Tracer.Trace ("ALS version: " & $VERSION & " (" & $BUILD_DATE & ")");

source/ada/lsp-ada_handlers-open_als_log_file_commands.adb

@@ -45,15 +45,18 @@ package body LSP.Ada_Handlers.Open_ALS_Log_File_Commands is
    is
       pragma Unreferenced (Response);
 
-      Log_File_Path : constant LSP.Structures.Virtual_String := Handler.Tracer.Location;
-   begin
+      Log_File_Path : constant LSP.Structures.Virtual_String :=
+        Handler.Tracer.Location;
+
       Message : constant LSP.Structures.ShowDocumentParams :=
         (uri       => (Log_File_Path with null record),
          takeFocus => LSP.Constants.True,
          others    => <>);
 
       New_Id : constant LSP.Structures.Integer_Or_Virtual_String :=
-      Handler.Server.Allocate_Request_Id;
+        Handler.Server.Allocate_Request_Id;
+
+   begin
       Handler.Sender.On_ShowDocument_Request (New_Id, Message);
    end Execute;
 

source/ada/lsp-ada_handlers-open_project_file_commands.adb

@@ -48,20 +48,22 @@ package body LSP.Ada_Handlers.Open_Project_File_Commands is
       pragma Unreferenced (Response);
 
       Project_File : constant Virtual_File :=
-         Handler.Project_Status.Get_Project_File;
-   begin
-      if Project_File.Is_Regular_File then
-         URI : constant LSP.Structures.DocumentUri :=
-            Handler.To_URI (Project_File.Display_Full_Name);
+        LSP.Ada_Project_Loading.Get_Project_File (Handler.Project_Status);
+
+      URI : constant LSP.Structures.DocumentUri :=
+        (if Project_File.Is_Regular_File
+         then Handler.To_URI (Project_File.Display_Full_Name)
+         else "");
 
-         Message : constant LSP.Structures.ShowDocumentParams :=
-         (uri       => (VSS.Strings.Virtual_String (URI) with null record),
-            takeFocus => LSP.Constants.True,
-            others    => <>);
+      Message : constant LSP.Structures.ShowDocumentParams :=
+        (uri       => (VSS.Strings.Virtual_String (URI) with null record),
+         takeFocus => LSP.Constants.True,
+         others    => <>);
 
-         New_Id : constant LSP.Structures.Integer_Or_Virtual_String :=
-         Handler.Server.Allocate_Request_Id;
-         Handler.Sender.On_ShowDocument_Request (New_Id, Message);
+   begin
+      if Project_File.Is_Regular_File then
+         Handler.Sender.On_ShowDocument_Request
+           (Handler.Server.Allocate_Request_Id, Message);
       else
          Handler.Sender.On_ShowMessage_Notification (
             (LSP.Enumerations.Error,

source/ada/lsp-ada_project_loading.adb

@@ -170,23 +170,28 @@ package body LSP.Ada_Project_Loading is
          use GPR2.Message;
       begin
          for Msg of GPR2_Messages loop
-            if Msg.Level in GPR2.Message.Warning .. GPR2.Message.Error then
+            --  Display a diagnostic only if we are dealing with an error or
+            --  a warning, with a non-empty message attached to it.
+            if Msg.Level in GPR2.Message.Warning .. GPR2.Message.Error
+              and then Msg.Message /= ""
+            then
                declare
                   Sloc : constant GPR2.Source_Reference.Object :=
                     GPR2.Message.Sloc (Msg);
                   File : constant GPR2.Path_Name.Object :=
-                    (if Sloc.Is_Defined then
-                        GPR2.Path_Name.Create_File
-                       (GPR2.Filename_Type (Sloc.Filename))
-                     else
-                        GPR2.Path_Name.Undefined);
+                    (if Sloc.Is_Defined
+                     then
+                       GPR2.Path_Name.Create_File
+                         (GPR2.Filename_Type (Sloc.Filename))
+                     else GPR2.Path_Name.Undefined);
                begin
                   --  Display a diagnostic for GPR2 messages only if the file
                   --  attached to the message is defined.
                   if File.Is_Defined and then File.Has_Value then
                      Parent_Diagnostic.relatedInformation.Append
                        (LSP.Structures.DiagnosticRelatedInformation'
-                          (location => LSP.Structures.Location'
+                          (location =>
+                             LSP.Structures.Location'
                                (uri     => LSP.Utils.To_URI (File),
                                 a_range => LSP.Utils.To_Range (Sloc),
                                 others  => <>),

subprojects/libadalang.toml

@@ -14,7 +14,7 @@ GPR_PROJECT_PATH.prepend = "${CRATE_ROOT}/build"
 
 [[actions]]
 type = "pre-build"
-command = ["bash", "-c", "-x", "source setenv.sh; pip install -r REQUIREMENTS.dev; python manage.py generate"]
+command = ["bash", "-c", "-x", "source setenv.sh; pip install -rrequirements-{github,pypi}.txt && python manage.py generate"]
 
 [[depends-on]]
 gnatcoll = "^24"

testsuite/ada_lsp/definition_protected/show_protected_objects_entries.adb

@@ -0,0 +1,67 @@
+with Ada.Text_IO; use Ada.Text_IO;
+
+procedure Show_Protected_Objects_Entries is
+
+   protected Obj is
+      procedure Set (V : Integer);
+      entry Get (V : out Integer);
+   private
+      Local  : Integer;
+      Is_Set : Boolean := False;
+   end Obj;
+
+   protected body Obj is
+      procedure Set (V : Integer) is
+      begin
+         Local := V;
+         Is_Set := True;
+      end Set;
+
+      entry Get (V : out Integer)
+        when Is_Set is
+         --  Entry is blocked until the
+         --  condition is true. The barrier
+         --  is evaluated at call of entries
+         --  and at exits of procedures and
+         --  entries. The calling task sleeps
+         --  until the barrier is released.
+      begin
+         V := Local;
+         Is_Set := False;
+      end Get;
+   end Obj;
+
+   N : Integer := 0;
+
+   task T is
+      entry Seize;
+   end T;
+
+   task body T is
+   begin
+
+      accept Seize;
+      Put_Line
+        ("Task T will delay for 4 seconds...");
+      delay 4.0;
+
+      accept Seize;
+      Put_Line
+        ("Task T will set Obj...");
+      Obj.Set (5);
+
+      accept Seize;
+      Put_Line
+        ("Task T has just set Obj...");
+   end T;
+begin
+   Put_Line
+     ("Main application will get Obj...");
+   Obj.Get (N);
+
+   Put_Line
+     ("Main application has retrieved Obj...");
+   Put_Line
+     ("Number is: " & Integer'Image (N));
+
+end Show_Protected_Objects_Entries;

testsuite/ada_lsp/definition_protected/test.gpr

@@ -0,0 +1,2 @@
+project Test is
+end Test;