Skip to content

Commit 9714cf6

Browse files
HugoGGuerrierHugoGGuerrier
committed
Merge branch 'topic/opt_parse/fix_empty_args_handling' into 'master'
Ensure empty arguments aren't matching on flags and options anymore Closes #141 See merge request eng/toolchain/gnatcoll-core!218
2 parents 2296295 + 6b86387 commit 9714cf6

File tree

7 files changed

+139
-8
lines changed

7 files changed

+139
-8
lines changed

‎core/src/gnatcoll-opt_parse.adb‎

Lines changed: 8 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -534,8 +534,8 @@ package body GNATCOLL.Opt_Parse is
534534
-- we encounter an unknown argument.
535535
if Unknown_Args = null then
536536
Handle_Failure
537-
("Unrecognized argument " &
538-
(+Cmd_Line_Args (Current_Arg)));
537+
("Unrecognized argument """ &
538+
(+Cmd_Line_Args (Current_Arg)) & """");
539539
return False;
540540
else
541541
Unknown_Args.Append (Cmd_Line_Args (Current_Arg));
@@ -892,7 +892,9 @@ package body GNATCOLL.Opt_Parse is
892892
Result : in out Parsed_Arguments) return Parser_Return
893893
is
894894
begin
895-
if Args (Pos) = Self.Long or else Args (Pos) = Self.Short then
895+
if (Self.Long /= "" and then Args (Pos) = Self.Long)
896+
or else (Self.Short /= "" and then Args (Pos) = Self.Short)
897+
then
896898

897899
declare
898900
Res : constant Parser_Result_Access := new Flag_Parser_Result'
@@ -1629,7 +1631,9 @@ package body GNATCOLL.Opt_Parse is
16291631
Allow_Collated_Short_Form : Boolean := True) return XString
16301632
is
16311633
begin
1632-
if Args (Pos) = Long or Args (Pos) = Short then
1634+
if (Long /= "" and then Args (Pos) = Long)
1635+
or else (Short /= "" and then Args (Pos) = Short)
1636+
then
16331637
-- Case 1: `-a b` or `--arg b`
16341638

16351639
if Pos + 1 > Args'Last then

‎testsuite/core/tests/opt_parse/custom_error_handler/test.adb‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -123,7 +123,7 @@ begin
123123
else
124124
A.Assert
125125
(Handler.Last_Error.To_String,
126-
"Unrecognized argument --what",
126+
"Unrecognized argument ""--what""",
127127
"Wrong error message");
128128
end if;
129129

‎testsuite/core/tests/opt_parse/empty_arg/test.adb‎

Lines changed: 125 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,125 @@
1+
------------------------------------------------------------------------------
2+
-- G N A T C O L L --
3+
-- --
4+
-- Copyright (C) 2010-2025, AdaCore --
5+
-- --
6+
-- This library is free software; you can redistribute it and/or modify it --
7+
-- under terms of the GNU General Public License as published by the Free --
8+
-- Software Foundation; either version 3, or (at your option) any later --
9+
-- version. This library is distributed in the hope that it will be useful, --
10+
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
11+
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
12+
-- --
13+
-- As a special exception under Section 7 of GPL version 3, you are granted --
14+
-- additional permissions described in the GCC Runtime Library Exception, --
15+
-- version 3.1, as published by the Free Software Foundation. --
16+
-- --
17+
-- You should have received a copy of the GNU General Public License and --
18+
-- a copy of the GCC Runtime Library Exception along with this program; --
19+
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
20+
-- <http://www.gnu.org/licenses/>. --
21+
-- --
22+
------------------------------------------------------------------------------
23+
24+
with GNATCOLL.Opt_Parse; use GNATCOLL.Opt_Parse;
25+
with GNATCOLL.Strings; use GNATCOLL.Strings;
26+
27+
with Test_Assert;
28+
29+
function Test return Integer is
30+
package A renames Test_Assert;
31+
32+
function "+" (Self : String) return XString renames To_XString;
33+
34+
package One_Flag_Args is
35+
Parser : Argument_Parser :=
36+
Create_Argument_Parser
37+
(Help => "Dummy parser", Generate_Help_Flag => False);
38+
39+
package Flag is new
40+
Parse_Flag
41+
(Parser => Parser,
42+
Long => "--flag",
43+
Help => "testing flag");
44+
45+
end One_Flag_Args;
46+
47+
package One_Option_Args is
48+
Parser : Argument_Parser :=
49+
Create_Argument_Parser
50+
(Help => "Dummy parser", Generate_Help_Flag => False);
51+
52+
package Option is new
53+
Parse_Option
54+
(Parser => Parser,
55+
Long => "--option",
56+
Arg_Type => XString,
57+
Default_Val => +"default",
58+
Help => "testing option");
59+
60+
end One_Option_Args;
61+
62+
Empty_Args : XString_Array (1 .. 0);
63+
64+
begin
65+
-- Test a parser with only one flag
66+
-- Parse an empty argument list
67+
if One_Flag_Args.Parser.Parse (Empty_Args) then
68+
A.Assert (not One_Flag_Args.Flag.Get, "Flag should be false");
69+
else
70+
A.Assert (False, "Parsing failed");
71+
end if;
72+
73+
-- Parse a argument list with the --flag flag
74+
if One_Flag_Args.Parser.Parse ((1 => +"--flag")) then
75+
A.Assert (One_Flag_Args.Flag.Get, "Flag should be true");
76+
else
77+
A.Assert (False, "Parsing failed");
78+
end if;
79+
80+
-- Parse a argument list with an empty argument
81+
if One_Flag_Args.Parser.Parse ((1 => +"")) then
82+
A.Assert (False, "Parsing shouldn't succeed");
83+
else
84+
A.Assert
85+
(not One_Flag_Args.Flag.Get,
86+
"Flag should be false because of parsing failure");
87+
A.Assert
88+
(One_Flag_Args.Parser.Last_Error,
89+
"Unrecognized argument """"",
90+
"Wrong error message");
91+
end if;
92+
93+
-- Test a parser with only one option
94+
-- Parse an empty argument list
95+
if One_Option_Args.Parser.Parse (Empty_Args) then
96+
A.Assert
97+
(One_Option_Args.Option.Get = +"default",
98+
"Option should be 'default'");
99+
else
100+
A.Assert (False, "Parsing failed");
101+
end if;
102+
103+
-- Parse a valid option
104+
if One_Option_Args.Parser.Parse ((+"--option", +"test")) then
105+
A.Assert
106+
(One_Option_Args.Option.Get = +"test", "Option should be 'test'");
107+
else
108+
A.Assert (False, "Parsing failed");
109+
end if;
110+
111+
-- Parse an empty argument
112+
if One_Option_Args.Parser.Parse ((+"", +"test")) then
113+
A.Assert (False, "Parsing shouldn't succeed");
114+
else
115+
A.Assert
116+
(One_Option_Args.Option.Get = +"default",
117+
"Option should be 'default' because of parsing failure");
118+
A.Assert
119+
(One_Option_Args.Parser.Last_Error,
120+
"Unrecognized argument """"",
121+
"Wrong error message");
122+
end if;
123+
124+
return A.Report;
125+
end Test;

‎testsuite/core/tests/opt_parse/empty_arg/test.yaml‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
description:
2+
Test parsing an argument list with an empty argument

‎testsuite/core/tests/opt_parse/erroneous_parses/test.adb‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -145,7 +145,7 @@ begin
145145
else
146146
A.Assert
147147
(Arg.Parser.Last_Error,
148-
"Unrecognized argument --what",
148+
"Unrecognized argument ""--what""",
149149
"Wrong error message");
150150
end if;
151151

‎testsuite/core/tests/opt_parse/help_on_error/test.out‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,3 @@
1-
Argument parsing failed: Unrecognized argument -Q
1+
Argument parsing failed: Unrecognized argument "-Q"
22
OK test.adb:26
33
<=== TEST PASSED ===>

‎testsuite/core/tests/opt_parse/regular_arg_list/test.adb‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -70,7 +70,7 @@ begin
7070
A.Assert (False, "Parsing should fail");
7171
else
7272
A.Assert (Arg.Parser.Last_Error,
73-
"Unrecognized argument pouet",
73+
"Unrecognized argument ""pouet""",
7474
"Wrong error message");
7575
end if;
7676

0 commit comments

Comments
 (0)