1
1
-- ----------------------------------------------------------------------------
2
2
-- Language Server Protocol --
3
3
-- --
4
- -- Copyright (C) 2018-2019 , AdaCore --
4
+ -- Copyright (C) 2018-2023 , AdaCore --
5
5
-- --
6
6
-- This is free software; you can redistribute it and/or modify it under --
7
7
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -21,35 +21,61 @@ with Ada.Strings.Unbounded;
21
21
with Ada.Text_IO ;
22
22
with GNATCOLL.JSON ;
23
23
24
- with Tester.Macros ;
25
- with Tester.Tests ;
24
+ with VSS.Command_Line ;
25
+ with VSS.Strings ;
26
+ with VSS.Strings.Conversions ;
27
+ with VSS.String_Vectors ;
26
28
27
29
with Spawn.Environments ;
28
30
31
+ with Tester.Macros ;
32
+ with Tester.Tests ;
33
+
29
34
procedure Tester.Run is
35
+
36
+ package Options is
37
+ -- Command line options and arguments
38
+
39
+ Debug : constant VSS.Command_Line.Binary_Option :=
40
+ (Short_Name => " d" ,
41
+ Long_Name => " debug" ,
42
+ Description => " disable timeouts then pause after server start" );
43
+
44
+ File : constant VSS.Command_Line.Positional_Option :=
45
+ (Name => " test.json" ,
46
+ Description => " JSON test script" );
47
+ end Options ;
48
+
30
49
Env : constant Spawn.Environments.Process_Environment :=
31
50
Spawn.Environments.System_Environment;
32
51
33
52
JSON : GNATCOLL.JSON.JSON_Value;
34
53
begin
35
- if not (Ada.Command_Line.Argument_Count = 1
36
- or else (Ada.Command_Line.Argument_Count = 2
37
- and then Ada.Command_Line.Argument (1 ) = " --debug" ))
38
- then
39
- Ada.Text_IO.Put_Line (" Usage:" );
40
- Ada.Text_IO.Put_Line
41
- (" " & Ada.Command_Line.Command_Name & " [options] test.json" );
42
- Ada.Text_IO.New_Line;
43
- Ada.Text_IO.Put_Line (" Options are:" );
44
- Ada.Text_IO.Put_Line
45
- (" --debug disable timeouts and pause after server start" );
46
- Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
47
- return ;
54
+ VSS.Command_Line.Add_Option (Options.Debug);
55
+ VSS.Command_Line.Add_Option (Options.File);
56
+ VSS.Command_Line.Process; -- This terminates process on option's error
57
+
58
+ if not Options.File.Is_Specified then
59
+ declare
60
+ use type VSS.Strings.Virtual_String;
61
+ Usage : VSS.String_Vectors.Virtual_String_Vector;
62
+ begin
63
+ Usage.Append (" Usage:" );
64
+ Usage.Append
65
+ (" tester-run [options] " & Options.File.Name);
66
+ Usage.Append (" " );
67
+ Usage.Append (" Options are:" );
68
+ Usage.Append
69
+ (" --" & Options.Debug.Long_Name
70
+ & " (-" & Options.Debug.Short_Name & " )"
71
+ & " " & Options.Debug.Description);
72
+ VSS.Command_Line.Report_Error (Usage.Join_Lines (VSS.Strings.LF));
73
+ end ;
48
74
end if ;
49
75
50
76
declare
51
- File : constant String := Ada.Command_Line.Argument
52
- (Ada.Command_Line.Argument_Count );
77
+ File : constant String := VSS.Strings.Conversions.To_UTF_8_String
78
+ (Options.File.Value );
53
79
Input : Ada.Text_IO.File_Type;
54
80
Text : Ada.Strings.Unbounded.Unbounded_String;
55
81
begin
73
99
declare
74
100
Test : Tester.Tests.Test;
75
101
begin
76
- Test.Run (JSON.Get, Debug => Ada.Command_Line.Argument_Count = 2 );
102
+ Test.Run (JSON.Get, Debug => Options.Debug.Is_Specified );
77
103
end ;
78
104
end ;
79
105
end Tester.Run ;
0 commit comments