-----------------------------------------------------------------------
--  ADO Drivers -- Database Drivers
--  Copyright (C) 2010, 2011, 2012, 2013, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Properties;

--  == Database Drivers ==
--  Database drivers provide operations to access the database.  These operations are
--  specific to the database type and the `ADO.Drivers` package among others provide
--  an abstraction that allows to make the different databases look like they have almost
--  the same interface.
--
--  A database driver exists for SQLite, MySQL and PostgreSQL. The driver
--  is either statically linked to the application or it can be loaded dynamically if it was
--  built as a shared library.  For a dynamic load, the driver shared library name must be
--  prefixed by `libada_ado_`.  For example, for a `mysql` driver, the shared
--  library name is `libada_ado_mysql.so`.
--
--  | Driver name | Database       |
--  | ----------- | ---------      |
--  | mysql       | MySQL, MariaDB |
--  | sqlite      | SQLite         |
--  | postgresql  | PostgreSQL     |
--
--  The database drivers are initialized automatically but in some cases, you may want
--  to control some database driver configuration parameter.  In that case,
--  the initialization must be done only once before creating a session
--  factory and getting a database connection.  The initialization can be made using
--  a property file which contains the configuration for the database drivers and
--  the database connection properties.  For such initialization, you will have to
--  call one of the `Initialize` operation from the `ADO.Drivers` package.
--
--    ADO.Drivers.Initialize ("db.properties");
--
--  The set of configuration properties can be set programatically and passed to the
--  `Initialize` operation.
--
--    Config : Util.Properties.Manager;
--    ...
--      Config.Set ("ado.database", "sqlite:///mydatabase.db");
--      Config.Set ("ado.queries.path", ".;db");
--      ADO.Drivers.Initialize (Config);
--
--  Once initialized, a configuration property can be retrieved by using the `Get_Config`
--  operation.
--
--    URI : constant String := ADO.Drivers.Get_Config ("ado.database");
--
--  Dynamic loading of database drivers is disabled by default for security reasons and
--  it can be enabled by setting the following property in the configuration file:
--
--    ado.drivers.load=true
--
--  Dynamic loading is triggered when a database connection string refers to a database
--  driver which is not known.
--
--  @include ado-mysql.ads
--  @include ado-sqlite.ads
--  @include ado-postgresql.ads
package ADO.Drivers is

   --  Raised for all errors reported by the database.
   Database_Error   : exception;

   type Driver_Index is new Natural range 0 .. 4;

   --  Initialize the drivers and the library by reading the property file
   --  and configure the runtime with it.
   procedure Initialize (Config : in String);

   --  Initialize the drivers and the library and configure the runtime with the given properties.
   procedure Initialize (Config : in Util.Properties.Manager'Class);

   --  Get the global configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Name    : in String;
                        Default : in String := "") return String;

   --  Returns true if the global configuration property is set to true/on.
   function Is_On (Name   : in String) return Boolean;

private

   --  Initialize the drivers which are available.
   procedure Initialize;

end ADO.Drivers;

-----------------------------------------------------------------------
--  ADO Drivers -- Database Drivers
--  Copyright (C) 2010, 2011, 2012, 2013, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Properties;

--  == Database Drivers ==
--  Database drivers provide operations to access the database.  These operations are
--  specific to the database type and the `ADO.Drivers` package among others provide
--  an abstraction that allows to make the different databases look like they have almost
--  the same interface.
--
--  A database driver exists for SQLite, MySQL and PostgreSQL. The driver
--  is either statically linked to the application or it can be loaded dynamically if it was
--  built as a shared library.  For a dynamic load, the driver shared library name must be
--  prefixed by `libada_ado_`.  For example, for a `mysql` driver, the shared
--  library name is `libada_ado_mysql.so`.
--
--  | Driver name | Database       |
--  | ----------- | ---------      |
--  | mysql       | MySQL, MariaDB |
--  | sqlite      | SQLite         |
--  | postgresql  | PostgreSQL     |
--
--  The database drivers are initialized automatically but in some cases, you may want
--  to control some database driver configuration parameter.  In that case,
--  the initialization must be done only once before creating a session
--  factory and getting a database connection.  The initialization can be made using
--  a property file which contains the configuration for the database drivers and
--  the database connection properties.  For such initialization, you will have to
--  call one of the `Initialize` operation from the `ADO.Drivers` package.
--
--    ADO.Drivers.Initialize ("db.properties");
--
--  The set of configuration properties can be set programatically and passed to the
--  `Initialize` operation.
--
--    Config : Util.Properties.Manager;
--    ...
--      Config.Set ("ado.database", "sqlite:///mydatabase.db");
--      Config.Set ("ado.queries.path", ".;db");
--      ADO.Drivers.Initialize (Config);
--
--  Once initialized, a configuration property can be retrieved by using the `Get_Config`
--  operation.
--
--    URI : constant String := ADO.Drivers.Get_Config ("ado.database");
--
--  Dynamic loading of database drivers is disabled by default for security reasons and
--  it can be enabled by setting the following property in the configuration file:
--
--    ado.drivers.load=true
--
--  Dynamic loading is triggered when a database connection string refers to a database
--  driver which is not known.
--
--  @include ado-mysql.ads
--  @include ado-sqlite.ads
--  @include ado-postgresql.ads
package ADO.Drivers is

   --  Raised for all errors reported by the database.
   Database_Error   : exception;

   type Driver_Index is new Natural range 0 .. 4;

   --  Initialize the drivers and the library by reading the property file
   --  and configure the runtime with it.
   procedure Initialize (Config : in String);

   --  Initialize the drivers and the library and configure the runtime with the given properties.
   procedure Initialize (Config : in Util.Properties.Manager'Class);

   --  Get the global configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Name    : in String;
                        Default : in String := "") return String;

   --  Returns true if the global configuration property is set to true/on.
   function Is_On (Name   : in String) return Boolean;

   --  Initialize the drivers which are available.
   procedure Initialize;

end ADO.Drivers;

Make the Initialize procedure public

Make the Initialize procedure public


------------------------------------------------------------------------------
-- Copyright (c) 2015-2016, 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.Characters.Latin_1;
with Ada.Streams;
with Ada.Strings.Unbounded;
with Natools.S_Expressions;
with Natools.Smaz_256;
with Natools.Smaz_64;
with Natools.Smaz_Generic;
with Natools.Smaz_Original;
with Natools.Smaz_Test_Base_64_Hash;

package body Natools.Smaz_Tests is

   generic
      with package Smaz is new Natools.Smaz_Generic (<>);
      with function Image (S : Ada.Streams.Stream_Element_Array) return String;
   procedure Generic_Roundtrip_Test
     (Test : in out NT.Test;
      Dict : in Smaz.Dictionary;
      Decompressed : in String;
      Compressed : in Ada.Streams.Stream_Element_Array);

   function Decimal_Image (S : Ada.Streams.Stream_Element_Array) return String;

   function Direct_Image (S : Ada.Streams.Stream_Element_Array) return String
     renames Natools.S_Expressions.To_String;

   function To_SEA (S : String) return Ada.Streams.Stream_Element_Array
     renames Natools.S_Expressions.To_Atom;

   -----------------------
   -- Test Dictionaries --
   -----------------------

   LF : constant Character := Ada.Characters.Latin_1.LF;

   Dict_64 : constant Natools.Smaz_64.Dictionary
     := (Last_Code => 59,
         Values_Last => 119,
         Variable_Length_Verbatim => False,
         Max_Word_Length => 6,
         Offsets => (2, 3, 5, 6, 7, 8, 9, 10, 11, 12, 13, 15, 16, 18, 20, 22,
            24, 25, 26, 28, 30, 31, 32, 36, 38, 40, 42, 44, 45, 47, 49, 51, 53,
            56, 60, 63, 65, 68, 70, 72, 74, 76, 80, 82, 84, 88, 90, 92, 94, 98,
            101, 102, 103, 105, 111, 112, 114, 115, 118),
         Values => " ee stainruos l dt enescm pépd de lere ld"
            & "e" & LF & "on cqumede mentes aiquen teerou    r  sque , is m q"
            & "ueà v'tiweblogfanj." & LF & LF & "ch",
         Hash => Natools.Smaz_Test_Base_64_Hash.Hash'Access);

   ------------------------------
   -- Local Helper Subprograms --
   ------------------------------

   function Decimal_Image (S : Ada.Streams.Stream_Element_Array) return String
   is
      use Ada.Strings.Unbounded;
      Result : Unbounded_String;
   begin
      for I in S'Range loop
         Append (Result, Ada.Streams.Stream_Element'Image (S (I)));
      end loop;

      return To_String (Result);
   end Decimal_Image;

   procedure Generic_Roundtrip_Test
     (Test : in out NT.Test;
      Dict : in Smaz.Dictionary;
      Decompressed : in String;
      Compressed : in Ada.Streams.Stream_Element_Array)
   is
      use type Ada.Streams.Stream_Element_Array;
      use type Ada.Streams.Stream_Element_Offset;
   begin
      declare
         First_OK : Boolean := False;
      begin
         declare
            Buffer : constant Ada.Streams.Stream_Element_Array
              := Smaz.Compress (Dict, Decompressed);
         begin
            First_OK := True;

            if Buffer /= Compressed then
               Test.Fail ("Bad compression of """ & Decompressed & '"');
               Test.Info ("Found:   " & Image (Buffer));
               Test.Info ("Expected:" & Image (Compressed));

               declare
                  Round : constant String
                    := Smaz.Decompress (Dict, Buffer);
               begin
                  if Round /= Decompressed then
                     Test.Info ("Roundtrip failed, got: """ & Round & '"');
                  else
                     Test.Info ("Roundtrip OK");
                  end if;
               end;
            end if;
         end;
      exception
         when Error : others =>
            if not First_OK then
               Test.Info ("During compression of """ & Decompressed & '"');
            end if;

            Test.Report_Exception (Error, NT.Fail);
      end;

      declare
         First_OK : Boolean := False;
      begin
         declare
            Buffer : constant String
              := Smaz.Decompress (Dict, Compressed);
         begin
            First_OK := True;

            if Buffer /= Decompressed then
               Test.Fail ("Bad decompression of " & Image (Compressed));
               Test.Info ("Found:   """ & Buffer & '"');
               Test.Info ("Expected:""" & Decompressed & '"');

               declare
                  Round : constant Ada.Streams.Stream_Element_Array
                    := Smaz.Compress (Dict, Buffer);
               begin
                  if Round /= Compressed then
                     Test.Info ("Roundtrip failed, got: " & Image (Round));
                  else
                     Test.Info ("Roundtrip OK");
                  end if;
               end;
            end if;
         end;
      exception
         when Error : others =>
            if not First_OK then
               Test.Info ("During compression of " & Image (Compressed));
            end if;

            Test.Report_Exception (Error, NT.Fail);
      end;
   end Generic_Roundtrip_Test;

   procedure Roundtrip_Test is new Generic_Roundtrip_Test
     (Natools.Smaz_256, Decimal_Image);

   procedure Roundtrip_Test is new Generic_Roundtrip_Test
     (Natools.Smaz_64, Direct_Image);

   -------------------------
   -- Complete Test Suite --
   -------------------------

   procedure All_Tests (Report : in out NT.Reporter'Class) is
   begin
      Report.Section ("Base 256");
      All_Tests_256 (Report);
      Report.End_Section;

      Report.Section ("Base 64");
      All_Tests_64 (Report);
      Report.End_Section;
   end All_Tests;

   ------------------------------
   -- Test Suite for Each Base --
   ------------------------------

   procedure All_Tests_256 (Report : in out NT.Reporter'Class) is
   begin
      Test_Validity_256 (Report);
      Sample_Strings_256 (Report);
   end All_Tests_256;

   procedure All_Tests_64 (Report : in out NT.Reporter'Class) is
   begin
      Test_Validity_64 (Report);
      Sample_Strings_64 (Report);
   end All_Tests_64;

   -------------------------------
   -- Individual Base-256 Tests --
   -------------------------------

   procedure Sample_Strings_256 (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Roundtrip on sample strings");
   begin
      Roundtrip_Test (Test, Smaz_Original.Dictionary,
         "This is a small string",
         (254, 84, 76, 56, 172, 62, 173, 152, 62, 195, 70));
      Roundtrip_Test (Test, Smaz_Original.Dictionary,
         "foobar",
         (220, 6, 90, 79));
      Roundtrip_Test (Test, Smaz_Original.Dictionary,
         "the end",
         (1, 171, 61));
      Roundtrip_Test (Test, Smaz_Original.Dictionary,
         "not-a-g00d-Exampl333",
         (132, 204, 4, 204, 59, 255, 12, 48, 48, 100, 45, 69, 120, 97, 109,
           112, 108, 51, 51, 51));
      Roundtrip_Test (Test, Smaz_Original.Dictionary,
         "Smaz is a simple compression library",
         (254, 83, 173, 219, 56, 172, 62, 226, 60, 87, 161, 45, 60, 33, 166,
           107, 205, 8, 90, 130, 12, 83));
      Roundtrip_Test (Test, Smaz_Original.Dictionary,
         "Nothing is more difficult, and therefore more precious, "
           & "than to be able to decide",
         (254, 78, 223, 102, 99, 116, 45, 42, 11, 129, 44, 44, 131, 38, 22, 3,
           148, 63, 210, 68, 11, 45, 42, 11, 60, 33, 28, 144, 164, 36, 203,
           143, 96, 92, 25, 90, 87, 82, 165, 215, 237, 2));
      Roundtrip_Test (Test, Smaz_Original.Dictionary,
         "this is an example of what works very well with smaz",
         (155, 56, 172, 41, 2, 250, 4, 45, 60, 87, 32, 159, 135, 65, 42, 254,
           107, 23, 231, 71, 145, 152, 243, 227, 10, 173, 219));
      Roundtrip_Test (Test, Smaz_Original.Dictionary,
         "1000 numbers 2000 will 10 20 30 compress very little",
         (255, 3, 49, 48, 48, 48, 236, 38, 45, 92, 221, 0, 255, 3, 50, 48, 48,
           48, 243, 152, 0, 255, 7, 49, 48, 32, 50, 48, 32, 51,
           48, 161, 45, 60, 33, 166, 0, 231, 71, 151, 3, 3, 87));
      Roundtrip_Test (Test, Smaz_Original.Dictionary,
         ": : : :",
         (255, 6, 58, 32, 58, 32, 58, 32, 58));
   exception
      when Error : others => Test.Report_Exception (Error);
   end Sample_Strings_256;

   procedure Test_Validity_256 (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Test dictionary validity");
   begin
      if not Natools.Smaz_256.Is_Valid (Smaz_Original.Dictionary) then
         Test.Fail;
      end if;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Test_Validity_256;

   ------------------------------
   -- Individual Base-64 Tests --
   ------------------------------

   procedure Sample_Strings_64 (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Roundtrip on sample strings");
   begin
      Roundtrip_Test (Test, Dict_64,
         "Simple Test",
         To_SEA ("+TBGSVYA+UBQE"));
         --       <S>imp* <T>*t
   exception
      when Error : others => Test.Report_Exception (Error);
   end Sample_Strings_64;

   procedure Test_Validity_64 (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Test dictionary validity");
   begin
      if not Natools.Smaz_64.Is_Valid (Dict_64) then
         Test.Fail;
      end if;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Test_Validity_64;

end Natools.Smaz_Tests;

------------------------------------------------------------------------------
-- Copyright (c) 2015-2016, 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.Characters.Latin_1;
with Ada.Streams;
with Ada.Strings.Unbounded;
with Natools.S_Expressions;
with Natools.Smaz_256;
with Natools.Smaz_64;
with Natools.Smaz_Generic;
with Natools.Smaz_Original;
with Natools.Smaz_Test_Base_64_Hash;

package body Natools.Smaz_Tests is

   generic
      with package Smaz is new Natools.Smaz_Generic (<>);
      with function Image (S : Ada.Streams.Stream_Element_Array) return String;
   procedure Generic_Roundtrip_Test
     (Test : in out NT.Test;
      Dict : in Smaz.Dictionary;
      Decompressed : in String;
      Compressed : in Ada.Streams.Stream_Element_Array);

   function Decimal_Image (S : Ada.Streams.Stream_Element_Array) return String;

   function Direct_Image (S : Ada.Streams.Stream_Element_Array) return String
     renames Natools.S_Expressions.To_String;

   function To_SEA (S : String) return Ada.Streams.Stream_Element_Array
     renames Natools.S_Expressions.To_Atom;

   -----------------------
   -- Test Dictionaries --
   -----------------------

   LF : constant Character := Ada.Characters.Latin_1.LF;

   Dict_64 : constant Natools.Smaz_64.Dictionary
     := (Last_Code => 59,
         Values_Last => 119,
         Variable_Length_Verbatim => False,
         Max_Word_Length => 6,
         Offsets => (2, 3, 5, 6, 7, 8, 9, 10, 11, 12, 13, 15, 16, 18, 20, 22,
            24, 25, 26, 28, 30, 31, 32, 36, 38, 40, 42, 44, 45, 47, 49, 51, 53,
            56, 60, 63, 65, 68, 70, 72, 74, 76, 80, 82, 84, 88, 90, 92, 94, 98,
            101, 102, 103, 105, 111, 112, 114, 115, 118),
         Values => " ee stainruos l dt enescm pépd de lere ld"
            & "e" & LF & "on cqumede mentes aiquen teerou    r  sque , is m q"
            & "ueà v'tiweblogfanj." & LF & LF & "ch",
         Hash => Natools.Smaz_Test_Base_64_Hash.Hash'Access);

   ------------------------------
   -- Local Helper Subprograms --
   ------------------------------

   function Decimal_Image (S : Ada.Streams.Stream_Element_Array) return String
   is
      use Ada.Strings.Unbounded;
      Result : Unbounded_String;
   begin
      for I in S'Range loop
         Append (Result, Ada.Streams.Stream_Element'Image (S (I)));
      end loop;

      return To_String (Result);
   end Decimal_Image;

   procedure Generic_Roundtrip_Test
     (Test : in out NT.Test;
      Dict : in Smaz.Dictionary;
      Decompressed : in String;
      Compressed : in Ada.Streams.Stream_Element_Array)
   is
      use type Ada.Streams.Stream_Element_Array;
      use type Ada.Streams.Stream_Element_Offset;
   begin
      declare
         First_OK : Boolean := False;
      begin
         declare
            Buffer : constant Ada.Streams.Stream_Element_Array
              := Smaz.Compress (Dict, Decompressed);
         begin
            First_OK := True;

            if Buffer /= Compressed then
               Test.Fail ("Bad compression of """ & Decompressed & '"');
               Test.Info ("Found:   " & Image (Buffer));
               Test.Info ("Expected:" & Image (Compressed));

               declare
                  Round : constant String
                    := Smaz.Decompress (Dict, Buffer);
               begin
                  if Round /= Decompressed then
                     Test.Info ("Roundtrip failed, got: """ & Round & '"');
                  else
                     Test.Info ("Roundtrip OK");
                  end if;
               end;
            end if;
         end;
      exception
         when Error : others =>
            if not First_OK then
               Test.Info ("During compression of """ & Decompressed & '"');
            end if;

            Test.Report_Exception (Error, NT.Fail);
      end;

      declare
         First_OK : Boolean := False;
      begin
         declare
            Buffer : constant String
              := Smaz.Decompress (Dict, Compressed);
         begin
            First_OK := True;

            if Buffer /= Decompressed then
               Test.Fail ("Bad decompression of " & Image (Compressed));
               Test.Info ("Found:   """ & Buffer & '"');
               Test.Info ("Expected:""" & Decompressed & '"');

               declare
                  Round : constant Ada.Streams.Stream_Element_Array
                    := Smaz.Compress (Dict, Buffer);
               begin
                  if Round /= Compressed then
                     Test.Info ("Roundtrip failed, got: " & Image (Round));
                  else
                     Test.Info ("Roundtrip OK");
                  end if;
               end;
            end if;
         end;
      exception
         when Error : others =>
            if not First_OK then
               Test.Info ("During compression of " & Image (Compressed));
            end if;

            Test.Report_Exception (Error, NT.Fail);
      end;
   end Generic_Roundtrip_Test;

   procedure Roundtrip_Test is new Generic_Roundtrip_Test
     (Natools.Smaz_256, Decimal_Image);

   procedure Roundtrip_Test is new Generic_Roundtrip_Test
     (Natools.Smaz_64, Direct_Image);

   -------------------------
   -- Complete Test Suite --
   -------------------------

   procedure All_Tests (Report : in out NT.Reporter'Class) is
   begin
      Report.Section ("Base 256");
      All_Tests_256 (Report);
      Report.End_Section;

      Report.Section ("Base 64");
      All_Tests_64 (Report);
      Report.End_Section;
   end All_Tests;

   ------------------------------
   -- Test Suite for Each Base --
   ------------------------------

   procedure All_Tests_256 (Report : in out NT.Reporter'Class) is
   begin
      Test_Validity_256 (Report);
      Sample_Strings_256 (Report);
   end All_Tests_256;

   procedure All_Tests_64 (Report : in out NT.Reporter'Class) is
   begin
      Test_Validity_64 (Report);
      Sample_Strings_64 (Report);
   end All_Tests_64;

   -------------------------------
   -- Individual Base-256 Tests --
   -------------------------------

   procedure Sample_Strings_256 (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Roundtrip on sample strings");
   begin
      Roundtrip_Test (Test, Smaz_Original.Dictionary,
         "This is a small string",
         (254, 84, 76, 56, 172, 62, 173, 152, 62, 195, 70));
      Roundtrip_Test (Test, Smaz_Original.Dictionary,
         "foobar",
         (220, 6, 90, 79));
      Roundtrip_Test (Test, Smaz_Original.Dictionary,
         "the end",
         (1, 171, 61));
      Roundtrip_Test (Test, Smaz_Original.Dictionary,
         "not-a-g00d-Exampl333",
         (132, 204, 4, 204, 59, 255, 12, 48, 48, 100, 45, 69, 120, 97, 109,
           112, 108, 51, 51, 51));
      Roundtrip_Test (Test, Smaz_Original.Dictionary,
         "Smaz is a simple compression library",
         (254, 83, 173, 219, 56, 172, 62, 226, 60, 87, 161, 45, 60, 33, 166,
           107, 205, 8, 90, 130, 12, 83));
      Roundtrip_Test (Test, Smaz_Original.Dictionary,
         "Nothing is more difficult, and therefore more precious, "
           & "than to be able to decide",
         (254, 78, 223, 102, 99, 116, 45, 42, 11, 129, 44, 44, 131, 38, 22, 3,
           148, 63, 210, 68, 11, 45, 42, 11, 60, 33, 28, 144, 164, 36, 203,
           143, 96, 92, 25, 90, 87, 82, 165, 215, 237, 2));
      Roundtrip_Test (Test, Smaz_Original.Dictionary,
         "this is an example of what works very well with smaz",
         (155, 56, 172, 41, 2, 250, 4, 45, 60, 87, 32, 159, 135, 65, 42, 254,
           107, 23, 231, 71, 145, 152, 243, 227, 10, 173, 219));
      Roundtrip_Test (Test, Smaz_Original.Dictionary,
         "1000 numbers 2000 will 10 20 30 compress very little",
         (255, 3, 49, 48, 48, 48, 236, 38, 45, 92, 221, 0, 255, 3, 50, 48, 48,
           48, 243, 152, 0, 255, 7, 49, 48, 32, 50, 48, 32, 51,
           48, 161, 45, 60, 33, 166, 0, 231, 71, 151, 3, 3, 87));
      Roundtrip_Test (Test, Smaz_Original.Dictionary,
         ": : : :",
         (255, 6, 58, 32, 58, 32, 58, 32, 58));
   exception
      when Error : others => Test.Report_Exception (Error);
   end Sample_Strings_256;

   procedure Test_Validity_256 (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Test dictionary validity");
   begin
      if not Natools.Smaz_256.Is_Valid (Smaz_Original.Dictionary) then
         Test.Fail;
      end if;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Test_Validity_256;

   ------------------------------
   -- Individual Base-64 Tests --
   ------------------------------

   procedure Sample_Strings_64 (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Roundtrip on sample strings");
   begin
      Roundtrip_Test (Test, Dict_64,
         "Simple Test",
         To_SEA ("+TBGSVYA+UBQE"));
         --       <S>imp* <T>*t
      Roundtrip_Test (Test, Dict_64,
         "SiT",
         To_SEA ("/ATlGV"));
         --        <SiT>  smaller than <S>i<T> ("+TBG+UB")
      Roundtrip_Test (Test, Dict_64,
         "sIMple TEST_WITH_14_B",
         To_SEA ("D9J1EVYA8UVETR1XXlEVI9VM08lQ"));
         --       s<IM>p* <TE ST_ WIT H_1 4_B>
         --  TE   001010_10  1010_0010  00
         --  ST_  110010_10  0010_1010  11_111010
         --  WIT  111010_10  1001_0010  00_101010
         --  H_1  000100_10  1111_1010  10_001100
         --  4_B  001011_00  1111_1010  01_000010
      Roundtrip_Test (Test, Dict_64,
         "'7B_Verbatim'",
         To_SEA ("0+3IC9lVlJnYF1S0"));
         --       '<7B_Verb  >a*m'
         --  7    111011_00  0100
         --  B_V  010000_10  1111_1010  01_101010
         --  erb  101001_10  0100_1110  01_000110
         --  "erb" could have been encoded separately as "o+iB", which has
         --  the same length, but the tie is broken in favor of the longer
         --  verbatim fragment to help with corner cases.
   exception
      when Error : others => Test.Report_Exception (Error);
   end Sample_Strings_64;

   procedure Test_Validity_64 (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Test dictionary validity");
   begin
      if not Natools.Smaz_64.Is_Valid (Dict_64) then
         Test.Fail;
      end if;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Test_Validity_64;

end Natools.Smaz_Tests;

smaz_tests: add tests to fully cover non-variable-verbatim code


-----------------------------------------------------------------------
--  mat-readers-sockets -- Reader for TCP/IP sockets
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Finalization;

with Util.Streams.Sockets;
with GNAT.Sockets;
package MAT.Readers.Streams.Sockets is

   type Socket_Listener_Type is new Ada.Finalization.Limited_Controlled with private;

   --  Initialize the socket listener.
   overriding
   procedure Initialize (Listener : in out Socket_Listener_Type);

   --  Destroy the socket listener.
   overriding
   procedure Finalize (Listener : in out Socket_Listener_Type);

   --  Open the socket to accept connections and start the listener task.
   procedure Start (Listener : in out Socket_Listener_Type;
                    Address  : in GNAT.Sockets.Sock_Addr_Type);

   --  Stop the listener socket.
   procedure Stop (Listener : in out Socket_Listener_Type);

   type Socket_Reader_Type is new MAT.Readers.Streams.Stream_Reader_Type with private;
   type Socket_Reader_Type_Access is access all Socket_Reader_Type'Class;

   --  Open the socket to accept connections.
   procedure Open (Reader  : in out Socket_Reader_Type;
                   Address : in GNAT.Sockets.Sock_Addr_Type);

   procedure Close (Reader : in out Socket_Reader_Type);

private

   type Socket_Listener_Type_Access is access all Socket_Listener_Type;

   task type Socket_Listener_Task is
      entry Start (Listener : in Socket_Listener_Type_Access;
                   Address  : in GNAT.Sockets.Sock_Addr_Type);
   end Socket_Listener_Task;

   task type Socket_Reader_Task is
      entry Start (S : in Socket_Reader_Type_Access;
                   Address : in GNAT.Sockets.Sock_Addr_Type);
   end Socket_Reader_Task;

   type Socket_Reader_Type is new MAT.Readers.Streams.Stream_Reader_Type with record
      Socket : aliased Util.Streams.Sockets.Socket_Stream;
      Server : Socket_Reader_Task;
      Stop   : Boolean := False;
   end record;

   type Socket_Listener_Type is new Ada.Finalization.Limited_Controlled with record
      Accept_Selector : aliased GNAT.Sockets.Selector_Type;
      Listener        : Socket_Listener_Task;
   end record;

end MAT.Readers.Streams.Sockets;

-----------------------------------------------------------------------
--  mat-readers-sockets -- Reader for TCP/IP sockets
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Finalization;

with Util.Streams.Sockets;
with GNAT.Sockets;
package MAT.Readers.Streams.Sockets is

   type Socket_Listener_Type is new Ada.Finalization.Limited_Controlled with private;

   --  Initialize the socket listener.
   overriding
   procedure Initialize (Listener : in out Socket_Listener_Type);

   --  Destroy the socket listener.
   overriding
   procedure Finalize (Listener : in out Socket_Listener_Type);

   --  Open the socket to accept connections and start the listener task.
   procedure Start (Listener : in out Socket_Listener_Type;
                    Address  : in GNAT.Sockets.Sock_Addr_Type);

   --  Stop the listener socket.
   procedure Stop (Listener : in out Socket_Listener_Type);

   --  Create a target instance for the new client.
   procedure Create_Target (Listener : in out Socket_Listener_Type;
                            Client   : in GNAT.Sockets.Socket_Type;
                            Address  : in GNAT.Sockets.Sock_Addr_Type);

   type Socket_Reader_Type is new MAT.Readers.Streams.Stream_Reader_Type with private;
   type Socket_Reader_Type_Access is access all Socket_Reader_Type'Class;

   --  Open the socket to accept connections.
   procedure Open (Reader  : in out Socket_Reader_Type;
                   Address : in GNAT.Sockets.Sock_Addr_Type);

   procedure Close (Reader : in out Socket_Reader_Type);

private

   type Socket_Listener_Type_Access is access all Socket_Listener_Type;

   task type Socket_Listener_Task is
      entry Start (Listener : in Socket_Listener_Type_Access;
                   Address  : in GNAT.Sockets.Sock_Addr_Type);
   end Socket_Listener_Task;

   task type Socket_Reader_Task is
      entry Start (Reader  : in Socket_Reader_Type_Access;
                   Client  : in GNAT.Sockets.Socket_Type);
   end Socket_Reader_Task;

   type Socket_Reader_Type is new MAT.Readers.Streams.Stream_Reader_Type with record
      Socket : aliased Util.Streams.Sockets.Socket_Stream;
      Server : Socket_Reader_Task;
      Stop   : Boolean := False;
   end record;

   type Socket_Listener_Type is new Ada.Finalization.Limited_Controlled with record
      Accept_Selector : aliased GNAT.Sockets.Selector_Type;
      Listener        : Socket_Listener_Task;
   end record;

end MAT.Readers.Streams.Sockets;

Declare the Create_Target procedure to setup a new client reader


-----------------------------------------------------------------------
--  util-commands-tests - Test for commands
--  Copyright (C) 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with GNAT.Command_Line;
with Util.Test_Caller;
with Util.Commands.Parsers.GNAT_Parser;
with Util.Commands.Drivers;
package body Util.Commands.Tests is

   package Caller is new Util.Test_Caller (Test, "Commands");

   type Test_Context_Type is record
      Number  : Integer;
      Success : Boolean := False;
   end record;

   package Test_Command is new
     Util.Commands.Drivers (Context_Type => Test_Context_Type,
                            Config_Parser => Util.Commands.Parsers.GNAT_Parser.Config_Parser,
                            Driver_Name  => "test");

   type Test_Command_Type is new Test_Command.Command_Type with record
      Opt_Count : aliased Integer := 0;
      Opt_V     : aliased Boolean := False;
      Opt_N     : aliased Boolean := False;
      Expect_V  : Boolean := False;
      Expect_N  : Boolean := False;
      Expect_C  : Integer := 0;
      Expect_A  : Integer := 0;
      Expect_Help : Boolean := False;
   end record;

   overriding
   procedure Execute (Command   : in out Test_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Test_Context_Type);

   --  Setup the command before parsing the arguments and executing it.
   procedure Setup (Command : in out Test_Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Test_Context_Type);

   --  Write the help associated with the command.
   procedure Help (Command   : in out Test_Command_Type;
                   Context   : in out Test_Context_Type);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Execute",
                       Test_Execute'Access);
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Help",
                       Test_Help'Access);
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Usage",
                       Test_Usage'Access);
   end Add_Tests;

   overriding
   procedure Execute (Command   : in out Test_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Test_Context_Type) is
      pragma Unreferenced (Name);
   begin
      Context.Success := Command.Opt_Count = Command.Expect_C and
        Command.Opt_V = Command.Expect_V and
        Command.Opt_N = Command.Expect_N and
        Args.Get_Count = Command.Expect_A and
        not Command.Expect_Help;
   end Execute;

   --  ------------------------------
   --  Setup the command before parsing the arguments and executing it.
   --  ------------------------------
   procedure Setup (Command : in out Test_Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Test_Context_Type) is
   begin
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-c:",
                                       Long_Switch => "--count=",
                                       Help        => "Number option",
                                       Section     => "",
                                       Initial     => Integer (0),
                                       Default     => Integer (10),
                                       Output      => Command.Opt_Count'Access);
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-v",
                                       Long_Switch => "--verbose",
                                       Help        => "Verbose option",
                                       Section     => "",
                                       Output      => Command.Opt_V'Access);
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-n",
                                       Long_Switch => "--not",
                                       Help        => "Not option",
                                       Section     => "",
                                       Output      => Command.Opt_N'Access);
   end Setup;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Command   : in out Test_Command_Type;
                   Context   : in out Test_Context_Type) is

   begin
      Context.Success := Command.Expect_Help;
   end Help;

   --  ------------------------------
   --  Tests when the execution of commands.
   --  ------------------------------
   procedure Test_Execute (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);

      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_V := True;
         C1.Expect_N := True;
         C1.Expect_C := 4;
         C1.Expect_A := 2;
         Initialize (Args, "list --count=4 -v -n test titi");
         D.Execute ("list", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_V := False;
         C1.Expect_N := True;
         C1.Expect_C := 8;
         C1.Expect_A := 3;
         Initialize (Args, "list -c 8 -n test titi last");
         D.Execute ("list", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

   end Test_Execute;

   --  ------------------------------
   --  Test execution of help.
   --  ------------------------------
   procedure Test_Help (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      H     : aliased Test_Command.Help_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);
      D.Add_Command ("help", H'Unchecked_Access);
      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_Help := True;
         Initialize (Args, "help list");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

      declare
         Ctx   : Test_Context_Type;
      begin
         C2.Expect_Help := True;
         Initialize (Args, "help print");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;
   end Test_Help;

   --  ------------------------------
   --  Test usage operation.
   --  ------------------------------
   procedure Test_Usage (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      H     : aliased Test_Command.Help_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);
      D.Add_Command ("help", H'Unchecked_Access);
      Args.Initialize (Line => "cmd list");
      declare
         Ctx   : Test_Context_Type;
      begin
         D.Usage (Args, Ctx);
         C1.Expect_Help := True;
         Initialize (Args, "help list");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;
   end Test_Usage;

end Util.Commands.Tests;

-----------------------------------------------------------------------
--  util-commands-tests - Test for commands
--  Copyright (C) 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with GNAT.Command_Line;
with Util.Test_Caller;
with Util.Commands.Parsers.GNAT_Parser;
with Util.Commands.Drivers;
package body Util.Commands.Tests is

   package Caller is new Util.Test_Caller (Test, "Commands");

   type Test_Context_Type is record
      Number  : Integer;
      Success : Boolean := False;
   end record;

   package Test_Command is new
     Util.Commands.Drivers (Context_Type => Test_Context_Type,
                            Config_Parser => Util.Commands.Parsers.GNAT_Parser.Config_Parser,
                            Driver_Name  => "test");

   type Test_Command_Type is new Test_Command.Command_Type with record
      Opt_Count : aliased Integer := 0;
      Opt_V     : aliased Boolean := False;
      Opt_N     : aliased Boolean := False;
      Expect_V  : Boolean := False;
      Expect_N  : Boolean := False;
      Expect_C  : Integer := 0;
      Expect_A  : Integer := 0;
      Expect_Help : Boolean := False;
   end record;

   overriding
   procedure Execute (Command   : in out Test_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Test_Context_Type);

   --  Setup the command before parsing the arguments and executing it.
   procedure Setup (Command : in out Test_Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Test_Context_Type);

   --  Write the help associated with the command.
   procedure Help (Command   : in out Test_Command_Type;
                   Context   : in out Test_Context_Type);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Execute",
                       Test_Execute'Access);
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Help",
                       Test_Help'Access);
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Usage",
                       Test_Usage'Access);
   end Add_Tests;

   overriding
   procedure Execute (Command   : in out Test_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Test_Context_Type) is
      pragma Unreferenced (Name);
   begin
      Context.Success := Command.Opt_Count = Command.Expect_C and
        Command.Opt_V = Command.Expect_V and
        Command.Opt_N = Command.Expect_N and
        Args.Get_Count = Command.Expect_A and
        not Command.Expect_Help;
   end Execute;

   --  ------------------------------
   --  Setup the command before parsing the arguments and executing it.
   --  ------------------------------
   procedure Setup (Command : in out Test_Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Test_Context_Type) is
      pragma Unreferenced (Context);
   begin
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-c:",
                                       Long_Switch => "--count=",
                                       Help        => "Number option",
                                       Section     => "",
                                       Initial     => Integer (0),
                                       Default     => Integer (10),
                                       Output      => Command.Opt_Count'Access);
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-v",
                                       Long_Switch => "--verbose",
                                       Help        => "Verbose option",
                                       Section     => "",
                                       Output      => Command.Opt_V'Access);
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-n",
                                       Long_Switch => "--not",
                                       Help        => "Not option",
                                       Section     => "",
                                       Output      => Command.Opt_N'Access);
   end Setup;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Command   : in out Test_Command_Type;
                   Context   : in out Test_Context_Type) is

   begin
      Context.Success := Command.Expect_Help;
   end Help;

   --  ------------------------------
   --  Tests when the execution of commands.
   --  ------------------------------
   procedure Test_Execute (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);

      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_V := True;
         C1.Expect_N := True;
         C1.Expect_C := 4;
         C1.Expect_A := 2;
         Initialize (Args, "list --count=4 -v -n test titi");
         D.Execute ("list", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_V := False;
         C1.Expect_N := True;
         C1.Expect_C := 8;
         C1.Expect_A := 3;
         Initialize (Args, "list -c 8 -n test titi last");
         D.Execute ("list", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

   end Test_Execute;

   --  ------------------------------
   --  Test execution of help.
   --  ------------------------------
   procedure Test_Help (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      H     : aliased Test_Command.Help_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);
      D.Add_Command ("help", H'Unchecked_Access);
      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_Help := True;
         Initialize (Args, "help list");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

      declare
         Ctx   : Test_Context_Type;
      begin
         C2.Expect_Help := True;
         Initialize (Args, "help print");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;
   end Test_Help;

   --  ------------------------------
   --  Test usage operation.
   --  ------------------------------
   procedure Test_Usage (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      H     : aliased Test_Command.Help_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);
      D.Add_Command ("help", H'Unchecked_Access);
      Args.Initialize (Line => "cmd list");
      declare
         Ctx   : Test_Context_Type;
      begin
         D.Usage (Args, Ctx);
         C1.Expect_Help := True;
         Initialize (Args, "help list");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;
   end Test_Usage;

end Util.Commands.Tests;

Fix compilation warning, unused Context parameter


-----------------------------------------------------------------------
--  awa-storages-modules -- Storage management module
--  Copyright (C) 2012 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with ASF.Applications;

with AWA.Modules;
with AWA.Storages.Services;
with AWA.Storages.Servlets;

--  == Storage Module ==
--  The <tt>Storage_Module</tt> type represents the storage module.  An instance of the storage
--  module must be declared and registered when the application is created and initialized.
--  The storage module is associated with the storage service which provides and implements
--  the storage management operations.
package AWA.Storages.Modules is

   NAME : constant String := "storages";

   type Storage_Module is new AWA.Modules.Module with private;
   type Storage_Module_Access is access all Storage_Module'Class;

   --  Initialize the storage module.
   overriding
   procedure Initialize (Plugin : in out Storage_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Get the storage manager.
   function Get_Storage_Manager (Plugin : in Storage_Module)
                                 return Services.Storage_Service_Access;

   --  Create a storage manager.  This operation can be overridden to provide another
   --  storage service implementation.
   function Create_Storage_Manager (Plugin : in Storage_Module)
                                    return Services.Storage_Service_Access;

   --  Get the storage module instance associated with the current application.
   function Get_Storage_Module return Storage_Module_Access;

   --  Get the storage manager instance associated with the current application.
   function Get_Storage_Manager return Services.Storage_Service_Access;

private

   type Storage_Module is new AWA.Modules.Module with record
      Manager         : Services.Storage_Service_Access := null;
      Storage_Servlet : aliased AWA.Storages.Servlets.Storage_Servlet;
   end record;

end AWA.Storages.Modules;

Fix compilation warning

Fix compilation warning


-----------------------------------------------------------------------
--  asf.servlets -- ASF Servlets
--  Copyright (C) 2010, 2011, 2012, 2013, 2015, 2016, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with ASF.Requests;
with ASF.Responses;
with ASF.Sessions;
with ASF.Sessions.Factory;
with ASF.Routes;
limited with ASF.Filters;

with Ada.Finalization;
with Ada.Strings.Unbounded;
with Ada.Strings.Hash;
with Ada.Calendar;
with Ada.Exceptions;

with Util.Log;
with Util.Properties;
with Util.Strings.Vectors;

with EL.Contexts;

private with Ada.Containers.Indefinite_Hashed_Maps;

--  The ASF.Servlets package implements a subset of the
--  Java Servlet Specification adapted for the Ada language.
--
--  The rationale for this implementation is to provide a set of
--  interfaces and ways of developing a Web application which
--  benefit from the architecture expertise defined in Java applications.
--
--  The ASF.Servlets, ASF.Requests, ASF.Responses
--  and ASF.Sessions packages are independent of the web server
--  which will be used (such as AWS, Apache or Lighthttpd).
--
package ASF.Servlets is

   Servlet_Error : exception;

   --  Filter chain as defined by JSR 315 6. Filtering
   type Filter_Chain is limited private;
   type Filter_Config is private;

   type Filter_Access is access all ASF.Filters.Filter'Class;
   type Filter_List_Access is access all ASF.Filters.Filter_List;

   --  Causes the next filter in the chain to be invoked, or if the calling
   --  filter is the last filter in the chain, causes the resource at the end
   --  of the chain to be invoked.
   procedure Do_Filter (Chain    : in out Filter_Chain;
                        Request  : in out Requests.Request'Class;
                        Response : in out Responses.Response'Class);

   --  Get the filter name.
   function Get_Filter_Name (Config : in Filter_Config) return String;

   --  Returns a String containing the value of the named context-wide initialization
   --  parameter, or the default value if the parameter does not exist.
   --
   --  The filter parameter name is automatically prefixed by the filter name followed by '.'.
   function Get_Init_Parameter (Config  : in Filter_Config;
                                Name    : in String;
                                Default : in String := "") return String;
   function Get_Init_Parameter (Config : in Filter_Config;
                                Name    : in String;
                                Default : in String := "")
                                return Ada.Strings.Unbounded.Unbounded_String;

   --  type Servlet_Registry;
   type Servlet_Registry is new ASF.Sessions.Factory.Session_Factory with private;

   type Servlet_Registry_Access is access all Servlet_Registry'Class;

   --  Get the servlet context associated with the filter chain.
   function Get_Servlet_Context (Chain : in Filter_Chain) return Servlet_Registry_Access;

   --  Get the servlet context associated with the filter config.
   function Get_Servlet_Context (Config : in Filter_Config) return Servlet_Registry_Access;

   --  The Servlet represents the component that will handle
   --  an HTTP request received by the server.
   --
   --  JSR 315 - 2. The Servlet Interface
   type Servlet is tagged limited private;
   type Servlet_Access is access all Servlet'Class;

   --  Get the servlet name.
   function Get_Name (Server : in Servlet) return String;

   --  Get the servlet context associated with this servlet.
   function Get_Servlet_Context (Server : in Servlet) return Servlet_Registry_Access;

   --  Called by the servlet container to indicate to a servlet that the servlet
   --  is being placed into service.
   --  not overriding
   procedure Initialize (Server  : in out Servlet;
                         Context : in Servlet_Registry'Class);

   --  Receives standard HTTP requests from the public service method and dispatches
   --  them to the Do_XXX methods defined in this class. This method is an HTTP-specific
   --  version of the Servlet.service(Request, Response) method. There's no need
   --  to override this method.
   procedure Service (Server   : in Servlet;
                      Request  : in out Requests.Request'Class;
                      Response : in out Responses.Response'Class);

   --  Returns the time the Request object was last modified, in milliseconds since
   --  midnight January 1, 1970 GMT.  If the time is unknown, this method returns
   --  a negative number (the default).
   --
   --  Servlets that support HTTP GET requests and can quickly determine their
   --  last modification time should override this method. This makes browser and
   --  proxy caches work more effectively, reducing the load on server and network
   --  resources.
   function Get_Last_Modified (Server  : in Servlet;
                               Request : in Requests.Request'Class)
                               return Ada.Calendar.Time;

   --  Called by the server (via the service method) to allow a servlet to handle
   --  a GET request.
   --
   --  Overriding this method to support a GET request also automatically supports
   --  an HTTP HEAD request. A HEAD request is a GET request that returns no body
   --  in the response, only the request header fields.
   --
   --  When overriding this method, read the request data, write the response headers,
   --  get the response's writer or output stream object, and finally, write the
   --  response data. It's best to include content type and encoding.
   --  When using a PrintWriter object to return the response, set the content type
   --  before accessing the PrintWriter object.
   --
   --  The servlet container must write the headers before committing the response,
   --  because in HTTP the headers must be sent before the response body.
   --
   --  Where possible, set the Content-Length header (with the
   --  Response.Set_Content_Length method), to allow the servlet container
   --  to use a persistent connection to return its response to the client,
   --  improving performance. The content length is automatically set if the entire
   --  response fits inside the response buffer.
   --
   --  When using HTTP 1.1 chunked encoding (which means that the response has a
   --  Transfer-Encoding header), do not set the Content-Length header.
   --
   --  The GET method should be safe, that is, without any side effects for which
   --  users are held responsible. For example, most form queries have no side effects.
   --  If a client request is intended to change stored data, the request should use
   --  some other HTTP method.
   --
   --  The GET method should also be idempotent, meaning that it can be safely repeated.
   --  Sometimes making a method safe also makes it idempotent. For example, repeating
   --  queries is both safe and idempotent, but buying a product online or modifying
   --  data is neither safe nor idempotent.
   --
   --  If the request is incorrectly formatted, Do_Get  returns an HTTP "Bad Request"
   procedure Do_Get (Server   : in Servlet;
                     Request  : in out Requests.Request'Class;
                     Response : in out Responses.Response'Class);

   --  Receives an HTTP HEAD request from the protected service method and handles
   --  the request. The client sends a HEAD request when it wants to see only the
   --  headers of a response, such as Content-Type or Content-Length. The HTTP HEAD
   --  method counts the output bytes in the response to set the Content-Length header
   --  accurately.
   --
   --  If you override this method, you can avoid computing the response body and just
   --  set the response headers directly to improve performance. Make sure that the
   --  Do_Head method you write is both safe and idempotent (that is, protects itself
   --  from being called multiple times for one HTTP HEAD request).
   --
   --  If the HTTP HEAD request is incorrectly formatted, doHead returns an HTTP
   --  "Bad Request" message.
   procedure Do_Head (Server   : in Servlet;
                      Request  : in out Requests.Request'Class;
                      Response : in out Responses.Response'Class);

   --  Called by the server (via the service method) to allow a servlet to handle
   --  a POST request. The HTTP POST method allows the client to send data of unlimited
   --  length to the Web server a single time and is useful when posting information
   --  such as credit card numbers.
   --
   --  When overriding this method, read the request data, write the response headers,
   --  get the response's writer or output stream object, and finally, write the
   --  response data. It's best to include content type and encoding. When using
   --  a PrintWriter object to return the response, set the content type before
   --  accessing the PrintWriter object.
   --
   --  The servlet container must write the headers before committing the response,
   --  because in HTTP the headers must be sent before the response body.
   --
   --  Where possible, set the Content-Length header (with the
   --  Response.Set_Content_Length method), to allow the servlet container to use
   --  a persistent connection to return its response to the client, improving
   --  performance. The content length is automatically set if the entire response
   --  fits inside the response buffer.
   --
   --  When using HTTP 1.1 chunked encoding (which means that the response has a
   --  Transfer-Encoding header), do not set the Content-Length header.
   --
   --  This method does not need to be either safe or idempotent. Operations
   --  requested through POST can have side effects for which the user can be held
   --  accountable, for example, updating stored data or buying items online.
   --
   --  If the HTTP POST request is incorrectly formatted, doPost returns
   --  an HTTP "Bad Request" message.
   procedure Do_Post (Server   : in Servlet;
                      Request  : in out Requests.Request'Class;
                      Response : in out Responses.Response'Class);

   --  Called by the server (via the service method) to allow a servlet to handle
   --  a PUT request. The PUT operation allows a client to place a file on the server
   --  and is similar to sending a file by FTP.
   --
   --  When overriding this method, leave intact any content headers sent with
   --  the request (including Content-Length, Content-Type, Content-Transfer-Encoding,
   --  Content-Encoding, Content-Base, Content-Language, Content-Location,
   --  Content-MD5, and Content-Range). If your method cannot handle a content
   --  header, it must issue an error message (HTTP 501 - Not Implemented) and
   --  discard the request. For more information on HTTP 1.1, see RFC 2616 .
   --
   --  This method does not need to be either safe or idempotent. Operations that
   --  Do_Put performs can have side effects for which the user can be held accountable.
   --  When using this method, it may be useful to save a copy of the affected URL
   --  in temporary storage.
   --
   --  If the HTTP PUT request is incorrectly formatted, Do_Put returns
   --  an HTTP "Bad Request" message.
   procedure Do_Put (Server   : in Servlet;
                     Request  : in out Requests.Request'Class;
                     Response : in out Responses.Response'Class);

   --  Called by the server (via the service method) to allow a servlet to handle
   --  a DELETE request. The DELETE operation allows a client to remove a document
   --  or Web page from the server.
   --
   --  This method does not need to be either safe or idempotent. Operations requested
   --  through DELETE can have side effects for which users can be held accountable.
   --  When using this method, it may be useful to save a copy of the affected URL in
   --  temporary storage.
   --
   --  If the HTTP DELETE request is incorrectly formatted, Do_Delete returns an HTTP
   --  "Bad Request" message.
   procedure Do_Delete (Server   : in Servlet;
                        Request  : in out Requests.Request'Class;
                        Response : in out Responses.Response'Class);

   --  Called by the server (via the service method) to allow a servlet to handle a
   --  OPTIONS request. The OPTIONS request determines which HTTP methods the server
   --  supports and returns an appropriate header. For example, if a servlet overrides
   --  Do_Get, this method returns the following header:
   --
   --  Allow: GET, HEAD, TRACE, OPTIONS
   --
   --  There's no need to override this method unless the servlet implements new
   --  HTTP methods, beyond those implemented by HTTP 1.1.
   procedure Do_Options (Server   : in Servlet;
                         Request  : in out Requests.Request'Class;
                         Response : in out Responses.Response'Class);

   --  Called by the server (via the service method) to allow a servlet to handle
   --  a TRACE request. A TRACE returns the headers sent with the TRACE request to
   --  the client, so that they can be used in debugging. There's no need to override
   --  this method.
   procedure Do_Trace (Server   : in Servlet;
                       Request  : in out Requests.Request'Class;
                       Response : in out Responses.Response'Class);

   --  JSR 315 9. Dispatching Requests
   type Request_Dispatcher is limited private;

   --  Forwards a request from a servlet to another resource
   --  (servlet, or HTML file) on the server. This method allows one servlet to do
   --  preliminary processing of a request and another resource to generate the response.
   --
   --  For a Request_Dispatcher obtained via Get_Request_Dispatcher(),
   --  the ServletRequest  object has its path elements and parameters adjusted
   --  to match the path of the target resource.
   --
   --  forward should be called before the response has been committed to the
   --  client (before response body output has been flushed). If the response
   --  already has been committed, this method throws an IllegalStateException.
   --  Uncommitted output in the response buffer is automatically cleared before
   --  the forward.
   --
   --  The request and response parameters must be either the same objects as were
   --  passed to the calling servlet's service method or be subclasses of the
   --  RequestWrapper or ResponseWrapper  classes that wrap them.
   procedure Forward (Dispatcher : in Request_Dispatcher;
                      Request    : in out Requests.Request'Class;
                      Response   : in out Responses.Response'Class);

   --  Includes the content of a resource (servlet, or, HTML file) in the response.
   --  In essence, this method enables programmatic server-side includes.
   --
   --  The Response object has its path elements and parameters remain
   --  unchanged from the caller's. The included servlet cannot change the response
   --  status code or set headers; any attempt to make a change is ignored.
   --
   --  The request and response parameters must be either the same objects as were
   --  passed to the calling servlet's service method or be subclasses of the
   --  RequestWrapper or ResponseWrapper  classes that wrap them.
   procedure Include (Dispatcher : in Request_Dispatcher;
                      Request    : in out Requests.Request'Class;
                      Response   : in out Responses.Response'Class);

   --  Returns the servlet that will be called when forwarding the request.
   function Get_Servlet (Dispatcher : in Request_Dispatcher) return Servlet_Access;

   --  Returns a Request_Dispatcher object that acts as a wrapper for the resource
   --  located at the given path.  A Request_Dispatcher  object can be used to forward
   --  a request to the resource or to include the resource in a response.
   --  The resource can be dynamic or static.
   function Get_Request_Dispatcher (Context : in Servlet_Registry;
                                    Path    : in String)
                                    return Request_Dispatcher;

   --  Returns a Request_Dispatcher object that acts as a wrapper for the named servlet.
   --
   --  Servlets may be given names via server administration or via a web application
   --  deployment descriptor.  A servlet instance can determine its name using
   --  ServletConfig.getServletName().
   function Get_Name_Dispatcher (Context : in Servlet_Registry;
                                 Name    : in String)
                                 return Request_Dispatcher;

   --  Returns the context path of the web application.
   --  The context path is the portion of the request URI that is used to select the context
   --  of the request.  The context path always comes first in a request URI.  The path starts
   --  with a "/" character but does not end with a "/" character. For servlets in the default
   --  (root) context, this method returns "".
   function Get_Context_Path (Context : in Servlet_Registry) return String;

   --  Returns a String containing the value of the named context-wide initialization
   --  parameter, or null if the parameter does not exist.
   --
   --  This method can make available configuration information useful to an entire
   --  "web application". For example, it can provide a webmaster's email address
   --  or the name of a system that holds critical data.
   function Get_Init_Parameter (Context : in Servlet_Registry;
                                Name    : in String;
                                Default : in String := "") return String;
   function Get_Init_Parameter (Context : in Servlet_Registry;
                                Name    : in String;
                                Default : in String := "")
                                return Ada.Strings.Unbounded.Unbounded_String;

   --  Set the init parameter identified by Name to the value Value.
   procedure Set_Init_Parameter (Context : in out Servlet_Registry;
                                 Name    : in String;
                                 Value   : in String);

   --  Set the init parameters by copying the properties defined in Params.
   --  Existing parameters will be overriding by the new values.
   procedure Set_Init_Parameters (Context : in out Servlet_Registry;
                                  Params  : in Util.Properties.Manager'Class);

   --  Get access to the init parameters.
   procedure Get_Init_Parameters (Context : in Servlet_Registry;
                                  Process : not null access
                                    procedure (Params : in Util.Properties.Manager'Class));

   --  Returns the absolute path of the resource identified by the given relative path.
   --  The resource is searched in a list of directories configured by the application.
   --  The path must begin with a "/" and is interpreted as relative to the current
   --  context root.
   --
   --  This method allows the servlet container to make a resource available to
   --  servlets from any source.
   --
   --  This method returns an empty string if the resource could not be localized.
   function Get_Resource (Context : in Servlet_Registry;
                          Path    : in String) return String;

   --  Registers the given servlet instance with this ServletContext under
   --  the given servletName.
   --
   --  If this ServletContext already contains a preliminary
   --  ServletRegistration for a servlet with the given servletName,
   --  it will be completed (by assigning the class name of the given
   --  servlet instance to it) and returned.
   procedure Add_Servlet (Registry : in out Servlet_Registry;
                          Name     : in String;
                          Server   : in Servlet_Access);

   --  Registers the given filter instance with this Servlet context.
   procedure Add_Filter (Registry : in out Servlet_Registry;
                         Name     : in String;
                         Filter   : in Filter_Access);

   procedure Add_Filter (Registry : in out Servlet_Registry;
                         Target   : in String;
                         Name     : in String);

   --  Add a filter mapping with the given pattern
   --  If the URL pattern is already mapped to a different servlet,
   --  no updates will be performed.
   procedure Add_Filter_Mapping (Registry : in out Servlet_Registry;
                                 Pattern  : in String;
                                 Name     : in String);

   --  Add a servlet mapping with the given pattern
   --  If the URL pattern is already mapped to a different servlet,
   --  no updates will be performed.
   procedure Add_Mapping (Registry : in out Servlet_Registry;
                          Pattern  : in String;
                          Name     : in String);

   --  Add a servlet mapping with the given pattern
   --  If the URL pattern is already mapped to a different servlet,
   --  no updates will be performed.
   procedure Add_Mapping (Registry : in out Servlet_Registry;
                          Pattern  : in String;
                          Server   : in Servlet_Access);

   --  Add a route associated with the given path pattern.  The pattern is split into components.
   --  Some path components can be a fixed string (/home) and others can be variable.
   --  When a path component is variable, the value can be retrieved from the route context.
   --  Once the route path is created, the <tt>Process</tt> procedure is called with the route
   --  reference.
   procedure Add_Route (Registry  : in out Servlet_Registry;
                        Pattern   : in String;
                        ELContext : in EL.Contexts.ELContext'Class;
                        Process   : not null access
                          procedure (Route : in out ASF.Routes.Route_Type_Ref));

   --  Set the error page that will be used if a servlet returns an error.
   procedure Set_Error_Page (Server : in out Servlet_Registry;
                             Error  : in Integer;
                             Page   : in String);

   --  Send the error page content defined by the response status.
   procedure Send_Error_Page (Server   : in Servlet_Registry;
                              Request  : in out Requests.Request'Class;
                              Response : in out Responses.Response'Class);

   --  Report an error when an exception occurred while processing the request.
   procedure Error (Registry : in Servlet_Registry;
                    Request  : in out Requests.Request'Class;
                    Response : in out Responses.Response'Class;
                    Ex       : in Ada.Exceptions.Exception_Occurrence);

   --  Register the application represented by Registry under the base URI defined
   --  by URI.  This is called by the Web container when the application is registered.
   --  The default implementation keeps track of the base URI to implement the context path
   --  operation.
   procedure Register_Application (Registry : in out Servlet_Registry;
                                   URI      : in String);

   --  Start the application.
   procedure Start (Registry : in out Servlet_Registry);

   --  Finalize the servlet registry releasing the internal mappings.
   overriding
   procedure Finalize (Registry : in out Servlet_Registry);

   --  Dump the routes and filter configuration in the log with the given log level.
   procedure Dump_Routes (Registry : in out Servlet_Registry;
                          Level    : in Util.Log.Level_Type);

private

   use Ada.Strings.Unbounded;

   --  Find the servlet and filter mapping that must be used for the given URI.
   --  Search the mapping according to Ch 12/SRV 11. Mapping Requests to Servlets:
   --  o look for an exact match,
   --  o look for the longest match,
   --  o look for an extension
   --  o use the default servlet mapping
--     function Find_Mapping (Registry : in Servlet_Registry;
--                            URI      : in String) return Mapping_Access;

   type Filter_Chain is limited record
      Filter_Pos : Natural;
      Filters    : Filter_List_Access;
      Servlet    : Servlet_Access;
   end record;

   type Request_Dispatcher is limited record
      Context : aliased ASF.Routes.Route_Context_Type;
      Filters : Filter_List_Access;
      Servlet : Servlet_Access := null;
      Pos     : Natural := 0;
   end record;

   type Servlet is new Ada.Finalization.Limited_Controlled with record
      Name      : Unbounded_String;
      Context   : Servlet_Registry_Access := null;
   end record;

   package Filter_Maps is new
     Ada.Containers.Indefinite_Hashed_Maps (Key_Type     => String,
                                            Element_Type => Filter_Access,
                                            Hash         => Ada.Strings.Hash,
                                            Equivalent_Keys => "=");

   package Filter_List_Maps is new
     Ada.Containers.Indefinite_Hashed_Maps (Key_Type     => String,
                                            Element_Type => Filter_List_Access,
                                            Hash         => Ada.Strings.Hash,
                                            Equivalent_Keys => "=");

   package Servlet_Maps is new
     Ada.Containers.Indefinite_Hashed_Maps (Key_Type     => String,
                                            Element_Type => Servlet_Access,
                                            Hash         => Ada.Strings.Hash,
                                            Equivalent_Keys => "=");

   function Hash (N : Integer) return Ada.Containers.Hash_Type;

   package Error_Maps is new
     Ada.Containers.Indefinite_Hashed_Maps (Key_Type            => Integer,
                                            Element_Type        => String,
                                            Hash                => Hash,
                                            Equivalent_Keys     => "=");

   type Servlet_Registry is new ASF.Sessions.Factory.Session_Factory with record
      Config            : Util.Properties.Manager;
      Servlets          : Servlet_Maps.Map;
      Filters           : Filter_Maps.Map;
      Filter_Rules      : Filter_List_Maps.Map;
      Filter_Patterns   : Util.Strings.Vectors.Vector;
      Error_Pages       : Error_Maps.Map;
      Context_Path      : Unbounded_String;
      Routes            : ASF.Routes.Router_Type;
   end record;

   --  Install the servlet filters after all the mappings have been registered.
   procedure Install_Filters (Registry : in out Servlet_Registry);

   type Filter_Config is record
      Name      : Unbounded_String;
      Context   : Servlet_Registry_Access := null;
   end record;

end ASF.Servlets;

-----------------------------------------------------------------------
--  asf.servlets -- ASF Servlets
--  Copyright (C) 2010, 2011, 2012, 2013, 2015, 2016, 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Servlet.Core;
with Servlet.Requests;
with Servlet.Responses;
package ASF.Servlets is

   subtype Servlet_Access is Servlet.Core.Servlet_Access;
   subtype Servlet_Registry is Servlet.Core.Servlet_Registry;
   subtype Servlet_Registry_Access is Servlet.Core.Servlet_Registry_Access;
   subtype Request_Dispatcher is Servlet.Core.Request_Dispatcher;
   subtype Filter_Config is Servlet.Core.Filter_Config;
   subtype Filter_Chain is Servlet.Core.Filter_Chain;

   --  Get the servlet context associated with the filter chain.
   function Get_Servlet_Context (Chain : in Filter_Chain) return Servlet_Registry_Access
     renames Servlet.Core.Get_Servlet_Context;

   --  Causes the next filter in the chain to be invoked, or if the calling
   --  filter is the last filter in the chain, causes the resource at the end
   --  of the chain to be invoked.
   procedure Do_Filter (Chain    : in out Filter_Chain;
                        Request  : in out Servlet.Requests.Request'Class;
                        Response : in out Servlet.Responses.Response'Class)
                        renames Servlet.Core.Do_Filter;

   function Get_Init_Parameter (Config  : in Filter_Config;
                                Name    : in String;
                                Default : in String := "") return String
                                renames Servlet.Core.Get_Init_Parameter;
   function Get_Init_Parameter (Config : in Filter_Config;
                                Name    : in String;
                                Default : in String := "")
                                return Ada.Strings.Unbounded.Unbounded_String
                                renames Servlet.Core.Get_Init_Parameter;
   function Get_Init_Parameter (Context : in Servlet_Registry;
                                Name    : in String;
                                Default : in String := "") return String
                                renames Servlet.Core.Get_Init_Parameter;
   function Get_Init_Parameter (Context : in Servlet_Registry;
                                Name    : in String;
                                Default : in String := "")
                                return Ada.Strings.Unbounded.Unbounded_String
                                renames Servlet.Core.Get_Init_Parameter;

end ASF.Servlets;

Package ASF.Servlets moved to Servlet.Core