------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- A U N I T . R E P O R T E R . X M L --
-- --
-- B o d y --
-- --
-- --
-- Copyright (C) 2000-2009, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- GNAT is maintained by AdaCore (http://www.adacore.com) --
-- --
------------------------------------------------------------------------------
with Util.Strings;
with Util.Strings.Transforms;
with AUnit.Time_Measure;
-- Very simple reporter to console
package body Util.Tests.Reporter is
use AUnit.Test_Results;
use type AUnit.Message_String;
use type AUnit.Time_Measure.Time;
use Ada.Text_IO;
procedure Print_Summary (R : in out Result'Class);
procedure Dump_Result_List (File : in Ada.Text_IO.File_Type;
L : in Result_Lists.List);
-- List failed assertions
-- procedure Put_Measure is new Gen_Put_Measure;
-- Output elapsed time
procedure Report_Test (File : in Ada.Text_IO.File_Type;
Test : in Test_Result);
-- Report a single assertion failure or unexpected exception
procedure Put (File : in Ada.Text_IO.File_Type;
I : in Integer);
procedure Put (File : in Ada.Text_IO.File_Type;
T : in AUnit.Time_Measure.Time);
procedure Put (File : in Ada.Text_IO.File_Type;
I : in Integer) is
begin
Ada.Text_IO.Put (File, Util.Strings.Image (I));
end Put;
procedure Put (File : in Ada.Text_IO.File_Type;
T : in AUnit.Time_Measure.Time) is
use Ada.Calendar;
D : constant Duration := T.Stop - T.Start;
S : constant String := Duration'Image (D);
Pos : Natural := S'Last;
begin
while Pos > S'First and S (Pos) = '0' loop
Pos := Pos - 1;
end loop;
if D >= 0.0 then
Put (File, S (S'First + 1 .. Pos));
else
Put (File, S (S'First .. Pos));
end if;
end Put;
----------------------
-- Dump_Result_List --
----------------------
procedure Dump_Result_List (File : in Ada.Text_IO.File_Type;
L : in Result_Lists.List) is
use Result_Lists;
C : Cursor := First (L);
begin
-- Note: can't use Iterate because it violates restriction
-- No_Implicit_Dynamic_Code
while Has_Element (C) loop
Report_Test (File, Element (C));
Next (C);
end loop;
end Dump_Result_List;
------------
-- Report --
------------
procedure Report (Engine : in XML_Reporter;
R : in out Result'Class;
Options : in AUnit.Options.AUnit_Options := AUnit.Options.Default_Options)
is
Output : Ada.Text_IO.File_Type;
begin
Ada.Text_IO.Create (File => Output,
Mode => Ada.Text_IO.Out_File,
Name => To_String (Engine.File));
Engine.Report (Output, R);
Ada.Text_IO.Close (Output);
end Report;
procedure Print_Summary (R : in out Result'Class) is
S_Count : constant Integer := Integer (Success_Count (R));
F_Count : constant Integer := Integer (Failure_Count (R));
E_Count : constant Integer := Integer (Error_Count (R));
begin
New_Line;
Put ("Total Tests Run: ");
Put (Util.Strings.Image (Integer (Test_Count (R))));
New_Line;
Put ("Successful Tests: ");
Put (Util.Strings.Image (S_Count));
New_Line;
Put ("Failed Assertions: ");
Put (Util.Strings.Image (F_Count));
New_Line;
Put ("Unexpected Errors: ");
Put (Util.Strings.Image (E_Count));
New_Line;
end Print_Summary;
------------
-- Report --
------------
procedure Report (Engine : XML_Reporter;
File : in out Ada.Text_IO.File_Type;
R : in out Result'Class)
is
pragma Unreferenced (Engine);
begin
Put_Line (File, "");
Put (File, "");
else
Put_Line (File, ">");
end if;
Print_Summary (R);
Put_Line (File, " ");
Put (File, " ");
Put (File, Integer (Test_Count (R)));
Put_Line (File, "");
Put (File, " ");
Put (File, Integer (Failure_Count (R)) + Integer (Error_Count (R)));
Put_Line (File, "");
Put (File, " ");
Put (File, Integer (Failure_Count (R)));
Put_Line (File, "");
Put (File, " ");
Put (File, Integer (Error_Count (R)));
Put_Line (File, "");
Put_Line (File, " ");
declare
S : Result_Lists.List;
begin
Put_Line (File, " ");
Successes (R, S);
Dump_Result_List (File, S);
Put_Line (File, " ");
end;
Put_Line (File, " ");
declare
F : Result_Lists.List;
begin
Failures (R, F);
Dump_Result_List (File, F);
end;
declare
E : Result_Lists.List;
begin
Errors (R, E);
Dump_Result_List (File, E);
end;
Put_Line (File, " ");
Put_Line (File, "");
end Report;
------------------
-- Report_Error --
------------------
procedure Report_Test (File : in Ada.Text_IO.File_Type;
Test : in Test_Result) is
use Util.Strings.Transforms;
use type Ada.Calendar.Time;
Is_Assert : Boolean;
begin
Put (File, " ");
else
Put_Line (File, ">");
end if;
Put (File, " ");
Put (File, Escape_Xml (Test.Test_Name.all));
if Test.Routine_Name /= null then
Put (File, " : ");
Put (File, Escape_Xml (Test.Routine_Name.all));
end if;
Put_Line (File, "");
if Test.Failure /= null or else Test.Error /= null then
if Test.Failure /= null then
Is_Assert := True;
else
Is_Assert := False;
end if;
Put (File, " ");
if Is_Assert then
Put (File, "Assertion");
else
Put (File, "Error");
end if;
Put_Line (File, "");
Put (File, " ");
if Is_Assert then
Put (File, Escape_Xml (Test.Failure.Message.all));
else
Put (File, Test.Error.Exception_Name.all);
end if;
Put_Line (File, "");
if Is_Assert then
Put_Line (File, " ");
Put (File, " ");
Put (File, Escape_Xml (Test.Failure.Source_Name.all));
Put_Line (File, "");
Put (File, " ");
Put (File, Test.Failure.Line);
Put_Line (File, "");
Put_Line (File, " ");
else
Put_Line (File, " ");
Put (File, " ");
Put (File, Test.Error.Exception_Name.all);
Put_Line (File, "");
if Test.Error.Exception_Message /= null then
Put (File, " ");
Put (File, Escape_Xml (Test.Error.Exception_Message.all));
Put_Line (File, "");
end if;
if Test.Error.Traceback /= null then
Put (File, " ");
Put (File, Escape_Xml (Test.Error.Traceback.all));
Put_Line (File, "");
end if;
Put_Line (File, " ");
end if;
end if;
Put_Line (File, " ");
end Report_Test;
end Util.Tests.Reporter;