------------------------------------------------------------------------------ -- 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;