Natools

      begin
         raise Option_Error with "Unknown option " & Image (Name);
      end Unknown_Option;

   end Handlers;



   -------------------------------------
   -- Simple configuration parameters --
   -------------------------------------

   function Posixly_Correct (Config : Configuration) return Boolean is
   begin
      return Config.Posixly_Correct;
   end Posixly_Correct;


   procedure Posixly_Correct
     (Config : in out Configuration;
      To     : Boolean := True) is
   begin
      Config.Posixly_Correct := To;
   end Posixly_Correct;


   function Long_Only (Config : Configuration) return Boolean is
   begin
      return Config.Long_Only;
   end Long_Only;


   procedure Use_Long_Only
     (Config : in out Configuration;
      Value  : Boolean := True) is
   begin
      Config.Long_Only := Value;
   end Use_Long_Only;



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

   procedure Add_Option
     (Config     : in out Configuration;

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

   procedure Process
     (Config : Configuration;
      Handler : in out Handlers.Callback'Class;


      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
      procedure Process_Long_Option (Arg : String);

      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 Config.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 Config.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
               --  Process a list of short options, until one with required
               --    argument is encountered (and the rest is its argument).
               for Arg_I in Arg'First + 1 .. Arg'Last loop

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

   type Argument_Requirement is
     (No_Argument, Required_Argument, Optional_Argument);

   type Configuration is tagged private;


   -- Simple parameters --

   function Posixly_Correct (Config : Configuration) return Boolean;

   procedure Posixly_Correct
     (Config : in out Configuration;
      To     : Boolean := True);

   function Long_Only (Config : Configuration) return Boolean;

   procedure Use_Long_Only
     (Config : in out Configuration;
      Value  : Boolean := True);


   -- Option list management --

   procedure Add_Option
     (Config     : in out Configuration;
      Long_Name  : String;
      Short_Name : Character;
      Has_Arg    : Argument_Requirement;
      Id         : Option_Id);
      --  Add an option with both a short and a long name to the database.

      --  Remove from the database an option identified by its long name.

   procedure Del_Option
     (Config     : in out Configuration;
      Short_Name : Character);
      --  Remove from the database an option identified by its short name.


   -- Formatting subprograms --

   function Format_Long_Names
     (Config      : Configuration;
      Id          : Option_Id;
      Separator   : String := ", ";
      Name_Prefix : String := "--")
      return String;
      --  Return a human-readable list of long names for the given option.

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

   procedure Process
     (Config : Configuration;
      Handler : in out Handlers.Callback'Class;


      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.

   package Short_Option_Maps is
      new Ada.Containers.Indefinite_Ordered_Maps (Character, Option);

   type Configuration is tagged record
      By_Long_Name : Long_Option_Maps.Map;
      By_Short_Name : Short_Option_Maps.Map;
      Posixly_Correct : Boolean := True;
      Long_Only : Boolean := False;
   end record;

end Natools.Getopt_Long;

   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 Getopt_Config
     (Posixly_Correct, Long_Only : Boolean)
      return Getopt.Configuration;
      --  Create the Getopt.Configuration object used for these tests.


   function Getopt_Config
     (Posixly_Correct, Long_Only : Boolean)
      return Getopt.Configuration is
   begin
      return OD : Getopt.Configuration 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);
         OD.Posixly_Correct (Posixly_Correct);
         OD.Use_Long_Only (Long_Only);
      end return;
   end Getopt_Config;



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

      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;
      Config : constant Getopt.Configuration
        := Getopt_Config (Posixly_Correct, Long_Only);
      Handler : Handlers.Basic;
   begin
      begin
         Getopt.Process
           (Config             => Config,
            Handler            => Handler,


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

      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;
         Config : constant Getopt.Configuration := Getopt_Config (True, False);
         Handler : Handlers.Recovering;
      begin
         Getopt.Process
           (Config         => Config,
            Handler        => Handler,
            Argument_Count => Argument_Count'Access,
            Argument       => Argument'Access);