Index: tests/natools-s_expressions-printers-pretty-tests.adb ================================================================== --- tests/natools-s_expressions-printers-pretty-tests.adb +++ tests/natools-s_expressions-printers-pretty-tests.adb @@ -22,15 +22,10 @@ package body Natools.S_Expressions.Printers.Pretty.Tests is package Latin_1 renames Ada.Characters.Latin_1; - procedure Check_Stream - (Test : in out NT.Test; - Stream : in Test_Tools.Memory_Stream); - -- On error in Stream, report error and dump relevant information. - procedure Parse_Print_Test (Test : in out NT.Test; Param : in Parameters; Expected : in Atom); -- Parse Expected and feed it into a new pretty printer, checking @@ -39,44 +34,10 @@ ------------------------------ -- Local Helper Subprograms -- ------------------------------ - - procedure Check_Stream - (Test : in out NT.Test; - Stream : in Test_Tools.Memory_Stream) is - begin - if Stream.Has_Mismatch or else Stream.Unread_Expected /= Null_Atom then - if Stream.Has_Mismatch then - Test.Fail ("Mismatch at position" - & Count'Image (Stream.Mismatch_Index)); - - declare - Stream_Data : Atom renames Stream.Get_Data; - begin - Test_Tools.Dump_Atom - (Test, - Stream_Data (Stream_Data'First .. Stream.Mismatch_Index - 1), - "Matching data"); - Test_Tools.Dump_Atom - (Test, - Stream_Data (Stream.Mismatch_Index .. Stream_Data'Last), - "Mismatching data"); - end; - end if; - - if Stream.Unread_Expected /= Null_Atom then - Test.Fail; - Test_Tools.Dump_Atom - (Test, - Stream.Unread_Expected, - "Left to expect"); - end if; - end if; - end Check_Stream; - procedure Parse_Print_Test (Test : in out NT.Test; Param : in Parameters; Expected : in Atom) is @@ -91,11 +52,11 @@ Input.Set_Data (Expected); Output.Set_Expected (Expected); Pretty_Printer.Set_Parameters (Param); Subparser.Next (Event); Transfer (Subparser, Pretty_Printer); - Check_Stream (Test, Output); + Output.Check_Stream (Test); end; exception when Error : others => Test.Report_Exception (Error); end Parse_Print_Test; @@ -190,11 +151,11 @@ Pr.Open_List; Pr.Append_Atom (To_Atom ("01234567")); Pr.Close_List; - Check_Stream (Test, Output); + Output.Check_Stream (Test); end; Param.Fallback := Base64; declare @@ -211,11 +172,11 @@ Pr.Open_List; Pr.Append_Atom (To_Atom ("abcDEFghiJKL")); Pr.Close_List; - Check_Stream (Test, Output); + Output.Check_Stream (Test); end; exception when Error : others => Test.Report_Exception (Error); end Atom_Width; @@ -237,11 +198,11 @@ P.Close_List; P.Append_Atom (To_Atom ("arg")); P.Close_List; P.Append_Atom (To_Atom ("end")); - Check_Stream (Test, Output); + Output.Check_Stream (Test); end; exception when Error : others => Test.Report_Exception (Error); end Basic_Printing; @@ -340,11 +301,11 @@ & " ""quot\" & Latin_1.CR & "ed" & Latin_1.CR & "\n" & Latin_1.CR & "str"")")); Print (Pr); - Check_Stream (Test, Output); + Output.Check_Stream (Test); end; Param.Newline := LF; declare @@ -356,11 +317,11 @@ ("(begin" & Latin_1.LF & " ""quot\" & Latin_1.LF & "ed\r" & Latin_1.LF & "\rstr"")")); Print (Pr); - Check_Stream (Test, Output); + Output.Check_Stream (Test); end; Param.Newline := CR_LF; declare @@ -372,11 +333,11 @@ ("(begin" & Latin_1.CR & Latin_1.LF & " ""quot\" & Latin_1.CR & Latin_1.LF & "ed" & Latin_1.CR & Latin_1.LF & "\rstr"")")); Print (Pr); - Check_Stream (Test, Output); + Output.Check_Stream (Test); end; Param.Newline := LF_CR; declare @@ -388,11 +349,11 @@ ("(begin" & Latin_1.LF & Latin_1.CR & " ""quot\" & Latin_1.LF & Latin_1.CR & "ed\r" & Latin_1.LF & Latin_1.CR & "str"")")); Print (Pr); - Check_Stream (Test, Output); + Output.Check_Stream (Test); end; exception when Error : others => Test.Report_Exception (Error); end Newline_Formats; @@ -514,11 +475,11 @@ & Encodings.Encode_Hex (Source (Source'First + 1 .. Source'Last), Param.Hex_Casing) & Encodings.Hex_Atom_End); Pr.Set_Parameters (Param); Pr.Append_Atom (Source (Source'First + 1 .. Source'Last)); - Check_Stream (Test, Output); + Output.Check_Stream (Test); end; declare Output : aliased Test_Tools.Memory_Stream; Pr : Printer (Output'Access); @@ -531,11 +492,11 @@ & "\xAA, \xC3, \xE2\x88, \xF0\x9F\x81, \xF9\x88\xB4\x95, " & "\xFD\xB6\x95\x83\x88, \xFE." & Latin_1.CR & Latin_1.LF & "<>\r\n""")); Pr.Set_Parameters (Param); Pr.Append_Atom (Source); - Check_Stream (Test, Output); + Output.Check_Stream (Test); end; Param.Char_Encoding := Latin; Param.Hex_Casing := Encodings.Lower; @@ -566,11 +527,11 @@ & "\x95\x83\x88, " & Character'Val (16#FE#) & '.' & Latin_1.CR & Latin_1.LF & "<>\r\n""")); Pr.Set_Parameters (Param); Pr.Append_Atom (Source); - Check_Stream (Test, Output); + Output.Check_Stream (Test); end; Param.Char_Encoding := UTF_8; Param.Quoted_Escape := Octal_Escape; @@ -585,11 +546,11 @@ & "\371\210\264\225, \375\266\225\203\210, \376." & Latin_1.CR & Latin_1.LF & "<>\r\n""")); Pr.Set_Parameters (Param); Pr.Append_Atom (Source); - Check_Stream (Test, Output); + Output.Check_Stream (Test); end; Param.Width := 31; declare @@ -606,11 +567,11 @@ & "\225\203\210, \376." & Latin_1.CR & Latin_1.LF & "<>\r\n""")); Pr.Set_Parameters (Param); Pr.Append_Atom (Source); - Check_Stream (Test, Output); + Output.Check_Stream (Test); end; exception when Error : others => Test.Report_Exception (Error); end Quoted_String_Escapes; @@ -640,11 +601,11 @@ Pr : Printer (Output'Access); begin Output.Set_Expected (To_Atom ("5:begin(()(4:head4:tail))3:end")); Pr.Set_Parameters (Param); Test_Exp (Pr); - Check_Stream (Test, Output); + Output.Check_Stream (Test); end; Param.Space_At := (others => (others => True)); declare @@ -653,11 +614,11 @@ begin Output.Set_Expected (To_Atom ("5:begin ( ( ) ( 4:head 4:tail ) ) 3:end")); Pr.Set_Parameters (Param); Test_Exp (Pr); - Check_Stream (Test, Output); + Output.Check_Stream (Test); end; Param.Newline_At := (others => (others => True)); Param.Newline := LF; @@ -675,11 +636,11 @@ & ')' & Latin_1.LF & ')' & Latin_1.LF & "3:end")); Pr.Set_Parameters (Param); Test_Exp (Pr); - Check_Stream (Test, Output); + Output.Check_Stream (Test); end; exception when Error : others => Test.Report_Exception (Error); end Separators; @@ -725,12 +686,12 @@ Pr.Append_Atom (Token); Pr.Close_List; Pr.Append_Atom (To_Atom ("end")); Pr.Close_List; - Check_Stream (Test, Output); + Output.Check_Stream (Test); end; exception when Error : others => Test.Report_Exception (Error); end Token_Separation; end Natools.S_Expressions.Printers.Pretty.Tests; Index: tests/natools-s_expressions-test_tools.adb ================================================================== --- tests/natools-s_expressions-test_tools.adb +++ tests/natools-s_expressions-test_tools.adb @@ -322,6 +322,40 @@ else return 0; end if; end Mismatch_Index; + + procedure Check_Stream + (Stream : in Test_Tools.Memory_Stream; + Test : in out NT.Test) is + begin + if Stream.Has_Mismatch or else Stream.Unread_Expected /= Null_Atom then + if Stream.Has_Mismatch then + Test.Fail ("Mismatch at position" + & Count'Image (Stream.Mismatch_Index)); + + declare + Stream_Data : Atom renames Stream.Get_Data; + begin + Test_Tools.Dump_Atom + (Test, + Stream_Data (Stream_Data'First .. Stream.Mismatch_Index - 1), + "Matching data"); + Test_Tools.Dump_Atom + (Test, + Stream_Data (Stream.Mismatch_Index .. Stream_Data'Last), + "Mismatching data"); + end; + end if; + + if Stream.Unread_Expected /= Null_Atom then + Test.Fail; + Test_Tools.Dump_Atom + (Test, + Stream.Unread_Expected, + "Left to expect"); + end if; + end if; + end Check_Stream; + 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 @@ -96,10 +96,15 @@ function Mismatch_Index (Stream : Memory_Stream) return Count; -- Return the position of the first mismatching octet, -- or 0 when there has been no mismatch. + procedure Check_Stream + (Stream : in Test_Tools.Memory_Stream; + Test : in out NT.Test); + -- On error in Stream, report error and dump relevant information. + private type Memory_Stream is new Ada.Streams.Root_Stream_Type with record Internal : Atom_Buffers.Atom_Buffer; Expected : Atom_Buffers.Atom_Buffer;