Natools

natools-getopt_long_tests.adb at [43826b6a6a]
Login

File natools-getopt_long_tests.adb artifact bf7f31f3e7 part of check-in 43826b6a6a


------------------------------------------------------------------------------
-- Copyright (c) 2011, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Ada.Containers.Indefinite_Vectors;
with Ada.Exceptions;
with Ada.Strings.Unbounded;
with Natools.Getopt_Long;

package body Natools.Getopt_Long_Tests is

   package US renames Ada.Strings.Unbounded;

   ----------------------------------------
   -- Dynamic command line argument list --
   ----------------------------------------

   package String_Vectors is new Ada.Containers.Indefinite_Vectors
     (Index_Type => Positive, Element_Type => String);

   Command_Line : String_Vectors.Vector;


   function Argument_Count return Natural;
   function Argument (Number : Positive) return String;


   function Argument_Count return Natural is
   begin
      return Natural (Command_Line.Length);
   end Argument_Count;

   function Argument (Number : Positive) return String is
   begin
      return Command_Line.Element (Number);
   end Argument;



   --------------------------------
   -- Arguments used for testing --
   --------------------------------

   type Option_Id is
     (Short_No_Arg, Short_No_Arg_2, Short_Opt_Arg, Short_Arg,
      Long_No_Arg, Long_Opt_Arg, Long_Arg, Long_Ambiguous,
      Mixed_No_Arg, Mixed_Opt_Arg, Mixed_Arg,
      Command_Argument);

   type Flag_Seen_Array is array (Option_Id) of Boolean;

   type Flag_Argument_Array is array (Option_Id) of US.Unbounded_String;

   package Getopt is new Natools.Getopt_Long (Option_Id);

   Flag_Seen : Flag_Seen_Array;
   Flag_Argument : Flag_Argument_Array;
   Flag_Error : String_Vectors.Vector;
   Separator : constant Character := ';';

   procedure Callback (Id : Option_Id; Argument : String);
      --  Process the given argument, by recording it as seen in Flag_Seen
      --    and appending the argument to Flag_Argument.
   procedure Dump (Report : in out NT.Reporter'Class);
      --  Dump the current state (Flag_* variables) into the Report.
   function Option_Definitions return Getopt.Option_Definitions;
      --  Create the Option_Definitions object used for these tests.
   procedure Reset_Flags;
      --  Reset Flag_* variables for a new test.



   procedure Callback (Id : Option_Id; Argument : String) is
   begin
      Flag_Seen (Id) := True;
      US.Append (Flag_Argument (Id), Argument & Separator);
   end Callback;


   procedure Dump (Report : in out NT.Reporter'Class) is
      procedure Process (Position : String_Vectors.Cursor);
      function Seen_String (Seen : Boolean) return String;

      procedure Process (Position : String_Vectors.Cursor) is
      begin
         Report.Info ("Error """ & String_Vectors.Element (Position) & '"');
      end Process;

      function Seen_String (Seen : Boolean) return String is
      begin
         if Seen then
            return "Seen";
         else
            return "Not seen";
         end if;
      end Seen_String;
   begin
      Report.Info ("Flags:");
      for Id in Option_Id loop
         Report.Info ("  " & Option_Id'Image (Id) & ": "
                           & Seen_String (Flag_Seen (Id)) & ", """
                           & US.To_String (Flag_Argument (Id)) & '"');
      end loop;
      Flag_Error.Iterate (Process'Access);
   end Dump;


   function Option_Definitions return Getopt.Option_Definitions is
   begin
      return OD : Getopt.Option_Definitions do
         OD.Add_Option ('a', Getopt.No_Argument, Short_No_Arg);
         OD.Add_Option ('q', Getopt.No_Argument, Short_No_Arg_2);
         OD.Add_Option ('f', Getopt.Required_Argument, Short_Arg);
         OD.Add_Option ('v', Getopt.Optional_Argument, Short_Opt_Arg);
         OD.Add_Option ("aq", Getopt.No_Argument, Long_Ambiguous);
         OD.Add_Option ("aquatic", Getopt.No_Argument, Long_No_Arg);
         OD.Add_Option ("color", Getopt.Optional_Argument, Long_Opt_Arg);
         OD.Add_Option ("input", Getopt.Required_Argument, Long_Arg);
         OD.Add_Option ("execute", 'e', Getopt.Required_Argument, Mixed_Arg);
         OD.Add_Option ("ignore-case", 'i', Getopt.No_Argument, Mixed_No_Arg);
         OD.Add_Option ("write", 'w', Getopt.Optional_Argument, Mixed_Opt_Arg);
      end return;
   end Option_Definitions;


   procedure Reset_Flags is
   begin
      for Id in Option_Id loop
         Flag_Seen (Id) := False;
         Flag_Argument (Id) := US.Null_Unbounded_String;
      end loop;
      Flag_Error.Clear;
   end Reset_Flags;



   ----------------------------
   -- Generic test procedure --
   ----------------------------

   procedure Test
     (Report : in out NT.Reporter'Class;
      Name : String;
      Expected_Seen : Flag_Seen_Array;
      Expected_Argument : Flag_Argument_Array;
      Expected_Error : String_Vectors.Vector := String_Vectors.Empty_Vector;
      Posixly_Correct : Boolean := True;
      Long_Only : Boolean := False);


   procedure Test
     (Report : in out NT.Reporter'Class;
      Name : String;
      Expected_Seen : Flag_Seen_Array;
      Expected_Argument : Flag_Argument_Array;
      Expected_Error : String_Vectors.Vector := String_Vectors.Empty_Vector;
      Posixly_Correct : Boolean := True;
      Long_Only : Boolean := False)
   is
      use type String_Vectors.Vector;
      Options : constant Getopt.Option_Definitions := Option_Definitions;
   begin
      Reset_Flags;
      begin
         Options.Process
           (Top_Level_Argument => Command_Argument,
            Callback           => Callback'Access,
            Posixly_Correct    => Posixly_Correct,
            Long_Only          => Long_Only,
            Argument_Count     => Argument_Count'Access,
            Argument           => Argument'Access);
      exception
         when Error : Getopt.Option_Error =>
            Flag_Error.Append (Ada.Exceptions.Exception_Message (Error));
      end;

      if Flag_Seen = Expected_Seen and
         Flag_Argument = Expected_Argument and
         Flag_Error = Expected_Error
      then
         Report.Item (Name, NT.Success);
      else
         Report.Item (Name, NT.Fail);
         Dump (Report);
      end if;
   exception
      when Error : others =>
         Report.Report_Exception (Name, Error);
         Dump (Report);
   end Test;



   ---------------------------
   -- Public test functions --
   ---------------------------

   procedure All_Tests (Report : in out NT.Reporter'Class) is
   begin
      Test_Arguments (Report);
      Test_Empty (Report);
      Test_Error_Callbacks (Report);
      Test_Everything (Report);
      Test_Long (Report);
      Test_Long_Only (Report);
      Test_Long_Partial (Report);
      Test_Long_Partial_Ambiguous (Report);
      Test_Missing_Argument_Long (Report);
      Test_Missing_Argument_Short (Report);
      Test_Mixed_Arg (Report);
      Test_Mixed_No_Arg (Report);
      Test_Posixly_Correct (Report);
      Test_Short_Argument (Report);
      Test_Short_Compact (Report);
      Test_Short_Expanded (Report);
      Test_Unexpected_Argument (Report);
      Test_Unknown_Long (Report);
      Test_Unknown_Short (Report);
   end All_Tests;


   procedure Test_Arguments (Report : in out NT.Reporter'Class) is
   begin
      Command_Line.Clear;
      Command_Line.Append ("Argument 1");
      Command_Line.Append ("Argument 2");
      Command_Line.Append ("Argument 3");
      Test (Report, "Arguments without flag",
            (Command_Argument => True,
             others => False),
            (Command_Argument
               => US.To_Unbounded_String ("Argument 1;Argument 2;Argument 3;"),
             others => US.Null_Unbounded_String));
   end Test_Arguments;


   procedure Test_Empty (Report : in out NT.Reporter'Class) is
   begin
      Command_Line.Clear;
      Test (Report, "Empty command line",
            (others => False),
            (others => US.Null_Unbounded_String));
   end Test_Empty;


   procedure Test_Error_Callbacks (Report : in out NT.Reporter'Class) is
      procedure Local_Test
        (Name : String;
         Expected_Seen : Flag_Seen_Array;
         Expected_Argument : Flag_Argument_Array;
         Expected_Missing_Argument : Natural := 0;
         Expected_Unexpected_Argument : Natural := 0;
         Expected_Unknown_Long_Option : Natural := 0;
         Expected_Unknown_Short_Option : Natural := 0);
      procedure Missing_Argument (Id : Option_Id);
      procedure Unexpected_Argument (Id : Option_Id; Arg : String);
      procedure Unknown_Long_Option (Name : String);
      procedure Unknown_Short_Option (Name : Character);

      Missing_Argument_Nb, Unexpected_Argument_Nb,
      Unknown_Long_Option_Nb, Unknown_Short_Option_Nb : Natural;

      procedure Local_Test
        (Name : String;
         Expected_Seen : Flag_Seen_Array;
         Expected_Argument : Flag_Argument_Array;
         Expected_Missing_Argument : Natural := 0;
         Expected_Unexpected_Argument : Natural := 0;
         Expected_Unknown_Long_Option : Natural := 0;
         Expected_Unknown_Short_Option : Natural := 0)
      is
         Options : constant Getopt.Option_Definitions := Option_Definitions;
      begin
         Reset_Flags;
         Missing_Argument_Nb := 0;
         Unexpected_Argument_Nb := 0;
         Unknown_Long_Option_Nb := 0;
         Unknown_Short_Option_Nb := 0;
         Options.Process
           (Top_Level_Argument   => Command_Argument,
            Callback             => Callback'Access,
            Missing_Argument     => Missing_Argument'Access,
            Unexpected_Argument  => Unexpected_Argument'Access,
            Unknown_Long_Option  => Unknown_Long_Option'Access,
            Unknown_Short_Option => Unknown_Short_Option'Access,
            Argument_Count       => Argument_Count'Access,
            Argument             => Argument'Access);
         if Missing_Argument_Nb /= Expected_Missing_Argument or
           Unexpected_Argument_Nb /= Expected_Unexpected_Argument or
           Unknown_Long_Option_Nb /= Expected_Unknown_Long_Option or
           Unknown_Short_Option_Nb /= Expected_Unknown_Short_Option
         then
            Report.Item (Name, NT.Fail);
            if Missing_Argument_Nb /= Expected_Missing_Argument then
               Report.Info ("Missing argument callback called"
                            & Natural'Image (Missing_Argument_Nb)
                            & " times, expected"
                            & Natural'Image (Expected_Missing_Argument));
            end if;
            if Unexpected_Argument_Nb /= Expected_Unexpected_Argument then
               Report.Info ("Unexpected argument callback called"
                            & Natural'Image (Unexpected_Argument_Nb)
                            & " times, expected"
                            & Natural'Image (Expected_Unexpected_Argument));
            end if;
            if Unknown_Long_Option_Nb /= Expected_Unknown_Long_Option then
               Report.Info ("Unknown long option callback called"
                            & Natural'Image (Unknown_Long_Option_Nb)
                            & " times, expected"
                            & Natural'Image (Expected_Unknown_Long_Option));
            end if;
            if Unknown_Short_Option_Nb /= Expected_Unknown_Short_Option then
               Report.Info ("Unknown short option callback called"
                            & Natural'Image (Unknown_Short_Option_Nb)
                            & " times, expected"
                            & Natural'Image (Expected_Unknown_Short_Option));
            end if;
         elsif Flag_Seen /= Expected_Seen or
           Flag_Argument /= Expected_Argument
         then
            Report.Item (Name, NT.Fail);
            Dump (Report);
         else
            Report.Item (Name, NT.Success);
         end if;
      exception
         when Error : others =>
            Report.Report_Exception (Name, Error);
            Dump (Report);
      end Local_Test;

      procedure Missing_Argument (Id : Option_Id) is
         pragma Unreferenced (Id);
      begin
         Missing_Argument_Nb := Missing_Argument_Nb + 1;
      end Missing_Argument;

      procedure Unexpected_Argument (Id : Option_Id; Arg : String) is
         pragma Unreferenced (Id, Arg);
      begin
         Unexpected_Argument_Nb := Unexpected_Argument_Nb + 1;
      end Unexpected_Argument;

      procedure Unknown_Long_Option (Name : String) is
         pragma Unreferenced (Name);
      begin
         Unknown_Long_Option_Nb := Unknown_Long_Option_Nb + 1;
      end Unknown_Long_Option;

      procedure Unknown_Short_Option (Name : Character) is
         pragma Unreferenced (Name);
      begin
         Unknown_Short_Option_Nb := Unknown_Short_Option_Nb + 1;
      end Unknown_Short_Option;
   begin
      Report.Section ("Error-handling callbacks");

      Command_Line.Clear;
      Command_Line.Append ("-af");
      Local_Test ("Missing argument for short option",
                  (Short_No_Arg => True, others => False),
                  (Short_No_Arg => US.To_Unbounded_String (";"),
                   others => US.Null_Unbounded_String),
                  Expected_Missing_Argument => 1);

      Command_Line.Clear;
      Command_Line.Append ("--color");
      Command_Line.Append ("--input");
      Local_Test ("Missing argument for long option",
                  (Long_Opt_Arg => True, others => False),
                  (Long_Opt_Arg => US.To_Unbounded_String (";"),
                   others => US.Null_Unbounded_String),
                  Expected_Missing_Argument => 1);

      Command_Line.Clear;
      Command_Line.Append ("--aquatic=extra");
      Local_Test ("Unexpected argument",
                  (others => False),
                  (others => US.Null_Unbounded_String),
                  Expected_Unexpected_Argument => 1);

      Command_Line.Clear;
      Command_Line.Append ("-a");
      Command_Line.Append ("--ignore-case=true");
      Command_Line.Append ("--execute");
      Command_Line.Append ("command");
      Command_Line.Append ("file");
      Local_Test ("Process continues after caught unexpected argument",
                  (Short_No_Arg | Mixed_Arg | Command_Argument => True,
                   others => False),
                  (Short_No_Arg => US.To_Unbounded_String (";"),
                   Mixed_Arg => US.To_Unbounded_String ("command;"),
                   Command_Argument => US.To_Unbounded_String ("file;"),
                   others => US.Null_Unbounded_String),
                  Expected_Unexpected_Argument => 1);

      Command_Line.Clear;
      Command_Line.Append ("-abqffoo");
      Local_Test ("Unknown short option",
                  (Short_No_Arg | Short_No_Arg_2 | Short_Arg => True,
                   others => False),
                  (Short_No_Arg => US.To_Unbounded_String (";"),
                   Short_No_Arg_2 => US.To_Unbounded_String (";"),
                   Short_Arg => US.To_Unbounded_String ("foo;"),
                   others => US.Null_Unbounded_String),
                  Expected_Unknown_Short_Option => 1);

      Command_Line.Clear;
      Command_Line.Append ("--execute");
      Command_Line.Append ("command");
      Command_Line.Append ("--unknown=argument");
      Command_Line.Append ("file");
      Local_Test ("Unknown long option",
                  (Mixed_Arg | Command_Argument => True, others => False),
                  (Mixed_Arg => US.To_Unbounded_String ("command;"),
                   Command_Argument => US.To_Unbounded_String ("file;"),
                   others => US.Null_Unbounded_String),
                  Expected_Unknown_Long_Option => 1);

      Command_Line.Clear;
      Command_Line.Append ("--ignore-case");
      Command_Line.Append ("-bffoo");
      Command_Line.Append ("--aq=unexpected");
      Command_Line.Append ("-ecommand");
      Command_Line.Append ("--unknown");
      Command_Line.Append ("--input");
      Local_Test ("All errors simultaneously",
                  (Short_Arg | Mixed_No_Arg | Mixed_Arg => True,
                   others => False),
                  (Short_Arg => US.To_Unbounded_String ("foo;"),
                   Mixed_Arg => US.To_Unbounded_String ("command;"),
                   Mixed_No_Arg => US.To_Unbounded_String (";"),
                   others => US.Null_Unbounded_String),
                  Expected_Missing_Argument => 1,
                  Expected_Unexpected_Argument => 1,
                  Expected_Unknown_Long_Option => 1,
                  Expected_Unknown_Short_Option => 1);

      Report.End_Section;
   end Test_Error_Callbacks;


   procedure Test_Everything (Report : in out NT.Reporter'Class) is
   begin
      Command_Line.Clear;
      Command_Line.Append ("--write=arg 1");
      Command_Line.Append ("-awvfarg 2");
      Command_Line.Append ("--aq");
      Command_Line.Append ("-e");
      Command_Line.Append ("arg 3");
      Command_Line.Append ("--ignore-case");
      Command_Line.Append ("--color=arg 4");
      Command_Line.Append ("-iv");
      Command_Line.Append ("--execute=arg 5");
      Command_Line.Append ("--color");
      Command_Line.Append ("--input");
      Command_Line.Append ("arg 6");
      Command_Line.Append ("arg 7");
      Command_Line.Append ("arg 8");
      Test (Report, "Everything together",
            (Short_No_Arg_2 | Long_No_Arg => False, others => True),
            (Short_No_Arg     => US.To_Unbounded_String (";"),
             Short_No_Arg_2   => US.Null_Unbounded_String,
             Short_Arg        => US.To_Unbounded_String ("arg 2;"),
             Short_Opt_Arg    => US.To_Unbounded_String (";;"),
             Long_Ambiguous   => US.To_Unbounded_String (";"),
             Long_No_Arg      => US.Null_Unbounded_String,
             Long_Opt_Arg     => US.To_Unbounded_String ("arg 4;;"),
             Long_Arg         => US.To_Unbounded_String ("arg 6;"),
             Mixed_Arg        => US.To_Unbounded_String ("arg 3;arg 5;"),
             Mixed_No_Arg     => US.To_Unbounded_String (";;"),
             Mixed_Opt_Arg    => US.To_Unbounded_String ("arg 1;;"),
             Command_Argument => US.To_Unbounded_String ("arg 7;arg 8;")));
   end Test_Everything;


   procedure Test_Long (Report : in out NT.Reporter'Class) is
   begin
      Command_Line.Clear;
      Command_Line.Append ("--aquatic");
      Command_Line.Append ("--input=i equal");
      Command_Line.Append ("--color=c equal");
      Command_Line.Append ("--input");
      Command_Line.Append ("i space");
      Command_Line.Append ("--color");
      Command_Line.Append ("c space");
      Command_Line.Append ("top level");
      Test (Report, "Long flags",
            (Long_No_Arg | Long_Opt_Arg | Long_Arg | Command_Argument => True,
             others => False),
            (Long_No_Arg => US.To_Unbounded_String (";"),
             Long_Opt_Arg => US.To_Unbounded_String ("c equal;;"),
             Long_Arg => US.To_Unbounded_String ("i equal;i space;"),
             Command_Argument => US.To_Unbounded_String ("c space;top level;"),
             others => US.Null_Unbounded_String));
   end Test_Long;


   procedure Test_Long_Only (Report : in out NT.Reporter'Class) is
   begin
      Command_Line.Clear;
      Command_Line.Append ("-aq");
         --  Can be either 'a' and 'q' short flags or "aq" long flag, depending
         --    on Long_Only parameter

      --  Without Long_Only (default)
      Test (Report, "Long_Only disabled (default)",
            (Short_No_Arg | Short_No_Arg_2 => True, others => False),
            (Short_No_Arg | Short_No_Arg_2 => US.To_Unbounded_String (";"),
             others => US.Null_Unbounded_String),
            Long_Only => False);

      --  With Long_Only
      Test (Report, "Long_Only enabled",
            (Long_Ambiguous => True, others => False),
            (Long_Ambiguous => US.To_Unbounded_String (";"),
             others => US.Null_Unbounded_String),
            Long_Only => True);
   end Test_Long_Only;


   procedure Test_Long_Partial (Report : in out NT.Reporter'Class) is
   begin
      Command_Line.Clear;
      Command_Line.Append ("--aqu");
      Command_Line.Append ("--co=foo");
      Command_Line.Append ("--in");
      Command_Line.Append ("bar");
      Test (Report, "Partial matches for long flags",
            (Long_No_Arg | Long_Opt_Arg | Long_Arg => True, others => False),
            (Long_No_Arg => US.To_Unbounded_String (";"),
             Long_Opt_Arg => US.To_Unbounded_String ("foo;"),
             Long_Arg => US.To_Unbounded_String ("bar;"),
             others => US.Null_Unbounded_String));
   end Test_Long_Partial;


   procedure Test_Long_Partial_Ambiguous (Report : in out NT.Reporter'Class) is
   begin
      Command_Line.Clear;
      Command_Line.Append ("--i");
         --  partial match for both "input" and "ignore-case" long flags
      Test (Report, "Ambiguous partial match for long flags",
            (others => False),
            (others => US.Null_Unbounded_String),
            String_Vectors.To_Vector ("Unknown long option i", 1));

      Command_Line.Clear;
      Command_Line.Append ("--aq");
         --  partial match for both "aq" and "aquatic" long flags
         --  but exact match is preferred
      Test (Report, "Ambiguous exact match for long flags",
            (Long_Ambiguous => True, others => False),
            (Long_Ambiguous => US.To_Unbounded_String (";"),
             others => US.Null_Unbounded_String));
   end Test_Long_Partial_Ambiguous;


   procedure Test_Missing_Argument_Long (Report : in out NT.Reporter'Class) is
   begin
      Command_Line.Clear;
      Command_Line.Append ("--color");
      Command_Line.Append ("--input");
      Test (Report, "Missing argument for long option",
            (Long_Opt_Arg => True, others => False),
            (Long_Opt_Arg => US.To_Unbounded_String (";"),
             others => US.Null_Unbounded_String),
            String_Vectors.To_Vector ("Missing argument to option input", 1));
   end Test_Missing_Argument_Long;


   procedure Test_Missing_Argument_Short (Report : in out NT.Reporter'Class) is
   begin
      Command_Line.Clear;
      Command_Line.Append ("-v");
      Command_Line.Append ("-f");
      Test (Report, "Missing argument for long option",
            (Short_Opt_Arg => True, others => False),
            (Short_Opt_Arg => US.To_Unbounded_String (";"),
             others => US.Null_Unbounded_String),
            String_Vectors.To_Vector ("Missing argument to option f", 1));
   end Test_Missing_Argument_Short;


   procedure Test_Mixed_Arg (Report : in out NT.Reporter'Class) is
   begin
      Command_Line.Clear;
      Command_Line.Append ("-efoo");
      Command_Line.Append ("-qe");
      Command_Line.Append ("bar");
      Command_Line.Append ("-aebaz");
      Command_Line.Append ("--execute=long");
      Test (Report, "Short and long options with arguments",
            (Mixed_Arg | Short_No_Arg | Short_No_Arg_2  => True,
             others => False),
            (Mixed_Arg => US.To_Unbounded_String ("foo;bar;baz;long;"),
             Short_No_Arg | Short_No_Arg_2 => US.To_Unbounded_String (";"),
             others => US.Null_Unbounded_String));
   end Test_Mixed_Arg;


   procedure Test_Mixed_No_Arg (Report : in out NT.Reporter'Class) is
   begin
      Command_Line.Clear;
      Command_Line.Append ("-ai");
      Command_Line.Append ("--ignore-case");
      Test (Report, "Short and long options without arguments",
            (Mixed_No_Arg | Short_No_Arg => True, others => False),
            (Mixed_No_Arg => US.To_Unbounded_String (";;"),
             Short_No_Arg => US.To_Unbounded_String (";"),
             others => US.Null_Unbounded_String));
   end Test_Mixed_No_Arg;


   procedure Test_Posixly_Correct (Report : in out NT.Reporter'Class) is
   begin
      Command_Line.Clear;
      Command_Line.Append ("-a");
      Command_Line.Append ("top level");
      Command_Line.Append ("-q");
         --  Posixly_Correct defines whether this "-q" is a top-level argument
         --    or a short flag

      --  With the flag
      Test (Report, "Posixly correct behavior",
            (Short_No_Arg | Command_Argument => True,
             others => False),
            (Short_No_Arg => US.To_Unbounded_String (";"),
             Command_Argument => US.To_Unbounded_String ("top level;-q;"),
             others => US.Null_Unbounded_String),
            Posixly_Correct => True);

      --  Without the flag
      Test (Report, "GNU (posixly incorrect) behavior",
            (Short_No_Arg | Short_No_Arg_2 | Command_Argument => True,
             others => False),
            (Short_No_Arg | Short_No_Arg_2 => US.To_Unbounded_String (";"),
             Command_Argument => US.To_Unbounded_String ("top level;"),
             others => US.Null_Unbounded_String),
            Posixly_Correct => False);
   end Test_Posixly_Correct;


   procedure Test_Short_Argument (Report : in out NT.Reporter'Class) is
   begin
      Command_Line.Clear;
      Command_Line.Append ("-faq");
         --  "aq" is argument for 'f' short flag, not 'a' and 'q' short flags
      Command_Line.Append ("-f");
      Command_Line.Append ("-a");
         --  "-a" is argument for 'f' short flag, not 'a' short flag
      Command_Line.Append ("-v");
      Command_Line.Append ("bar");
         --  "bar" is top level argument, because optional argument for short
         --    flags are never set
      Test (Report, "Arguments to short flags",
            (Short_Arg | Short_Opt_Arg | Command_Argument => True,
             others => False),
            (Short_Arg => US.To_Unbounded_String ("aq;-a;"),
             Short_Opt_Arg => US.To_Unbounded_String (";"),
             Command_Argument => US.To_Unbounded_String ("bar;"),
             others => US.Null_Unbounded_String));
   end Test_Short_Argument;


   procedure Test_Short_Compact (Report : in out NT.Reporter'Class) is
   begin
      Command_Line.Clear;
      Command_Line.Append ("-avq");
         --  "q" is not argument to 'v' short flag, but a short flag itself
      Test (Report, "Argumentless compact short flags",
            (Short_No_Arg | Short_No_Arg_2 | Short_Opt_Arg => True,
             others => False),
            (Short_No_Arg | Short_No_Arg_2 | Short_Opt_Arg =>
               US.To_Unbounded_String (";"),
             others => US.Null_Unbounded_String));
   end Test_Short_Compact;


   procedure Test_Short_Expanded (Report : in out NT.Reporter'Class) is
   begin
      Command_Line.Clear;
      Command_Line.Append ("-a");
      Command_Line.Append ("-v");
      Command_Line.Append ("-q");
      Test (Report, "Argumentless expanded short flags",
            (Short_No_Arg | Short_No_Arg_2 | Short_Opt_Arg => True,
             others => False),
            (Short_No_Arg | Short_No_Arg_2 | Short_Opt_Arg =>
               US.To_Unbounded_String (";"),
             others => US.Null_Unbounded_String));
   end Test_Short_Expanded;


   procedure Test_Unexpected_Argument (Report : in out NT.Reporter'Class) is
   begin
      Command_Line.Clear;
      Command_Line.Append ("--color=foo");
      Command_Line.Append ("--aq=bar");
      Test (Report, "Unexpected argument to long option",
            (Long_Opt_Arg => True, others => False),
            (Long_Opt_Arg => US.To_Unbounded_String ("foo;"),
             others => US.Null_Unbounded_String),
            String_Vectors.To_Vector ("Unexpected argument ""bar"" to aq", 1));
   end Test_Unexpected_Argument;


   procedure Test_Unknown_Long (Report : in out NT.Reporter'Class) is
   begin
      Command_Line.Clear;
      Command_Line.Append ("--long-flag");
      Test (Report, "Unknown long flag",
            (others => False), (others => US.Null_Unbounded_String),
            String_Vectors.To_Vector ("Unknown long option long-flag", 1));
   end Test_Unknown_Long;


   procedure Test_Unknown_Short (Report : in out NT.Reporter'Class) is
   begin
      Command_Line.Clear;
      Command_Line.Append ("-g");
      Test (Report, "Unknown short flag",
            (others => False), (others => US.Null_Unbounded_String),
            String_Vectors.To_Vector ("Unknown short option g", 1));
   end Test_Unknown_Short;

end Natools.Getopt_Long_Tests;