ADDED natools-tests-text_io.adb Index: natools-tests-text_io.adb ================================================================== --- natools-tests-text_io.adb +++ natools-tests-text_io.adb @@ -0,0 +1,135 @@ +------------------------------------------------------------------------------ +-- 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; ADDED natools-tests-text_io.ads Index: natools-tests-text_io.ads ================================================================== --- natools-tests-text_io.ads +++ natools-tests-text_io.ads @@ -0,0 +1,70 @@ +------------------------------------------------------------------------------ +-- 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;