Natools

      else
         Report.Item (Test_Name, NT.Fail);
         Dump_Atom (Report, Found, "Found");
         Dump_Atom (Report, Expected, "Expected");
      end if;
   end Test_Atom;



   -------------------
   -- Memory Stream --
   -------------------

   overriding procedure Read
     (Stream : in out Memory_Stream;
      Item : out Ada.Streams.Stream_Element_Array;
      Last : out Ada.Streams.Stream_Element_Offset) is
   begin
      Last := Item'First - 1;

      while Last + 1 in Item'Range
        and then Stream.Read_Pointer < Stream.Internal.Length
      loop
         Stream.Read_Pointer := Stream.Read_Pointer + 1;
         Last := Last + 1;
         Item (Last) := Stream.Internal.Element (Stream.Read_Pointer);
      end loop;
   end Read;


   overriding procedure Write
     (Stream : in out Memory_Stream;
      Item : in Ada.Streams.Stream_Element_Array) is
   begin
      if Stream.Read_Pointer >= Stream.Internal.Length then
         Stream.Internal.Soft_Reset;
         Stream.Read_Pointer := 0;
      end if;

      Stream.Internal.Append (Item);

      if not Stream.Mismatch then
         for I in Item'Range loop
            if Stream.Expect_Pointer + 1 > Stream.Expected.Length
              or else Stream.Expected.Element (Stream.Expect_Pointer + 1)
                /= Item (I)
            then
               Stream.Mismatch := True;
               exit;
            end if;

            Stream.Expect_Pointer := Stream.Expect_Pointer + 1;
         end loop;
      end if;
   end Write;


   function Get_Data (Stream : Memory_Stream) return Atom is
   begin
      return Stream.Internal.Query;
   end Get_Data;


   function Unread_Data (Stream : Memory_Stream) return Atom is
   begin
      if Stream.Read_Pointer < Stream.Internal.Length then
         return Stream.Internal.Query.Data.all
           (Stream.Read_Pointer + 1 .. Stream.Internal.Length);
      else
         return Null_Atom;
      end if;
   end Unread_Data;


   procedure Set_Data
     (Stream : in out Memory_Stream;
      Data : in Atom) is
   begin
      Stream.Internal.Soft_Reset;
      Stream.Internal.Append (Data);
   end Set_Data;


   function Unread_Expected (Stream : Memory_Stream) return Atom is
   begin
      if Stream.Expect_Pointer < Stream.Expected.Length then
         return Stream.Expected.Query.Data.all
           (Stream.Expect_Pointer + 1 .. Stream.Expected.Length);
      else
         return Null_Atom;
      end if;
   end Unread_Expected;


   procedure Set_Expected
     (Stream : in out Memory_Stream;
      Data : in Atom;
      Reset_Mismatch : in Boolean := True) is
   begin
      Stream.Expected.Soft_Reset;
      Stream.Expected.Append (Data);
      Stream.Expect_Pointer := 0;
      if Reset_Mismatch then
         Stream.Mismatch := False;
      end if;
   end Set_Expected;


   function Has_Mismatch (Stream : Memory_Stream) return Boolean is
   begin
      return Stream.Mismatch;
   end Has_Mismatch;


   procedure Reset_Mismatch (Stream : in out Memory_Stream) is
   begin
      Stream.Mismatch := False;
   end Reset_Mismatch;


   function Mismatch_Index (Stream : Memory_Stream) return Count is
   begin
      if Stream.Mismatch then
         return Stream.Expect_Pointer + 1;
      else
         return 0;
      end if;
   end Mismatch_Index;

end Natools.S_Expressions.Test_Tools;

-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.S_Expressions.Test_Tools provides tools used in S-expression     --
-- test suites.                                                             --
-- Memory_Stream is a stream implementation around a memory buffer where    --
-- written data can be subsequently read. A secondary buffer of expected    --
-- data can be optionally used, and the mismatch marker is set when written --
-- data does not match expected data.                                       --
------------------------------------------------------------------------------

with Ada.Streams;

with Natools.Tests;

with Natools.S_Expressions.Atom_Buffers;

package Natools.S_Expressions.Test_Tools is
   pragma Preelaborate (Test_Tools);

   package NT renames Natools.Tests;

   procedure Dump_Atom
     (Report : in out NT.Reporter'Class;
      Data : in Atom;
      Label : in String := "");
      --  Dump contents on Data as info in Report

   procedure Test_Atom
     (Report : in out NT.Reporter'Class;
      Test_Name : in String;
      Expected : in Atom;
      Found : in Atom);
      --  Report success when Found is equal to Expected, and failure
      --  with diagnostics otherwise.


   type Memory_Stream is new Ada.Streams.Root_Stream_Type with private;

   overriding procedure Read
     (Stream : in out Memory_Stream;
      Item : out Ada.Streams.Stream_Element_Array;
      Last : out Ada.Streams.Stream_Element_Offset);
      --  Consume data from the beginning of internal buffer

   overriding procedure Write
     (Stream : in out Memory_Stream;
      Item : in Ada.Streams.Stream_Element_Array);
      --  Append data at the end of internal buffer

   function Get_Data (Stream : Memory_Stream) return Atom;
      --  Return internal buffer

   function Unread_Data (Stream : Memory_Stream) return Atom;
      --  Return part of internal buffer that has not yet been read

   procedure Set_Data
     (Stream : in out Memory_Stream;
      Data : in Atom);
      --  Replace whole internal buffer with Data

   function Unread_Expected (Stream : Memory_Stream) return Atom;
      --  Return part of expected buffer that has not been matched yet

   procedure Set_Expected
     (Stream : in out Memory_Stream;
      Data : in Atom;
      Reset_Mismatch : in Boolean := True);
      --  Replace buffer of expected data

   function Has_Mismatch (Stream : Memory_Stream) return Boolean;
   procedure Reset_Mismatch (Stream : in out Memory_Stream);
      --  Accessor and mutator of the mismatch flag

   function Mismatch_Index (Stream : Memory_Stream) return Count;
      --  Return the position of the first mismatching octet,
      --  or 0 when there has been no mismatch.

private

   type Memory_Stream is new Ada.Streams.Root_Stream_Type with record
      Internal : Atom_Buffers.Atom_Buffer;
      Expected : Atom_Buffers.Atom_Buffer;
      Read_Pointer : Count := 0;
      Expect_Pointer : Count := 0;
      Mismatch : Boolean := False;
   end record;

end Natools.S_Expressions.Test_Tools;