diff --git a/source/os/implementation/vss-command_line-parsers.adb b/source/os/implementation/vss-command_line-parsers.adb index f5fe4cac..3375beb5 100644 --- a/source/os/implementation/vss-command_line-parsers.adb +++ b/source/os/implementation/vss-command_line-parsers.adb @@ -1,5 +1,5 @@ -- --- Copyright (C) 2022-2023, AdaCore +-- Copyright (C) 2022-2024, AdaCore -- -- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -- @@ -74,6 +74,10 @@ package body VSS.Command_Line.Parsers is Named_Option'Class (Option)); end if; + elsif Option in Multivalue_Positional_Option'Class then + Self.Defined_Multivalue_Option.Replace_Element + (Multivalue_Positional_Option (Option)); + else Self.Defined_Positional_Options.Append (Positional_Option'Class (Option)); @@ -250,6 +254,12 @@ package body VSS.Command_Line.Parsers is Usage.Append (Option.Name); end loop; + if not Self.Defined_Multivalue_Option.Is_Empty then + Usage.Append (' '); + Usage.Append (Self.Defined_Multivalue_Option.Element.Name); + Usage.Append ('…'); + end if; + Result.Append (Usage); end; @@ -285,10 +295,14 @@ package body VSS.Command_Line.Parsers is end loop; end if; - if not Self.Defined_Positional_Options.Is_Empty then + if not Self.Defined_Positional_Options.Is_Empty + or else not Self.Defined_Multivalue_Option.Is_Empty + then Result.Append (VSS.Strings.Empty_Virtual_String); Result.Append ("Arguments:"); + end if; + if not Self.Defined_Positional_Options.Is_Empty then for Option of Self.Defined_Positional_Options loop Option_Text.Clear; Option_Text.Append (" "); @@ -298,6 +312,15 @@ package body VSS.Command_Line.Parsers is end loop; end if; + if not Self.Defined_Multivalue_Option.Is_Empty then + Option_Text.Clear; + Option_Text.Append (" "); + Option_Text.Append (Self.Defined_Multivalue_Option.Element.Name); + + Append_Option_Description + (Option_Text, Self.Defined_Multivalue_Option.Element.Description); + end if; + return Result; end Help_Text; @@ -314,6 +337,14 @@ package body VSS.Command_Line.Parsers is Self.Known_Named_Options_Values.Contains (Named_Option'Class (Option).Unique_Name); + elsif Option in Multivalue_Positional_Option'Class then + return + not Self.Defined_Multivalue_Option.Is_Empty + and then Self.Defined_Multivalue_Option.Element + = Multivalue_Positional_Option (Option) + and then Natural (Self.Defined_Positional_Options.Length) + < Self.Positional_Options_Values.Length; + else return Self.Defined_Positional_Options.Find_Index @@ -616,10 +647,24 @@ package body VSS.Command_Line.Parsers is else if Self.Defined_Positional_Options.Is_Empty then - Self.Error_Message := "unexpected positional argument"; - Success := False; + if Self.Defined_Multivalue_Option.Is_Empty then + Self.Error_Message := "unexpected positional argument"; + Success := False; - return; + return; + end if; + + else + if Self.Positional_Options_Values.Length + = Natural (Self.Defined_Positional_Options.Length) + then + if Self.Defined_Multivalue_Option.Is_Empty then + Self.Error_Message := "unexpected positional argument"; + Success := False; + + return; + end if; + end if; end if; Self.Positional_Options_Values.Append (Argument); @@ -776,4 +821,21 @@ package body VSS.Command_Line.Parsers is end return; end Values; + ------------ + -- Values -- + ------------ + + function Values + (Self : Command_Line_Parser'Class; + Option : Multivalue_Positional_Option'Class) + return VSS.String_Vectors.Virtual_String_Vector is + begin + return + Self.Positional_Options_Values.Slice + (Natural (Self.Defined_Positional_Options.Length) + 1, + Self.Positional_Options_Values.Length); + + return VSS.String_Vectors.Empty_Virtual_String_Vector; + end Values; + end VSS.Command_Line.Parsers; diff --git a/source/os/implementation/vss-command_line.adb b/source/os/implementation/vss-command_line.adb index 61ec7ba6..f4bec837 100644 --- a/source/os/implementation/vss-command_line.adb +++ b/source/os/implementation/vss-command_line.adb @@ -234,6 +234,17 @@ package body VSS.Command_Line is -- Values -- ------------ + function Values + (Option : Multivalue_Positional_Option'Class) + return VSS.String_Vectors.Virtual_String_Vector is + begin + return Parser.Values (Option); + end Values; + + ------------ + -- Values -- + ------------ + function Values (Option : Name_Value_Option'Class) return Name_Value_Vectors.Vector is begin diff --git a/source/os/vss-command_line-parsers.ads b/source/os/vss-command_line-parsers.ads index aa5d79c9..7a9d19f5 100644 --- a/source/os/vss-command_line-parsers.ads +++ b/source/os/vss-command_line-parsers.ads @@ -1,5 +1,5 @@ -- --- Copyright (C) 2022-2023, AdaCore +-- Copyright (C) 2022-2024, AdaCore -- -- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -- @@ -8,6 +8,7 @@ private with Ada.Containers.Hashed_Maps; private with Ada.Containers.Indefinite_Hashed_Maps; +private with Ada.Containers.Indefinite_Holders; private with Ada.Containers.Indefinite_Vectors; private with Ada.Containers.Hashed_Sets; @@ -66,6 +67,12 @@ package VSS.Command_Line.Parsers is -- Return all name=value pairs of the given option specified in the -- command line. + function Values + (Self : Command_Line_Parser'Class; + Option : Multivalue_Positional_Option'Class) + return VSS.String_Vectors.Virtual_String_Vector; + -- Return all values provided for given multivalued positional option. + function Positional_Arguments (Self : Command_Line_Parser'Class) return VSS.String_Vectors.Virtual_String_Vector; @@ -111,12 +118,17 @@ private (Index_Type => Positive, Element_Type => Named_Option'Class); + package Multivalue_Positional_Option_Holders is + new Ada.Containers.Indefinite_Holders (Multivalue_Positional_Option); + type Command_Line_Parser is tagged limited record Defined_Named_Options_List : Named_Option_Vectors.Vector; Defined_Short_Options : Name_Sets.Set; Defined_Long_Options : Name_Sets.Set; Defined_Named_Options : Named_Option_Maps.Map; Defined_Positional_Options : Positional_Option_Vectors.Vector; + Defined_Multivalue_Option : + Multivalue_Positional_Option_Holders.Holder; Error_Message : VSS.Strings.Virtual_String; Only_Positional : Boolean := False; diff --git a/source/os/vss-command_line.ads b/source/os/vss-command_line.ads index df65e35d..a8946d1d 100644 --- a/source/os/vss-command_line.ads +++ b/source/os/vss-command_line.ads @@ -29,6 +29,10 @@ package VSS.Command_Line is Name : VSS.Strings.Virtual_String; end record; + type Multivalue_Positional_Option is new Abstract_Option with record + Name : VSS.Strings.Virtual_String; + end record; + type Named_Option is abstract new Abstract_Option with record Short_Name : VSS.Strings.Virtual_String; Long_Name : VSS.Strings.Virtual_String; @@ -71,6 +75,11 @@ package VSS.Command_Line is return VSS.String_Vectors.Virtual_String_Vector; -- Return all values of the given option specified in the command line. + function Values + (Option : Multivalue_Positional_Option'Class) + return VSS.String_Vectors.Virtual_String_Vector; + -- Return all values of the given option specified in the command line. + function Values (Option : Name_Value_Option'Class) return Name_Value_Vectors.Vector; -- Return all name=value pairs of the given option specified in the diff --git a/source/text/implementation/vss-string_vectors.adb b/source/text/implementation/vss-string_vectors.adb index e37ce699..7c1b1b09 100644 --- a/source/text/implementation/vss-string_vectors.adb +++ b/source/text/implementation/vss-string_vectors.adb @@ -1,5 +1,5 @@ -- --- Copyright (C) 2020-2023, AdaCore +-- Copyright (C) 2020-2024, AdaCore -- -- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -- @@ -403,6 +403,24 @@ package body VSS.String_Vectors is end if; end Replace; + ----------- + -- Slice -- + ----------- + + function Slice + (Self : Virtual_String_Vector'Class; + From : Positive; + To : Natural) return Virtual_String_Vector is + begin + return Result : Virtual_String_Vector do + for J in From .. To loop + exit when J > Self.Length; + + Result.Append (Self (J)); + end loop; + end return; + end Slice; + ----------- -- Write -- ----------- diff --git a/source/text/vss-string_vectors.ads b/source/text/vss-string_vectors.ads index 8aef94a5..f9fd9224 100644 --- a/source/text/vss-string_vectors.ads +++ b/source/text/vss-string_vectors.ads @@ -1,5 +1,5 @@ -- --- Copyright (C) 2020-2023, AdaCore +-- Copyright (C) 2020-2024, AdaCore -- -- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -- @@ -49,6 +49,12 @@ package VSS.String_Vectors is Index : Positive) return VSS.Strings.Virtual_String; -- Return given element. Return "null" string when index is out of bound. + function Slice + (Self : Virtual_String_Vector'Class; + From : Positive; + To : Natural) return Virtual_String_Vector; + -- Return elements inside given range. + function First_Element (Self : Virtual_String_Vector'Class) return VSS.Strings.Virtual_String; -- Return first element of the vector. diff --git a/testsuite/os/test_command_line_parser.adb b/testsuite/os/test_command_line_parser.adb index d56bdb35..0a500ec9 100644 --- a/testsuite/os/test_command_line_parser.adb +++ b/testsuite/os/test_command_line_parser.adb @@ -1,5 +1,5 @@ -- --- Copyright (C) 2022-2023, AdaCore +-- Copyright (C) 2022-2024, AdaCore -- -- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -- @@ -57,12 +57,15 @@ procedure Test_Command_Line_Parser is -- Test that "--subprojects=project.gpr" raise error procedure Test_Short_Binary_With_Equal_Sign_Error; - -- Test that "--S=" raise error + -- Test that "-S=" raise error procedure Test_Short_Binary_With_Value_Error; -- Test that "--S=project.gpr" raise error - procedure Test_Positional_Long_List; + procedure Test_Few_Positionals_All_Specified; + -- Test processing of the positional arguments. + + procedure Test_Few_Positionals_Long_List; -- Test processing of the positional arguments: list of arguments is -- longer than number of defined positional arguments. @@ -70,6 +73,138 @@ procedure Test_Command_Line_Parser is -- Test processing of the positional arguments: some of defined positional -- argument is not specified in the command line. + procedure Test_Command_Line_Parser; + -- Run testcases of Command_Line_Parser. + + procedure Test_Multiple_Positional; + -- Test multiple positional option + + ------------------------------ + -- Test_Command_Line_Parser -- + ------------------------------ + + procedure Test_Command_Line_Parser is + begin + Test_Support.Run_Testcase + (Test_Short_No_Separator'Access, + "short option with value without separator"); + Test_Support.Run_Testcase + (Test_Short_Equal'Access, + "short option with value after equal separator"); + Test_Support.Run_Testcase + (Test_Short_Next'Access, + "short option with value as following argument"); + Test_Support.Run_Testcase + (Test_Long_Equal'Access, + "long option with value after equal separator"); + Test_Support.Run_Testcase + (Test_Long_Next'Access, + "long option with value as following argument"); + Test_Support.Run_Testcase + (Test_Multiple_Values_Mixed'Access, + "multiple values of different styles"); + Test_Support.Run_Testcase + (Test_Name_Value_No_Separator'Access, + "name-value without separator"); + Test_Support.Run_Testcase + (Test_Name_Value_Next'Access, + "name-value as following argument"); + Test_Support.Run_Testcase + (Test_Name_Value_Mixed'Access, + "name-value with different styles"); + + Test_Support.Run_Testcase + (Test_Long_Binary'Access, + "long boolean option"); + Test_Support.Run_Testcase + (Test_Short_Binary'Access, + "short boolean option"); + Test_Support.Run_Testcase + (Test_Long_Binary_With_Equal_Sign_Error'Access, + "long boolean option with equal separator no value"); + Test_Support.Run_Testcase + (Test_Long_Binary_With_Value_Error'Access, + "long boolean option with value after equal separator"); + Test_Support.Run_Testcase + (Test_Short_Binary_With_Equal_Sign_Error'Access, + "short boolean option with equal separator no value"); + Test_Support.Run_Testcase + (Test_Short_Binary_With_Value_Error'Access, + "short boolean option with value after equal separator"); + + Test_Support.Run_Testcase + (Test_Few_Positionals_All_Specified'Access, + "few positional arguments all specified"); + Test_Support.Run_Testcase + (Test_Few_Positionals_Long_List'Access, + "few positional arguments more arguments"); + Test_Support.Run_Testcase + (Test_Positional_Unspecified'Access, + "single positional arguments without value specified"); + + Test_Support.Run_Testcase + (Test_Multiple_Positional'Access, + "multiple positional argument"); + end Test_Command_Line_Parser; + + -------------------------- + -- Test_Few_Positionals -- + -------------------------- + + procedure Test_Few_Positionals_All_Specified is + use type VSS.String_Vectors.Virtual_String_Vector; + + Arguments : VSS.String_Vectors.Virtual_String_Vector; + Option_A : constant VSS.Command_Line.Positional_Option := + (Name => "file.a", + Description => ""); + Option_B : constant VSS.Command_Line.Positional_Option := + (Name => "file.b", + Description => ""); + Parser : VSS.Command_Line.Parsers.Command_Line_Parser; + + begin + Parser.Add_Option (Option_A); + Parser.Add_Option (Option_B); + + Arguments.Append ("file1"); + Arguments.Append ("file2"); + + Test_Support.Assert (Parser.Parse (Arguments)); + Test_Support.Assert (Parser.Error_Message.Is_Empty); + Test_Support.Assert (Parser.Positional_Arguments = Arguments); + Test_Support.Assert (Parser.Is_Specified (Option_A)); + Test_Support.Assert (Parser.Value (Option_A) = "file1"); + Test_Support.Assert (Parser.Is_Specified (Option_B)); + Test_Support.Assert (Parser.Value (Option_B) = "file2"); + end Test_Few_Positionals_All_Specified; + + ------------------------------------ + -- Test_Few_Positionals_Long_List -- + ------------------------------------ + + procedure Test_Few_Positionals_Long_List is + Arguments : VSS.String_Vectors.Virtual_String_Vector; + Option_A : constant VSS.Command_Line.Positional_Option := + (Name => "file.a", + Description => ""); + Option_B : constant VSS.Command_Line.Positional_Option := + (Name => "file.b", + Description => ""); + Parser : VSS.Command_Line.Parsers.Command_Line_Parser; + + begin + Parser.Add_Option (Option_A); + Parser.Add_Option (Option_B); + + Arguments.Append ("file1"); + Arguments.Append ("file2"); + Arguments.Append ("file3"); + + Test_Support.Assert (not Parser.Parse (Arguments)); + Test_Support.Assert (not Parser.Error_Message.Is_Empty); + end Test_Few_Positionals_Long_List; + ---------------------- -- Test_Long_Binary -- ---------------------- @@ -185,6 +320,30 @@ procedure Test_Command_Line_Parser is Test_Support.Assert (Parser.Value (Option) = "project.gpr"); end Test_Long_Next; + ------------------------------ + -- Test_Multiple_Positional -- + ------------------------------ + + procedure Test_Multiple_Positional is + Arguments : VSS.String_Vectors.Virtual_String_Vector; + Option : constant VSS.Command_Line.Multivalue_Positional_Option := + (Name => "files", + Description => ""); + Parser : VSS.Command_Line.Parsers.Command_Line_Parser; + + begin + Parser.Add_Option (Option); + + Arguments.Append ("file1"); + Arguments.Append ("file2"); + + Test_Support.Assert (Parser.Parse (Arguments)); + Test_Support.Assert (Parser.Error_Message.Is_Empty); + Test_Support.Assert (Parser.Is_Specified (Option)); + Test_Support.Assert (Parser.Values (Option) (1) = "file1"); + Test_Support.Assert (Parser.Values (Option) (2) = "file2"); + end Test_Multiple_Positional; + -------------------------------- -- Test_Multiple_Values_Mixed -- -------------------------------- @@ -306,39 +465,6 @@ procedure Test_Command_Line_Parser is Test_Support.Assert (Parser.Values (Option) (1).Value = "value"); end Test_Name_Value_No_Separator; - ------------------------------- - -- Test_Positional_Long_List -- - ------------------------------- - - procedure Test_Positional_Long_List is - use type VSS.String_Vectors.Virtual_String_Vector; - - Arguments : VSS.String_Vectors.Virtual_String_Vector; - Option_A : constant VSS.Command_Line.Positional_Option := - (Name => "file.a", - Description => ""); - Option_B : constant VSS.Command_Line.Positional_Option := - (Name => "file.b", - Description => ""); - Parser : VSS.Command_Line.Parsers.Command_Line_Parser; - - begin - Parser.Add_Option (Option_A); - Parser.Add_Option (Option_B); - - Arguments.Append ("file1"); - Arguments.Append ("file2"); - Arguments.Append ("file3"); - - Test_Support.Assert (Parser.Parse (Arguments)); - Test_Support.Assert (Parser.Error_Message.Is_Empty); - Test_Support.Assert (Parser.Positional_Arguments = Arguments); - Test_Support.Assert (Parser.Is_Specified (Option_A)); - Test_Support.Assert (Parser.Value (Option_A) = "file1"); - Test_Support.Assert (Parser.Is_Specified (Option_B)); - Test_Support.Assert (Parser.Value (Option_B) = "file2"); - end Test_Positional_Long_List; - --------------------------------- -- Test_Positional_Unspecified -- --------------------------------- @@ -510,23 +636,6 @@ procedure Test_Command_Line_Parser is end Test_Short_No_Separator; begin - Test_Short_No_Separator; - Test_Short_Equal; - Test_Short_Next; - Test_Long_Equal; - Test_Long_Next; - Test_Multiple_Values_Mixed; - Test_Name_Value_No_Separator; - Test_Name_Value_Next; - Test_Name_Value_Mixed; - - Test_Long_Binary; - Test_Short_Binary; - Test_Long_Binary_With_Equal_Sign_Error; - Test_Long_Binary_With_Value_Error; - Test_Short_Binary_With_Equal_Sign_Error; - Test_Short_Binary_With_Value_Error; - - Test_Positional_Long_List; - Test_Positional_Unspecified; + Test_Support.Run_Testsuite + (Test_Command_Line_Parser'Access, "Command Line Parser"); end Test_Command_Line_Parser;