Skip to content

Commit 094f132

Browse files
committed
W119-049 Use VSS.Command_Line to parse tester-run options
1 parent 9d03f61 commit 094f132

File tree

4 files changed

+50
-23
lines changed

4 files changed

+50
-23
lines changed

source/client/lsp-raw_clients.adb

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
------------------------------------------------------------------------------
22
-- Language Server Protocol --
33
-- --
4-
-- Copyright (C) 2018-2021, AdaCore --
4+
-- Copyright (C) 2018-2023, AdaCore --
55
-- --
66
-- This is free software; you can redistribute it and/or modify it under --
77
-- terms of the GNU General Public License as published by the Free Soft- --

source/tester/tester-run.adb

Lines changed: 45 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
------------------------------------------------------------------------------
22
-- Language Server Protocol --
33
-- --
4-
-- Copyright (C) 2018-2019, AdaCore --
4+
-- Copyright (C) 2018-2023, AdaCore --
55
-- --
66
-- This is free software; you can redistribute it and/or modify it under --
77
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -21,35 +21,61 @@ with Ada.Strings.Unbounded;
2121
with Ada.Text_IO;
2222
with GNATCOLL.JSON;
2323

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

2729
with Spawn.Environments;
2830

31+
with Tester.Macros;
32+
with Tester.Tests;
33+
2934
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+
3049
Env : constant Spawn.Environments.Process_Environment :=
3150
Spawn.Environments.System_Environment;
3251

3352
JSON : GNATCOLL.JSON.JSON_Value;
3453
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;
4874
end if;
4975

5076
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);
5379
Input : Ada.Text_IO.File_Type;
5480
Text : Ada.Strings.Unbounded.Unbounded_String;
5581
begin
@@ -73,7 +99,7 @@ begin
7399
declare
74100
Test : Tester.Tests.Test;
75101
begin
76-
Test.Run (JSON.Get, Debug => Ada.Command_Line.Argument_Count = 2);
102+
Test.Run (JSON.Get, Debug => Options.Debug.Is_Specified);
77103
end;
78104
end;
79105
end Tester.Run;

source/tester/tester-tests.adb

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
------------------------------------------------------------------------------
22
-- Language Server Protocol --
33
-- --
4-
-- Copyright (C) 2018-2021, AdaCore --
4+
-- Copyright (C) 2018-2023, AdaCore --
55
-- --
66
-- This is free software; you can redistribute it and/or modify it under --
77
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -478,7 +478,8 @@ package body Tester.Tests is
478478
Ignore : Integer;
479479
begin
480480
Ada.Text_IO.Put_Line
481-
("Language server is running. You can attach it with GDB.");
481+
("Language server is running. You can attach it with GDB:");
482+
Ada.Text_IO.Put_Line ("gdb -p " & Self.Server_PID);
482483
Ada.Text_IO.Put_Line ("Press ENTER to continue.");
483484

484485
-- Wait for ENTER:

source/tester/tester-tests.ads

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
------------------------------------------------------------------------------
22
-- Language Server Protocol --
33
-- --
4-
-- Copyright (C) 2018-2019, AdaCore --
4+
-- Copyright (C) 2018-2023, AdaCore --
55
-- --
66
-- This is free software; you can redistribute it and/or modify it under --
77
-- terms of the GNU General Public License as published by the Free Soft- --

0 commit comments

Comments
 (0)