Skip to content

Commit 90b6cff

Browse files
committed
Added ability to set usage text for Parse_Option
Added test case for the new parameter V111-032 Change-Id: I33c1e55182cfaf9414a4e7e5ebe2434be8e7c5b2
1 parent b1c019f commit 90b6cff

File tree

12 files changed

+298
-10
lines changed

12 files changed

+298
-10
lines changed

src/gnatcoll-opt_parse.adb

Lines changed: 36 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
------------------------------------------------------------------------------
22
-- G N A T C O L L --
33
-- --
4-
-- Copyright (C) 2009-2021, AdaCore --
4+
-- Copyright (C) 2009-2022, AdaCore --
55
-- --
66
-- This library is free software; you can redistribute it and/or modify it --
77
-- under terms of the GNU General Public License as published by the Free --
@@ -780,9 +780,7 @@ package body GNATCOLL.Opt_Parse is
780780
end record;
781781

782782
overriding function Usage
783-
(Self : Option_Parser) return String
784-
is ("[" & Long & (if Short = "" then "" else "|" & Short) & " "
785-
& To_Upper (Long (3 .. Long'Last)) & "]");
783+
(Self : Option_Parser) return String;
786784

787785
overriding function Help_Name
788786
(Dummy : Option_Parser) return String
@@ -813,6 +811,21 @@ package body GNATCOLL.Opt_Parse is
813811

814812
Self : constant Parser_Access := Self_Val'Unchecked_Access;
815813

814+
-----------
815+
-- Usage --
816+
-----------
817+
818+
overriding function Usage
819+
(Self : Option_Parser) return String
820+
is
821+
begin
822+
if Usage_Text = "" then
823+
return "[" & Long & (if Short = "" then "" else "|" & Short)
824+
& " " & To_Upper (Long (3 .. Long'Last)) & "]";
825+
end if;
826+
return Usage_Text;
827+
end Usage;
828+
816829
---------
817830
-- Get --
818831
---------
@@ -916,7 +929,8 @@ package body GNATCOLL.Opt_Parse is
916929
Arg_Type => Arg_Type,
917930
Default_Val => Default_Val,
918931
Convert => Convert,
919-
Enabled => Enabled);
932+
Enabled => Enabled,
933+
Usage_Text => Usage_Text);
920934

921935
function Get
922936
(Args : Parsed_Arguments := No_Parsed_Arguments) return Arg_Type
@@ -937,10 +951,7 @@ package body GNATCOLL.Opt_Parse is
937951
end record;
938952

939953
overriding function Usage
940-
(Self : Option_List_Parser) return String
941-
is ("[" & Long & (if Short = "" then "" else "|" & Short) & " "
942-
& To_Upper (Long (3 .. Long'Last))
943-
& "[" & To_Upper (Long (3 .. Long'Last)) & "...]]");
954+
(Self : Option_List_Parser) return String;
944955

945956
overriding function Help_Name
946957
(Dummy : Option_List_Parser) return String
@@ -973,6 +984,22 @@ package body GNATCOLL.Opt_Parse is
973984

974985
Self : constant Parser_Access := Self_Val'Unchecked_Access;
975986

987+
-----------
988+
-- Usage --
989+
-----------
990+
991+
overriding function Usage
992+
(Self : Option_List_Parser) return String
993+
is
994+
begin
995+
if Usage_Text = "" then
996+
return "[" & Long & (if Short = "" then "" else "|" & Short)
997+
& " " & To_Upper (Long (3 .. Long'Last))
998+
& "[" & To_Upper (Long (3 .. Long'Last)) & "...]]";
999+
end if;
1000+
return Usage_Text;
1001+
end Usage;
1002+
9761003
---------
9771004
-- Get --
9781005
---------

src/gnatcoll-opt_parse.ads

Lines changed: 13 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
------------------------------------------------------------------------------
22
-- G N A T C O L L --
33
-- --
4-
-- Copyright (C) 2009-2021, AdaCore --
4+
-- Copyright (C) 2009-2022, AdaCore --
55
-- --
66
-- This library is free software; you can redistribute it and/or modify it --
77
-- under terms of the GNU General Public License as published by the Free --
@@ -294,6 +294,10 @@ package GNATCOLL.Opt_Parse is
294294
Enabled : Boolean := True;
295295
-- Whether to add this argument parser
296296

297+
Usage_Text : String := "";
298+
-- Usage string for the argument. When left empty default usage text
299+
-- will be generated in the form of [--Long|-Short LONG].
300+
297301
package Parse_Option is
298302
function Get
299303
(Args : Parsed_Arguments := No_Parsed_Arguments) return Arg_Type;
@@ -325,6 +329,10 @@ package GNATCOLL.Opt_Parse is
325329
Enabled : Boolean := True;
326330
-- Whether to add this argument parser
327331

332+
Usage_Text : String := "";
333+
-- Usage string for the argument. When left empty default usage text
334+
-- will be generated in the form of [--Long|-Short LONG].
335+
328336
package Parse_Enum_Option is
329337
pragma Compile_Time_Error
330338
(Arg_Type'Type_Class /= Type_Class_Enumeration,
@@ -368,6 +376,10 @@ package GNATCOLL.Opt_Parse is
368376
Enabled : Boolean := True;
369377
-- Whether to add this argument parser
370378

379+
Usage_Text : String := "";
380+
-- Usage string for the argument. When left empty default usage text
381+
-- will be generated in the form of [--Long|-Short LONG [LONG...]].
382+
371383
package Parse_Option_List is
372384
type Result_Array is array (Positive range <>) of Arg_Type;
373385

Lines changed: 81 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,81 @@
1+
import os
2+
3+
from e3.testsuite.driver.classic import TestAbortWithError
4+
from e3.testsuite.driver.diff import DiffTestDriver, OutputRefiner, Substitute
5+
6+
from drivers import gprbuild
7+
8+
9+
class ToLower(OutputRefiner):
10+
"""Output refiner to switch to lower case."""
11+
12+
def refine(self, output):
13+
return output.lower()
14+
15+
16+
class BuildRunDiffDriver(DiffTestDriver):
17+
"""Build and run a project using GNATCOLL.
18+
19+
Put project and source files in the test directory, in particular
20+
"test.gpr" in the root directory, whose compilation is supposed to create a
21+
"test" executable in the same directory.
22+
23+
This test driver builds the "test.gpr" project file and then executes the
24+
"test" shell script (test.sh). This script should run the executable that
25+
was built. It can either pass through all output to stdout, or stdout can
26+
be piped to files to allow for post processesing first. The test succeeds
27+
if all of the following items are true:
28+
29+
* the compilation is successful;
30+
* the "test" program completes with status code 0.
31+
* the contents of test.out/regex_test.out match the stdout of the test.sh
32+
"""
33+
34+
@property
35+
def baseline(self):
36+
# Allow a missing test.out or regex_test.out -- treat as empty
37+
test_out = self.test_dir("test.out")
38+
regex_test_out = self.test_dir("regex_test.out")
39+
regex = False
40+
if os.path.exists(test_out):
41+
with open(test_out, encoding=self.default_encoding) as f:
42+
baseline = f.read()
43+
elif os.path.exists(regex_test_out):
44+
with open(regex_test_out, encoding=self.default_encoding) as f:
45+
baseline = f.read()
46+
regex = True
47+
else:
48+
baseline = ""
49+
test_out = None
50+
51+
return (test_out, baseline, regex)
52+
53+
@property
54+
def output_refiners(self):
55+
result = super().output_refiners
56+
if self.test_env.get("fold_casing", False):
57+
result.append(ToLower())
58+
if self.test_env.get("canonicalize_backslashes", False):
59+
result.append(Substitute("\\", "/"))
60+
return result
61+
62+
def run(self):
63+
# Build the test project
64+
if self.test_env.get('no-coverage'):
65+
gpr_project_path = self.env.gnatcoll_debug_gpr_dir
66+
else:
67+
gpr_project_path = self.env.gnatcoll_gpr_dir
68+
gprbuild(
69+
self,
70+
project_file="test.gpr",
71+
gcov=self.env.gcov,
72+
gpr_project_path=gpr_project_path
73+
)
74+
75+
# Run the test program
76+
p = self.shell(["bash", "test.sh"], catch_error=False)
77+
78+
if p.status:
79+
self.output += ">>>program returned status code {}\n".format(
80+
p.status
81+
)

testsuite/run-tests

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
from drivers import make_gnatcoll, TESTSUITE_ROOT_DIR
33
from drivers.basic import BasicTestDriver
44
from drivers.build_and_run import BuildAndRunDriver
5+
from drivers.build_run_diff import BuildRunDiffDriver
56
from drivers.json_validation import JSONValidationDriver
67
from drivers.data_validation import DataValidationDriver
78
from drivers.gnatcov import list_to_file, produce_report
@@ -22,6 +23,7 @@ class MyTestsuite(Testsuite):
2223
'data_validation': DataValidationDriver,
2324
'default': BasicTestDriver,
2425
'build_and_run': BuildAndRunDriver,
26+
'build_run_diff': BuildRunDiffDriver,
2527
}
2628

2729
def add_options(self, parser):
Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
with "gnatcoll";
2+
3+
library project Mylib is
4+
for Source_Dirs use ("src-mylib");
5+
for Object_Dir use "obj-mylib";
6+
for Library_Dir use "lib-mylib";
7+
for Library_Name use "mylib";
8+
9+
for Interfaces use ("mylib.ads", "mylib.adb");
10+
end Mylib;
Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,12 @@
1+
with GNATCOLL.Strings;
2+
3+
package body Mylib is
4+
5+
procedure Run is
6+
Dummy : constant Boolean := Args.Parser.Parse
7+
((1 => GNATCOLL.Strings.To_XString ("--help")));
8+
begin
9+
null;
10+
end;
11+
12+
end Mylib;
Lines changed: 82 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,82 @@
1+
with Ada.Containers.Vectors;
2+
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
3+
4+
with GNATCOLL.Opt_Parse; use GNATCOLL.Opt_Parse;
5+
6+
package Mylib is
7+
8+
package Int_Vectors is new Ada.Containers.Vectors (Positive, Integer);
9+
10+
type Day is (Mon, Tue, Wed, Thu, Fri, Sat, Sun);
11+
12+
type Context is record
13+
Ints : Int_Vectors.Vector;
14+
end record;
15+
type Context_Array is array (Positive range <>) of Context;
16+
17+
package Args is
18+
Parser : Argument_Parser :=
19+
Create_Argument_Parser (Help => "Test program");
20+
21+
package Charset_Option is new Parse_Option
22+
(Parser => Parser,
23+
Short => "-C",
24+
Long => "--charset",
25+
Arg_Type => Unbounded_String,
26+
Usage_Text => "[--charset|-C <charset name>]",
27+
Help =>
28+
"What charset to use when parsing files. "
29+
& "Default is ""latin-1""",
30+
Default_Val => To_Unbounded_String ("latin-1"));
31+
32+
package Day_Option is new Parse_Enum_Option
33+
(Parser => Parser,
34+
Short => "-D",
35+
Long => "--day",
36+
Arg_Type => Day,
37+
Usage_Text => "[--day|-D <three letter day of week>]",
38+
Help =>
39+
"What day of the week is it? "
40+
& "Default is ""Mon""",
41+
Default_Val => Mon);
42+
43+
package Files_Option is new Parse_Option_List
44+
(Parser => Parser,
45+
Short => "-F",
46+
Long => "--files",
47+
Arg_Type => Unbounded_String,
48+
Usage_Text => "[--files|-F <list of filepaths to parse>]",
49+
Help => "List of files to be parsed.");
50+
51+
package Charset_Option2 is new Parse_Option
52+
(Parser => Parser,
53+
Short => "-C2",
54+
Long => "--charset2",
55+
Arg_Type => Unbounded_String,
56+
Help =>
57+
"What charset to use when parsing files. "
58+
& "Default is ""latin-1""",
59+
Default_Val => To_Unbounded_String ("latin-1"));
60+
61+
package Day_Option2 is new Parse_Enum_Option
62+
(Parser => Parser,
63+
Short => "-D2",
64+
Long => "--day2",
65+
Arg_Type => Day,
66+
Help =>
67+
"What day of the week is it? "
68+
& "Default is ""Mon""",
69+
Default_Val => Mon);
70+
71+
package Files_Option2 is new Parse_Option_List
72+
(Parser => Parser,
73+
Short => "-F2",
74+
Long => "--files2",
75+
Arg_Type => Unbounded_String,
76+
Help => "List of files to be parsed.");
77+
78+
end Args;
79+
80+
procedure Run;
81+
82+
end Mylib;
Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
with Mylib;
2+
3+
procedure Test is
4+
begin
5+
Mylib.Run;
6+
end Test;
Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
with "mylib";
2+
3+
project Test is
4+
for Object_Dir use "obj-test";
5+
for Exec_Dir use ".";
6+
for Main use ("test.adb");
7+
end Test;
Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
stdout contained new usage text for option
2+
stdout contained new usage text for enum option
3+
stdout contained new usage text for option list
4+
stdout contained default usage text for option
5+
stdout contained default usage text for enum option
6+
stdout contained default usage text for option list

0 commit comments

Comments
 (0)