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

Add basic support for steps display

This commit is contained in:
Emmanuel Briot 2014-02-07 12:26:59 +01:00
parent 6ed248afa3
commit 0f8363c858
8 changed files with 363 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

113
src/bdd-features.adb
View File

@ -205,6 +205,38 @@ package body BDD.Features is
Self.Steps.Append (S);
end Add;
------------------
-- Foreach_Step --
------------------
procedure Foreach_Step
(Self : not null access Scenario_Record;
Callback : not null access procedure
(S : not null access Step_Record'Class))
is
begin
for S of Self.Steps loop
Callback (S);
end loop;
end Foreach_Step;
-------------------
-- Longuest_Step --
-------------------
function Longuest_Step
(Self : not null access Scenario_Record) return Natural is
begin
if Self.Longuest_Step = -1 then
Self.Longuest_Step := Length (Self.Name) + Cst_Scenario'Length + 1;
for S of Self.Steps loop
Self.Longuest_Step := Integer'Max
(Self.Longuest_Step, Length (S.Text));
end loop;
end if;
return Self.Longuest_Step;
end Longuest_Step;
--------------------
-- Set_Attributes --
--------------------
@ -243,16 +275,57 @@ package body BDD.Features is
Append (Self.Description, " " & Descr & ASCII.LF);
end Add_To_Description;
--------------
-- Set_Text --
--------------
------------
-- Create --
------------
procedure Set_Text
(Self : not null access Step_Record'Class; Text : String)
function Create
(Text : String; Line : Positive) return not null access Step_Record
is
Self : constant Step := new Step_Record;
begin
Append (Self.Text, Text);
end Set_Text;
Self.Text := To_Unbounded_String (Text);
Self.Line := Line;
Self.Status := Status_Undefined;
return Self;
end Create;
----------------------
-- Add_To_Multiline --
----------------------
procedure Add_To_Multiline
(Self : not null access Step_Record'Class; Text : String) is
begin
Append (Self.Multiline, Text & ASCII.LF);
end Add_To_Multiline;
----------
-- Line --
----------
function Line (Self : not null access Step_Record) return Positive is
begin
return Self.Line;
end Line;
----------
-- Text --
----------
function Text (Self : not null access Step_Record) return String is
begin
return To_String (Self.Text);
end Text;
---------------
-- Multiline --
---------------
function Multiline (Self : not null access Step_Record) return String is
begin
return To_String (Self.Multiline);
end Multiline;
----------
-- Free --
@ -260,7 +333,9 @@ package body BDD.Features is
procedure Free (Self : in out Step_Record) is
begin
Self.Text := Null_Unbounded_String;
Self.Text := Null_Unbounded_String;
Self.Multiline := Null_Unbounded_String;
Self.Line := 1;
end Free;
----------
@ -290,4 +365,26 @@ package body BDD.Features is
Step_Lists.Clear (Step_Lists.List (List)); -- inherited
end Clear;
----------------
-- Set_Status --
----------------
procedure Set_Status
(Self : not null access Step_Record;
Status : BDD.Scenario_Status)
is
begin
Self.Status := Status;
end Set_Status;
------------
-- Status --
------------
function Status
(Self : not null access Step_Record) return BDD.Scenario_Status is
begin
return Self.Status;
end Status;
end BDD.Features;

38
src/bdd-features.ads
View File

@ -35,14 +35,33 @@ package BDD.Features is
type Step_Record (<>) is tagged private;
type Step is access all Step_Record'Class;
procedure Set_Text
function Create
(Text : String; Line : Positive) return not null access Step_Record;
-- Create a new step.
-- The line references the file contain the feature in which the step is
-- found.
procedure Add_To_Multiline
(Self : not null access Step_Record'Class; Text : String);
-- Set the text of the step
-- Add some contents to the final multi-line string.
-- Text is always added a ASCII.LF
procedure Free (Self : in out Step_Record);
procedure Free (Self : in out Step);
-- Free the memory associated with Self
function Line (Self : not null access Step_Record) return Positive;
function Text (Self : not null access Step_Record) return String;
function Multiline (Self : not null access Step_Record) return String;
-- Return the components of the step
procedure Set_Status
(Self : not null access Step_Record;
Status : BDD.Scenario_Status);
function Status
(Self : not null access Step_Record) return BDD.Scenario_Status;
-- Set the status for a specific step
--------------
-- Scenario --
--------------
@ -78,6 +97,16 @@ package BDD.Features is
S : not null access Step_Record'Class);
-- Add a new step
procedure Foreach_Step
(Self : not null access Scenario_Record;
Callback : not null access procedure
(S : not null access Step_Record'Class));
-- Iterate over each step
function Longuest_Step
(Self : not null access Scenario_Record) return Natural;
-- The length of the longuest step (for display purposes)
-------------
-- Feature --
-------------
@ -119,7 +148,10 @@ package BDD.Features is
private
type Step_Record is tagged record
Line : Positive;
Text : Ada.Strings.Unbounded.Unbounded_String;
Multiline : Ada.Strings.Unbounded.Unbounded_String;
Status : BDD.Scenario_Status;
end record;
package Step_Lists is new Ada.Containers.Doubly_Linked_Lists (Step);
@ -132,6 +164,8 @@ private
Index : Positive := 1;
Kind : Scenario_Kind := Kind_Scenario;
Steps : Step_List;
Longuest_Step : Integer := -1;
end record;
-- Make sure this type can be put in a list and automatically reclaim
-- storage when the list is clearer.

170
src/bdd-formatters.adb
View File

@ -26,6 +26,10 @@ with GNATCOLL.Utils; use GNATCOLL.Utils;
package body BDD.Formatters is
Scenario_Indent : constant String := " ";
Step_Indent : constant String := " ";
-- Visual indentation in the display
function Scenario_Name
(Feature : not null access BDD.Features.Feature_Record'Class;
Scenario : not null access BDD.Features.Scenario_Record'Class)
@ -36,7 +40,12 @@ package body BDD.Formatters is
(Self : Formatter'Class;
Feature : not null access BDD.Features.Feature_Record'Class;
Scenario : not null access BDD.Features.Scenario_Record'Class);
-- Display location information for the scenario
procedure Display_Location
(Self : Formatter'Class;
Feature : not null access BDD.Features.Feature_Record'Class;
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;
@ -44,6 +53,19 @@ package body BDD.Formatters is
Scenario : not null access BDD.Features.Scenario_Record'Class);
-- Display the feature and scenario headers, as needed.
procedure Display_Scenario_And_Steps
(Self : in out Formatter_Hide_Passed;
Feature : not null access BDD.Features.Feature_Record'Class;
Scenario : not null access BDD.Features.Scenario_Record'Class);
-- Display a scenario and all its steps
procedure Display_Step
(Self : in out Formatter'Class;
Feature : not null access BDD.Features.Feature_Record'Class;
Scenario : not null access BDD.Features.Scenario_Record'Class;
Step : not null access BDD.Features.Step_Record'Class);
-- Display the text for a specific step
procedure Display_Progress
(Self : in out Formatter'Class;
Feature : not null access BDD.Features.Feature_Record'Class;
@ -51,6 +73,13 @@ package body BDD.Formatters is
-- Display the name of the scenario being run, if supported by the
-- terminal
procedure Put_And_Align
(Scenario : not null access BDD.Features.Scenario_Record'Class;
Text : 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.
@ -81,6 +110,30 @@ package body BDD.Formatters is
& ":" & Image (Scenario.Line, 1);
end Scenario_Name;
--------------------------------
-- Display_Scenario_And_Steps --
--------------------------------
procedure Display_Scenario_And_Steps
(Self : in out Formatter_Hide_Passed;
Feature : not null access BDD.Features.Feature_Record'Class;
Scenario : not null access BDD.Features.Scenario_Record'Class)
is
procedure Show_Step
(Step : not null access BDD.Features.Step_Record'Class);
-- Display a step for a scenario
procedure Show_Step
(Step : not null access BDD.Features.Step_Record'Class) is
begin
Display_Step (Self, Feature, Scenario, Step);
end Show_Step;
begin
Display_Scenario_Header (Self, Feature, Scenario);
Scenario.Foreach_Step (Show_Step'Access);
New_Line;
end Display_Scenario_And_Steps;
----------------------
-- Display_Location --
----------------------
@ -101,6 +154,44 @@ package body BDD.Formatters is
New_Line;
end Display_Location;
----------------------
-- Display_Location --
----------------------
procedure Display_Location
(Self : Formatter'Class;
Feature : not null access BDD.Features.Feature_Record'Class;
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
& (+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;
-------------------
-- Put_And_Align --
-------------------
procedure Put_And_Align
(Scenario : not null access BDD.Features.Scenario_Record'Class;
Text : String)
is
Long : constant Natural := Scenario.Longuest_Step + Step_Indent'Length;
begin
Put (Text);
Put ((1 .. 1 + Long - Text'Length => ' '));
end Put_And_Align;
----------------------
-- Display_Progress --
----------------------
@ -164,10 +255,47 @@ package body BDD.Formatters is
Self.Last_Displayed_Feature_Id := Feature.Id;
end if;
Put (" " & Cst_Scenario & ' ' & Scenario.Name & " ");
Put_And_Align
(Scenario, Scenario_Indent & Cst_Scenario & ' ' & Scenario.Name);
Display_Location (Self, Feature, Scenario);
end Display_Scenario_Header;
------------------
-- Display_Step --
------------------
procedure Display_Step
(Self : in out Formatter'Class;
Feature : not null access BDD.Features.Feature_Record'Class;
Scenario : not null access BDD.Features.Scenario_Record'Class;
Step : not null access BDD.Features.Step_Record'Class)
is
begin
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Foreground => BDD.Step_Colors (Step.Status));
Put_And_Align (Scenario, Step_Indent & Step.Text);
if Self.Term.Has_Colors then
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Style => Reset_All);
Display_Location (Self, Feature, Step);
else
case Step.Status is
when Status_Passed =>
Display_Location (Self, Feature, Step, "[OK] ");
when Status_Failed =>
Display_Location (Self, Feature, Step, "[FAILED] ");
when Status_Undefined =>
Display_Location (Self, Feature, Step, "[UNDEFINED] ");
when Status_Skipped =>
Display_Location (Self, Feature, Step, "[SKIPPED] ");
end case;
end if;
end Display_Step;
--------------------
-- Scenario_Start --
--------------------
@ -199,6 +327,19 @@ package body BDD.Formatters is
New_Line;
end Scenario_Completed;
--------------------
-- Step_Completed --
--------------------
overriding procedure Step_Completed
(Self : in out Formatter_Full;
Feature : not null access BDD.Features.Feature_Record'Class;
Scenario : not null access BDD.Features.Scenario_Record'Class;
Step : not null access BDD.Features.Step_Record'Class) is
begin
Display_Step (Self, Feature, Scenario, Step);
end Step_Completed;
------------------------
-- Scenario_Completed --
------------------------
@ -209,18 +350,22 @@ package body BDD.Formatters is
Scenario : not null access BDD.Features.Scenario_Record'Class;
Status : BDD.Scenario_Status)
is
pragma Unreferenced (Self, Feature, Scenario);
pragma Unreferenced (Feature, Scenario);
begin
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Foreground => BDD.Step_Colors (Status));
case Status is
when Status_Passed =>
Put (".");
when Status_Failed =>
Put ("F");
when Status_Undefined =>
Put ("U");
when Status_Skipped =>
Put ("-");
when Status_Passed => Put (".");
when Status_Failed => Put ("F");
when Status_Undefined => Put ("U");
when Status_Skipped => Put ("-");
end case;
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Style => Reset_All);
end Scenario_Completed;
--------------------
@ -281,8 +426,7 @@ package body BDD.Formatters is
when Status_Failed | Status_Undefined =>
Clear_Progress (Self);
Display_Scenario_Header (Self, Feature, Scenario);
New_Line;
Display_Scenario_And_Steps (Self, Feature, Scenario);
end case;
end Scenario_Completed;

13
src/bdd-formatters.ads
View File

@ -50,6 +50,14 @@ package BDD.Formatters is
Status : BDD.Scenario_Status) is null;
-- Called when a scenario has completed
procedure Step_Completed
(Self : in out Formatter;
Feature : not null access BDD.Features.Feature_Record'Class;
Scenario : not null access BDD.Features.Scenario_Record'Class;
Step : not null access BDD.Features.Step_Record'Class) is null;
-- Called when a step has completed.
-- Step.Status has been set appropriately
function Create_Formatter return not null access Formatter'Class;
-- Create the formatter to use, depending on BDD.Output
@ -70,6 +78,11 @@ package BDD.Formatters is
Feature : not null access BDD.Features.Feature_Record'Class;
Scenario : not null access BDD.Features.Scenario_Record'Class;
Status : BDD.Scenario_Status);
overriding procedure Step_Completed
(Self : in out Formatter_Full;
Feature : not null access BDD.Features.Feature_Record'Class;
Scenario : not null access BDD.Features.Scenario_Record'Class;
Step : not null access BDD.Features.Step_Record'Class);
----------
-- Dots --

40
src/bdd-parser.adb
View File

@ -42,10 +42,10 @@ package body BDD.Parser is
In_String,
In_Outline, In_Examples);
State : State_Type := None;
F : Feature;
Scenar : Scenario;
F : BDD.Features.Feature;
Scenar : BDD.Features.Scenario;
Step : BDD.Features.Step;
Buffer : GNAT.Strings.String_Access := File.Read_File;
Seen_Scenar : Boolean := False; -- Whether we have one scenario in F
Index : Integer := Buffer'First;
Line : Natural := 0;
Index_In_Feature : Natural := 0;
@ -69,10 +69,10 @@ package body BDD.Parser is
begin
case State is
when In_Scenario | In_Outline | In_Examples =>
Step := null;
Runner.Scenario_End (F, Scenar);
Free (Scenar);
State := In_Feature;
Seen_Scenar := True;
when others =>
null;
@ -92,7 +92,6 @@ package body BDD.Parser is
end if;
State := None;
Seen_Scenar := False;
end Finish_Feature;
------------------
@ -136,7 +135,7 @@ package body BDD.Parser is
if Starts_With (Buffer (First_Char .. Line_E), """""""") then
if State = In_String then
State := In_Scenario;
elsif State = In_Scenario then
elsif Step /= null then
State := In_String;
String_Indent := First_Char - Line_S;
String_Line_Start := Line;
@ -148,13 +147,12 @@ package body BDD.Parser is
elsif State = In_String then
if First_Char < Line_S + String_Indent - 1 then
Trace (Me, "MANU String="
& Buffer (First_Char .. Line_E));
Step.Add_To_Multiline (Buffer (First_Char .. Line_E));
elsif Line_S + String_Indent - 1 <= Line_E then
Trace (Me, "MANU String="
& Buffer (Line_S + String_Indent - 1 .. Line_E));
Step.Add_To_Multiline
(Get_Line_End (Line_S + String_Indent - 1));
else
Trace (Me, "MANU String=");
Step.Add_To_Multiline ("");
end if;
elsif First_Char > Line_E then
@ -164,7 +162,13 @@ package body BDD.Parser is
elsif Buffer (First_Char) = '|' then
case State is
when In_Scenario | In_Outline =>
Trace (Me, "MANU Table=" & Buffer (First_Char .. Line_E));
if Step /= null then
Trace (Me, "MANU Table=" & Buffer (First_Char .. Line_E));
else
raise Syntax_Error with "Tables only allowed in"
& " steps, at " & File.Display_Full_Name & ":"
& Image (Line, 1);
end if;
when In_Examples =>
Trace (Me, "MANU Example=" & Buffer (First_Char .. Line_E));
@ -200,7 +204,7 @@ package body BDD.Parser is
& Image (Line, 1);
end if;
if Seen_Scenar then
if Scenar /= null then
raise Syntax_Error with "Background must be defined before all"
& " Scenario, at " & File.Display_Full_Name & ":"
& Image (Line, 1);
@ -279,16 +283,16 @@ package body BDD.Parser is
or else Starts_With (Buffer (First_Char .. Line_E), Cst_But)
or else Starts_With (Buffer (First_Char .. Line_E), Cst_When)
then
if State /= In_Scenario
and then State /= In_Outline
then
if Scenar = null then
raise Syntax_Error with "Step must be defined with in a"
& " Scenario at " & File.Display_Full_Name & ":"
& Image (Line, 1);
end if;
-- ??? Should handle the step
null;
Step := Create
(Text => Buffer (First_Char .. Line_E),
Line => Line);
Scenar.Add (Step);
else
if State = None then

43
src/bdd-runner.adb
View File

@ -97,21 +97,6 @@ package body BDD.Runner is
end if;
end Run;
--------------------
-- Scenario_Start --
--------------------
overriding procedure Scenario_Start
(Self : in out Feature_Runner;
Feature : not null access BDD.Features.Feature_Record'Class;
Scenario : not null access BDD.Features.Scenario_Record'Class)
is
begin
if Scenario.Kind = Kind_Scenario then
Self.Format.Scenario_Start (Feature, Scenario);
end if;
end Scenario_Start;
------------------
-- Scenario_End --
------------------
@ -121,13 +106,31 @@ package body BDD.Runner is
Feature : not null access BDD.Features.Feature_Record'Class;
Scenario : not null access BDD.Features.Scenario_Record'Class)
is
Status : Scenario_Status;
Status : Scenario_Status := Status_Passed;
procedure Run_Step (S : not null access Step_Record'Class);
-- Run a specific step of the scenario
procedure Run_Step (S : not null access Step_Record'Class) is
begin
case Status is
when Status_Passed =>
-- ??? Simulate a run
delay 0.2;
S.Set_Status (Status_Undefined);
Status := Status_Undefined;
when Status_Failed | Status_Skipped | Status_Undefined =>
S.Set_Status (Status_Skipped);
end case;
Self.Format.Step_Completed (Feature, Scenario, S);
end Run_Step;
begin
if Scenario.Kind = Kind_Scenario then
Status := Status_Failed;
delay 1.0;
Self.Format.Scenario_Start (Feature, Scenario);
Scenario.Foreach_Step (Run_Step'Access);
Self.Format.Scenario_Completed (Feature, Scenario, Status);
end if;
end Scenario_End;

4
src/bdd-runner.ads
View File

@ -63,10 +63,6 @@ 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 : not null access BDD.Features.Feature_Record'Class;
Scenario : not null access BDD.Features.Scenario_Record'Class);
overriding procedure Scenario_End
(Self : in out Feature_Runner;
Feature : not null access BDD.Features.Feature_Record'Class;

7
src/bdd.ads
View File

@ -65,6 +65,13 @@ package BDD is
Status_Undefined,
Status_Skipped);
Step_Colors : array (Scenario_Status) of GNATCOLL.Terminal.ANSI_Color :=
(Status_Passed => GNATCOLL.Terminal.Green,
Status_Failed => GNATCOLL.Terminal.Red,
Status_Undefined => GNATCOLL.Terminal.Yellow,
Status_Skipped => GNATCOLL.Terminal.Cyan);
-- Mapping status to colors in the output
procedure Command_Line_Switches;
-- Handles the command line switches