Natools

with Ada.Strings.Fixed;
with Ada.Strings.Maps;

package body Natools.Getopt_Long is

   package Fixed renames Ada.Strings.Fixed;
   package Maps renames Ada.Strings.Maps;


   ---------------------------
   -- Any_Name constructors --
   ---------------------------

   function To_Name (Long_Name : String) return Any_Name is
   begin
      return Any_Name'(Style => Long,
                       Size => Long_Name'Length,
                       Long => Long_Name);
   end To_Name;


   function To_Name (Short_Name : Character) return Any_Name is
   begin
      return Any_Name'(Style => Short, Size => 1, Short => Short_Name);
   end To_Name;


   function Image (Name : Any_Name) return String is
   begin
      case Name.Style is
         when Short => return '-' & Name.Short;
         when Long  => return "--" & Name.Long;
      end case;
--  Alternate implementation:
--    case Name.Style is
--       when Short => return String'(1 => Name.Short);
--       when Long  => return '"' & Name.Long & '"';
--    end case;
   end Image;



   ----------------------
   -- Default handlers --
   ----------------------

   package body Handlers is

      procedure Missing_Argument
        (Handler : in out Callback;
         Id      : Option_Id;
         Name    : Any_Name)
      is
         pragma Unreferenced (Handler);
         pragma Unreferenced (Id);
      begin
         raise Option_Error with
           "Missing argument to option " & Image (Name);
      end Missing_Argument;


      procedure Unexpected_Argument
        (Handler  : in out Callback;
         Id       : Option_Id;
         Name     : Any_Name;
         Argument : String)
      is
         pragma Unreferenced (Handler);
         pragma Unreferenced (Id);
      begin
         raise Option_Error with
           "Unexpected argument """ & Argument
           & """ to option " & Image (Name);
      end Unexpected_Argument;


      procedure Unknown_Option
        (Handler : in out Callback;
         Name    : Any_Name)
      is
         pragma Unreferenced (Handler);
      begin
         raise Option_Error with "Unknown option " & Image (Name);
      end Unknown_Option;

   end Handlers;



   ----------------------------
   -- Option list management --
   ----------------------------

   procedure Add_Option
     (Options    : in out Option_Definitions;

   -----------------------------
   -- Command-line processing --
   -----------------------------

   procedure Process
     (Options : Option_Definitions;

      Handler : in out Handlers.Callback'Class;






      Posixly_Correct : Boolean := True;
      Long_Only : Boolean := False;
      Argument_Count : not null access function return Natural
        := Ada.Command_Line.Argument_Count'Access;
      Argument : not null access function (Number : Positive) return String
        := Ada.Command_Line.Argument'Access)
   is

            if not Long_Option_Maps.Has_Element (Cursor) then
               --  Looking for a unique partial match
               Cursor := Options.By_Long_Name.Ceiling (Arg_Name);
               if not Long_Option_Maps.Has_Element (Cursor) or else
                 not Has_Prefix (Cursor, Arg_Name) or else
                 Has_Prefix (Long_Option_Maps.Next (Cursor), Arg_Name)
               then



                  Handler.Unknown_Option (To_Name (Arg_Name));
                  return;

               end if;
            end if;
            --  At this point, Cursor points to the selected argument
            declare
               Opt : constant Option := Long_Option_Maps.Element (Cursor);
            begin
               case Opt.Has_Arg is
                  when No_Argument =>
                     if Equal = 0 then
                        Handler.Option (Opt.Id, "");
                     else
                        Handler.Unexpected_Argument
                          (Opt.Id,

                           To_Name (Opt.Long_Name),


                           Arg (Equal + 1 .. Arg'Last));

                     end if;
                  when Optional_Argument =>
                     if Equal = 0 then
                        Handler.Option (Opt.Id, "");
                     else
                        Handler.Option (Opt.Id, Arg (Equal + 1 .. Arg'Last));
                     end if;
                  when Required_Argument =>
                     if Equal = 0 then
                        if Arg_N = Arg_Count then
                           Handler.Missing_Argument

                             (Opt.Id, To_Name (Opt.Long_Name));
                        else



                           Handler.Option (Opt.Id, Argument (Arg_N + 1));
                           Arg_N := Arg_N + 1;
                        end if;
                     else
                        Handler.Option (Opt.Id, Arg (Equal + 1 .. Arg'Last));
                     end if;
               end case;
            end;
         end;
      end Process_Long_Option;
   begin
      while Arg_N <= Arg_Count loop
         declare
            Arg : constant String := Argument (Arg_N);
         begin
            if Arg'Length <= 1 or else Arg (Arg'First) /= '-' then
               --  This is a non-flag argument, abort option processing if
               --    posixly correct.
               if Posixly_Correct then
                  exit;
               else
                  Handler.Argument (Arg);
                  Arg_N := Arg_N + 1;
               end if;
            elsif Arg (Arg'First + 1) = '-' then
               --  "--" stops option processing.
               if Arg'Length = 2 then
                  Arg_N := Arg_N + 1;
                  exit;
               end if;
               --  Argument starting with "--": long option.
               Process_Long_Option (Arg (Arg'First + 2 .. Arg'Last));
               Arg_N := Arg_N + 1;
            elsif Long_Only then
               --  Force long option on a single dash prefix.
               Process_Long_Option (Arg (Arg'First + 1 .. Arg'Last));
               Arg_N := Arg_N + 1;
            else

                        declare
                           Opt : constant Option
                             := Short_Option_Maps.Element (Cursor);
                        begin
                           if Opt.Has_Arg = Required_Argument then
                              if Arg_I = Arg'Last then
                                 if Arg_N = Arg_Count then
                                    Handler.Missing_Argument


                                      (Opt.Id, To_Name (Opt.Short_Name));
                                 else

                                    Handler.Option

                                      (Opt.Id, Argument (Arg_N + 1));
                                    Arg_N := Arg_N + 1;
                                    exit;
                                 end if;
                              else
                                 Handler.Option
                                   (Opt.Id, Arg (Arg_I + 1 .. Arg'Last));
                                 exit;
                              end if;
                           else
                              Handler.Option (Opt.Id, "");
                           end if;
                        end;
                     else


                        Handler.Unknown_Option (To_Name (Arg (Arg_I)));



                     end if;
                  end;
               end loop;
               Arg_N := Arg_N + 1;
            end if;
         end;
      end loop;

      --  Only non-flag arguments remain
      while Arg_N <= Arg_Count loop
         Handler.Argument (Argument (Arg_N));
         Arg_N := Arg_N + 1;
      end loop;
   end Process;

end Natools.Getopt_Long;

------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.Getopt_Long is a native Ada implementation of getopt_long()      --
-- processor for command line arguments.                                    --
--                                                                          --
-- This package is generic, and its only formal parameter is a descrete     --
-- type supposed to cover all command-line options.                         --

--                                                                          --
-- Option_Definitions objects hold the list of recognized flags. Flags can  --
-- have a single-character short name or a multiple-character long name.    --
-- Moreover, there is no limit to the number of flag names referring to the --
-- same Option_Id value.                                                    --
--                                                                          --
-- Once the Option_Definitions object has been filled with flags recognized --
-- by the client, the actual command-line arguments can be processed,       --
-- using the handler callbacks from a Handlers.Callback'Class object.       --


--                                                                          --
-- Callback subprograms for normal operation are Option, for command-line   --
-- flags identified by their Option_Id, and Argument, for top-level command --
-- line arguments. There are also callbacks for error conditions (missing   --
-- or unexpected argument, unknown option), whose implementation in         --
-- Handlers.Callback are simply to raise Option_Error with an appropriate   --
-- message.                                                                 --
------------------------------------------------------------------------------


with Ada.Command_Line;
private with Ada.Containers.Indefinite_Ordered_Maps;

generic
   type Option_Id is (<>);

package Natools.Getopt_Long is
   pragma Preelaborate (Getopt_Long);

   Null_Long_Name : constant String := "";
   Null_Short_Name : constant Character := Character'Val (0);



   ------------------------------------------
   -- Holder for both short and long names --
   ------------------------------------------

   type Name_Style is (Long, Short);

   type Any_Name (Style : Name_Style; Size : Positive) is record
      case Style is
         when Short =>
            Short : Character;
         when Long =>
            Long : String (1 .. Size);
      end case;
   end record;

   function To_Name (Long_Name : String) return Any_Name;
   function To_Name (Short_Name : Character) return Any_Name;
   function Image (Name : Any_Name) return String;



   ------------------------
   -- Callback interface --
   ------------------------

   Option_Error : exception;

   package Handlers is

      type Callback is abstract tagged null record;

      procedure Option
        (Handler  : in out Callback;
         Id       : Option_Id;
         Argument : String)
         is abstract;
         --  Callback for successfully-parsed options.

      procedure Argument
        (Handler  : in out Callback;
         Argument : String)
         is abstract;
         --  Callback for non-flag arguments.

      procedure Missing_Argument
        (Handler : in out Callback;
         Id      : Option_Id;
         Name    : Any_Name);
         --  Raise Option_Error (default error handler).

      procedure Unexpected_Argument
        (Handler  : in out Callback;
         Id       : Option_Id;
         Name     : Any_Name;
         Argument : String);
         --  Raise Option_Error (default error handler).

      procedure Unknown_Option
        (Handler : in out Callback;
         Name    : Any_Name);
         --  Raise Option_Error (default error handler).

   end Handlers;



   ---------------------
   -- Option database --
   ---------------------

   type Argument_Requirement is
     (No_Argument, Required_Argument, Optional_Argument);

   type Option_Definitions is tagged private;

   procedure Add_Option
     (Options    : in out Option_Definitions;

      --  Iterate over all options, starting with options having a short name,
      --    followed by options having only a long name, sorted respectively by
      --    short and long name.
      --  Process is called for each option; for options lacking a long name,
      --    Long_Name is "", and for options lacking a short name, Short_Name
      --    is Character'Val (0).



   --------------------------------------
   -- Command line argument processing --
   --------------------------------------

   procedure Process
     (Options : Option_Definitions;

      Handler : in out Handlers.Callback'Class;






      Posixly_Correct : Boolean := True;
      Long_Only : Boolean := False;
      Argument_Count : not null access function return Natural
        := Ada.Command_Line.Argument_Count'Access;
      Argument : not null access function (Number : Positive) return String
        := Ada.Command_Line.Argument'Access);
      --  Process system command line argument list, using the provided option
      --    definitions and handler callbacks.







private

   type Option (Long_Name_Length : Natural) is record
      Id : Option_Id;
      Has_Arg : Argument_Requirement;
      Long_Name : String (1 .. Long_Name_Length);

      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;






   Separator : constant Character := ';';

   package Getopt is new Natools.Getopt_Long (Option_Id);




   function Option_Definitions return Getopt.Option_Definitions;
      --  Create the Option_Definitions object used for these tests.








































   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;



   -------------------
   -- Test Handlers --
   -------------------

   package Handlers is

      type Basic is new Getopt.Handlers.Callback with record
         Flag_Seen : Flag_Seen_Array := (others => False);
         Flag_Argument : Flag_Argument_Array;
         Flag_Error : String_Vectors.Vector;
      end record;

      overriding
      procedure Option (Handler : in out Basic;
                        Id : Option_Id;
                        Argument : String);
         --  Process the given option, by recording it as seen in Flag_Seen
         --    and appending the argument to Flag_Argument.

      overriding
      procedure Argument (Handler : in out Basic;
                          Argument : String);
         --  Process the given argument, by recording it
         --    in Flag_Seen (Command_Argument) and appending it
         --    to Flag_Argument (Command_Argument).

      not overriding
      procedure Dump (Handler : Basic;
                      Report : in out NT.Reporter'Class);
         --  Dump the current state (Flag_* variables) into the Report.


      type Error_Count is record
         Missing_Argument_Long  : Natural := 0;
         Missing_Argument_Short : Natural := 0;
         Unexpected_Argument    : Natural := 0;
         Unknown_Long_Option    : Natural := 0;
         Unknown_Short_Option   : Natural := 0;
      end record;

      type Recovering is new Basic with record
         Count : Error_Count;
      end record;

      procedure Increment (Number : in out Natural);

      overriding
      procedure Missing_Argument
        (Handler : in out Recovering;
         Id      : Option_Id;
         Name    : Getopt.Any_Name);

      overriding
      procedure Unexpected_Argument
        (Handler  : in out Recovering;
         Id       : Option_Id;
         Name     : Getopt.Any_Name;
         Argument : String);

      overriding
      procedure Unknown_Option
        (Handler : in out Recovering;
         Name    : Getopt.Any_Name);

   end Handlers;



   package body Handlers is

      overriding
      procedure Option (Handler : in out Basic;
                        Id : Option_Id;
                        Argument : String) is
      begin
         Handler.Flag_Seen (Id) := True;
         US.Append (Handler.Flag_Argument (Id), Argument & Separator);
      end Option;


      overriding
      procedure Argument (Handler : in out Basic;
                          Argument : String) is
      begin
         Option (Handler, Command_Argument, Argument);
      end Argument;


      not overriding
      procedure Dump (Handler : Basic;
                      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 (Handler.Flag_Seen (Id)) & ", """
                         & US.To_String (Handler.Flag_Argument (Id)) & '"');
         end loop;
         Handler.Flag_Error.Iterate (Process'Access);
      end Dump;


      procedure Increment (Number : in out Natural) is
      begin
         Number := Number + 1;
      end Increment;


      overriding
      procedure Missing_Argument
        (Handler : in out Recovering;
         Id      : Option_Id;
         Name    : Getopt.Any_Name)
      is
         pragma Unreferenced (Id);
      begin
         case Name.Style is
            when Getopt.Short =>
               Increment (Handler.Count.Missing_Argument_Short);
            when Getopt.Long  =>
               Increment (Handler.Count.Missing_Argument_Long);
         end case;
      end Missing_Argument;

      overriding
      procedure Unexpected_Argument
        (Handler  : in out Recovering;
         Id       : Option_Id;
         Name     : Getopt.Any_Name;
         Argument : String)
      is
         pragma Unreferenced (Id);
         pragma Unreferenced (Name);
         pragma Unreferenced (Argument);
      begin
         Increment (Handler.Count.Unexpected_Argument);
      end Unexpected_Argument;


      overriding
      procedure Unknown_Option
        (Handler : in out Recovering;
         Name    : Getopt.Any_Name) is
      begin
         case Name.Style is
            when Getopt.Short =>
               Increment (Handler.Count.Unknown_Short_Option);
            when Getopt.Long =>
               Increment (Handler.Count.Unknown_Long_Option);
         end case;
      end Unknown_Option;

   end Handlers;



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

      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;
      Handler : Handlers.Basic;
   begin

      begin
         Options.Process

           (Handler            => Handler,
            Posixly_Correct    => Posixly_Correct,
            Long_Only          => Long_Only,
            Argument_Count     => Argument_Count'Access,
            Argument           => Argument'Access);
      exception
         when Error : Getopt.Option_Error =>
            Handler.Flag_Error.Append
              (Ada.Exceptions.Exception_Message (Error));
      end;

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



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

   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_Count : Handlers.Error_Count);











      procedure Local_Test
        (Name : String;
         Expected_Seen : Flag_Seen_Array;
         Expected_Argument : Flag_Argument_Array;
         Expected_Count : Handlers.Error_Count)



      is
         use type Handlers.Error_Count;
         Options : constant Getopt.Option_Definitions := Option_Definitions;
         Handler : Handlers.Recovering;
      begin





         Options.Process

           (Handler        => Handler,




            Argument_Count => Argument_Count'Access,
            Argument       => Argument'Access);
         if Handler.Count /= Expected_Count then
            Report.Item (Name, NT.Fail);
            if Handler.Count.Missing_Argument_Long

              /= Expected_Count.Missing_Argument_Long
            then


               Report.Info ("Missing argument to long option callback called"
                 & Natural'Image (Handler.Count.Missing_Argument_Long)
                 & " times, expected"
                 & Natural'Image (Expected_Count.Missing_Argument_Long));
            end if;
            if Handler.Count.Missing_Argument_Short
              /= Expected_Count.Missing_Argument_Short
            then
               Report.Info ("Missing argument to short option callback called"
                 & Natural'Image (Handler.Count.Missing_Argument_Short)
                 & " times, expected"
                 & Natural'Image (Expected_Count.Missing_Argument_Short));
            end if;
            if Handler.Count.Unexpected_Argument
              /= Expected_Count.Unexpected_Argument
            then
               Report.Info ("Unexpected argument callback called"
                 & Natural'Image (Handler.Count.Unexpected_Argument)
                 & " times, expected"
                 & Natural'Image (Expected_Count.Unexpected_Argument));
            end if;
            if Handler.Count.Unknown_Long_Option
              /= Expected_Count.Unknown_Long_Option
            then
               Report.Info ("Unknown long option callback called"
                 & Natural'Image (Handler.Count.Unknown_Long_Option)
                 & " times, expected"
                 & Natural'Image (Expected_Count.Unknown_Long_Option));
            end if;
            if Handler.Count.Unknown_Short_Option
              /= Expected_Count.Unknown_Short_Option
            then
               Report.Info ("Unknown short option callback called"
                 & Natural'Image (Handler.Count.Unknown_Short_Option)
                 & " times, expected"
                 & Natural'Image (Expected_Count.Unknown_Short_Option));
            end if;
         elsif Handler.Flag_Seen /= Expected_Seen or
           Handler.Flag_Argument /= Expected_Argument
         then
            Report.Item (Name, NT.Fail);
            Handler.Dump (Report);
         else
            Report.Item (Name, NT.Success);
         end if;
      exception
         when Error : others =>
            Report.Report_Exception (Name, Error);
            Handler.Dump (Report);
      end Local_Test;
























   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),
                  (Missing_Argument_Short => 1, others => 0));

      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),
                  (Missing_Argument_Long => 1, others => 0));

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

      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),
                  (Unexpected_Argument => 1, others => 0));

      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),
                  (Unknown_Short_Option => 1, others => 0));

      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),
                  (Unknown_Long_Option => 1, others => 0));

      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),
                  (Missing_Argument_Long => 1,
                   Missing_Argument_Short => 0,
                   Unexpected_Argument => 1,
                   Unknown_Long_Option => 1,
                   Unknown_Short_Option => 1));

      Report.End_Section;
   end Test_Error_Callbacks;


   procedure Test_Everything (Report : in out NT.Reporter'Class) is
   begin

   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 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),

      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.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 option --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 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 option -g", 1));
   end Test_Unknown_Short;

end Natools.Getopt_Long_Tests;