-----------------------------------------------------------------------
--  bkp-files -- File and directories
--  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.Calendar;
with Ada.Strings.Unbounded;
with Util.Encoders.SHA1;
with ADO;
package Babel.Files is

   NO_IDENTIFIER : constant ADO.Identifier := ADO.NO_IDENTIFIER;

   subtype File_Identifier is ADO.Identifier;
   subtype Directory_Identifier is ADO.Identifier;
   subtype File_Size is Long_Long_Integer;
   type File_Mode is mod 2**16;
   type Uid_Type is mod 2**16;
   type Gid_Type is mod 2**16;

   type File_Type is private;
   type File_Type_Array is array (Positive range <>) of File_Type;
   type File_Type_Array_Access is access all File_Type_Array;

   type Directory_Type is private;
   type Directory_Type_Array is array (Positive range <>) of Directory_Type;
   type Directory_Type_Array_Access is access all Directory_Type_Array;

   NO_DIRECTORY : constant Directory_Type;
   NO_FILE      : constant File_Type;

   type Status_Type is mod 2**16;

   --  The file was modified.
   FILE_MODIFIED : constant Status_Type := 16#0001#;

   --  There was some error while processing this file.
   FILE_ERROR    : constant Status_Type := 16#8000#;

   --  The SHA1 signature for the file is known and valid.
   FILE_HAS_SHA1 : constant Status_Type := 16#0002#;

   --  Allocate a File_Type entry with the given name for the directory.
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return File_Type;

   --  Allocate a Directory_Type entry with the given name for the directory.
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return Directory_Type;

   type File (Len : Positive) is record
      Id     : File_Identifier := NO_IDENTIFIER;
      Size   : File_Size       := 0;
      Dir    : Directory_Type  := NO_DIRECTORY;
      Mode   : File_Mode       := 8#644#;
      User   : Uid_Type        := 0;
      Group  : Gid_Type        := 0;
      Status : Status_Type     := 0;
      Date   : Ada.Calendar.Time;
      SHA1   : Util.Encoders.SHA1.Hash_Array;
      Name   : aliased String (1 .. Len);
   end record;

   --  Return true if the file was modified and need a backup.
   function Is_Modified (Element : in File_Type) return Boolean;

   --  Set the file as modified.
   procedure Set_Modified (Element : in File_Type);

   --  Set the SHA1 signature that was computed for this file.
   --  If the computed signature is different from the current signature,
   --  the FILE_MODIFIED flag is set on the file.  The FILE_HAS_SHA1 flag
   --  is set on the file.
   procedure Set_Signature (Element   : in File_Type;
                            Signature : in Util.Encoders.SHA1.Hash_Array);

   --  Set the file size.  If the new size is different, the FILE_MODIFIED
   --  flag is set on the file.
   procedure Set_Size (Element : in File_Type;
                       Size    : in File_Size);

   --  Return the path for the file.
   function Get_Path (Element : in File_Type) return String;

   --  Return the path for the directory.
   function Get_Path (Element : in Directory_Type) return String;

   --  Return the SHA1 signature computed for the file.
   function Get_SHA1 (Element : in File_Type) return String;

   type File_Container is limited interface;

   --  Add the file with the given name in the container.
   procedure Add_File (Into    : in out File_Container;
                       Element : in File_Type) is abstract;

   --  Add the directory with the given name in the container.
   procedure Add_Directory (Into    : in out File_Container;
                            Element : in Directory_Type) is abstract;

   --  Create a new file instance with the given name in the container.
   function Create (Into : in File_Container;
                    Name : in String) return File_Type is abstract;

   --  Create a new directory instance with the given name in the container.
   function Create (Into : in File_Container;
                    Name : in String) return Directory_Type is abstract;

   --  Find the file with the given name in this file container.
   --  Returns NO_FILE if the file was not found.
   function Find (From : in File_Container;
                  Name : in String) return File_Type is abstract;

   --  Find the directory with the given name in this file container.
   --  Returns NO_DIRECTORY if the directory was not found.
   function Find (From : in File_Container;
                  Name : in String) return Directory_Type is abstract;

   type Default_Container is new File_Container with private;

   --  Add the file with the given name in the container.
   procedure Add_File (Into    : in out Default_Container;
                       Element : in File_Type);

   --  Add the directory with the given name in the container.
   procedure Add_Directory (Into    : in out Default_Container;
                            Element : in Directory_Type);

   --  Create a new file instance with the given name in the container.
   function Create (Into : in Default_Container;
                    Name : in String) return File_Type;

   --  Create a new directory instance with the given name in the container.
   function Create (Into : in Default_Container;
                    Name : in String) return Directory_Type;

   --  Find the file with the given name in this file container.
   --  Returns NO_FILE if the file was not found.
   function Find (From : in Default_Container;
                  Name : in String) return File_Type;

   --  Find the directory with the given name in this file container.
   --  Returns NO_DIRECTORY if the directory was not found.
   function Find (From : in Default_Container;
                  Name : in String) return Directory_Type;

private

   type Directory (Len : Positive) is record
      Id       : Directory_Identifier := NO_IDENTIFIER;
      Parent   : Directory_Type;
      Mode     : File_Mode := 8#755#;
      User     : Uid_Type  := 0;
      Group    : Gid_Type  := 0;
      Files    : File_Type_Array_Access;
      Children : Directory_Type_Array_Access;
      Path     : Ada.Strings.Unbounded.Unbounded_String;
      Name     : aliased String (1 .. Len);
   end record;

   type File_Type is access all File;

   type Directory_Type is access all Directory;

   type Default_Container is new Babel.Files.File_Container with record
      Current : Directory_Type;
   end record;

   NO_DIRECTORY : constant Directory_Type := null;
   NO_FILE      : constant File_Type := null;

end Babel.Files;

-----------------------------------------------------------------------
--  bkp-files -- File and directories
--  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.Calendar;
with Ada.Strings.Unbounded;
with Util.Encoders.SHA1;
with ADO;
package Babel.Files is

   NO_IDENTIFIER : constant ADO.Identifier := ADO.NO_IDENTIFIER;

   subtype File_Identifier is ADO.Identifier;
   subtype Directory_Identifier is ADO.Identifier;
   subtype File_Size is Long_Long_Integer;
   type File_Mode is mod 2**16;
   type Uid_Type is mod 2**16;
   type Gid_Type is mod 2**16;

   type File_Type is private;
   type File_Type_Array is array (Positive range <>) of File_Type;
   type File_Type_Array_Access is access all File_Type_Array;

   type Directory_Type is private;
   type Directory_Type_Array is array (Positive range <>) of Directory_Type;
   type Directory_Type_Array_Access is access all Directory_Type_Array;

   NO_DIRECTORY : constant Directory_Type;
   NO_FILE      : constant File_Type;

   type Status_Type is mod 2**16;

   --  The file was modified.
   FILE_MODIFIED : constant Status_Type := 16#0001#;

   --  There was some error while processing this file.
   FILE_ERROR    : constant Status_Type := 16#8000#;

   --  The SHA1 signature for the file is known and valid.
   FILE_HAS_SHA1 : constant Status_Type := 16#0002#;

   --  Allocate a File_Type entry with the given name for the directory.
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return File_Type;

   --  Allocate a Directory_Type entry with the given name for the directory.
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return Directory_Type;

   type File (Len : Positive) is record
      Id     : File_Identifier := NO_IDENTIFIER;
      Size   : File_Size       := 0;
      Dir    : Directory_Type  := NO_DIRECTORY;
      Mode   : File_Mode       := 8#644#;
      User   : Uid_Type        := 0;
      Group  : Gid_Type        := 0;
      Status : Status_Type     := 0;
      Date   : Ada.Calendar.Time;
      SHA1   : Util.Encoders.SHA1.Hash_Array;
      Name   : aliased String (1 .. Len);
   end record;

   --  Return true if the file was modified and need a backup.
   function Is_Modified (Element : in File_Type) return Boolean;

   --  Set the file as modified.
   procedure Set_Modified (Element : in File_Type);

   --  Set the SHA1 signature that was computed for this file.
   --  If the computed signature is different from the current signature,
   --  the FILE_MODIFIED flag is set on the file.  The FILE_HAS_SHA1 flag
   --  is set on the file.
   procedure Set_Signature (Element   : in File_Type;
                            Signature : in Util.Encoders.SHA1.Hash_Array);

   --  Set the file size.  If the new size is different, the FILE_MODIFIED
   --  flag is set on the file.
   procedure Set_Size (Element : in File_Type;
                       Size    : in File_Size);

   --  Return the path for the file.
   function Get_Path (Element : in File_Type) return String;

   --  Return the path for the directory.
   function Get_Path (Element : in Directory_Type) return String;

   --  Return the SHA1 signature computed for the file.
   function Get_SHA1 (Element : in File_Type) return String;

   type File_Container is limited interface;

   --  Add the file with the given name in the container.
   procedure Add_File (Into    : in out File_Container;
                       Element : in File_Type) is abstract;

   --  Add the directory with the given name in the container.
   procedure Add_Directory (Into    : in out File_Container;
                            Element : in Directory_Type) is abstract;

   --  Create a new file instance with the given name in the container.
   function Create (Into : in File_Container;
                    Name : in String) return File_Type is abstract;

   --  Create a new directory instance with the given name in the container.
   function Create (Into : in File_Container;
                    Name : in String) return Directory_Type is abstract;

   --  Find the file with the given name in this file container.
   --  Returns NO_FILE if the file was not found.
   function Find (From : in File_Container;
                  Name : in String) return File_Type is abstract;

   --  Find the directory with the given name in this file container.
   --  Returns NO_DIRECTORY if the directory was not found.
   function Find (From : in File_Container;
                  Name : in String) return Directory_Type is abstract;

   type Default_Container is new File_Container with private;

   --  Add the file with the given name in the container.
   overriding
   procedure Add_File (Into    : in out Default_Container;
                       Element : in File_Type);

   --  Add the directory with the given name in the container.
   overriding
   procedure Add_Directory (Into    : in out Default_Container;
                            Element : in Directory_Type);

   --  Create a new file instance with the given name in the container.
   overriding
   function Create (Into : in Default_Container;
                    Name : in String) return File_Type;

   --  Create a new directory instance with the given name in the container.
   overriding
   function Create (Into : in Default_Container;
                    Name : in String) return Directory_Type;

   --  Find the file with the given name in this file container.
   --  Returns NO_FILE if the file was not found.
   overriding
   function Find (From : in Default_Container;
                  Name : in String) return File_Type;

   --  Find the directory with the given name in this file container.
   --  Returns NO_DIRECTORY if the directory was not found.
   overriding
   function Find (From : in Default_Container;
                  Name : in String) return Directory_Type;

private

   type Directory (Len : Positive) is record
      Id       : Directory_Identifier := NO_IDENTIFIER;
      Parent   : Directory_Type;
      Mode     : File_Mode := 8#755#;
      User     : Uid_Type  := 0;
      Group    : Gid_Type  := 0;
      Files    : File_Type_Array_Access;
      Children : Directory_Type_Array_Access;
      Path     : Ada.Strings.Unbounded.Unbounded_String;
      Name     : aliased String (1 .. Len);
   end record;

   type File_Type is access all File;

   type Directory_Type is access all Directory;

   type Default_Container is new Babel.Files.File_Container with record
      Current : Directory_Type;
   end record;

   NO_DIRECTORY : constant Directory_Type := null;
   NO_FILE      : constant File_Type := null;

end Babel.Files;

Mark the Default_Container operation as overriding


-----------------------------------------------------------------------
--  streams.buffered.tests -- Unit tests for buffered streams
--  Copyright (C) 2010, 2011, 2017, 2018, 2019 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.Test_Caller;
with Util.Streams.Texts;
package body Util.Streams.Buffered.Tests is

   use Util.Tests;
   use Util.Streams.Texts;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Streams.Buffered.Write, Read",
                       Test_Read_Write'Access);
      Caller.Add_Test (Suite, "Test Util.Streams.Buffered.Write, Flush (String)",
                       Test_Write'Access);
      Caller.Add_Test (Suite, "Test Util.Streams.Buffered.Write, Flush (Stream_Array)",
                       Test_Write_Stream'Access);
   end Add_Tests;

   --  ------------------------------
   --  Write on a buffered stream and read what was written.
   --  ------------------------------
   procedure Test_Read_Write (T : in out Test) is
      Stream  : Print_Stream;
      Buf     : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Stream.Initialize (Size => 4);
      Stream.Write ("abcd");

      Assert_Equals (T, 4, Integer (Stream.Get_Size), "Invalid size for stream");

      Stream.Flush (Buf);
      Assert_Equals (T, 4, Ada.Strings.Unbounded.Length (Buf), "Invalid size for string");

      Assert_Equals (T, "abcd", Ada.Strings.Unbounded.To_String (Buf), "Invalid stream content");

      Assert_Equals (T, 0, Integer (Stream.Get_Size), "Invalid size for stream after Flush");
   end Test_Read_Write;

   --  ------------------------------
   --  Write on a buffer and force regular flush on a larger buffer
   --  ------------------------------
   procedure Test_Write (T : in out Test) is
      Big_Stream : aliased Output_Buffer_Stream;
      Stream     : Output_Buffer_Stream;
      Size       : Stream_Element_Offset := 0;
      Count      : constant Stream_Element_Offset := 1000;
      Max_Size   : constant Stream_Element_Offset := (Count * (Count + 1)) / 2;
   begin
      Big_Stream.Initialize (Size => Natural (Max_Size));
      Stream.Initialize (Output => Big_Stream'Access, Size => 13);

      for I in 1 .. Count loop
         declare
            S : Stream_Element_Array (1 .. I);
         begin
            for J in S'Range loop
               S (J) := Stream_Element (J mod 255);
            end loop;

            Stream.Write (S);
            Stream.Flush;

            Size := Size + I;
            Assert_Equals (T, 1, Integer (Stream.Write_Pos), "Stream must be flushed");

            --  Verify that 'Big_Stream' holds the expected number of bytes.
            Assert_Equals (T, Integer (Size), Integer (Big_Stream.Write_Pos) - 1,
                           "Target stream has an invalid write position at "
                          & Stream_Element_Offset'Image (I));
         end;
      end loop;
   end Test_Write;

   --  ------------------------------
   --  Write on a buffer and force regular flush on a larger buffer
   --  ------------------------------
   procedure Test_Write_Stream (T : in out Test) is
      Big_Stream : aliased Output_Buffer_Stream;
      Stream     : Output_Buffer_Stream;
      Size       : Stream_Element_Offset := 0;
      Count      : constant Stream_Element_Offset := 200;
      Max_Size   : constant Stream_Element_Offset := 5728500;
   begin
      Big_Stream.Initialize (Size => Natural (Max_Size));
      for Buf_Size in 1 .. 19 loop
         Stream.Initialize (Output => Big_Stream'Access,
                            Size => Buf_Size);

         for I in 1 .. Count loop
            for Repeat in 1 .. 5 loop
               declare
                  S : Stream_Element_Array (1 .. I);
               begin
                  for J in S'Range loop
                     S (J) := Stream_Element'Val (J mod 255);
                  end loop;

                  for J in 1 .. Repeat loop
                     Stream.Write (S);
                  end loop;
                  Stream.Flush;

                  Size := Size +  (I) * Stream_Element_Offset (Repeat);
                  Assert_Equals (T, 1, Integer (Stream.Write_Pos), "Stream must be flushed");

                  --  Verify that 'Big_Stream' holds the expected number of bytes.
                  Assert_Equals (T, Integer (Size), Integer (Big_Stream.Write_Pos) - 1,
                                 "Target stream has an invalid write position at "
                                 & Stream_Element_Offset'Image (I) & " with buffer "
                                 & Natural'Image (Buf_Size) & " repeat " & Natural'Image (Repeat));
               end;
            end loop;
         end loop;
      end loop;
      Assert_Equals (T, Integer (Max_Size), Integer (Big_Stream.Get_Size), "Invalid final size");
   end Test_Write_Stream;

end Util.Streams.Buffered.Tests;

-----------------------------------------------------------------------
--  streams.buffered.tests -- Unit tests for buffered streams
--  Copyright (C) 2010, 2011, 2017, 2018, 2019, 2020 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.Wide_Wide_Unbounded;
with Ada.Streams.Stream_IO;
with Util.Test_Caller;
with Util.Streams.Texts;
with Util.Streams.Files;
package body Util.Streams.Buffered.Tests is

   pragma Wide_Character_Encoding (UTF8);

   use Util.Tests;
   use Util.Streams.Texts;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Streams.Buffered.Write, Read",
                       Test_Read_Write'Access);
      Caller.Add_Test (Suite, "Test Util.Streams.Buffered.Write, Flush (String)",
                       Test_Write'Access);
      Caller.Add_Test (Suite, "Test Util.Streams.Buffered.Write, Flush (Stream_Array)",
                       Test_Write_Stream'Access);
      Caller.Add_Test (Suite, "Test Util.Streams.Buffered.Read (UTF-8)",
                       Test_Read_UTF_8'Access);
   end Add_Tests;

   --  ------------------------------
   --  Write on a buffered stream and read what was written.
   --  ------------------------------
   procedure Test_Read_Write (T : in out Test) is
      Stream  : Print_Stream;
      Buf     : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Stream.Initialize (Size => 4);
      Stream.Write ("abcd");

      Assert_Equals (T, 4, Integer (Stream.Get_Size), "Invalid size for stream");

      Stream.Flush (Buf);
      Assert_Equals (T, 4, Ada.Strings.Unbounded.Length (Buf), "Invalid size for string");

      Assert_Equals (T, "abcd", Ada.Strings.Unbounded.To_String (Buf), "Invalid stream content");

      Assert_Equals (T, 0, Integer (Stream.Get_Size), "Invalid size for stream after Flush");
   end Test_Read_Write;

   --  ------------------------------
   --  Write on a buffer and force regular flush on a larger buffer
   --  ------------------------------
   procedure Test_Write (T : in out Test) is
      Big_Stream : aliased Output_Buffer_Stream;
      Stream     : Output_Buffer_Stream;
      Size       : Stream_Element_Offset := 0;
      Count      : constant Stream_Element_Offset := 1000;
      Max_Size   : constant Stream_Element_Offset := (Count * (Count + 1)) / 2;
   begin
      Big_Stream.Initialize (Size => Natural (Max_Size));
      Stream.Initialize (Output => Big_Stream'Access, Size => 13);

      for I in 1 .. Count loop
         declare
            S : Stream_Element_Array (1 .. I);
         begin
            for J in S'Range loop
               S (J) := Stream_Element (J mod 255);
            end loop;

            Stream.Write (S);
            Stream.Flush;

            Size := Size + I;
            Assert_Equals (T, 1, Integer (Stream.Write_Pos), "Stream must be flushed");

            --  Verify that 'Big_Stream' holds the expected number of bytes.
            Assert_Equals (T, Integer (Size), Integer (Big_Stream.Write_Pos) - 1,
                           "Target stream has an invalid write position at "
                          & Stream_Element_Offset'Image (I));
         end;
      end loop;
   end Test_Write;

   --  ------------------------------
   --  Write on a buffer and force regular flush on a larger buffer
   --  ------------------------------
   procedure Test_Write_Stream (T : in out Test) is
      Big_Stream : aliased Output_Buffer_Stream;
      Stream     : Output_Buffer_Stream;
      Size       : Stream_Element_Offset := 0;
      Count      : constant Stream_Element_Offset := 200;
      Max_Size   : constant Stream_Element_Offset := 5728500;
   begin
      Big_Stream.Initialize (Size => Natural (Max_Size));
      for Buf_Size in 1 .. 19 loop
         Stream.Initialize (Output => Big_Stream'Access,
                            Size => Buf_Size);

         for I in 1 .. Count loop
            for Repeat in 1 .. 5 loop
               declare
                  S : Stream_Element_Array (1 .. I);
               begin
                  for J in S'Range loop
                     S (J) := Stream_Element'Val (J mod 255);
                  end loop;

                  for J in 1 .. Repeat loop
                     Stream.Write (S);
                  end loop;
                  Stream.Flush;

                  Size := Size +  (I) * Stream_Element_Offset (Repeat);
                  Assert_Equals (T, 1, Integer (Stream.Write_Pos), "Stream must be flushed");

                  --  Verify that 'Big_Stream' holds the expected number of bytes.
                  Assert_Equals (T, Integer (Size), Integer (Big_Stream.Write_Pos) - 1,
                                 "Target stream has an invalid write position at "
                                 & Stream_Element_Offset'Image (I) & " with buffer "
                                 & Natural'Image (Buf_Size) & " repeat " & Natural'Image (Repeat));
               end;
            end loop;
         end loop;
      end loop;
      Assert_Equals (T, Integer (Max_Size), Integer (Big_Stream.Get_Size), "Invalid final size");
   end Test_Write_Stream;

   --  ------------------------------
   --  Test reading UTF-8 file.
   --  ------------------------------
   procedure Test_Read_UTF_8 (T : in out Test) is
      File    : aliased Util.Streams.Files.File_Stream;
      Stream  : Util.Streams.Buffered.Input_Buffer_Stream;
      Path    : constant String := Util.Tests.Get_Path ("regtests/files/utf-8.txt");
   begin
      Stream.Initialize (Input => File'Access, Size => 1024);

      File.Open (Ada.Streams.Stream_IO.In_File, Path);
      declare
         S : Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
         Expect : constant Wide_Wide_String := "àéúíòࠀ€ಜ࠴𝄞" & Wide_Wide_Character'Val (16#0A#);
      begin
         Stream.Read (S);

         declare
            Result : constant Wide_Wide_String
              := Ada.Strings.Wide_Wide_Unbounded.To_Wide_Wide_String (S);
         begin
            if Expect /= Result then
               T.Fail ("Invalid UTF-8 string");
            end if;
         end;
      end;
   end Test_Read_UTF_8;

end Util.Streams.Buffered.Tests;

Implement Test_Read_UTF_8 to check reading UTF-8 sequences


-----------------------------------------------------------------------
--  ado-parameters-tests -- Test query parameters and SQL expansion
--  Copyright (C) 2011, 2015 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.Test_Caller;
with Util.Measures;
package body ADO.Parameters.Tests is

   use Util.Tests;

   type Dialect is new ADO.Drivers.Dialects.Dialect with null record;

   --  Check if the string is a reserved keyword.
   overriding
   function Is_Reserved (D    : in Dialect;
                         Name : in String) return Boolean;

   --  Test the Add_Param operation for various types.
   generic
      type T (<>) is private;
      with procedure Add_Param (L : in out ADO.Parameters.Abstract_List;
                                V : in T) is <>;
      Value : T;
      Name  : String;
   procedure Test_Add_Param_T (Tst   : in out Test);

   --  Test the Bind_Param operation for various types.
   generic
      type T (<>) is private;
      with procedure Bind_Param (L : in out ADO.Parameters.Abstract_List;
                                 N : in String;
                                 V : in T) is <>;
      Value : T;
      Name  : String;
   procedure Test_Bind_Param_T (Tst   : in out Test);

   --  Test the Add_Param operation for various types.
   procedure Test_Add_Param_T (Tst   : in out Test) is
      Count : constant Positive := 100;
      SQL   : ADO.Parameters.List;
      S     : Util.Measures.Stamp;
   begin
      for I in 1 .. Count loop
         Add_Param (ADO.Parameters.Abstract_List (SQL), Value);
      end loop;
      Util.Measures.Report (S, "Add_Param " & Name & "(" & Positive'Image (Count) & " calls)");
      Util.Tests.Assert_Equals (Tst, Count, SQL.Length, "Invalid param list for " & Name);
   end Test_Add_Param_T;

   --  Test the Bind_Param operation for various types.
   procedure Test_Bind_Param_T (Tst   : in out Test) is
      Count : constant Positive := 100;
      SQL   : ADO.Parameters.List;
      S     : Util.Measures.Stamp;
   begin
      for I in 1 .. Count loop
         Bind_Param (ADO.Parameters.Abstract_List (SQL), "a_parameter_name", Value);
      end loop;
      Util.Measures.Report (S, "Bind_Param " & Name & "(" & Positive'Image (Count) & " calls)");
      Util.Tests.Assert_Equals (Tst, 1, SQL.Length, "Invalid param list for " & Name);
   end Test_Bind_Param_T;

   procedure Test_Add_Param_Integer is
     new Test_Add_Param_T (Integer, Add_Param, 10, "Integer");
   procedure Test_Add_Param_Long_Long_Integer is
     new Test_Add_Param_T (Long_Long_Integer, Add_Param, 10_000_000_000_000, "Long_Long_Integer");
   procedure Test_Add_Param_Identifier is
     new Test_Add_Param_T (Identifier, Add_Param, 100, "Identifier");
   procedure Test_Add_Param_Boolean is
     new Test_Add_Param_T (Boolean, Add_Param, False, "Boolean");
   procedure Test_Add_Param_String is
     new Test_Add_Param_T (String, Add_Param, "0123456789ABCDEF", "String");
   procedure Test_Add_Param_Calendar is
     new Test_Add_Param_T (Ada.Calendar.Time, Add_Param, Ada.Calendar.Clock, "Time");
   procedure Test_Add_Param_Unbounded_String is
     new Test_Add_Param_T (Unbounded_String, Add_Param, To_Unbounded_String ("0123456789ABCDEF"),
                           "Unbounded_String");

   procedure Test_Bind_Param_Integer is
     new Test_Bind_Param_T (Integer, Bind_Param, 10, "Integer");
   procedure Test_Bind_Param_Long_Long_Integer is
     new Test_Bind_Param_T (Long_Long_Integer, Bind_Param, 10_000_000_000_000,
                            "Long_Long_Integer");
   procedure Test_Bind_Param_Identifier is
     new Test_Bind_Param_T (Identifier, Bind_Param, 100, "Identifier");
   procedure Test_Bind_Param_Entity_Type is
     new Test_Bind_Param_T (Entity_Type, Bind_Param, 100, "Entity_Type");
   procedure Test_Bind_Param_Boolean is
     new Test_Bind_Param_T (Boolean, Bind_Param, False, "Boolean");
   procedure Test_Bind_Param_String is
     new Test_Bind_Param_T (String, Bind_Param, "0123456789ABCDEF", "String");
   procedure Test_Bind_Param_Calendar is
     new Test_Bind_Param_T (Ada.Calendar.Time, Bind_Param, Ada.Calendar.Clock, "Time");
   procedure Test_Bind_Param_Unbounded_String is
     new Test_Bind_Param_T (Unbounded_String, Bind_Param, To_Unbounded_String ("0123456789ABCDEF"),
                           "Unbounded_String");

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ADO.Parameters.Expand",
                       Test_Expand_Sql'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Expand (invalid params)",
                       Test_Expand_Error'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Expand (perf)",
                       Test_Expand_Perf'Access);

      Caller.Add_Test (Suite, "Test ADO.Parameters.Add_Param (Boolean)",
                       Test_Add_Param_Boolean'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Add_Param (Integer)",
                       Test_Add_Param_Integer'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Add_Param (Long_Long_Integer)",
                       Test_Add_Param_Long_Long_Integer'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Add_Param (Identifier)",
                       Test_Add_Param_Identifier'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Add_Param (Calendar)",
                       Test_Add_Param_Calendar'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Add_Param (String)",
                       Test_Add_Param_String'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Add_Param (Unbounded_String)",
                       Test_Add_Param_Unbounded_String'Access);

      Caller.Add_Test (Suite, "Test ADO.Parameters.Bind_Param (Boolean)",
                       Test_Bind_Param_Boolean'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Bind_Param (Integer)",
                       Test_Bind_Param_Integer'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Bind_Param (Long_Long_Integer)",
                       Test_Bind_Param_Long_Long_Integer'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Bind_Param (Identifier)",
                       Test_Bind_Param_Identifier'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Bind_Param (Calendar)",
                       Test_Bind_Param_Calendar'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Bind_Param (String)",
                       Test_Bind_Param_String'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Bind_Param (Unbounded_String)",
                       Test_Bind_Param_Unbounded_String'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Bind_Param (Entity_Type)",
                       Test_Bind_Param_Entity_Type'Access);
   end Add_Tests;

   --  ------------------------------
   --  Check if the string is a reserved keyword.
   --  ------------------------------
   overriding
   function Is_Reserved (D    : in Dialect;
                         Name : in String) return Boolean is
      pragma Unreferenced (D, Name);
   begin
      return False;
   end Is_Reserved;

   --  ------------------------------
   --  Test expand SQL with parameters.
   --  ------------------------------
   procedure Test_Expand_Sql (T : in out Test) is
      SQL : ADO.Parameters.List;
      D   : aliased Dialect;

      procedure Check (Pattern : in String; Expect : in String);

      procedure Check (Pattern : in String; Expect : in String) is
         Result : constant String := SQL.Expand (Pattern);
      begin
         Assert_Equals (T, Expect, Result, "Invalid SQL expansion");
      end Check;

   begin
      SQL.Set_Dialect (D'Unchecked_Access);
      SQL.Bind_Param (1, "select '");
      SQL.Bind_Param (2, "from");
      SQL.Bind_Param ("user_id", String '("23"));
      SQL.Bind_Param ("object_23_identifier", Integer (44));
      SQL.Bind_Param ("bool", True);
      SQL.Bind_Param (6, False);
      SQL.Bind_Param ("_date", Ada.Calendar.Clock);
      SQL.Bind_Null_Param ("_null");

      Check ("?", "'select '''");
      Check (":2", "'from'");
      Check (":6", "0");
      Check (":user_id", "'23'");
      Check (":bool", "1");
      Check (":_null", "NULL");

      Check ("select :1 :2 :3 :4 :5 :6", "select 'select ''' 'from' '23' 44 1 0");
      Check ("select ? ? ? ? ? ?", "select 'select ''' 'from' '23' 44 1 0");
      Check ("select ? :2 :user_id :object_23_identifier :bool :6",
             "select 'select ''' 'from' '23' 44 1 0");
   end Test_Expand_Sql;

   --  ------------------------------
   --  Test expand with invalid parameters.
   --  ------------------------------
   procedure Test_Expand_Error (T : in out Test) is
      SQL : ADO.Parameters.List;

      procedure Check (Pattern : in String; Expect : in String);

      procedure Check (Pattern : in String; Expect : in String) is
         Result : constant String := SQL.Expand (Pattern);
      begin
         Assert_Equals (T, Expect, Result, "Invalid SQL expansion");
      end Check;

   begin
      Check (":<", "<");
      Check (":234", "");
      Check (":name", "");
      Check ("select :", "select :");
   end Test_Expand_Error;

   --  ------------------------------
   --  Test expand performance.
   --  ------------------------------
   procedure Test_Expand_Perf (T : in out Test) is
      pragma Unreferenced (T);

      SQL : ADO.Parameters.List;
      D   : aliased Dialect;
   begin
      SQL.Set_Dialect (D'Unchecked_Access);
      declare
         T : Util.Measures.Stamp;
      begin
         for I in 1 .. 1_000 loop
            SQL.Bind_Param (I, I);
         end loop;
         Util.Measures.Report (T, "Bind_Param (1000 calls)");
      end;

      declare
         B : constant Unbounded_String
           := To_Unbounded_String ("select t.a, t.b, t.c, t.d, t.e, t.f "
                                   & "from T where t.b = 23");
         T : Util.Measures.Stamp;
      begin
         for I in 1 .. 1_000 loop
            declare
               S : constant String := To_String (B);
               pragma Unreferenced (S);
            begin
               null;
            end;
         end loop;
         Util.Measures.Report (T, "Expand reference To_String");
      end;
      declare
         T : Util.Measures.Stamp;
      begin
         for I in 1 .. 1_000 loop
            declare
               S : constant String := SQL.Expand ("select t.a, t.b, t.c, t.d, t.e, t.f "
                                                  & "from T where t.b = 23");
               pragma Unreferenced (S);
            begin
               null;
            end;
         end loop;
         Util.Measures.Report (T, "Expand (1000 calls with 0 parameter)");
      end;
      declare
         T : Util.Measures.Stamp;
      begin
         for I in 1 .. 1_000 loop
            declare
               S : constant String := SQL.Expand ("select t.a, t.b, t.c, t.d, t.e, t.f "
                                                  & "from T where t.b = :10");
               pragma Unreferenced (S);
            begin
               null;
            end;
         end loop;
         Util.Measures.Report (T, "Expand (1000 calls with 1 parameter)");
      end;
      declare
         T : Util.Measures.Stamp;
      begin
         for I in 1 .. 1_000 loop
            declare
               S : constant String := SQL.Expand (":10 :20 :30 :40 :50 :60 :70 :80 :90 :100");
               pragma Unreferenced (S);
            begin
               null;
            end;
         end loop;
         Util.Measures.Report (T, "Expand (1000 calls with 10 parameters)");
      end;
   end Test_Expand_Perf;

end ADO.Parameters.Tests;

-----------------------------------------------------------------------
--  ado-parameters-tests -- Test query parameters and SQL expansion
--  Copyright (C) 2011, 2015, 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 Util.Test_Caller;
with Util.Measures;
with ADO.Caches.Discrete;
with ADO.Caches;
package body ADO.Parameters.Tests is

   use Util.Tests;

   package Int_Cache is new ADO.Caches.Discrete (Element_Type => Integer);

   type Dialect is new ADO.Drivers.Dialects.Dialect with null record;

   --  Check if the string is a reserved keyword.
   overriding
   function Is_Reserved (D    : in Dialect;
                         Name : in String) return Boolean;

   --  Test the Add_Param operation for various types.
   generic
      type T (<>) is private;
      with procedure Add_Param (L : in out ADO.Parameters.Abstract_List;
                                V : in T) is <>;
      Value : T;
      Name  : String;
   procedure Test_Add_Param_T (Tst   : in out Test);

   --  Test the Bind_Param operation for various types.
   generic
      type T (<>) is private;
      with procedure Bind_Param (L : in out ADO.Parameters.Abstract_List;
                                 N : in String;
                                 V : in T) is <>;
      Value : T;
      Name  : String;
   procedure Test_Bind_Param_T (Tst   : in out Test);

   --  Test the Add_Param operation for various types.
   procedure Test_Add_Param_T (Tst   : in out Test) is
      Count : constant Positive := 100;
      SQL   : ADO.Parameters.List;
      S     : Util.Measures.Stamp;
   begin
      for I in 1 .. Count loop
         Add_Param (ADO.Parameters.Abstract_List (SQL), Value);
      end loop;
      Util.Measures.Report (S, "Add_Param " & Name & "(" & Positive'Image (Count) & " calls)");
      Util.Tests.Assert_Equals (Tst, Count, SQL.Length, "Invalid param list for " & Name);
   end Test_Add_Param_T;

   --  Test the Bind_Param operation for various types.
   procedure Test_Bind_Param_T (Tst   : in out Test) is
      Count : constant Positive := 100;
      SQL   : ADO.Parameters.List;
      S     : Util.Measures.Stamp;
   begin
      for I in 1 .. Count loop
         Bind_Param (ADO.Parameters.Abstract_List (SQL), "a_parameter_name", Value);
      end loop;
      Util.Measures.Report (S, "Bind_Param " & Name & "(" & Positive'Image (Count) & " calls)");
      Util.Tests.Assert_Equals (Tst, 1, SQL.Length, "Invalid param list for " & Name);
   end Test_Bind_Param_T;

   procedure Test_Add_Param_Integer is
     new Test_Add_Param_T (Integer, Add_Param, 10, "Integer");
   procedure Test_Add_Param_Long_Long_Integer is
     new Test_Add_Param_T (Long_Long_Integer, Add_Param, 10_000_000_000_000, "Long_Long_Integer");
   procedure Test_Add_Param_Identifier is
     new Test_Add_Param_T (Identifier, Add_Param, 100, "Identifier");
   procedure Test_Add_Param_Boolean is
     new Test_Add_Param_T (Boolean, Add_Param, False, "Boolean");
   procedure Test_Add_Param_String is
     new Test_Add_Param_T (String, Add_Param, "0123456789ABCDEF", "String");
   procedure Test_Add_Param_Calendar is
     new Test_Add_Param_T (Ada.Calendar.Time, Add_Param, Ada.Calendar.Clock, "Time");
   procedure Test_Add_Param_Unbounded_String is
     new Test_Add_Param_T (Unbounded_String, Add_Param, To_Unbounded_String ("0123456789ABCDEF"),
                           "Unbounded_String");

   procedure Test_Bind_Param_Integer is
     new Test_Bind_Param_T (Integer, Bind_Param, 10, "Integer");
   procedure Test_Bind_Param_Long_Long_Integer is
     new Test_Bind_Param_T (Long_Long_Integer, Bind_Param, 10_000_000_000_000,
                            "Long_Long_Integer");
   procedure Test_Bind_Param_Identifier is
     new Test_Bind_Param_T (Identifier, Bind_Param, 100, "Identifier");
   procedure Test_Bind_Param_Entity_Type is
     new Test_Bind_Param_T (Entity_Type, Bind_Param, 100, "Entity_Type");
   procedure Test_Bind_Param_Boolean is
     new Test_Bind_Param_T (Boolean, Bind_Param, False, "Boolean");
   procedure Test_Bind_Param_String is
     new Test_Bind_Param_T (String, Bind_Param, "0123456789ABCDEF", "String");
   procedure Test_Bind_Param_Calendar is
     new Test_Bind_Param_T (Ada.Calendar.Time, Bind_Param, Ada.Calendar.Clock, "Time");
   procedure Test_Bind_Param_Unbounded_String is
     new Test_Bind_Param_T (Unbounded_String, Bind_Param, To_Unbounded_String ("0123456789ABCDEF"),
                           "Unbounded_String");

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ADO.Parameters.Expand",
                       Test_Expand_Sql'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Expand (invalid params)",
                       Test_Expand_Error'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Expand (perf)",
                       Test_Expand_Perf'Access);

      Caller.Add_Test (Suite, "Test ADO.Parameters.Add_Param (Boolean)",
                       Test_Add_Param_Boolean'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Add_Param (Integer)",
                       Test_Add_Param_Integer'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Add_Param (Long_Long_Integer)",
                       Test_Add_Param_Long_Long_Integer'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Add_Param (Identifier)",
                       Test_Add_Param_Identifier'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Add_Param (Calendar)",
                       Test_Add_Param_Calendar'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Add_Param (String)",
                       Test_Add_Param_String'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Add_Param (Unbounded_String)",
                       Test_Add_Param_Unbounded_String'Access);

      Caller.Add_Test (Suite, "Test ADO.Parameters.Bind_Param (Boolean)",
                       Test_Bind_Param_Boolean'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Bind_Param (Integer)",
                       Test_Bind_Param_Integer'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Bind_Param (Long_Long_Integer)",
                       Test_Bind_Param_Long_Long_Integer'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Bind_Param (Identifier)",
                       Test_Bind_Param_Identifier'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Bind_Param (Calendar)",
                       Test_Bind_Param_Calendar'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Bind_Param (String)",
                       Test_Bind_Param_String'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Bind_Param (Unbounded_String)",
                       Test_Bind_Param_Unbounded_String'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Bind_Param (Entity_Type)",
                       Test_Bind_Param_Entity_Type'Access);
      Caller.Add_Test (Suite, "Test ADO.Parameters.Expand (cache expander)",
                       Test_Expand_With_Expander'Access);
   end Add_Tests;

   --  ------------------------------
   --  Check if the string is a reserved keyword.
   --  ------------------------------
   overriding
   function Is_Reserved (D    : in Dialect;
                         Name : in String) return Boolean is
      pragma Unreferenced (D, Name);
   begin
      return False;
   end Is_Reserved;

   --  ------------------------------
   --  Test expand SQL with parameters.
   --  ------------------------------
   procedure Test_Expand_Sql (T : in out Test) is
      SQL : ADO.Parameters.List;
      D   : aliased Dialect;

      procedure Check (Pattern : in String; Expect : in String);

      procedure Check (Pattern : in String; Expect : in String) is
         Result : constant String := SQL.Expand (Pattern);
      begin
         Assert_Equals (T, Expect, Result, "Invalid SQL expansion");
      end Check;

   begin
      SQL.Set_Dialect (D'Unchecked_Access);
      SQL.Bind_Param (1, "select '");
      SQL.Bind_Param (2, "from");
      SQL.Bind_Param ("user_id", String '("23"));
      SQL.Bind_Param ("object_23_identifier", Integer (44));
      SQL.Bind_Param ("bool", True);
      SQL.Bind_Param (6, False);
      SQL.Bind_Param ("_date", Ada.Calendar.Clock);
      SQL.Bind_Null_Param ("_null");

      Check ("?", "'select '''");
      Check (":2", "'from'");
      Check (":6", "0");
      Check (":user_id", "'23'");
      Check (":bool", "1");
      Check (":_null", "NULL");

      Check ("select :1 :2 :3 :4 :5 :6", "select 'select ''' 'from' '23' 44 1 0");
      Check ("select ? ? ? ? ? ?", "select 'select ''' 'from' '23' 44 1 0");
      Check ("select ? :2 :user_id :object_23_identifier :bool :6",
             "select 'select ''' 'from' '23' 44 1 0");
   end Test_Expand_Sql;

   --  ------------------------------
   --  Test expand with invalid parameters.
   --  ------------------------------
   procedure Test_Expand_Error (T : in out Test) is
      SQL : ADO.Parameters.List;

      procedure Check (Pattern : in String; Expect : in String);

      procedure Check (Pattern : in String; Expect : in String) is
         Result : constant String := SQL.Expand (Pattern);
      begin
         Assert_Equals (T, Expect, Result, "Invalid SQL expansion");
      end Check;

   begin
      Check (":<", "<");
      Check (":234", "");
      Check (":name", "");
      Check ("select :", "select :");
   end Test_Expand_Error;

   --  ------------------------------
   --  Test expand performance.
   --  ------------------------------
   procedure Test_Expand_Perf (T : in out Test) is
      pragma Unreferenced (T);

      SQL : ADO.Parameters.List;
      D   : aliased Dialect;
   begin
      SQL.Set_Dialect (D'Unchecked_Access);
      declare
         T : Util.Measures.Stamp;
      begin
         for I in 1 .. 1_000 loop
            SQL.Bind_Param (I, I);
         end loop;
         Util.Measures.Report (T, "Bind_Param (1000 calls)");
      end;

      declare
         B : constant Unbounded_String
           := To_Unbounded_String ("select t.a, t.b, t.c, t.d, t.e, t.f "
                                   & "from T where t.b = 23");
         T : Util.Measures.Stamp;
      begin
         for I in 1 .. 1_000 loop
            declare
               S : constant String := To_String (B);
               pragma Unreferenced (S);
            begin
               null;
            end;
         end loop;
         Util.Measures.Report (T, "Expand reference To_String");
      end;
      declare
         T : Util.Measures.Stamp;
      begin
         for I in 1 .. 1_000 loop
            declare
               S : constant String := SQL.Expand ("select t.a, t.b, t.c, t.d, t.e, t.f "
                                                  & "from T where t.b = 23");
               pragma Unreferenced (S);
            begin
               null;
            end;
         end loop;
         Util.Measures.Report (T, "Expand (1000 calls with 0 parameter)");
      end;
      declare
         T : Util.Measures.Stamp;
      begin
         for I in 1 .. 1_000 loop
            declare
               S : constant String := SQL.Expand ("select t.a, t.b, t.c, t.d, t.e, t.f "
                                                  & "from T where t.b = :10");
               pragma Unreferenced (S);
            begin
               null;
            end;
         end loop;
         Util.Measures.Report (T, "Expand (1000 calls with 1 parameter)");
      end;
      declare
         T : Util.Measures.Stamp;
      begin
         for I in 1 .. 1_000 loop
            declare
               S : constant String := SQL.Expand (":10 :20 :30 :40 :50 :60 :70 :80 :90 :100");
               pragma Unreferenced (S);
            begin
               null;
            end;
         end loop;
         Util.Measures.Report (T, "Expand (1000 calls with 10 parameters)");
      end;
   end Test_Expand_Perf;

   --  ------------------------------
   --  Test expand with cache expander.
   --  ------------------------------
   procedure Test_Expand_With_Expander (T : in out Test) is
      procedure Check (Content : in String;
                       Expect  : in String);

      SQL : ADO.Parameters.List;
      D   : aliased Dialect;
      C   : aliased ADO.Caches.Cache_Manager;
      M   : access Int_Cache.Cache_Type := new Int_Cache.Cache_Type;
      P   : access Int_Cache.Cache_Type := new Int_Cache.Cache_Type;

      procedure Check (Content : in String;
                       Expect  : in String) is
         S : constant String := SQL.Expand (Content);
      begin
         Util.Tests.Assert_Equals (T, Expect, S, "Invalid expand for SQL '" & Content & "'");
      end Check;

   begin
      C.Add_Cache ("test-group", M.all'Access);
      C.Add_Cache ("G2", P.all'Access);
      SQL.Expander := C'Unchecked_Access;
      M.Insert ("value-1", 123);
      M.Insert ("2", 2);
      M.Insert ("a name", 10);
      P.Insert ("1", 10);
      P.Insert ("a", 0);
      P.Insert ("c", 1);
      SQL.Set_Dialect (D'Unchecked_Access);
      Check ("$test-group[2]", "2");
      Check ("$test-group[a name]", "10");
      Check ("SELECT * FROM user WHERE id = $test-group[2]+$test-group[value-1]",
             "SELECT * FROM user WHERE id = 2+123");
      Check ("SELECT * FROM user WHERE id = $G2[a]+$test-group[value-1]",
             "SELECT * FROM user WHERE id = 0+123");
      P.Insert ("a", 1, True);
      Check ("SELECT * FROM user WHERE id = $G2[a]+$test-group[value-1]",
             "SELECT * FROM user WHERE id = 1+123");
   end Test_Expand_With_Expander;

end ADO.Parameters.Tests;

Implement the Test_Expand_With_Expander and register the new unit test


-----------------------------------------------------------------------
--  util-files -- Various File Utility Packages
--  Copyright (C) 2001 - 2022 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 Util.Strings.Maps;
with Util.Strings.Vectors;

--  = Files =
--  The `Util.Files` package provides various utility operations arround files
--  to help in reading, writing, searching for files in a path.
--  To use the operations described here, use the following GNAT project:
--
--    with "utilada_base";
--
--  == Reading and writing ==
--  To easily get the full content of a file, the `Read_File` procedure can be
--  used.  A first form exists that populates a `Unbounded_String` or a vector
--  of strings.  A second form exists with a procedure that is called with each
--  line while the file is read.  These different forms simplify the reading of
--  files as it is possible to write:
--
--    Content : Ada.Strings.Unbounded.Unbounded_String;
--    Util.Files.Read_File ("config.txt", Content);
--
--  or
--
--    List : Util.Strings.Vectors.Vector;
--    Util.Files.Read_File ("config.txt", List);
--
--  or
--
--    procedure Read_Line (Line : in String) is ...
--    Util.Files.Read_File ("config.txt", Read_Line'Access);
--
--  Similarly, writing a file when you have a string or an `Unbounded_String`
--  is easily written by using `Write_File` as follows:
--
--    Util.Files.Write_File ("config.txt", "full content");
--
--  == Searching files ==
--  Searching for a file in a list of directories can be accomplished by using
--  the `Iterate_Path`, `Iterate_Files_Path` or `Find_File_Path`.
--
--  The `Find_File_Path` function is helpful to find a file in some `PATH`
--  search list.  The function looks in each search directory for the given
--  file name and it builds and returns the computed path of the first file
--  found in the search list.  For example:
--
--    Path : String := Util.Files.Find_File_Path ("ls",
--                                                "/bin:/usr/bin",
--                                                ":");
--
--  This will return `/usr/bin/ls` on most Unix systems.
--
--  @include util-files-rolling.ads
package Util.Files is

   use Ada.Strings.Unbounded;

   subtype Direction is Ada.Strings.Direction;

   --  Read a complete file into a string.
   --  The Max_Size parameter indicates the maximum size that is read.
   procedure Read_File (Path     : in String;
                        Into     : out Unbounded_String;
                        Max_Size : in Natural := 0);

   --  Read the file with the given path, one line at a time and execute the Process
   --  procedure with each line as argument.
   procedure Read_File (Path     : in String;
                        Process  : not null access procedure (Line : in String));

   --  Read the file with the given path, one line at a time and append each line to
   --  the Into vector.
   procedure Read_File (Path  : in String;
                        Into  : in out Util.Strings.Vectors.Vector);

   --  Save the string into a file creating the file if necessary
   procedure Write_File (Path    : in String;
                         Content : in String);

   --  Save the string into a file creating the file if necessary
   procedure Write_File (Path    : in String;
                         Content : in Unbounded_String);

   --  Iterate over the search directories defined in Path and execute
   --  Process with each directory until it returns True in Done
   --  or the last search directory is found.  Each search directory
   --  is separated by ';' (yes, even on Unix).  When Going is set to Backward, the
   --  directories are searched in reverse order.
   procedure Iterate_Path (Path     : in String;
                           Process  : not null access procedure (Dir  : in String;
                                                                 Done : out Boolean);
                           Going    : in Direction := Ada.Strings.Forward);

   --  Iterate over the search directories defined in Path and search
   --  for files matching the pattern defined by Pattern.  For each file,
   --  execute Process with the file basename and the full file path.
   --  Stop iterating when the Process procedure returns True.
   --  Each search directory is separated by ';'.  When Going is set to Backward, the
   --  directories are searched in reverse order.
   procedure Iterate_Files_Path (Pattern  : in String;
                                 Path     : in String;
                                 Process  : not null access procedure (Name : in String;
                                                                       File : in String;
                                                                       Done : out Boolean);
                                 Going    : in Direction := Ada.Strings.Forward);

   --  Find the file `Name` in one of the search directories defined in `Paths`.
   --  Each search directory is separated by ';' by default (yes, even on Unix).
   --  This can be changed by specifying the `Separator` value.
   --  Returns the path to be used for reading the file.
   function Find_File_Path (Name      : in String;
                            Paths     : in String;
                            Separator : in String := ";") return String;

   --  Find the files which match the pattern in the directories specified in the
   --  search path Path.  Each search directory is separated by ';'.
   --  File names are added to the string set in Into.
   procedure Find_Files_Path (Pattern : in String;
                              Path    : in String;
                              Into    : in out Util.Strings.Maps.Map);

   --  Returns the name of the external file with the specified directory
   --  and the name.  Unlike the Ada.Directories.Compose, the name can represent
   --  a relative path and thus include directory separators.
   function Compose (Directory : in String;
                     Name      : in String) return String;

   --  Compose an existing path by adding the specified name to each path component
   --  and return a new paths having only existing directories.  Each directory is
   --  separated by ';' (this can be overriding with the `Separator` parameter).
   --  If the composed path exists, it is added to the result path.
   --  Example:
   --    paths = 'web;regtests'  name = 'info'
   --    result = 'web/info;regtests/info'
   --  Returns the composed path.
   function Compose_Path (Paths     : in String;
                          Name      : in String;
                          Separator : in Character := ';') return String;

   --  Returns a relative path whose origin is defined by From and which refers
   --  to the absolute path referenced by To.  Both From and To are
   --  assumed to be absolute paths.  Returns the absolute path To if the relative
   --  path could not be found.  Both paths must have at least one root component in common.
   function Get_Relative_Path (From : in String;
                               To   : in String) return String;

   --  Rename the old name into a new name.
   procedure Rename (Old_Name, New_Name : in String);

end Util.Files;

-----------------------------------------------------------------------
--  util-files -- Various File Utility Packages
--  Copyright (C) 2001 - 2022 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 Util.Strings.Maps;
with Util.Strings.Vectors;

--  = Files =
--  The `Util.Files` package provides various utility operations arround files
--  to help in reading, writing, searching for files in a path.
--  To use the operations described here, use the following GNAT project:
--
--    with "utilada_base";
--
--  == Reading and writing ==
--  To easily get the full content of a file, the `Read_File` procedure can be
--  used.  A first form exists that populates a `Unbounded_String` or a vector
--  of strings.  A second form exists with a procedure that is called with each
--  line while the file is read.  These different forms simplify the reading of
--  files as it is possible to write:
--
--    Content : Ada.Strings.Unbounded.Unbounded_String;
--    Util.Files.Read_File ("config.txt", Content);
--
--  or
--
--    List : Util.Strings.Vectors.Vector;
--    Util.Files.Read_File ("config.txt", List);
--
--  or
--
--    procedure Read_Line (Line : in String) is ...
--    Util.Files.Read_File ("config.txt", Read_Line'Access);
--
--  Similarly, writing a file when you have a string or an `Unbounded_String`
--  is easily written by using `Write_File` as follows:
--
--    Util.Files.Write_File ("config.txt", "full content");
--
--  == Searching files ==
--  Searching for a file in a list of directories can be accomplished by using
--  the `Iterate_Path`, `Iterate_Files_Path` or `Find_File_Path`.
--
--  The `Find_File_Path` function is helpful to find a file in some `PATH`
--  search list.  The function looks in each search directory for the given
--  file name and it builds and returns the computed path of the first file
--  found in the search list.  For example:
--
--    Path : String := Util.Files.Find_File_Path ("ls",
--                                                "/bin:/usr/bin",
--                                                ':');
--
--  This will return `/usr/bin/ls` on most Unix systems.
--
--  @include util-files-rolling.ads
package Util.Files is

   use Ada.Strings.Unbounded;

   subtype Direction is Ada.Strings.Direction;

   --  Read a complete file into a string.
   --  The Max_Size parameter indicates the maximum size that is read.
   procedure Read_File (Path     : in String;
                        Into     : out Unbounded_String;
                        Max_Size : in Natural := 0);

   --  Read the file with the given path, one line at a time and execute the Process
   --  procedure with each line as argument.
   procedure Read_File (Path     : in String;
                        Process  : not null access procedure (Line : in String));

   --  Read the file with the given path, one line at a time and append each line to
   --  the Into vector.
   procedure Read_File (Path  : in String;
                        Into  : in out Util.Strings.Vectors.Vector);

   --  Save the string into a file creating the file if necessary
   procedure Write_File (Path    : in String;
                         Content : in String);

   --  Save the string into a file creating the file if necessary
   procedure Write_File (Path    : in String;
                         Content : in Unbounded_String);

   --  Iterate over the search directories defined in Path and execute
   --  Process with each directory until it returns True in Done
   --  or the last search directory is found.  Each search directory
   --  is separated by ';' (yes, even on Unix).  When Going is set to Backward, the
   --  directories are searched in reverse order.
   procedure Iterate_Path (Path     : in String;
                           Process  : not null access procedure (Dir  : in String;
                                                                 Done : out Boolean);
                           Going    : in Direction := Ada.Strings.Forward);

   --  Iterate over the search directories defined in Path and search
   --  for files matching the pattern defined by Pattern.  For each file,
   --  execute Process with the file basename and the full file path.
   --  Stop iterating when the Process procedure returns True.
   --  Each search directory is separated by ';'.  When Going is set to Backward, the
   --  directories are searched in reverse order.
   procedure Iterate_Files_Path (Pattern  : in String;
                                 Path     : in String;
                                 Process  : not null access procedure (Name : in String;
                                                                       File : in String;
                                                                       Done : out Boolean);
                                 Going    : in Direction := Ada.Strings.Forward);

   --  Find the file `Name` in one of the search directories defined in `Paths`.
   --  Each search directory is separated by ';' by default (yes, even on Unix).
   --  This can be changed by specifying the `Separator` value.
   --  Returns the path to be used for reading the file.
   function Find_File_Path (Name      : in String;
                            Paths     : in String;
                            Separator : in Character := ';') return String;

   --  Find the files which match the pattern in the directories specified in the
   --  search path Path.  Each search directory is separated by ';'.
   --  File names are added to the string set in Into.
   procedure Find_Files_Path (Pattern : in String;
                              Path    : in String;
                              Into    : in out Util.Strings.Maps.Map);

   --  Returns the name of the external file with the specified directory
   --  and the name.  Unlike the Ada.Directories.Compose, the name can represent
   --  a relative path and thus include directory separators.
   function Compose (Directory : in String;
                     Name      : in String) return String;

   --  Compose an existing path by adding the specified name to each path component
   --  and return a new paths having only existing directories.  Each directory is
   --  separated by ';' (this can be overriding with the `Separator` parameter).
   --  If the composed path exists, it is added to the result path.
   --  Example:
   --    paths = 'web;regtests'  name = 'info'
   --    result = 'web/info;regtests/info'
   --  Returns the composed path.
   function Compose_Path (Paths     : in String;
                          Name      : in String;
                          Separator : in Character := ';') return String;

   --  Returns a relative path whose origin is defined by From and which refers
   --  to the absolute path referenced by To.  Both From and To are
   --  assumed to be absolute paths.  Returns the absolute path To if the relative
   --  path could not be found.  Both paths must have at least one root component in common.
   function Get_Relative_Path (From : in String;
                               To   : in String) return String;

   --  Rename the old name into a new name.
   procedure Rename (Old_Name, New_Name : in String);

end Util.Files;

Update Find_File_Path to use a Character for the Separator


-----------------------------------------------------------------------
--  util-files -- Various File Utility Packages
--  Copyright (C) 2001 - 2022 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 Util.Strings.Maps;
with Util.Strings.Vectors;

--  = Files =
--  The `Util.Files` package provides various utility operations arround files
--  to help in reading, writing, searching for files in a path.
--  To use the operations described here, use the following GNAT project:
--
--    with "utilada_base";
--
--  == Reading and writing ==
--  To easily get the full content of a file, the `Read_File` procedure can be
--  used.  A first form exists that populates a `Unbounded_String` or a vector
--  of strings.  A second form exists with a procedure that is called with each
--  line while the file is read.  These different forms simplify the reading of
--  files as it is possible to write:
--
--    Content : Ada.Strings.Unbounded.Unbounded_String;
--    Util.Files.Read_File ("config.txt", Content);
--
--  or
--
--    List : Util.Strings.Vectors.Vector;
--    Util.Files.Read_File ("config.txt", List);
--
--  or
--
--    procedure Read_Line (Line : in String) is ...
--    Util.Files.Read_File ("config.txt", Read_Line'Access);
--
--  Similarly, writing a file when you have a string or an `Unbounded_String`
--  is easily written by using `Write_File` as follows:
--
--    Util.Files.Write_File ("config.txt", "full content");
--
--  == Searching files ==
--  Searching for a file in a list of directories can be accomplished by using
--  the `Iterate_Path`, `Iterate_Files_Path` or `Find_File_Path`.
--
--  The `Find_File_Path` function is helpful to find a file in some `PATH`
--  search list.  The function looks in each search directory for the given
--  file name and it builds and returns the computed path of the first file
--  found in the search list.  For example:
--
--    Path : String := Util.Files.Find_File_Path ("ls",
--                                                "/bin:/usr/bin",
--                                                ':');
--
--  This will return `/usr/bin/ls` on most Unix systems.
--
--  @include util-files-rolling.ads
package Util.Files is

   use Ada.Strings.Unbounded;

   subtype Direction is Ada.Strings.Direction;

   --  Read a complete file into a string.
   --  The Max_Size parameter indicates the maximum size that is read.
   procedure Read_File (Path     : in String;
                        Into     : out Unbounded_String;
                        Max_Size : in Natural := 0);

   --  Read the file with the given path, one line at a time and execute the Process
   --  procedure with each line as argument.
   procedure Read_File (Path     : in String;
                        Process  : not null access procedure (Line : in String));

   --  Read the file with the given path, one line at a time and append each line to
   --  the Into vector.
   procedure Read_File (Path  : in String;
                        Into  : in out Util.Strings.Vectors.Vector);

   --  Save the string into a file creating the file if necessary
   procedure Write_File (Path    : in String;
                         Content : in String);

   --  Save the string into a file creating the file if necessary
   procedure Write_File (Path    : in String;
                         Content : in Unbounded_String);

   --  Iterate over the search directories defined in Path and execute
   --  Process with each directory until it returns True in Done
   --  or the last search directory is found.  Each search directory
   --  is separated by ';' (yes, even on Unix).  When Going is set to Backward, the
   --  directories are searched in reverse order.
   procedure Iterate_Path (Path     : in String;
                           Process  : not null access procedure (Dir  : in String;
                                                                 Done : out Boolean);
                           Going    : in Direction := Ada.Strings.Forward);

   --  Iterate over the search directories defined in Path and search
   --  for files matching the pattern defined by Pattern.  For each file,
   --  execute Process with the file basename and the full file path.
   --  Stop iterating when the Process procedure returns True.
   --  Each search directory is separated by ';'.  When Going is set to Backward, the
   --  directories are searched in reverse order.
   procedure Iterate_Files_Path (Pattern  : in String;
                                 Path     : in String;
                                 Process  : not null access procedure (Name : in String;
                                                                       File : in String;
                                                                       Done : out Boolean);
                                 Going    : in Direction := Ada.Strings.Forward);

   --  Find the file `Name` in one of the search directories defined in `Paths`.
   --  Each search directory is separated by ';' by default (yes, even on Unix).
   --  This can be changed by specifying the `Separator` value.
   --  Returns the path to be used for reading the file.
   function Find_File_Path (Name      : in String;
                            Paths     : in String;
                            Separator : in Character := ';') return String;

   --  Find the files which match the pattern in the directories specified in the
   --  search path Path.  Each search directory is separated by ';'.
   --  File names are added to the string set in Into.
   procedure Find_Files_Path (Pattern : in String;
                              Path    : in String;
                              Into    : in out Util.Strings.Maps.Map);

   --  Returns the name of the external file with the specified directory
   --  and the name.  Unlike the Ada.Directories.Compose, the name can represent
   --  a relative path and thus include directory separators.
   function Compose (Directory : in String;
                     Name      : in String) return String;

   --  Compose an existing path by adding the specified name to each path component
   --  and return a new paths having only existing directories.  Each directory is
   --  separated by ';' (this can be overriding with the `Separator` parameter).
   --  If the composed path exists, it is added to the result path.
   --  Example:
   --    paths = 'web;regtests'  name = 'info'
   --    result = 'web/info;regtests/info'
   --  Returns the composed path.
   function Compose_Path (Paths     : in String;
                          Name      : in String;
                          Separator : in Character := ';') return String;

   --  Returns a relative path whose origin is defined by From and which refers
   --  to the absolute path referenced by To.  Both From and To are
   --  assumed to be absolute paths.  Returns the absolute path To if the relative
   --  path could not be found.  Both paths must have at least one root component in common.
   function Get_Relative_Path (From : in String;
                               To   : in String) return String;

   --  Rename the old name into a new name.
   procedure Rename (Old_Name, New_Name : in String);

end Util.Files;

-----------------------------------------------------------------------
--  util-files -- Various File Utility Packages
--  Copyright (C) 2001 - 2022 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 Util.Strings.Maps;
with Util.Strings.Vectors;

--  = Files =
--  The `Util.Files` package provides various utility operations arround files
--  to help in reading, writing, searching for files in a path.
--  To use the operations described here, use the following GNAT project:
--
--    with "utilada_base";
--
--  == Reading and writing ==
--  To easily get the full content of a file, the `Read_File` procedure can be
--  used.  A first form exists that populates a `Unbounded_String` or a vector
--  of strings.  A second form exists with a procedure that is called with each
--  line while the file is read.  These different forms simplify the reading of
--  files as it is possible to write:
--
--    Content : Ada.Strings.Unbounded.Unbounded_String;
--    Util.Files.Read_File ("config.txt", Content);
--
--  or
--
--    List : Util.Strings.Vectors.Vector;
--    Util.Files.Read_File ("config.txt", List);
--
--  or
--
--    procedure Read_Line (Line : in String) is ...
--    Util.Files.Read_File ("config.txt", Read_Line'Access);
--
--  Similarly, writing a file when you have a string or an `Unbounded_String`
--  is easily written by using `Write_File` as follows:
--
--    Util.Files.Write_File ("config.txt", "full content");
--
--  == Searching files ==
--  Searching for a file in a list of directories can be accomplished by using
--  the `Iterate_Path`, `Iterate_Files_Path` or `Find_File_Path`.
--
--  The `Find_File_Path` function is helpful to find a file in some `PATH`
--  search list.  The function looks in each search directory for the given
--  file name and it builds and returns the computed path of the first file
--  found in the search list.  For example:
--
--    Path : String := Util.Files.Find_File_Path ("ls",
--                                                "/bin:/usr/bin",
--                                                ':');
--
--  This will return `/usr/bin/ls` on most Unix systems.
--
--  @include util-files-rolling.ads
package Util.Files is

   use Ada.Strings.Unbounded;

   subtype Direction is Ada.Strings.Direction;

   --  Read a complete file into a string.
   --  The Max_Size parameter indicates the maximum size that is read.
   procedure Read_File (Path     : in String;
                        Into     : out Unbounded_String;
                        Max_Size : in Natural := 0);

   --  Read the file with the given path, one line at a time and execute the Process
   --  procedure with each line as argument.
   procedure Read_File (Path     : in String;
                        Process  : not null access procedure (Line : in String));

   --  Read the file with the given path, one line at a time and append each line to
   --  the Into vector.
   procedure Read_File (Path  : in String;
                        Into  : in out Util.Strings.Vectors.Vector);

   --  Save the string into a file creating the file if necessary
   procedure Write_File (Path    : in String;
                         Content : in String);

   --  Save the string into a file creating the file if necessary
   procedure Write_File (Path    : in String;
                         Content : in Unbounded_String);

   --  Iterate over the search directories defined in Path and execute
   --  Process with each directory until it returns True in Done
   --  or the last search directory is found.  Each search directory
   --  is separated by ';' (yes, even on Unix).  When Going is set to Backward, the
   --  directories are searched in reverse order.
   procedure Iterate_Path (Path     : in String;
                           Process  : not null access procedure (Dir  : in String;
                                                                 Done : out Boolean);
                           Going    : in Direction := Ada.Strings.Forward);

   --  Iterate over the search directories defined in Path and search
   --  for files matching the pattern defined by Pattern.  For each file,
   --  execute Process with the file basename and the full file path.
   --  Stop iterating when the Process procedure returns True.
   --  Each search directory is separated by ';'.  When Going is set to Backward, the
   --  directories are searched in reverse order.
   procedure Iterate_Files_Path (Pattern  : in String;
                                 Path     : in String;
                                 Process  : not null access procedure (Name : in String;
                                                                       File : in String;
                                                                       Done : out Boolean);
                                 Going    : in Direction := Ada.Strings.Forward);

   --  Find the file `Name` in one of the search directories defined in `Paths`.
   --  Each search directory is separated by ';' by default (yes, even on Unix).
   --  This can be changed by specifying the `Separator` value.
   --  Returns the path to be used for reading the file.
   function Find_File_Path (Name      : in String;
                            Paths     : in String;
                            Separator : in Character := ';') return String;

   --  Find the files which match the pattern in the directories specified in the
   --  search path Path.  Each search directory is separated by ';'.
   --  File names are added to the string set in Into.
   procedure Find_Files_Path (Pattern : in String;
                              Path    : in String;
                              Into    : in out Util.Strings.Maps.Map);

   --  Returns the name of the external file with the specified directory
   --  and the name.  Unlike the Ada.Directories.Compose, the name can represent
   --  a relative path and thus include directory separators.
   function Compose (Directory : in String;
                     Name      : in String) return String;

   --  Compose an existing path by adding the specified name to each path component
   --  and return a new paths having only existing directories.  Each directory is
   --  separated by ';' (this can be overriding with the `Separator` parameter).
   --  If the composed path exists, it is added to the result path.
   --  Example:
   --    paths = 'web;regtests'  name = 'info'
   --    result = 'web/info;regtests/info'
   --  Returns the composed path.
   function Compose_Path (Paths     : in String;
                          Name      : in String;
                          Separator : in Character := ';') return String;

   --  Returns a relative path whose origin is defined by From and which refers
   --  to the absolute path referenced by To.  Both From and To are
   --  assumed to be absolute paths.  Returns the absolute path To if the relative
   --  path could not be found.  Both paths must have at least one root component in common.
   function Get_Relative_Path (From : in String;
                               To   : in String) return String;

   --  Rename the old name into a new name.
   procedure Rename (Old_Name, New_Name : in String);

   --  Delete the file including missing symbolic link
   --  or socket files (which GNAT fails to delete,
   --  see gcc/63222 and gcc/56055).
   procedure Delete_File (Path : in String);

end Util.Files;

Declare the Delete_File procedure to workarround GNAT bug that cannot delete some files


-----------------------------------------------------------------------
--  gen-commands-generate -- Generate command for dynamo
--  Copyright (C) 2011 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.
-----------------------------------------------------------------------

package Gen.Commands.Generate is

   --  ------------------------------
   --  Generator Command
   --  ------------------------------
   type Command is new Gen.Commands.Command with null record;

   --  Execute the command with the arguments.
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler);

   --  Write the help associated with the command.
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler);

end Gen.Commands.Generate;

-----------------------------------------------------------------------
--  gen-commands-generate -- Generate command for dynamo
--  Copyright (C) 2011, 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.
-----------------------------------------------------------------------

package Gen.Commands.Generate is

   --  ------------------------------
   --  Generator Command
   --  ------------------------------
   type Command is new Gen.Commands.Command with null record;

   --  Execute the command with the arguments.
   overriding
   procedure Execute (Cmd       : in Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler);

   --  Write the help associated with the command.
   overriding
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler);

end Gen.Commands.Generate;

Update to use the new command implementation


-----------------------------------------------------------------------
--  mat-readers-streams -- Reader for streams
--  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.Streams.Stream_IO;

with Util.Log.Loggers;
with MAT.Readers.Marshaller;
package body MAT.Readers.Streams is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Readers.Files");

   BUFFER_SIZE  : constant Natural := 100 * 1024;
   MAX_MSG_SIZE : constant Ada.Streams.Stream_Element_Offset := 2048;

   --  ------------------------------
   --  Read the events from the stream and stop when the end of the stream is reached.
   --  ------------------------------
   procedure Read_All (Reader : in out Stream_Reader_Type) is
      use Ada.Streams;
      use type MAT.Types.Uint8;

      Data    : aliased Ada.Streams.Stream_Element_Array (0 .. MAX_MSG_SIZE);
      Buffer  : aliased Buffer_Type;
      Msg     : Message;
      Last    : Ada.Streams.Stream_Element_Offset;
      Format  : MAT.Types.Uint8;
   begin
      Msg.Buffer := Buffer'Unchecked_Access;
      Msg.Buffer.Start := Data (0)'Address;
      Msg.Buffer.Current := Msg.Buffer.Start;
      Msg.Buffer.Last := Data (MAX_MSG_SIZE)'Address;
      Msg.Buffer.Size := 3;
      Reader.Stream.Read (Data (0 .. 2), Last);
      Format := MAT.Readers.Marshaller.Get_Uint8 (Msg.Buffer);
      if Format = 0 then
         Msg.Buffer.Endian := LITTLE_ENDIAN;
         Log.Debug ("Data stream is little endian");
      else
         Msg.Buffer.Endian := BIG_ENDIAN;
         Log.Debug ("Data stream is big endian");
      end if;
      Msg.Size := Natural (MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer));
      if Msg.Size < 2 then
         Log.Error ("Invalid message size {0}", Natural'Image (Msg.Size));
      end if;
      Reader.Stream.Read (Data (0 .. Ada.Streams.Stream_Element_Offset (Msg.Size - 1)), Last);
      Msg.Buffer.Current := Msg.Buffer.Start;
      Msg.Buffer.Last    := Data (Last)'Address;
      Msg.Buffer.Size    := Msg.Size;
      Reader.Read_Headers (Msg);
      while not Reader.Stream.Is_Eof loop
         Reader.Stream.Read (Data (0 .. 1), Last);
         exit when Last /= 2;
         Msg.Buffer.Size := 2;
         Msg.Buffer.Current := Msg.Buffer.Start;
         Msg.Size := Natural (MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer));
         if Msg.Size < 2 then
            Log.Error ("Invalid message size {0}", Natural'Image (Msg.Size));
         end if;
         if Ada.Streams.Stream_Element_Offset (Msg.Size) >= Data'Last then
            Log.Error ("Message size {0} is too big", Natural'Image (Msg.Size));
            exit;
         end if;
         Reader.Stream.Read (Data (0 .. Ada.Streams.Stream_Element_Offset (Msg.Size - 1)), Last);
         Msg.Buffer.Current := Msg.Buffer.Start;
         Msg.Buffer.Last    := Data (Last)'Address;
         Msg.Buffer.Size    := Msg.Size;
         Reader.Dispatch_Message (Msg);
      end loop;
   end Read_All;

end MAT.Readers.Streams;

-----------------------------------------------------------------------
--  mat-readers-streams -- Reader for streams
--  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.Streams;
with Ada.IO_Exceptions;

with Util.Log.Loggers;
with MAT.Readers.Marshaller;
package body MAT.Readers.Streams is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Readers.Files");

   MAX_MSG_SIZE : constant Ada.Streams.Stream_Element_Offset := 2048;

   --  ------------------------------
   --  Read a message from the stream.
   --  ------------------------------
   overriding
   procedure Read_Message (Reader : in out Stream_Reader_Type;
                           Msg    : in out Message) is
      use type Ada.Streams.Stream_Element_Offset;

      Buffer : constant Util.Streams.Buffered.Buffer_Access := Msg.Buffer.Buffer;
      Last   : Ada.Streams.Stream_Element_Offset;
   begin
      Reader.Stream.Read (Buffer (0 .. 1), Last);
      if Last /= 2 then
         raise Ada.IO_Exceptions.End_Error;
      end if;
      Msg.Buffer.Size := 2;
      Msg.Buffer.Current := Msg.Buffer.Start;
      Msg.Size := Natural (MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer));
      if Msg.Size < 2 then
         Log.Error ("Invalid message size {0}", Natural'Image (Msg.Size));
      end if;
      if Ada.Streams.Stream_Element_Offset (Msg.Size) >= Buffer'Last then
         Log.Error ("Message size {0} is too big", Natural'Image (Msg.Size));
         raise Ada.IO_Exceptions.Data_Error;
      end if;
      Reader.Stream.Read (Buffer (0 .. Ada.Streams.Stream_Element_Offset (Msg.Size - 1)), Last);
      Msg.Buffer.Current := Msg.Buffer.Start;
      Msg.Buffer.Last    := Buffer (Last)'Address;
      Msg.Buffer.Size    := Msg.Size;
   end Read_Message;

   --  ------------------------------
   --  Read the events from the stream and stop when the end of the stream is reached.
   --  ------------------------------
   procedure Read_All (Reader : in out Stream_Reader_Type) is
      use Ada.Streams;
      use type MAT.Types.Uint8;

      Data    : aliased Ada.Streams.Stream_Element_Array (0 .. MAX_MSG_SIZE);
      Buffer  : aliased Buffer_Type;
      Msg     : Message;
      Last    : Ada.Streams.Stream_Element_Offset;
      Format  : MAT.Types.Uint8;
   begin
      Msg.Buffer := Buffer'Unchecked_Access;
      Msg.Buffer.Start := Data (0)'Address;
      Msg.Buffer.Current := Msg.Buffer.Start;
      Msg.Buffer.Last := Data (MAX_MSG_SIZE)'Address;
      Msg.Buffer.Size := 3;
      Reader.Stream.Read (Data (0 .. 2), Last);
      Format := MAT.Readers.Marshaller.Get_Uint8 (Msg.Buffer);
      if Format = 0 then
         Msg.Buffer.Endian := LITTLE_ENDIAN;
         Log.Debug ("Data stream is little endian");
      else
         Msg.Buffer.Endian := BIG_ENDIAN;
         Log.Debug ("Data stream is big endian");
      end if;
      Msg.Size := Natural (MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer));
      if Msg.Size < 2 then
         Log.Error ("Invalid message size {0}", Natural'Image (Msg.Size));
      end if;
      Reader.Stream.Read (Data (0 .. Ada.Streams.Stream_Element_Offset (Msg.Size - 1)), Last);
      Msg.Buffer.Current := Msg.Buffer.Start;
      Msg.Buffer.Last    := Data (Last)'Address;
      Msg.Buffer.Size    := Msg.Size;
      Reader.Read_Headers (Msg);
      while not Reader.Stream.Is_Eof loop
         Reader.Stream.Read (Data (0 .. 1), Last);
         exit when Last /= 2;
         Msg.Buffer.Size := 2;
         Msg.Buffer.Current := Msg.Buffer.Start;
         Msg.Size := Natural (MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer));
         if Msg.Size < 2 then
            Log.Error ("Invalid message size {0}", Natural'Image (Msg.Size));
         end if;
         if Ada.Streams.Stream_Element_Offset (Msg.Size) >= Data'Last then
            Log.Error ("Message size {0} is too big", Natural'Image (Msg.Size));
            exit;
         end if;
         Reader.Stream.Read (Data (0 .. Ada.Streams.Stream_Element_Offset (Msg.Size - 1)), Last);
         Msg.Buffer.Current := Msg.Buffer.Start;
         Msg.Buffer.Last    := Data (Last)'Address;
         Msg.Buffer.Size    := Msg.Size;
         Reader.Dispatch_Message (Msg);
      end loop;
   end Read_All;

end MAT.Readers.Streams;

Implement the Read_Message procedure

Implement the Read_Message procedure