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

New formatters, and progress bar for 'full', 'quiet' and 'hide_passed'

This commit is contained in:
Emmanuel Briot 2014-02-06 18:09:52 +01:00
parent 04f5d7825d
commit a98955c033
10 changed files with 281 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
gnatbdd.gpr
View File

@ -2,7 +2,7 @@ with "gnatcoll";
project GNATBDD is
for Main use ("main.adb", "driver.adb");
for Languages use ("Ada", "C");
for Languages use ("Ada");
for Source_Dirs use ("src");
for Object_Dir use "obj";

22
src/bdd-features.adb
View File

@ -32,7 +32,7 @@ package body BDD.Features is
procedure Free (Self : in out Feature) is
begin
Self.File := No_File;
Self.Displayed := False;
Self.Id := -1;
Free (Self.Name);
Self.Description := Null_Unbounded_String;
end Free;
@ -79,22 +79,22 @@ package body BDD.Features is
end File;
-------------------
-- Set_Displayed --
-- Set_Unique_Id --
-------------------
procedure Set_Displayed (Self : in out Feature) is
procedure Set_Unique_Id (Self : in out Feature; Id : Integer) is
begin
Self.Displayed := True;
end Set_Displayed;
Self.Id := Id;
end Set_Unique_Id;
---------------
-- Displayed --
---------------
--------
-- Id --
--------
function Displayed (Self : Feature) return Boolean is
function Id (Self : Feature) return Integer is
begin
return Self.Displayed;
end Displayed;
return Self.Id;
end Id;
----------
-- Free --

13
src/bdd-features.ads
View File

@ -66,6 +66,10 @@ package BDD.Features is
procedure Free (Self : in out Feature);
-- Free the memory associated with Self
procedure Set_Unique_Id (Self : in out Feature; Id : Integer);
function Id (Self : Feature) return Integer;
-- Set a unique id for the feature
procedure Set_Name (Self : in out Feature; Name : String);
function Name (Self : Feature) return String;
-- The name of the feature
@ -75,13 +79,6 @@ package BDD.Features is
function File (Self : Feature) return GNATCOLL.VFS.Virtual_File;
-- The file in which the feature is defined
procedure Set_Displayed (Self : in out Feature);
function Displayed (Self : Feature) return Boolean;
-- Whether the feature has already been displayed on the screen.
-- This is used when displaying the output, because some of the tests
-- could be filtered out, and we only want to display the feature info
-- when at least one scenario is run.
function Description (Self : Feature) return String;
procedure Add_Description (Self : in out Feature; Descr : String);
-- Add some description information. Add_Description will be called once
@ -100,7 +97,7 @@ private
type Feature is tagged limited record
File : GNATCOLL.VFS.Virtual_File;
Name : GNAT.Strings.String_Access;
Displayed : Boolean := False;
Id : Integer;
Description : Ada.Strings.Unbounded.Unbounded_String;
end record;
end BDD.Features;

213
src/bdd-formatters.adb
View File

@ -26,12 +26,33 @@ with GNATCOLL.Utils; use GNATCOLL.Utils;
package body BDD.Formatters is
function Scenario_Name
(Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class) return String;
-- Return a string used to identify the scenario for the user.
procedure Display_Location
(Self : Formatter'Class;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class);
-- Display location information for the scenario
procedure Display_Scenario_Header
(Self : in out Formatter'Class;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class);
-- Display the feature and scenario headers, as needed.
procedure Display_Progress
(Self : in out Formatter'Class;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class);
-- Display the name of the scenario being run, if supported by the
-- terminal
procedure Clear_Progress (Self : in out Formatter'Class);
-- Clear progress indicator if needed.
----------
-- Init --
----------
@ -44,6 +65,20 @@ package body BDD.Formatters is
Self.Term := Term;
end Init;
-------------------
-- Scenario_Name --
-------------------
function Scenario_Name
(Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class) return String
is
begin
return +Feature.File.Relative_Path (Features_Directory)
& "#" & Image (Scenario.Index, 1)
& ":" & Image (Scenario.Line, 1);
end Scenario_Name;
----------------------
-- Display_Location --
----------------------
@ -57,55 +92,108 @@ package body BDD.Formatters is
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Foreground => Grey);
Put ("# "
& (+Feature.File.Relative_Path (Features_Directory))
& "#" & Image (Scenario.Index, 1)
& ":" & Image (Scenario.Line, 1));
Put ("# " & Scenario_Name (Feature, Scenario));
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Style => Reset_All);
New_Line;
end Display_Location;
---------------------
-- Display_Feature --
---------------------
----------------------
-- Display_Progress --
----------------------
overriding procedure Display_Feature
(Self : Formatter_Full;
Feature : BDD.Features.Feature'Class)
procedure Display_Progress
(Self : in out Formatter'Class;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class)
is
pragma Unreferenced (Self);
Width : constant Integer := Self.Term.Get_Width;
begin
Put_Line (Cst_Features & ' ' & Feature.Name);
Put_Line (Feature.Description);
end Display_Feature;
if Width /= -1 then
declare
N : constant String := Scenario_Name (Feature, 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;
----------------------
-- Display_Scenario --
----------------------
Self.Progress_Displayed := True;
end;
end if;
end Display_Progress;
overriding procedure Display_Scenario
(Self : Formatter_Full;
--------------------
-- 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 --
-----------------------------
procedure Display_Scenario_Header
(Self : in out Formatter'Class;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class)
is
begin
if Feature.Id /= Self.Last_Displayed_Feature_Id then
Put_Line (Cst_Features & ' ' & Feature.Name);
Put_Line (Feature.Description);
Self.Last_Displayed_Feature_Id := Feature.Id;
end if;
Put (" " & Cst_Scenario & ' ' & Scenario.Name & " ");
Display_Location (Self, Feature, Scenario);
end Display_Scenario;
end Display_Scenario_Header;
--------------------
-- Scenario_Start --
--------------------
overriding procedure Scenario_Start
(Self : in out Formatter_Full;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class)
is
begin
Clear_Progress (Self);
Display_Scenario_Header (Self, Feature, Scenario);
Display_Progress (Self, Feature, Scenario);
end Scenario_Start;
------------------------
-- Scenario_Completed --
------------------------
overriding procedure Scenario_Completed
(Self : Formatter_Full;
(Self : in out Formatter_Full;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class)
Scenario : BDD.Features.Scenario'Class;
Status : BDD.Scenario_Status)
is
pragma Unreferenced (Self, Feature, Scenario);
pragma Unreferenced (Feature, Scenario, Status);
begin
Clear_Progress (Self);
New_Line;
end Scenario_Completed;
@ -114,13 +202,86 @@ package body BDD.Formatters is
------------------------
overriding procedure Scenario_Completed
(Self : Formatter_Dots;
(Self : in out Formatter_Dots;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class)
Scenario : BDD.Features.Scenario'Class;
Status : BDD.Scenario_Status)
is
pragma Unreferenced (Self, Feature, Scenario);
begin
Put (".");
case Status is
when Status_Passed =>
Put (".");
when Status_Failed =>
Put ("F");
when Status_Undefined =>
Put ("U");
when Status_Skipped =>
Put ("-");
end case;
end Scenario_Completed;
--------------------
-- Scenario_Start --
--------------------
overriding procedure Scenario_Start
(Self : in out Formatter_Quiet;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class)
is
begin
Display_Progress (Self, Feature, Scenario);
end Scenario_Start;
------------------------
-- Scenario_Completed --
------------------------
overriding procedure Scenario_Completed
(Self : in out Formatter_Quiet;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class;
Status : BDD.Scenario_Status)
is
pragma Unreferenced (Feature, Scenario, Status);
begin
Clear_Progress (Self);
end Scenario_Completed;
--------------------
-- Scenario_Start --
--------------------
procedure Scenario_Start
(Self : in out Formatter_Hide_Passed;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class)
is
begin
Display_Progress (Self, Feature, Scenario);
end Scenario_Start;
------------------------
-- Scenario_Completed --
------------------------
overriding procedure Scenario_Completed
(Self : in out Formatter_Hide_Passed;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class;
Status : BDD.Scenario_Status)
is
begin
case Status is
when Status_Passed | Status_Skipped =>
null;
when Status_Failed | Status_Undefined =>
Clear_Progress (Self);
Display_Scenario_Header (Self, Feature, Scenario);
New_Line;
end case;
end Scenario_Completed;
----------------------

59
src/bdd-formatters.ads
View File

@ -36,22 +36,18 @@ package BDD.Formatters is
-- Prepare the output for a specific terminal.
-- This controls, among other things, whether the output supports colors.
procedure Display_Feature
(Self : Formatter;
Feature : BDD.Features.Feature'Class) is null;
-- Display information about a feature just before it is run, for instance
-- its name and description.
procedure Display_Scenario
(Self : Formatter;
procedure Scenario_Start
(Self : in out Formatter;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class) is null;
-- Display information about a scenario just before it is run
-- Display information about a feature and ascenario just before the
-- scenario is run.
procedure Scenario_Completed
(Self : Formatter;
(Self : in out Formatter;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class) is null;
Scenario : BDD.Features.Scenario'Class;
Status : BDD.Scenario_Status) is null;
-- Called when a scenario has completed
function Create_Formatter return not null access Formatter'Class;
@ -65,17 +61,15 @@ package BDD.Formatters is
-- A formatter that displays all the features, scenarios and steps that
-- are executed
overriding procedure Display_Feature
(Self : Formatter_Full;
Feature : BDD.Features.Feature'Class);
overriding procedure Display_Scenario
(Self : Formatter_Full;
overriding procedure Scenario_Start
(Self : in out Formatter_Full;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class);
overriding procedure Scenario_Completed
(Self : Formatter_Full;
(Self : in out Formatter_Full;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class);
Scenario : BDD.Features.Scenario'Class;
Status : BDD.Scenario_Status);
----------
-- Dots --
@ -84,9 +78,10 @@ package BDD.Formatters is
type Formatter_Dots is new Formatter with private;
overriding procedure Scenario_Completed
(Self : Formatter_Dots;
(Self : in out Formatter_Dots;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class);
Scenario : BDD.Features.Scenario'Class;
Status : BDD.Scenario_Status);
-----------
-- Quiet --
@ -94,19 +89,43 @@ package BDD.Formatters is
type Formatter_Quiet is new Formatter with private;
overriding procedure Scenario_Start
(Self : in out Formatter_Quiet;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class);
overriding procedure Scenario_Completed
(Self : in out Formatter_Quiet;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class;
Status : BDD.Scenario_Status);
-----------------
-- Hide_Passed --
-----------------
type Formatter_Hide_Passed is new Formatter with private;
overriding procedure Scenario_Start
(Self : in out Formatter_Hide_Passed;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class);
overriding procedure Scenario_Completed
(Self : in out Formatter_Hide_Passed;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class;
Status : BDD.Scenario_Status);
private
type Formatter is abstract tagged record
Term : GNATCOLL.Terminal.Terminal_Info_Access;
Last_Displayed_Feature_Id : Integer := -1;
Progress_Displayed : Boolean := False;
end record;
type Formatter_Full is new Formatter with null record;
type Formatter_Dots is new Formatter with null record;
type Formatter_Quiet is new Formatter with null record;
type Formatter_Hide_Passed is new Formatter with null record;

6
src/bdd-parser.adb
View File

@ -32,12 +32,10 @@ package body BDD.Parser is
-----------
procedure Parse
(Self : Feature_Parser;
(Self : in out Feature_Parser;
File : GNATCOLL.VFS.Virtual_File;
Runner : in out Abstract_Feature_Runner'Class)
is
pragma Unreferenced (Self);
type State_Type is (None, In_Feature,
In_Scenario,
In_String,
@ -186,6 +184,8 @@ package body BDD.Parser is
elsif Starts_With (Buffer (First_Char .. Line_E), Cst_Features) then
Finish_Feature;
F.Set_Unique_Id (Self.F_Id);
Self.F_Id := Self.F_Id + 1;
F.Set_File (File);
F.Set_Name (Buffer (First_Char + Cst_Features'Length .. Line_E));
Runner.Feature_Start (F);

6
src/bdd-parser.ads
View File

@ -63,7 +63,7 @@ package BDD.Parser is
type Feature_Parser is tagged private;
procedure Parse
(Self : Feature_Parser;
(Self : in out Feature_Parser;
File : GNATCOLL.VFS.Virtual_File;
Runner : in out Abstract_Feature_Runner'Class);
-- Parses a .feature file.
@ -74,7 +74,9 @@ package BDD.Parser is
private
type Feature_Parser is tagged record
null;
F_Id : Natural := 1;
-- Unique Id for the features that are parsed.
-- This is increased for all new feature found by this parser.
end record;
end BDD.Parser;

27
src/bdd-runner.adb
View File

@ -84,7 +84,7 @@ package body BDD.Runner is
procedure Run
(Self : in out Feature_Runner;
Format : not null access BDD.Formatters.Formatter'Class;
Parser : BDD.Parser.Feature_Parser'Class)
Parser : in out BDD.Parser.Feature_Parser'Class)
is
begin
if Self.Files /= null then
@ -97,6 +97,21 @@ package body BDD.Runner is
end if;
end Run;
--------------------
-- Scenario_Start --
--------------------
overriding procedure Scenario_Start
(Self : in out Feature_Runner;
Feature : in out BDD.Features.Feature'Class;
Scenario : in out BDD.Features.Scenario'Class)
is
begin
if Scenario.Kind = Kind_Scenario then
Self.Format.Scenario_Start (Feature, Scenario);
end if;
end Scenario_Start;
------------------
-- Scenario_End --
------------------
@ -106,16 +121,14 @@ package body BDD.Runner is
Feature : in out BDD.Features.Feature'Class;
Scenario : in out BDD.Features.Scenario'Class)
is
Status : Scenario_Status;
begin
if Scenario.Kind = Kind_Scenario then
if not Feature.Displayed then
Self.Format.Display_Feature (Feature);
Feature.Set_Displayed;
end if;
Status := Status_Failed;
Self.Format.Display_Scenario (Feature, Scenario);
delay 1.0;
Self.Format.Scenario_Completed (Feature, Scenario);
Self.Format.Scenario_Completed (Feature, Scenario, Status);
end if;
end Scenario_End;

6
src/bdd-runner.ads
View File

@ -53,7 +53,7 @@ package BDD.Runner is
procedure Run
(Self : in out Feature_Runner;
Format : not null access BDD.Formatters.Formatter'Class;
Parser : BDD.Parser.Feature_Parser'Class);
Parser : in out BDD.Parser.Feature_Parser'Class);
-- Run all features and their scenarios.
--
-- Each of the features file is parsed through Parser. This allows you to
@ -63,6 +63,10 @@ package BDD.Runner is
-- scenarios are run in the order they were defined in in the features
-- file.
overriding procedure Scenario_Start
(Self : in out Feature_Runner;
Feature : in out BDD.Features.Feature'Class;
Scenario : in out BDD.Features.Scenario'Class);
overriding procedure Scenario_End
(Self : in out Feature_Runner;
Feature : in out BDD.Features.Feature'Class;

6
src/bdd.ads
View File

@ -59,6 +59,12 @@ package BDD is
Output : Output_Type := Output_Dots;
-- The kind of output the user expects
type Scenario_Status is
(Status_Passed,
Status_Failed,
Status_Undefined,
Status_Skipped);
procedure Command_Line_Switches;
-- Handles the command line switches