Support global/localVariables in semanticTokenModifiers

For eng/ide/gnatstudio#389

Author: ogorodnik

source/ada/lsp-ada_highlighters.adb

@@ -17,6 +17,8 @@
 
 with GNATCOLL.Traces;
 
+with Laltools;
+with Laltools.Common;
 with Langkit_Support.Slocs;
 with Langkit_Support.Text;
 with Libadalang.Common; use Libadalang.Common;
@@ -477,6 +479,7 @@ package body LSP.Ada_Highlighters is
       use all type LSP.Enumerations.SemanticTokenTypes;
       use all type LSP.Enumerations.SemanticTokenModifiers;
       use type Libadalang.Analysis.Defining_Name;
+      use type Libadalang.Analysis.Ada_Node;
 
       procedure Highlight_Token
         (Token : Libadalang.Common.Token_Reference;
@@ -497,6 +500,9 @@ package body LSP.Ada_Highlighters is
       function Is_Predefined (Decl : Libadalang.Analysis.Basic_Decl)
         return Boolean;
 
+      procedure Get_Variable_Modifiers (Decl : Libadalang.Analysis.Basic_Decl);
+      --  Add variable's modifiers if Decl is a variable
+
       ------------------
       -- Has_Abstract --
       ------------------
@@ -741,10 +747,75 @@ package body LSP.Ada_Highlighters is
          end case;
       end To_Kind;
 
+      ----------------------------
+      -- Get_Variable_Modifiers --
+      ----------------------------
+
+      procedure Get_Variable_Modifiers
+        (Decl : Libadalang.Analysis.Basic_Decl)
+      is
+         --------------------------
+         -- Investigate_Variable --
+         --------------------------
+
+         procedure Investigate_Variable;
+         procedure Investigate_Variable is
+            use Libadalang.Analysis;
+            use Langkit_Support.Slocs;
+
+            Node_Enclosing_Declarative_Part : constant Declarative_Part :=
+                Laltools.Common.Get_Enclosing_Declarative_Part (Node);
+
+            Decl_Declarative_Part : Declarative_Part;
+         begin
+            if Compare
+               (Node_Enclosing_Declarative_Part.Sloc_Range,
+                Decl.Sloc_Range.Start_Sloc) = Inside
+            then
+               Highlight_Token (Node.Token_Start, localVariable);
+
+            else
+               Decl_Declarative_Part :=
+                 Laltools.Common.Get_Enclosing_Declarative_Part (Decl);
+
+               if Decl_Declarative_Part.Parent /= No_Ada_Node
+                  and then
+                    (Decl_Declarative_Part.Parent.Kind in
+                         Ada_Package_Body_Range
+                       or else Decl_Declarative_Part.Parent.Kind in
+                         Ada_Base_Package_Decl)
+               then
+                  Highlight_Token (Node.Token_Start, globalVariable);
+               end if;
+            end if;
+         end Investigate_Variable;
+
+      begin
+         case Decl.Kind is
+            when Ada_Base_Formal_Param_Decl =>
+               if Ada_Base_Formal_Param_Decl'(Decl.Kind) =
+                 Ada_Generic_Formal_Obj_Decl
+               then
+                  Investigate_Variable;
+               end if;
+
+            when Ada_Entry_Index_Spec | Ada_Object_Decl |
+                 Ada_Single_Protected_Decl | Ada_Single_Task_Decl =>
+               Investigate_Variable;
+
+            when Ada_For_Loop_Var_Decl |
+                 Ada_Extended_Return_Stmt_Object_Decl =>
+               Highlight_Token (Node.Token_Start, localVariable);
+
+            when others =>
+               null;
+         end case;
+      end Get_Variable_Modifiers;
+
       Failsafe_Decl : Libadalang.Analysis.Refd_Decl;
-      Def  : Libadalang.Analysis.Defining_Name;
-      Decl : Libadalang.Analysis.Basic_Decl;
-      Kind : LSP.Enumerations.SemanticTokenTypes;
+      Def           : Libadalang.Analysis.Defining_Name;
+      Decl          : Libadalang.Analysis.Basic_Decl;
+      Kind          : LSP.Enumerations.SemanticTokenTypes;
    begin
       if Node.Kind not in Ada_Identifier | Ada_String_Literal then
          --  Highlight only identifiers and operator symbols
@@ -753,11 +824,10 @@ package body LSP.Ada_Highlighters is
 
       if Node.P_Is_Defining then
          Def := Node.P_Enclosing_Defining_Name;
-
          begin
             declare
                Is_Canonical : constant Boolean :=
-                  not Def.Is_Null and then Def.P_Canonical_Part = Def;
+                 not Def.Is_Null and then Def.P_Canonical_Part = Def;
             begin
                if Is_Canonical then
                   Highlight_Token (Node.Token_Start, declaration);
@@ -795,6 +865,14 @@ package body LSP.Ada_Highlighters is
                Highlight_Token (Node.Token_Start, Kind);
             end if;
 
+            if Kind = variable
+              --  not a declaration itself
+              and then Laltools.Common.
+                Find_First_Common_Parent (Decl, Node, True) /= Decl
+            then
+               Get_Variable_Modifiers (Decl);
+            end if;
+
             begin
                if Kind in variable | parameter | typeParameter | property
                  and then Decl.P_Is_Constant_Object
@@ -961,6 +1039,8 @@ package body LSP.Ada_Highlighters is
       Append_Modifier (modification, "modification");
       Append_Modifier (documentation, "documentation");
       Append_Modifier (defaultLibrary, "defaultLibrary");
+      Append_Modifier (globalVariable, "globalVariable");
+      Append_Modifier (localVariable, "localVariable");
 
       Obsolescent := +"Obsolescent";
       Ada_Package := +"Ada";

testsuite/ada_lsp/highlight_variables/a.adb

@@ -0,0 +1,84 @@
+
+with Ada.Text_IO;
+with Ada.Strings.Unbounded;
+
+package body A is
+
+   C : Boolean := True;
+
+   type SemanticTokenModifiers is
+     (declaration,
+      definition,
+      readonly,
+      static,
+      deprecated,
+      an_abstract,
+      async,
+      modification,
+      documentation,
+      defaultLibrary,
+      globalVariable,
+      localVariable);
+
+   type Modifiers_Array is array (SemanticTokenModifiers) of Boolean;
+
+   -----------
+   -- Print --
+   -----------
+
+   procedure Print is
+      B : Boolean := True;
+
+      function Correct_Name (Value : String) return String;
+
+      function Correct_Name (Value : String) return String is
+      begin
+         return Value;
+      end Correct_Name;
+
+      function Get_Modifiers (Modifiers : Modifiers_Array) return String
+      is
+         use Ada.Strings.Unbounded;
+
+         M : Unbounded_String;
+      begin
+         for Index in SemanticTokenModifiers'Range loop
+            if Modifiers (Index) then
+               if Index = globalVariable
+                 or else Index = localVariable
+               then
+                  M := "-" & Correct_Name
+                    (SemanticTokenModifiers'Image (Index)) & M;
+               else
+                  Append (M, "-" & Correct_Name
+                          (SemanticTokenModifiers'Image (Index)));
+               end if;
+            end if;
+         end loop;
+
+         return To_String (M);
+      end Get_Modifiers;
+
+   begin
+      Ada.Text_IO.Put_Line ("A");
+      if B
+        and then C
+        and then D
+      then
+         null;
+      end if;
+
+      Ada.Text_IO.Put_Line
+        (Get_Modifiers ((deprecated => True, others => False)));
+   end Print;
+
+   -----------
+   -- Print --
+   -----------
+
+   procedure Print (Value : String) is
+   begin
+      Ada.Text_IO.Put_Line (Value);
+   end Print;
+
+end A;

testsuite/ada_lsp/highlight_variables/a.ads

@@ -0,0 +1,13 @@
+package A is
+
+   procedure Print;
+
+   procedure Print (Value : String);
+
+   type Print_Access is access procedure (Value : String);
+
+private
+
+   D : Boolean := True;
+
+end A;

testsuite/ada_lsp/highlight_variables/hello.gpr

@@ -0,0 +1,8 @@
+project Hello is
+
+   for Source_Dirs use (".");
+   for Object_Dir use "obj";
+   for Main use ("main.adb");
+   
+end Hello;
+

testsuite/ada_lsp/highlight_variables/main.adb

@@ -0,0 +1,8 @@
+
+with A;
+
+procedure Main is
+   use A;
+begin
+   A.Print;
+end Main;