Natools

------------------------------------------------------------------------------
-- Copyright (c) 2011, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Ada.Strings.Fixed;
with Ada.Text_IO;

package body Natools.Tests.Text_IO is

   ------------------------
   -- Helper subprograms --
   ------------------------

   function Indentation (Level : Natural) return String;
      --  Return the indentation string for the given level.

   function Indentation (Report : Text_Reporter) return String;
      --  Return the indentation string for the current level of Report.


   function Indentation (Level : Natural) return String is
      use Ada.Strings.Fixed;
   begin
      return Level * "  ";
   end Indentation;


   function Indentation (Report : Text_Reporter) return String is
   begin
      return Indentation (Natural (Report.Results.Length));
   end Indentation;


   ------------------------
   -- Public subprograms --
   ------------------------

   procedure Section (Report : in out Text_Reporter; Name : String) is
   begin
      Ada.Text_IO.Put_Line (Indentation (Report) & "Section: " & Name);
      Result_Lists.Append (Report.Results, (others => 0));
   end Section;


   procedure End_Section (Report : in out Text_Reporter) is
      Last_Item : Result_Lists.Cursor := Report.Results.Last;
   begin
      Result_Lists.Delete (Report.Results, Last_Item);
   end End_Section;


   procedure Item
     (Report  : in out Text_Reporter;
      Name    : in     String;
      Outcome : in     Result)
   is
      use Ada.Strings.Fixed;

      procedure Process (Position : Result_Lists.Cursor);
      procedure Update (R : in out Result_Summary);

      Indent : constant String := Indentation (Report);
      Text_Size : constant Positive
        := Indent'Length + Name'Length + Max_Result_String_Size + 1;
      Line_Length : constant Natural
        := Natural (Ada.Text_IO.Line_Length);

      procedure Process (Position : Result_Lists.Cursor) is
      begin
         Result_Lists.Update_Element (Report.Results, Position, Update'Access);
      end Process;

      procedure Update (R : in out Result_Summary) is
      begin
         R (Outcome) := R (Outcome) + 1;
      end Update;
   begin
      if Text_Size < Line_Length then
         Ada.Text_IO.Put_Line (Indent & Name
                               & (Line_Length - Text_Size) * " "
                               & Result'Image (Outcome));
      else
         Ada.Text_IO.Put_Line (Indent & Name);
         Ada.Text_IO.Put_Line (Indent & " -> " & Result'Image (Outcome));
      end if;
      Result_Lists.Iterate (Report.Results, Process'Access);
      Report.Total (Outcome) := Report.Total (Outcome) + 1;
   end Item;


   procedure Info (Report : in out Text_Reporter; Text : String) is
      pragma Unreferenced (Report);
   begin
      Ada.Text_IO.Put_Line (Text);
   end Info;


   function Current_Results (Report : Text_Reporter) return Result_Summary is
   begin
      return Result_Lists.Element (Report.Results.Last);
   end Current_Results;

   function Total_Results (Report : Text_Reporter) return Result_Summary is
   begin
      return Report.Total;
   end Total_Results;


   procedure Print_Results (R : Result_Summary) is
      use Ada.Strings.Fixed;
   begin
      for I in R'Range loop
         declare
            Image : constant String := Result'Image (I);
         begin
            Ada.Text_IO.Put_Line
              (Image
              & (Max_Result_String_Size + 1 - Image'Length) * " "
              & Natural'Image (R (I)));
         end;
      end loop;
   end Print_Results;
end Natools.Tests.Text_IO;

------------------------------------------------------------------------------
-- Copyright (c) 2011, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.Tests.Text_IO is a simple implementation of Natools.Tests        --
-- interface. It immediately prints Item and Info to default output using   --
-- Ada.Text_IO facilities. Current and total result summaries are stored    --
-- in a stack using Doubly_Linked_Lists.                                    --
-- Sections are represented by a two-space indentation.                     --
------------------------------------------------------------------------------

private with Ada.Containers.Doubly_Linked_Lists;

package Natools.Tests.Text_IO is

   type Text_Reporter is new Reporter with private;

   procedure Section (Report : in out Text_Reporter; Name : String);
      --  Start a new (sub)section. This prints section header and increments
      --    indentation.

   procedure End_Section (Report : in out Text_Reporter);
      --  End the current (sub)section. This does not output anything, but
      --    decrements the current indentation.

   procedure Item
     (Report  : in out Text_Reporter;
      Name    : in     String;
      Outcome : in     Result);
      --  Output the Item with its outcome. If Line_Length is wide enough,
      --    the outcome is right-aligned on the same line as the test name,
      --    otherwise it is printed below with an additional indentation.

   procedure Info (Report : in out Text_Reporter; Text : String);
      --  Output the Text directly. Association with previous Item is visual.

   function Current_Results (Report : Text_Reporter) return Result_Summary;
      --  Return the number of each result type in the current subsection.

   function Total_Results (Report : Text_Reporter) return Result_Summary;
      --  Return the total number of each result type.


   procedure Print_Results (R : Result_Summary);
      --  Pretty-print the result summary into the default output.

private

   package Result_Lists is
      new Ada.Containers.Doubly_Linked_Lists (Result_Summary);

   type Text_Reporter is new Reporter with record
      Results : Result_Lists.List;
      Total : Result_Summary := (others => 0);
   end record;

end Natools.Tests.Text_IO;