ada-libraries
/
gnatbdd
mirror of https://github.com/briot/gnatbdd
1
0
Fork 0
Code Issues Releases Wiki Activity

Provide HTML output 

This improves the framework for outputs, since the difference between
HTML and text output is only done at the lowest-level (user-overridable)
level. Other outputs could be done similarly now that the framework is in
place
This commit is contained in:
Emmanuel Briot 2014-06-05 11:34:10 +02:00
parent 3b9f0c149a
commit c0535d7b50
15 changed files with 1071 additions and 384 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
Makefile
View File

@ -6,10 +6,11 @@ build:
# Adding new scenarios does not erquire recompiling the driver
test: build_driver
./obj/driver --output=full
#./obj/driver --output=hide_passed
#./obj/driver --output=quiet
#./obj/driver --output=dots
#-./obj/driver --output=hide_passed
#-./obj/driver --output=quiet
#-./obj/driver --output=dots
-./obj/driver --output=full
-./obj/driver --output=full -o test.html
# Driver only needs to be recompiled when the step definitions change
build_driver: features/step_definitions/*

6
docs/output.rst
View File

@ -133,3 +133,9 @@ For the compilation to succeed, GNATbdd needs to find where the sources of the
steps are (see the :option:`--steps` switch), as well as all the sources on
which they depend. Such sources are found via a GNAT Project file, which can
be specified with the :option:`-P PROJECT.gpr` switch.
Exit status
===========
On exit, the driver will set its status to the number of failed scenarios.
As a result, it is easy to check whether there are any unexpected failures.

52
src/bdd-asserts.adb
View File

@ -22,8 +22,7 @@
------------------------------------------------------------------------------
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Text_IO; use Ada.Text_IO;
with GNATCOLL.Terminal; use GNATCOLL.Terminal;
with BDD.Media; use BDD.Media;
with GNATCOLL.Traces; use GNATCOLL.Traces;
package body BDD.Asserts is
@ -36,8 +35,8 @@ package body BDD.Asserts is
overriding procedure Display
(Self : not null access Error_With_Table;
Term : not null access GNATCOLL.Terminal.Terminal_Info'Class;
File : Ada.Text_IO.File_Type;
Output : not null access Media_Writer'Class;
Status : Scenario_Status;
Prefix : String := "");
procedure Diff
@ -179,10 +178,11 @@ package body BDD.Asserts is
overriding procedure Display
(Self : not null access Error_With_Table;
Term : not null access GNATCOLL.Terminal.Terminal_Info'Class;
File : Ada.Text_IO.File_Type;
Output : not null access Media_Writer'Class;
Status : Scenario_Status;
Prefix : String := "")
is
pragma Unreferenced (Status);
Current_Row : Integer := -1;
Widths : array (1 .. Self.Val1.Width) of Natural := (others => 0);
@ -199,6 +199,7 @@ package body BDD.Asserts is
E, A : String;
Status : Scenario_Status) return Boolean
is
pragma Unreferenced (Row);
W : Integer;
begin
if Status = Status_Failed then
@ -223,44 +224,39 @@ package body BDD.Asserts is
E, A : String;
Status : Scenario_Status) return Boolean
is
W : Integer := 0;
begin
if Row /= 1 and then Row /= Current_Row then
Put_Line (File, "|");
Output.End_Row;
end if;
if Row /= Current_Row then
Current_Row := Row;
Put (File, Prefix);
Output.Start_Row (Indent => Prefix);
end if;
Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Style => Reset_All);
Put (File, "| ");
Term.Set_Color
(Term => File,
Foreground => BDD.Step_Colors (Status));
Put (File, A);
W := W + A'Length;
if Status = Status_Failed then
Term.Set_Color
(Term => File,
Foreground => BDD.Config_Color);
Put (File, " /= " & E);
W := W + 4 + E'Length;
Output.Display_Cell
(A & " /= " & E,
Cell_Width => Widths (Column_In_Expected),
Header => False,
Status => Status);
else
Output.Display_Cell
(A,
Cell_Width => Widths (Column_In_Expected),
Header => False,
Status => Status);
end if;
Put (File, (1 .. Widths (Column_In_Expected) - W + 1 => ' '));
return True;
end On_Cell;
begin
Diff (Self.Val1, Self.Val2, On_Error'Access, Compute_Width'Access);
Output.Start_Table;
Diff (Self.Val1, Self.Val2, On_Error'Access, On_Cell'Access);
Put_Line (File, "|");
Output.End_Row;
Output.End_Table;
end Display;
end BDD.Asserts;

28
src/bdd-asserts_generic.adb
View File

@ -21,8 +21,6 @@
-- --
------------------------------------------------------------------------------
with BDD.Formatters; use BDD.Formatters;
package body BDD.Asserts_Generic is
Current_Exception : Assert_Error := No_Error;
@ -90,12 +88,12 @@ package body BDD.Asserts_Generic is
procedure Display
(Self : Assert_Error;
Term : not null access GNATCOLL.Terminal.Terminal_Info'Class;
File : Ada.Text_IO.File_Type;
Output : not null access BDD.Media.Media_Writer'Class;
Status : Scenario_Status;
Prefix : String := "")
is
begin
Display (Self.Details, Term, File, Prefix);
Display (Self.Details, Output, Status, Prefix);
end Display;
-------------
@ -104,28 +102,30 @@ package body BDD.Asserts_Generic is
procedure Display
(Self : not null access Error_Details;
Term : not null access GNATCOLL.Terminal.Terminal_Info'Class;
File : Ada.Text_IO.File_Type;
Output : not null access BDD.Media.Media_Writer'Class;
Status : Scenario_Status;
Prefix : String := "")
is
pragma Unreferenced (Term);
begin
Output.Start_Step_Messages (Status => Status);
if Self.Msg /= "" then
Indent (File, To_String (Self.Msg), Prefix => Prefix);
Output.Indent (To_String (Self.Msg), Prefix => Prefix);
if Element (Self.Msg, Length (Self.Msg)) /= ASCII.LF then
New_Line (File);
Output.New_Line;
end if;
end if;
if Self.Details /= "" then
Indent (File, To_String (Self.Details), Prefix => Prefix);
Output.Indent (To_String (Self.Details), Prefix => Prefix);
if Element (Self.Details, Length (Self.Details)) /= ASCII.LF then
New_Line (File);
Output.New_Line;
end if;
end if;
Indent (File, To_String (Self.Location), Prefix => Prefix);
New_Line (File);
Output.Indent (To_String (Self.Location), Prefix => Prefix);
Output.New_Line;
Output.End_Step_Messages;
end Display;
--------------------

11
src/bdd-asserts_generic.ads
View File

@ -25,10 +25,9 @@
with Ada.Exceptions; use Ada.Exceptions;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Text_IO; use Ada.Text_IO;
with BDD.Media; use BDD.Media;
with GNAT.Source_Info;
with GNATCOLL.Refcount; use GNATCOLL.Refcount;
with GNATCOLL.Terminal; use GNATCOLL.Terminal;
package BDD.Asserts_Generic is
@ -102,13 +101,13 @@ package BDD.Asserts_Generic is
procedure Display
(Self : Assert_Error;
Term : not null access GNATCOLL.Terminal.Terminal_Info'Class;
File : Ada.Text_IO.File_Type;
Output : not null access BDD.Media.Media_Writer'Class;
Status : Scenario_Status;
Prefix : String := "");
procedure Display
(Self : not null access Error_Details;
Term : not null access GNATCOLL.Terminal.Terminal_Info'Class;
File : Ada.Text_IO.File_Type;
Output : not null access BDD.Media.Media_Writer'Class;
Status : Scenario_Status;
Prefix : String := "");
-- Display the details on File, using Term to set appropriate colors.

361
src/bdd-formatters.adb
View File

@ -22,30 +22,17 @@
------------------------------------------------------------------------------
with Ada.Containers; use Ada.Containers;
with Ada.Text_IO; use Ada.Text_IO;
with BDD.Asserts_Generic; use BDD.Asserts_Generic;
with BDD.Tables; use BDD.Tables;
with GNATCOLL.Terminal; use GNATCOLL.Terminal;
with GNATCOLL.Utils; use GNATCOLL.Utils;
with GNAT.Regpat; use GNAT.Regpat;
package body BDD.Formatters is
Scenario_Indent : constant String := " ";
Step_Indent : constant String := " ";
-- Visual indentation in the display
function Scenario_Name (Scenario : BDD.Features.Scenario) return String;
-- Return a string used to identify the scenario for the user.
procedure Display_Location
(Self : Formatter'Class; Scenario : BDD.Features.Scenario);
procedure Display_Location
(Self : Formatter'Class;
Scenario : BDD.Features.Scenario;
Step : not null access BDD.Features.Step_Record'Class;
Extra : String := "");
-- Display location information for the scenario or the step
procedure Display_Scenario_Header
(Self : in out Formatter'Class;
Scenario : BDD.Features.Scenario);
@ -62,32 +49,16 @@ package body BDD.Formatters is
Step : not null access BDD.Features.Step_Record'Class);
-- Display the text for a specific step
procedure Display_Progress
(Self : in out Formatter'Class;
Scenario : BDD.Features.Scenario);
-- Display the name of the scenario being run, if supported by the
-- terminal
function Text_And_Align
(Scenario : BDD.Features.Scenario;
Text : String) return String;
-- Display text (assuming at the beginning of a line), and adds trailing
-- spaces so that the cursor is left aligned at a column suitable for
-- displaying the location.
procedure Clear_Progress (Self : in out Formatter'Class);
-- Clear progress indicator if needed.
----------
-- Init --
----------
procedure Init
(Self : in out Formatter;
Term : GNATCOLL.Terminal.Terminal_Info_Access)
Output : not null access Media_Writer'Class)
is
begin
Self.Term := Term;
Self.Output := Output;
end Init;
-------------------
@ -130,7 +101,7 @@ package body BDD.Formatters is
procedure Show_Scenario (Scenario : BDD.Features.Scenario) is
begin
Scenario.Foreach_Step (Show_Step'Access);
New_Line;
Self.Output.New_Line;
end Show_Scenario;
begin
@ -139,115 +110,13 @@ package body BDD.Formatters is
case Scenario.Kind is
when Kind_Scenario | Kind_Background =>
Scenario.Foreach_Step (Show_Step'Access);
New_Line;
Self.Output.New_Line;
when Kind_Outline =>
Scenario.Foreach_Scenario (Show_Scenario'Access);
end case;
end Display_Scenario_And_Steps;
----------------------
-- Display_Location --
----------------------
procedure Display_Location
(Self : Formatter'Class;
Scenario : BDD.Features.Scenario)
is
begin
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Foreground => Grey);
Put ("# " & Scenario_Name (Scenario));
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Style => Reset_All);
New_Line;
end Display_Location;
----------------------
-- Display_Location --
----------------------
procedure Display_Location
(Self : Formatter'Class;
Scenario : BDD.Features.Scenario;
Step : not null access BDD.Features.Step_Record'Class;
Extra : String := "")
is
begin
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Foreground => Grey);
Put ("# "
& Extra
& (+Scenario.Get_Feature.File.Relative_Path (Features_Directory))
& ":" & Image (Step.Line, 1));
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Style => Reset_All);
New_Line;
end Display_Location;
--------------------
-- Text_And_Align --
--------------------
function Text_And_Align
(Scenario : BDD.Features.Scenario;
Text : String) return String
is
Long : constant Natural := Scenario.Longuest_Step + Step_Indent'Length;
begin
return Text & (1 .. 1 + Long - Text'Length => ' ');
end Text_And_Align;
----------------------
-- Display_Progress --
----------------------
procedure Display_Progress
(Self : in out Formatter'Class;
Scenario : BDD.Features.Scenario)
is
Width : constant Integer := Self.Term.Get_Width;
begin
if Width /= -1 then
declare
N : constant String := Scenario_Name (Scenario);
begin
Self.Term.Beginning_Of_Line;
Self.Term.Clear_To_End_Of_Line;
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Foreground => Grey);
Put
("Running: "
& N (N'First .. Integer'Min (N'Last, N'First + Width - 10)));
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Style => Reset_All);
Self.Term.Beginning_Of_Line;
Self.Progress_Displayed := True;
end;
end if;
end Display_Progress;
--------------------
-- Clear_Progress --
--------------------
procedure Clear_Progress (Self : in out Formatter'Class) is
begin
if Self.Progress_Displayed then
Self.Progress_Displayed := False;
Self.Term.Beginning_Of_Line;
Self.Term.Clear_To_End_Of_Line;
end if;
end Clear_Progress;
-----------------------------
-- Display_Scenario_Header --
-----------------------------
@ -259,41 +128,17 @@ package body BDD.Formatters is
F : constant Feature'Class := Scenario.Get_Feature;
begin
if F.Id /= Self.Last_Displayed_Feature_Id then
Put_Line (Cst_Features & ' ' & F.Name);
Put_Line (F.Description);
Self.Output.Display_Feature (F.Name, F.Description);
Self.Last_Displayed_Feature_Id := F.Id;
end if;
Put (Text_And_Align
(Scenario,
Scenario_Indent & Scenario.Prefix & ' ' & Scenario.Name));
Display_Location (Self, Scenario);
Self.Output.Display_Scenario
(Prefix => Scenario.Prefix,
Name => Scenario.Name,
Longuest_Step => Scenario.Longuest_Step,
Location => Scenario_Name (Scenario));
end Display_Scenario_Header;
------------
-- Indent --
------------
procedure Indent
(File : Ada.Text_IO.File_Type;
Text : String;
Prefix : String := "")
is
Start, Last : Integer;
begin
Start := Text'First;
while Start <= Text'Last loop
Last := Line_End (Text, Start);
if Last < Start then -- empty line
New_Line (File);
Start := Last + 2;
else
Put (File, Prefix & Text (Start .. Last));
Start := Last + 1;
end if;
end loop;
end Indent;
------------------
-- Display_Step --
------------------
@ -303,109 +148,44 @@ package body BDD.Formatters is
Scenario : BDD.Features.Scenario;
Step : not null access BDD.Features.Step_Record'Class)
is
Info : constant Match_Array := Step.Match_Info;
begin
if Self.Term.Has_Colors then
declare
N : constant String :=
Text_And_Align (Scenario, Step_Indent & Step.Text);
H :
array (Step_Indent'Length + 1 .. N'Length) of Boolean :=
(others => False);
First, Last : Integer;
begin
for M in 1 .. Info'Last loop
if Info (M) /= No_Match then
H (Info (M).First + Step_Indent'Length ..
Info (M).Last + Step_Indent'Length) :=
(others => True);
end if;
end loop;
First := N'First + Step_Indent'Length;
Put (N (N'First .. First - 1)); -- indentation
while First <= N'Last loop
Last := First;
while Last <= N'Last and then not H (Last) loop
Last := Last + 1;
end loop;
if First <= Last - 1 then
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Foreground => BDD.Step_Colors (Step.Status));
Put (N (First .. Last - 1));
end if;
First := Last;
while First <= N'Last and then H (First) loop
First := First + 1;
end loop;
if Last <= First - 1 then
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Foreground => BDD.Config_Color);
Put (N (Last .. First - 1));
end if;
end loop;
end;
else
Put (Text_And_Align (Scenario, Step_Indent & Step.Text));
end if;
if Self.Term.Has_Colors then
Display_Location (Self, Scenario, Step);
else
case Step.Status is
when Status_Passed =>
Display_Location (Self, Scenario, Step, "[OK] ");
when Status_Failed =>
Display_Location (Self, Scenario, Step, "[FAILED] ");
when Status_Undefined =>
Display_Location (Self, Scenario, Step, "[UNDEFINED] ");
when Status_Skipped =>
Display_Location (Self, Scenario, Step, "[SKIPPED] ");
end case;
end if;
Self.Output.Display_Step
(Text => Step.Text,
Status => Step.Status,
Longuest_Step => Scenario.Longuest_Step,
Info => Step.Match_Info,
Location =>
+Scenario.Get_Feature.File.Relative_Path (Features_Directory)
& ":" & Image (Step.Line, 1));
declare
Multi : constant String := Step.Multiline;
begin
if Multi /= "" then
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Foreground => BDD.Step_Colors (Step.Status));
Put_Line (" """"""");
Indent (Ada.Text_IO.Standard_Output, Multi, Prefix => " ");
Put_Line (" """"""");
Self.Output.Start_Step_Messages (Status => Step.Status);
Self.Output.Writeln (" """"""");
Self.Output.Indent (Multi, Prefix => " ");
Self.Output.Writeln (" """"""");
Self.Output.End_Step_Messages;
end if;
end;
declare
Error : constant Assert_Error := Step.Error_Details;
begin
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Foreground => BDD.Step_Colors (Step.Status));
if Error /= No_Error then
Display (Error, Self.Term, Ada.Text_IO.Standard_Output,
Display (Error,
Self.Output,
Status => Step.Status,
Prefix => " ");
else
-- Display the default step's table, since it full matched or was
-- not even run.
if Step.Table /= No_Table then
Step.Table.Display
(Ada.Text_IO.Standard_Output, Prefix => " ");
Step.Table.Display (Self.Output, Prefix => " ");
end if;
end if;
end;
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Style => Reset_All);
end Display_Step;
----------------------------
@ -426,38 +206,37 @@ package body BDD.Formatters is
Is_First : Boolean := True;
begin
if Total /= 0 then
Put (" (");
Self.Output.Write (" (");
for S in Stats'Range loop
if Stats (S) /= 0 then
if not Is_First then
Put (", ");
Self.Output.Write (", ");
end if;
Is_First := False;
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Foreground => BDD.Step_Colors (S));
Put (Image (Stats (S), 1));
Put (" ");
Self.Output.Set_Color (Foreground => BDD.Step_Colors (S));
Self.Output.Write (Image (Stats (S), 1));
Self.Output.Write (" ");
case S is
when Status_Passed => Put ("passed");
when Status_Failed => Put ("failed");
when Status_Skipped => Put ("skipped");
when Status_Undefined => Put ("undefined");
when Status_Passed =>
Self.Output.Write ("passed");
when Status_Failed =>
Self.Output.Write ("failed");
when Status_Skipped =>
Self.Output.Write ("skipped");
when Status_Undefined =>
Self.Output.Write ("undefined");
end case;
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Style => Reset_All);
Self.Output.Set_Color (Style => Reset_All);
end if;
end loop;
Put (")");
Self.Output.Write (")");
end if;
New_Line;
Self.Output.New_Line;
end Put_Stats;
Sc_Count : Natural := 0;
@ -466,7 +245,7 @@ package body BDD.Formatters is
Seconds : Duration;
begin
Clear_Progress (Self);
Self.Output.Clear_Progress;
for S in Scenarios'Range loop
Sc_Count := Sc_Count + Scenarios (S);
@ -476,14 +255,13 @@ package body BDD.Formatters is
St_Count := St_Count + Steps (S);
end loop;
New_Line;
Self.Output.New_Line;
Self.Output.Writeln (Image (Features, 1) & " features");
Put_Line (Image (Features, 1) & " features");
Put (Image (Sc_Count, 1) & " scenarios");
Self.Output.Write (Image (Sc_Count, 1) & " scenarios");
Put_Stats (Sc_Count, Scenarios);
Put (Image (St_Count, 1) & " steps");
Self.Output.Write (Image (St_Count, 1) & " steps");
Put_Stats (St_Count, Steps);
Minutes := Integer (Elapsed / 60.0);
@ -492,7 +270,7 @@ package body BDD.Formatters is
declare
S : constant String := Seconds'Img;
begin
Put_Line
Self.Output.Writeln
(Image (Minutes, 1) & "m" & S (S'First + 1 .. S'First + 5) & "s");
end;
end All_Features_Completed;
@ -517,9 +295,9 @@ package body BDD.Formatters is
(Self : in out Formatter_Full;
Scenario : BDD.Features.Scenario)
is
pragma Unreferenced (Self, Scenario);
pragma Unreferenced (Scenario);
begin
New_Line;
Self.Output.New_Line;
end Scenario_Completed;
---------------------------
@ -531,10 +309,10 @@ package body BDD.Formatters is
Scenario : BDD.Features.Scenario;
Is_First : Boolean)
is
pragma Unreferenced (Self, Scenario);
pragma Unreferenced (Scenario);
begin
if not Is_First then
New_Line;
Self.Output.New_Line;
end if;
end Nested_Scenario_Start;
@ -559,20 +337,16 @@ package body BDD.Formatters is
Scenario : BDD.Features.Scenario)
is
begin
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Foreground => BDD.Step_Colors (Scenario.Status));
Self.Output.Set_Color (Foreground => BDD.Step_Colors (Scenario.Status));
case Scenario.Status is
when Status_Passed => Put (".");
when Status_Failed => Put ("F");
when Status_Undefined => Put ("U");
when Status_Skipped => Put ("-");
when Status_Passed => Self.Output.Write (".");
when Status_Failed => Self.Output.Write ("F");
when Status_Undefined => Self.Output.Write ("U");
when Status_Skipped => Self.Output.Write ("-");
end case;
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Style => Reset_All);
Self.Output.Set_Color (Style => Reset_All);
if Scenario.Status /= Status_Passed then
Self.Failed.Append (Scenario);
@ -591,10 +365,10 @@ package body BDD.Formatters is
Elapsed : Duration)
is
begin
Clear_Progress (Self);
Self.Output.Clear_Progress;
if Self.Failed.Length /= 0 then
New_Line;
Self.Output.New_Line;
for S of Self.Failed loop
Display_Scenario_And_Steps (Self, S);
end loop;
@ -614,7 +388,7 @@ package body BDD.Formatters is
Scenario : BDD.Features.Scenario)
is
begin
Display_Progress (Self, Scenario);
Self.Output.Display_Progress (Scenario_Name (Scenario));
end Scenario_Start;
------------------------
@ -627,7 +401,7 @@ package body BDD.Formatters is
is
pragma Unreferenced (Scenario);
begin
Clear_Progress (Self);
Self.Output.Clear_Progress;
end Scenario_Completed;
--------------------
@ -636,10 +410,9 @@ package body BDD.Formatters is
procedure Scenario_Start
(Self : in out Formatter_Hide_Passed;
Scenario : BDD.Features.Scenario)
is
Scenario : BDD.Features.Scenario) is
begin
Display_Progress (Self, Scenario);
Self.Output.Display_Progress (Scenario_Name (Scenario));
end Scenario_Start;
------------------------
@ -656,7 +429,7 @@ package body BDD.Formatters is
null;
when Status_Failed | Status_Undefined =>
Clear_Progress (Self);
Self.Output.Clear_Progress;
Display_Scenario_And_Steps (Self, Scenario);
end case;
end Scenario_Completed;

25
src/bdd-formatters.ads
View File

@ -21,12 +21,13 @@
-- --
------------------------------------------------------------------------------
-- The formatters are used to display output for the user
-- The formatters are used to prepare the output for the user.
-- They do not perform the actual output, which is done via BDD.Media, in
-- various formats.
with Ada.Text_IO;
private with Ada.Containers.Doubly_Linked_Lists;
with BDD.Features; use BDD.Features;
with GNATCOLL.Terminal; use GNATCOLL.Terminal;
with BDD.Media; use BDD.Media;
package BDD.Formatters is
@ -34,9 +35,8 @@ package BDD.Formatters is
procedure Init
(Self : in out Formatter;
Term : GNATCOLL.Terminal.Terminal_Info_Access);
-- Prepare the output for a specific terminal.
-- This controls, among other things, whether the output supports colors.
Output : not null access Media_Writer'Class);
-- Prepare the output for a specific media.
procedure Scenario_Start
(Self : in out Formatter;
@ -147,24 +147,13 @@ package BDD.Formatters is
(Self : in out Formatter_Hide_Passed;
Scenario : BDD.Features.Scenario);
-----------
-- Utils --
-----------
procedure Indent
(File : Ada.Text_IO.File_Type;
Text : String;
Prefix : String := "");
-- Print a multi-line text so that each line is indented by Prefix
private
package Scenario_Lists is new Ada.Containers.Doubly_Linked_Lists
(BDD.Features.Scenario);
type Formatter is abstract tagged record
Term : GNATCOLL.Terminal.Terminal_Info_Access;
Last_Displayed_Feature_Id : Integer := -1;
Progress_Displayed : Boolean := False;
Output : access Media_Writer'Class;
end record;
type Formatter_Full is new Formatter with null record;

16
src/bdd-main.adb
View File

@ -22,10 +22,10 @@
------------------------------------------------------------------------------
with BDD.Formatters; use BDD.Formatters;
with BDD.Media; use BDD.Media;
with BDD.Parser; use BDD.Parser;
with BDD.Runner; use BDD.Runner;
with GNAT.Command_Line; use GNAT.Command_Line;
with GNATCOLL.Terminal; use GNATCOLL.Terminal;
with GNATCOLL.Traces; use GNATCOLL.Traces;
package body BDD.Main is
@ -37,16 +37,24 @@ package body BDD.Main is
procedure Main (Self : in out BDD.Runner.Feature_Runner) is
Parser : BDD.Parser.Feature_Parser;
Format : access BDD.Formatters.Formatter'Class;
Term : constant Terminal_Info_Access := new Terminal_Info;
Media : Media_Writer_Access;
begin
GNATCOLL.Traces.Parse_Config_File;
BDD.Command_Line_Switches;
Self.Discover (+BDD.Features_File_Ext.all, BDD.Features_Directory);
Term.Init_For_Stdout (Colors => BDD.Colors);
Format := BDD.Formatters.Create_Formatter;
Format.Init (Term);
if BDD.Output_File = No_File then
Media := Open_Stdout;
elsif BDD.Output_File.File_Extension = ".html" then
Media := Open_HTML (Open_File (BDD.Output_File));
else
Media := Open_File (BDD.Output_File);
end if;
Format.Init (Media);
Self.Run (Format, Parser);

748
src/bdd-media.adb Normal file
View File

@ -0,0 +1,748 @@
-----------------------------------------------------------------------------
-- G N A T C O L L --
-- --
-- Copyright (C) 2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
-- Software Foundation; either version 3, or (at your option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
------------------------------------------------------------------------------
with Ada.Text_IO; use Ada.Text_IO;
with GNATCOLL.Utils; use GNATCOLL.Utils;
package body BDD.Media is
type File_Type_Access is access Ada.Text_IO.File_Type;
type File_Writer is new Media_Writer with record
Term : GNATCOLL.Terminal.Terminal_Info_Access;
File : File_Type_Access;
end record;
overriding procedure Write
(Self : not null access File_Writer;
Text : String);
overriding procedure Writeln
(Self : not null access File_Writer;
Text : String);
overriding procedure Set_Color
(Self : not null access File_Writer;
Foreground : ANSI_Color := Unchanged;
Style : ANSI_Style := Unchanged);
overriding procedure New_Line (Self : not null access File_Writer);
overriding function Has_Colors
(Self : not null access File_Writer) return Boolean;
type HTML_Writer is new Media_Writer with record
Base : not null access Media_Writer'Class;
Current_Color : ANSI_Color := Black;
end record;
overriding procedure Write
(Self : not null access HTML_Writer;
Text : String);
overriding procedure Writeln
(Self : not null access HTML_Writer;
Text : String);
overriding procedure Set_Color
(Self : not null access HTML_Writer;
Foreground : ANSI_Color := Unchanged;
Style : ANSI_Style := Unchanged);
overriding procedure New_Line (Self : not null access HTML_Writer);
overriding function Has_Colors
(Self : not null access HTML_Writer) return Boolean is (True);
overriding procedure Display_Feature
(Self : not null access HTML_Writer;
Name : String;
Description : String);
overriding procedure Display_Scenario
(Self : not null access HTML_Writer;
Prefix : String;
Name : String;
Longuest_Step : Natural;
Location : String);
overriding procedure Display_Step
(Self : not null access HTML_Writer;
Text : String;
Status : Scenario_Status;
Longuest_Step : Natural;
Info : GNAT.Regpat.Match_Array;
Location : String);
overriding procedure Start_Table (Self : not null access HTML_Writer);
overriding procedure End_Table (Self : not null access HTML_Writer);
overriding procedure Start_Row
(Self : not null access HTML_Writer; Indent : String);
overriding procedure End_Row (Self : not null access HTML_Writer);
overriding procedure Display_Cell
(Self : not null access HTML_Writer;
Value : String;
Cell_Width : Natural;
Header : Boolean;
Status : Scenario_Status := Status_Passed);
overriding procedure Start_Step_Messages
(Self : not null access HTML_Writer;
Status : Scenario_Status);
overriding procedure End_Step_Messages (Self : not null access HTML_Writer);
procedure Step_Parser
(Text : String;
Info : GNAT.Regpat.Match_Array;
On_Chunk : not null access procedure
(Chunk : String; Is_Match : Boolean));
-- Split a step's text into chunk, those matching a parenthesis group and
-- those that don't.
-----------------
-- Open_Stdout --
-----------------
function Open_Stdout return Media_Writer_Access is
Result : constant not null access File_Writer := new File_Writer;
begin
Result.Term := new Terminal_Info;
Result.Term.Init_For_Stdout (Colors => BDD.Colors);
Result.Stdout_Term := Result.Term;
Result.File := new File_Type'(Ada.Text_IO.Standard_Output);
return Media_Writer_Access (Result);
end Open_Stdout;
---------------
-- Open_File --
---------------
function Open_File
(File : GNATCOLL.VFS.Virtual_File) return Media_Writer_Access
is
Result : constant not null access File_Writer := new File_Writer;
begin
Result.File := new File_Type;
Create (Result.File.all, Out_File, File.Display_Full_Name);
Result.Term := new Terminal_Info;
Result.Term.Init_For_File (Colors => BDD.Colors);
Result.Stdout_Term := new Terminal_Info;
Result.Term.Init_For_Stdout (Colors => BDD.Colors);
return Media_Writer_Access (Result);
end Open_File;
---------------
-- Open_HTML --
---------------
function Open_HTML
(Base : not null access Media_Writer'Class)
return Media_Writer_Access
is
Result : constant not null access HTML_Writer :=
new HTML_Writer'(Stdout_Term => Base.Stdout_Term,
Progress_Displayed => False,
Base => Base,
Current_Color => Black);
begin
Base.Writeln ("<html>");
Base.Writeln (" <head>");
Base.Writeln (" <title>Testsuite result</title>");
Base.Writeln (" <style type='text/css'>");
Base.Writeln ("body {font-size: 12px}");
Base.Writeln ("p {margin: 0}");
Base.Writeln ("h1 {margin-bottom: 0; font-size: large}");
Base.Write ("p.feature {margin-bottom: 10px; font-size: small}");
Base.Writeln ("h2 {display: block; margin: 15px 0 0 0}");
Base.Write (".location {float: right; font-size: small;");
Base.Write (" color: grey; margin-top:0; margin-bottom:0;");
Base.Writeln (" vertical-align: top}");
Base.Writeln ("div.step {margin: 5px 0 0 30px; padding-left: 15px}");
Base.Writeln (".STATUS_PASSED {background-color: #DAFDB5;");
Base.Writeln (" color: #5F8E43; border-left: 5px solid #5F8E43;");
Base.Writeln (" border-bottom: 1px solid #5F9E43}");
Base.Writeln (".STATUS_FAILED {background-color: #C30A12;");
Base.Writeln (" color: white; border-left: 5px solid #7C050B;");
Base.Writeln (" border-bottom: 1px solid #7C050B}");
Base.Writeln (".STATUS_UNDEFINED {background-color: #FEFBD2;");
Base.Writeln (" color: #8D3B26; border-left: 5px solid #7C050B;");
Base.Writeln (" border-bottom: 1px solid #7C050B;}");
Base.Writeln (".STATUS_SKIPPED {background-color: #DFFFFD;");
Base.Writeln (" border-left: 5px solid #2EF5F2;");
Base.Writeln (" border-bottom: 1px solid #2EF5F2}");
Base.Writeln ("span.group {font-weight: bold}");
Base.Writeln ("table {margin: 0 0 0 50px}");
Base.Writeln ("th, td {padding: 0 10px 0 10px}");
Base.Writeln ("pre {margin: 0 0 0 50px; font-size: 11px}");
Base.Writeln (" </style>");
Base.Writeln (" </head>");
Base.Writeln (" <body>");
return Media_Writer_Access (Result);
end Open_HTML;
-----------
-- Write --
-----------
overriding procedure Write
(Self : not null access File_Writer;
Text : String)
is
begin
Put (Self.File.all, Text);
end Write;
overriding procedure Write
(Self : not null access HTML_Writer;
Text : String)
is
begin
Self.Base.Write (Text);
end Write;
-------------
-- Writeln --
-------------
overriding procedure Writeln
(Self : not null access File_Writer;
Text : String)
is
begin
Put_Line (Self.File.all, Text);
end Writeln;
overriding procedure Writeln
(Self : not null access HTML_Writer;
Text : String)
is
begin
Self.Base.Writeln (Text);
end Writeln;
--------------
-- New_Line --
--------------
overriding procedure New_Line (Self : not null access File_Writer) is
begin
New_Line (Self.File.all);
end New_Line;
overriding procedure New_Line (Self : not null access HTML_Writer) is
begin
Self.Base.New_Line; -- Writeln ("<br>");
end New_Line;
------------
-- Indent --
------------
procedure Indent
(Self : not null access Media_Writer;
Text : String;
Prefix : String := "")
is
Start, Last : Integer;
begin
Start := Text'First;
while Start <= Text'Last loop
Last := Line_End (Text, Start);
if Last < Start then -- empty line
Media_Writer'Class (Self.all).Writeln ("");
Start := Last + 2;
else
Media_Writer'Class (Self.all).Write
(Prefix & Text (Start .. Last));
Start := Last + 1;
end if;
end loop;
end Indent;
---------------
-- Set_Color --
---------------
overriding procedure Set_Color
(Self : not null access File_Writer;
Foreground : ANSI_Color := Unchanged;
Style : ANSI_Style := Unchanged)
is
begin
Self.Term.Set_Color
(Term => Self.File.all,
Foreground => Foreground,
Style => Style);
end Set_Color;
overriding procedure Set_Color
(Self : not null access HTML_Writer;
Foreground : ANSI_Color := Unchanged;
Style : ANSI_Style := Unchanged)
is
Fg : ANSI_Color := Foreground;
begin
if Fg = Unchanged or else Fg = Reset then
Fg := Black;
end if;
if Fg /= Self.Current_Color then
if Self.Current_Color /= Black then
Self.Base.Write ("</font>");
end if;
Self.Current_Color := Fg;
case Fg is
when Unchanged | Black | Reset => null;
when Red => Self.Base.Write ("<font color='red'>");
when Green => Self.Base.Write ("<font color='green'>");
when Yellow => Self.Base.Write ("<font color='yellow'>");
when Blue => Self.Base.Write ("<font color='blue'>");
when Magenta => Self.Base.Write ("<font color='magenta'>");
when Cyan => Self.Base.Write ("<font color='cyan'>");
when Grey => Self.Base.Write ("<font color='grey'>");
end case;
end if;
if Style = Reset_All then
if Self.Current_Color /= Black then
Self.Current_Color := Black;
Self.Base.Write ("</font>");
end if;
end if;
end Set_Color;
----------------
-- Has_Colors --
----------------
function Has_Colors
(Self : not null access File_Writer)
return Boolean
is
begin
return Self.Term.Has_Colors;
end Has_Colors;
----------------------
-- Display_Progress --
----------------------
procedure Display_Progress
(Self : not null access Media_Writer;
Text : String)
is
Width : constant Integer := Self.Stdout_Term.Get_Width;
begin
if Width /= -1 then
Self.Stdout_Term.Beginning_Of_Line;
Self.Stdout_Term.Clear_To_End_Of_Line;
Self.Stdout_Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Foreground => Grey,
Style => Unchanged);
Put
(Ada.Text_IO.Standard_Output,
"Running: "
& Text (Text'First
.. Integer'Min (Text'Last, Text'First + Width - 10)));
Self.Stdout_Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Style => Reset_All);
Self.Stdout_Term.Beginning_Of_Line;
Self.Progress_Displayed := True;
end if;
end Display_Progress;
--------------------
-- Clear_Progress --
--------------------
procedure Clear_Progress (Self : not null access Media_Writer) is
begin
if Self.Progress_Displayed then
Self.Progress_Displayed := False;
Self.Stdout_Term.Beginning_Of_Line;
Self.Stdout_Term.Clear_To_End_Of_Line;
end if;
end Clear_Progress;
---------------------
-- Display_Feature --
---------------------
procedure Display_Feature
(Self : not null access Media_Writer;
Name : String;
Description : String)
is
S : constant Media_Writer_Access := Media_Writer_Access (Self);
begin
S.Writeln (Cst_Features & ' ' & Name);
S.Writeln (Description);
end Display_Feature;
overriding procedure Display_Feature
(Self : not null access HTML_Writer;
Name : String;
Description : String)
is
begin
Self.Base.Writeln
("<h1 class='feature'>" & Cst_Features & ' ' & Name & "</h1>");
Self.Base.Writeln
("<p class='feature'>" & Description & "</p>");
end Display_Feature;
------------------
-- Text_And_Pad --
------------------
function Text_And_Pad (Text : String; Length : Natural) return String is
begin
return Text & (1 .. 1 + Length - Text'Length => ' ');
end Text_And_Pad;
----------------------
-- Display_Scenario --
----------------------
procedure Display_Scenario
(Self : not null access Media_Writer;
Prefix : String;
Name : String;
Longuest_Step : Natural;
Location : String)
is
S : constant Media_Writer_Access := Media_Writer_Access (Self);
begin
S.Write
(Text_And_Pad
(Scenario_Indent & Prefix & ' ' & Name,
Longuest_Step + Step_Indent'Length));
S.Set_Color (Grey);
S.Writeln ("# " & Location);
S.Set_Color (Style => Reset_All);
end Display_Scenario;
----------------------
-- Display_Scenario --
----------------------
overriding procedure Display_Scenario
(Self : not null access HTML_Writer;
Prefix : String;
Name : String;
Longuest_Step : Natural;
Location : String)
is
pragma Unreferenced (Longuest_Step);
begin
Self.Base.Writeln
("<h2 class='" & Prefix & "'>"
& Prefix & ' ' & Name
& " <p class='location'>" & Location & "</p></h2>");
end Display_Scenario;
-----------------
-- Step_Parser --
-----------------
procedure Step_Parser
(Text : String;
Info : GNAT.Regpat.Match_Array;
On_Chunk : not null access procedure
(Chunk : String; Is_Match : Boolean))
is
H : array (Step_Indent'Length + 1 .. Text'Length) of Boolean :=
(others => False);
First, Last : Integer;
begin
for M in 1 .. Info'Last loop
if Info (M) /= No_Match then
H (Info (M).First + Step_Indent'Length ..
Info (M).Last + Step_Indent'Length) :=
(others => True);
end if;
end loop;
First := Text'First + Step_Indent'Length;
On_Chunk (Text (Text'First .. First - 1), Is_Match => False); -- indent
while First <= Text'Last loop
Last := First;
while Last <= Text'Last and then not H (Last) loop
Last := Last + 1;
end loop;
if First <= Last - 1 then
On_Chunk (Text (First .. Last - 1), Is_Match => False);
end if;
First := Last;
while First <= Text'Last and then H (First) loop
First := First + 1;
end loop;
if Last <= First - 1 then
On_Chunk (Text (Last .. First - 1), Is_Match => True);
end if;
end loop;
end Step_Parser;
------------------
-- Display_Step --
------------------
procedure Display_Step
(Self : not null access Media_Writer;
Text : String;
Status : Scenario_Status;
Longuest_Step : Natural;
Info : GNAT.Regpat.Match_Array;
Location : String)
is
S : constant Media_Writer_Access := Media_Writer_Access (Self);
N : constant String := Text_And_Pad
(Step_Indent & Text, Longuest_Step + Step_Indent'Length);
procedure On_Chunk (Chunk : String; Is_Match : Boolean);
procedure On_Chunk (Chunk : String; Is_Match : Boolean) is
begin
if Is_Match then
S.Set_Color (Foreground => BDD.Config_Color);
else
S.Set_Color (Foreground => BDD.Step_Colors (Status));
end if;
S.Write (Chunk);
end On_Chunk;
begin
if S.Has_Colors then
Step_Parser (N, Info, On_Chunk'Access);
else
S.Write (N);
end if;
S.Set_Color (Grey);
S.Write ("# ");
if not S.Has_Colors then
case Status is
when Status_Passed => S.Write ("[OK] ");
when Status_Failed => S.Write ("[FAILED] ");
when Status_Undefined => S.Write ("[UNDEFINED] ");
when Status_Skipped => S.Write ("[SKIPPED] ");
end case;
end if;
S.Write (Location);
S.Set_Color (Style => Reset_All);
S.New_Line;
end Display_Step;
------------------
-- Display_Step --
------------------
overriding procedure Display_Step
(Self : not null access HTML_Writer;
Text : String;
Status : Scenario_Status;
Longuest_Step : Natural;
Info : GNAT.Regpat.Match_Array;
Location : String)
is
pragma Unreferenced (Longuest_Step);
procedure On_Chunk (Chunk : String; Is_Match : Boolean);
procedure On_Chunk (Chunk : String; Is_Match : Boolean) is
begin
if Is_Match then
Self.Base.Write ("<span class='group'>" & Chunk & "</span>");
else
Self.Base.Write (Chunk);
end if;
end On_Chunk;
begin
Self.Base.Write
("<div class='step " & Status'Img & "'>"
& "<span class='location'>" & Location & "</span>"
& "<span>");
Step_Parser (Step_Indent & Text, Info, On_Chunk'Access);
Self.Base.Writeln ("</span></div>");
end Display_Step;
---------------
-- Start_Row --
---------------
procedure Start_Row
(Self : not null access Media_Writer; Indent : String)
is
S : constant Media_Writer_Access := Media_Writer_Access (Self);
begin
-- One space is added in Display_Cell
S.Write (Indent (Indent'First .. Indent'Last - 1));
end Start_Row;
-------------
-- End_Row --
-------------
procedure End_Row (Self : not null access Media_Writer) is
S : constant Media_Writer_Access := Media_Writer_Access (Self);
begin
S.Set_Color (Style => Reset_All);
S.Writeln (" |");
end End_Row;
------------------
-- Display_Cell --
------------------
procedure Display_Cell
(Self : not null access Media_Writer;
Value : String;
Cell_Width : Natural;
Header : Boolean;
Status : Scenario_Status := Status_Passed)
is
pragma Unreferenced (Header);
S : constant Media_Writer_Access := Media_Writer_Access (Self);
begin
S.Set_Color (Style => Reset_All);
S.Write (" | ");
S.Set_Color (Foreground => BDD.Step_Colors (Status));
S.Write (Value & (1 .. Cell_Width - Value'Length => ' '));
end Display_Cell;
-----------------
-- Start_Table --
-----------------
overriding procedure Start_Table (Self : not null access HTML_Writer) is
begin
Self.Base.Writeln ("<table cellspacing='0' cellpadding='0'>");
end Start_Table;
---------------
-- End_Table --
---------------
overriding procedure End_Table (Self : not null access HTML_Writer) is
begin
Self.Base.Writeln ("</table>");
end End_Table;
---------------
-- Start_Row --
---------------
overriding procedure Start_Row
(Self : not null access HTML_Writer; Indent : String)
is
pragma Unreferenced (Indent);
begin
Self.Base.Writeln (" <tr>");
end Start_Row;
-------------
-- End_Row --
-------------
overriding procedure End_Row (Self : not null access HTML_Writer) is
begin
Self.Base.Writeln (" </tr>");
end End_Row;
------------------
-- Display_Cell --
------------------
overriding procedure Display_Cell
(Self : not null access HTML_Writer;
Value : String;
Cell_Width : Natural;
Header : Boolean;
Status : Scenario_Status := Status_Passed)
is
pragma Unreferenced (Cell_Width);
begin
if Header then
Self.Base.Write (" <th class='" & Status'Img & "'>"
& Value & "</th>");
else
Self.Base.Write (" <td class='" & Status'Img & "'>"
& Value & "</td>");
end if;
end Display_Cell;
-------------------------
-- Start_Step_Messages --
-------------------------
procedure Start_Step_Messages
(Self : not null access Media_Writer;
Status : Scenario_Status)
is
S : constant Media_Writer_Access := Media_Writer_Access (Self);
begin
S.Set_Color (Foreground => BDD.Step_Colors (Status));
end Start_Step_Messages;
-----------------------
-- End_Step_Messages --
-----------------------
procedure End_Step_Messages (Self : not null access Media_Writer) is
S : constant Media_Writer_Access := Media_Writer_Access (Self);
begin
S.Set_Color (Style => Reset_All);
end End_Step_Messages;
-------------------------
-- Start_Step_Messages --
-------------------------
overriding procedure Start_Step_Messages
(Self : not null access HTML_Writer;
Status : Scenario_Status)
is
begin
Self.Base.Writeln ("<pre class='" & Status'Img & "'/>");
end Start_Step_Messages;
-----------------------
-- End_Step_Messages --
-----------------------
overriding procedure End_Step_Messages
(Self : not null access HTML_Writer)
is
begin
Self.Base.Writeln ("</pre>");
end End_Step_Messages;
end BDD.Media;

146
src/bdd-media.ads Normal file
View File

@ -0,0 +1,146 @@
-----------------------------------------------------------------------------
-- G N A T C O L L --
-- --
-- Copyright (C) 2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
-- Software Foundation; either version 3, or (at your option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
------------------------------------------------------------------------------
-- Output to different media (stdout, files, html, json,...)
with GNAT.Regpat; use GNAT.Regpat;
with GNATCOLL.Terminal; use GNATCOLL.Terminal;
package BDD.Media is
type Media_Writer is abstract tagged private;
type Media_Writer_Access is access all Media_Writer'Class;
function Open_Stdout return Media_Writer_Access;
-- Will output to stdout
function Open_HTML
(Base : not null access Media_Writer'Class)
return Media_Writer_Access;
-- A writer that will output HTML text on the base writer
function Open_File
(File : GNATCOLL.VFS.Virtual_File) return Media_Writer_Access;
-- Output to a specific file
procedure Write
(Self : not null access Media_Writer;
Text : String) is abstract;
procedure Writeln
(Self : not null access Media_Writer;
Text : String) is abstract;
procedure New_Line (Self : not null access Media_Writer) is abstract;
-- Write some text (possibly followed by a newline)
procedure Indent
(Self : not null access Media_Writer;
Text : String;
Prefix : String := "");
-- Print a multi-line text so that each line is indented by Prefix
procedure Set_Color
(Self : not null access Media_Writer;
Foreground : ANSI_Color := Unchanged;
Style : ANSI_Style := Unchanged) is abstract;
-- Change the current color (when colors are supported)
function Has_Colors
(Self : not null access Media_Writer)
return Boolean is abstract;
-- Whether colors are used in the output
procedure Display_Progress
(Self : not null access Media_Writer;
Text : String);
procedure Clear_Progress (Self : not null access Media_Writer);
-- Display a progress bar (in general at the bottom of the screen).
-- This is in general sent to the user's terminal, not to the file in
-- which the output occurs.
-------------------------
-- Specific to GNATBDD --
-------------------------
Scenario_Indent : constant String := " ";
Step_Indent : constant String := " ";
-- Visual indentation in the display
procedure Display_Feature
(Self : not null access Media_Writer;
Name : String;
Description : String);
-- Display a feature header
procedure Display_Scenario
(Self : not null access Media_Writer;
Prefix : String;
Name : String;
Longuest_Step : Natural;
Location : String);
-- Display a scenario header.
-- Prefix is one of 'Scenario', 'Background', 'Outline',...
-- Longuest_Step indicates the number of characters needed to display the
-- longuest step's text
procedure Display_Step
(Self : not null access Media_Writer;
Text : String;
Status : Scenario_Status;
Longuest_Step : Natural;
Info : GNAT.Regpat.Match_Array;
Location : String);
-- Display a single step.
-- Info is used to find the location of the regexp's parenthesis groups,
-- to highlight them specially.
procedure Start_Table (Self : not null access Media_Writer) is null;
procedure End_Table (Self : not null access Media_Writer) is null;
procedure Start_Row (Self : not null access Media_Writer; Indent : String);
procedure End_Row (Self : not null access Media_Writer);
procedure Display_Cell
(Self : not null access Media_Writer;
Value : String;
Cell_Width : Natural;
Header : Boolean;
Status : Scenario_Status := Status_Passed);
-- Support for writing tables
procedure Start_Step_Messages
(Self : not null access Media_Writer;
Status : Scenario_Status);
procedure End_Step_Messages (Self : not null access Media_Writer);
-- Wraps the display of step messages
function Text_And_Pad (Text : String; Length : Natural) return String;
-- Return the text left-aligned, and with padding characters up to
-- Length.
private
type Media_Writer is abstract tagged record
Progress_Displayed : Boolean := False;
Stdout_Term : GNATCOLL.Terminal.Terminal_Info_Access;
-- The stdout terminal (used to display progress bars)
end record;
end BDD.Media;

5
src/bdd-runner.adb
View File

@ -21,6 +21,8 @@
-- --
------------------------------------------------------------------------------
with Ada.Command_Line; use Ada.Command_Line;
package body BDD.Runner is
--------------
@ -85,6 +87,9 @@ package body BDD.Runner is
Self.Run_End;
Self.Format := null;
Set_Exit_Status
(Exit_Status (Self.Scenario_Stats (Status_Failed)));
end if;
end Run;

28
src/bdd-tables.adb
View File

@ -211,7 +211,9 @@ package body BDD.Tables is
-------------
procedure Display
(Self : Table; File : Ada.Text_IO.File_Type; Prefix : String := "")
(Self : Table;
Output : not null access BDD.Media.Media_Writer'Class;
Prefix : String := "")
is
R : constant access Table_Record := Self.Get;
W : constant Integer := Self.Width;
@ -234,31 +236,31 @@ package body BDD.Tables is
end loop;
end loop;
Put (File, Prefix);
Output.Start_Table;
Output.Start_Row (Indent => Prefix);
Idx := Widths'First;
for N of R.Names loop
Put (File, "| "
& N
& (1 .. Widths (Idx) - N'Length => ' ')
& " ");
Output.Display_Cell (N, Cell_Width => Widths (Idx), Header => True);
Idx := Idx + 1;
end loop;
Put_Line (File, "|");
Output.End_Row;
for Row_Content of R.Rows loop
Put (File, Prefix);
Output.Start_Row (Indent => Prefix);
Idx := Widths'First;
for V of Row_Content loop
Put (File, "| "
& V
& (1 .. Widths (Idx) - V'Length => ' ')
& " ");
Output.Display_Cell
(V, Cell_Width => Widths (Idx), Header => False);
Idx := Idx + 1;
end loop;
Put_Line (File, "|");
Output.End_Row;
end loop;
Output.End_Table;
end Display;
end BDD.Tables;

7
src/bdd-tables.ads
View File

@ -26,9 +26,8 @@
with Ada.Containers.Indefinite_Vectors;
with Ada.Containers.Vectors;
with Ada.Text_IO; use Ada.Text_IO;
with BDD.Media; use BDD.Media;
with GNATCOLL.Refcount; use GNATCOLL.Refcount;
with GNATCOLL.Terminal; use GNATCOLL.Terminal;
package BDD.Tables is
@ -87,7 +86,9 @@ package BDD.Tables is
-- Return the size of the table
procedure Display
(Self : Table; File : Ada.Text_IO.File_Type; Prefix : String := "");
(Self : Table;
Output : not null access BDD.Media.Media_Writer'Class;
Prefix : String := "");
-- Display the table in File.
-- Each line is lead by a Prefix.

10
src/bdd.adb
View File

@ -52,6 +52,9 @@ package body BDD is
BDD.Colors := GNATCOLL.Terminal.Auto;
end if;
elsif Switch = "-o" then
BDD.Output_File := Create_From_Base (+Parameter);
elsif Switch = "--output" then
if Parameter = "quiet" then
BDD.Output := Output_Quiet;
@ -114,6 +117,13 @@ package body BDD is
Argument => "format",
Help => "Controls the output format (quiet|DOTS|hide_passed|full)");
Define_Switch
(Config,
Switch => "-o=",
Argument => "file",
Help => "Where the output should be sent (stdout by default)."
& " If the extension is .html, the output is HTML.");
Define_Switch
(Config,
Long_Switch => "--log=",

3
src/bdd.ads
View File

@ -76,6 +76,9 @@ package BDD is
GNATCOLL.Terminal.Blue;
-- Color used to highlight the parenthesis groups in steps
Output_File : Virtual_File;
-- Where we should send the output
procedure Command_Line_Switches;
-- Handles the command line switches