Index: tests/natools-s_expressions-test_tools.adb ================================================================== --- tests/natools-s_expressions-test_tools.adb +++ tests/natools-s_expressions-test_tools.adb @@ -205,15 +205,34 @@ procedure Test_Atom_Accessors (Test : in out NT.Test; Tested : in Descriptor'Class; Expected : in Atom; - Expected_Level : in Integer := -1) + Expected_Level : in Integer := -1; + Context : in String := "") is + Context_Given : Boolean := Context = ""; + + procedure Fail_With_Context; + + procedure Fail_With_Context is + begin + if not Context_Given then + Test.Fail (Context); + Context_Given := True; + else + Test.Fail; + end if; + end Fail_With_Context; + Print_Expected : Boolean := False; begin if Tested.Current_Event /= Events.Add_Atom then + if Context /= "" then + Test.Error (Context); + end if; + Test.Error ("Test_Atom_Accessors called with current event " & Events.Event'Image (Tested.Current_Event)); return; end if; @@ -221,11 +240,12 @@ Current_Level_Test : declare Level : constant Natural := Tested.Current_Level; begin if Level /= Expected_Level then - Test.Fail ("Current_Level is" + Fail_With_Context; + Test.Info ("Current_Level is" & Integer'Image (Level) & ", expected" & Integer'Image (Expected_Level)); end if; end Current_Level_Test; @@ -235,11 +255,11 @@ declare Current_Atom : constant Atom := Tested.Current_Atom; begin if Current_Atom /= Expected then Print_Expected := True; - Test.Fail; + Fail_With_Context; Dump_Atom (Test, Current_Atom, "Current_Atom"); end if; end Current_Atom_Test; Query_Atom_Test : @@ -256,19 +276,21 @@ end Process; begin Tested.Query_Atom (Process'Access); if Calls = 0 then - Test.Fail ("Query_Atom did not call Process"); + Fail_With_Context; + Test.Info ("Query_Atom did not call Process"); elsif Calls > 1 then - Test.Fail ("Query_Atom called Process" & Integer'Image (Calls) + Fail_With_Context; + Test.Info ("Query_Atom called Process" & Integer'Image (Calls) & " times"); Print_Expected := True; Dump_Atom (Test, Buffer.Data, "Buffer"); elsif Buffer.Data /= Expected then Print_Expected := True; - Test.Fail; + Fail_With_Context; Dump_Atom (Test, Buffer.Data, "Query_Atom"); end if; end Query_Atom_Test; Long_Read_Atom_Test : @@ -278,11 +300,11 @@ begin Tested.Read_Atom (Buffer, Length); if Buffer (Buffer'First .. Buffer'First + Length - 1) /= Expected then Print_Expected := True; - Test.Fail; + Fail_With_Context; Dump_Atom (Test, Buffer (Buffer'First .. Buffer'First + Length - 1), "Read_Atom"); end if; @@ -297,11 +319,11 @@ if Expected (Expected'First .. Expected'First + Buffer'Length - 1) /= Buffer then Print_Expected := True; - Test.Fail; + Fail_With_Context; Dump_Atom (Test, Buffer, "Short Read_Atom"); end if; end Short_Read_Atom_Test; if Print_Expected then @@ -310,29 +332,50 @@ end Test_Atom_Accessors; procedure Test_Atom_Accessor_Exceptions (Test : in out NT.Test; - Tested : in Descriptor'Class) is + Tested : in Descriptor'Class; + Context : in String := "") + is + Context_Given : Boolean := Context = ""; + + procedure Fail_With_Context; + + procedure Fail_With_Context is + begin + if not Context_Given then + Test.Fail (Context); + Context_Given := True; + else + Test.Fail; + end if; + end Fail_With_Context; begin if Tested.Current_Event = Events.Add_Atom then + if Context /= "" then + Test.Error (Context); + end if; + Test.Error ("Test_Atom_Accessor_Exceptions during Events.Add_Atom"); return; end if; Current_Atom_Test : begin declare Data : constant Atom := Tested.Current_Atom; begin - Test.Fail ("No exception raised in Current_Atom"); + Fail_With_Context; + Test.Info ("No exception raised in Current_Atom"); Dump_Atom (Test, Data, "Returned value"); end; exception when Program_Error => null; when Error : others => - Test.Fail ("Wrong exception raised in Current_Atom"); + Fail_With_Context; + Test.Info ("Wrong exception raised in Current_Atom"); Test.Report_Exception (Error, NT.Fail); end Current_Atom_Test; Query_Atom_Test : declare @@ -347,17 +390,19 @@ Buffer.Append (Data); end Process; begin Tested.Query_Atom (Process'Access); - Test.Fail ("No exception raised in Query_Atom"); + Fail_With_Context; + Test.Info ("No exception raised in Query_Atom"); Dump_Atom (Test, Buffer.Data, "Buffer from" & Natural'Image (Calls) & " calls"); exception when Program_Error => null; when Error : others => - Test.Fail ("Wrong exception raised in Query_Atom"); + Fail_With_Context; + Test.Info ("Wrong exception raised in Query_Atom"); Test.Report_Exception (Error, NT.Fail); end Query_Atom_Test; Read_Atom_Test : declare @@ -364,37 +409,48 @@ Buffer : Atom (0 .. 31) := (others => 46); Length : Count; begin Tested.Read_Atom (Buffer, Length); - Test.Fail ("No exception raised in Read_Atom"); + Fail_With_Context; + Test.Info ("No exception raised in Read_Atom"); Test.Info ("Returned Length:" & Count'Image (Length)); Dump_Atom (Test, Buffer, "Output Buffer"); exception when Program_Error => null; when Error : others => - Test.Fail ("Wrong exception raised in Read_Atom"); + Fail_With_Context; + Test.Info ("Wrong exception raised in Read_Atom"); Test.Report_Exception (Error, NT.Fail); end Read_Atom_Test; end Test_Atom_Accessor_Exceptions; procedure Next_And_Check (Test : in out NT.Test; Tested : in out Descriptor'Class; Expected : in Events.Event; - Level : in Natural) + Level : in Natural; + Context : in String := "") is Event : Events.Event; begin Tested.Next (Event); if Event /= Expected then + if Context /= "" then + Test.Fail (Context); + end if; + Test.Fail ("Found event " & Events.Event'Image (Event) & ", expected " & Events.Event'Image (Expected)); elsif Tested.Current_Level /= Level then + if Context /= "" then + Test.Fail (Context); + end if; + Test.Fail ("Found event " & Events.Event'Image (Event) & " at level" & Integer'Image (Tested.Current_Level) & ", expected" @@ -405,21 +461,27 @@ procedure Next_And_Check (Test : in out NT.Test; Tested : in out Descriptor'Class; Expected : in Atom; - Level : in Natural) + Level : in Natural; + Context : in String := "") is Event : Events.Event; begin Tested.Next (Event); if Event /= Events.Add_Atom then + if Context /= "" then + Test.Fail (Context); + end if; + Test.Fail ("Found event " & Events.Event'Image (Event) & ", expected Add_Atom"); else - Test_Tools.Test_Atom_Accessors (Test, Tested, Expected, Level); + Test_Tools.Test_Atom_Accessors + (Test, Tested, Expected, Level, Context); end if; end Next_And_Check; Index: tests/natools-s_expressions-test_tools.ads ================================================================== --- tests/natools-s_expressions-test_tools.ads +++ tests/natools-s_expressions-test_tools.ads @@ -58,30 +58,34 @@ procedure Test_Atom_Accessors (Test : in out NT.Test; Tested : in Descriptor'Class; Expected : in Atom; - Expected_Level : in Integer := -1); + Expected_Level : in Integer := -1; + Context : in String := ""); -- Test all the ways of accessing atom in Tested procedure Test_Atom_Accessor_Exceptions (Test : in out NT.Test; - Tested : in Descriptor'Class); + Tested : in Descriptor'Class; + Context : in String := ""); -- Check that all atom accessors raise Program_Error procedure Next_And_Check (Test : in out NT.Test; Tested : in out Descriptor'Class; Expected : in Events.Event; - Level : in Natural); + Level : in Natural; + Context : in String := ""); -- Call Tested.Next and check the current event and level procedure Next_And_Check (Test : in out NT.Test; Tested : in out Descriptor'Class; Expected : in Atom; - Level : in Natural); + Level : in Natural; + Context : in String := ""); -- Call Tested.Next and check current event is Add_Atom with Expected, -- using Test_Atom_Accessors. type Memory_Stream is new Ada.Streams.Root_Stream_Type with private;