Index: tests/natools-s_expressions-test_tools.adb ================================================================== --- tests/natools-s_expressions-test_tools.adb +++ tests/natools-s_expressions-test_tools.adb @@ -157,6 +157,128 @@ 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; Index: tests/natools-s_expressions-test_tools.ads ================================================================== --- tests/natools-s_expressions-test_tools.ads +++ tests/natools-s_expressions-test_tools.ads @@ -15,13 +15,21 @@ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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; @@ -38,6 +46,58 @@ 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;