ada_language_server_23.0.0_66f2e7fb/source/tester/tester-tests.ads

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
------------------------------------------------------------------------------
--                         Language Server Protocol                         --
--                                                                          --
--                     Copyright (C) 2018-2019, 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.Calendar;
with Ada.Containers.Hashed_Sets;
with Ada.Strings.Unbounded;

private with VSS.Strings;
private with VSS.Strings.Hash;

with GNATCOLL.JSON;

with LSP.Raw_Clients;

with Spawn.String_Vectors;

package Tester.Tests is

   type Test is tagged limited private;

   procedure Run
     (Self     : in out Test;
      Commands : GNATCOLL.JSON.JSON_Array;
      Debug    : Boolean);

private

   task type Watch_Dog_Task is
      entry Start
        (Timeout : Duration;
         Command : Ada.Strings.Unbounded.Unbounded_String);

      entry Restart;

      entry Cancel;
   end Watch_Dog_Task;

   package String_Sets is new Ada.Containers.Hashed_Sets
     (VSS.Strings.Virtual_String,
      VSS.Strings.Hash,
      VSS.Strings."=",
      VSS.Strings."=");

   type Test is new LSP.Raw_Clients.Raw_Client with record
      Index        : Positive := 1;
      Sort_Reply   : GNATCOLL.JSON.JSON_Value;
      Waits        : GNATCOLL.JSON.JSON_Array;
      --  Array of JSON object to wait
      In_Debug     : Boolean;
      --  In debug mode (disable timeout, pause after start)
      Watch_Dog    : Watch_Dog_Task;
      --  Task to restrict a command execution time
      Started      : Ada.Calendar.Time;
      --  Command execution start/reset time
      Known_Ids    : String_Sets.Set;
      --  Set of processed request ids

      Full_Server_Output : GNATCOLL.JSON.JSON_Array;
      --  Complete output received from the server

   end record;

   overriding procedure On_Error
     (Self  : in out Test;
      Error : String);

   overriding procedure On_Raw_Message
     (Self    : in out Test;
      Data    : Ada.Strings.Unbounded.Unbounded_String;
      Success : in out Boolean);

   overriding function Error_Message
     (Self : Test) return VSS.Strings.Virtual_String
        is (VSS.Strings.Empty_Virtual_String);

   procedure Execute_Command
     (Self    : in out Test;
      Command : GNATCOLL.JSON.JSON_Value);

   procedure Do_Abort (Self : Test);

   procedure Do_Fail
     (Self : in out Test;
      Text : Spawn.String_Vectors.UTF_8_String_Vector);
   --  Mark test as failed with given Text

end Tester.Tests;