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

Add support for running scenario outlines

This commit is contained in:
Emmanuel Briot 2014-06-03 18:05:45 +02:00
parent 1197e90be6
commit c2d5d27f84
18 changed files with 346 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Makefile
View File

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

14
features/first.feature
View File

@ -2,8 +2,22 @@ Feature: A first feature
This is not very useful, we are just testing that we can execute basic
calculator tests.
Background:
Given an empty calculator
Scenario: Simple additions
When I enter "1"
And I enter "2"
And I enter "+"
Then I should read 3
Scenario Outline: testing operators
When I enter "<first>"
And I enter "<second>"
And I enter "<operation>"
Then I should read <result>
Examples:
| first | second | operation | result |
| 10 | 20 | + | 30 |
| 20 | 10 | - | 10 |
| 10 | 20 | + | 40 |

BIN
features/step_definitions/.calculator.adb.swp
View File

Binary file not shown.

5
features/step_definitions/calculator.adb
View File

@ -5,6 +5,11 @@ package body Calculator is
Stack : array (1 .. 5) of Integer;
Stack_Top : Integer := Stack'First;
procedure Reset is
begin
Stack_Top := Stack'First;
end Reset;
procedure Enter (Value : String) is
begin
if Is_Digit (Value (Value'First)) then

1
features/step_definitions/calculator.ads
View File

@ -1,5 +1,6 @@
package Calculator is
procedure Reset;
procedure Enter (Value : String);
function Peek return Integer;

5
features/step_definitions/mysteps1.adb
View File

@ -3,6 +3,11 @@ with Calculator; use Calculator;
package body MySteps1 is
procedure Given_An_Empty_Calculator is
begin
Reset;
end Given_An_Empty_Calculator;
procedure When_I_Enter (Value : String) is
begin
Enter (Value);

3
features/step_definitions/mysteps1.ads
View File

@ -1,5 +1,8 @@
package MySteps1 is
-- @given ^an empty calculator$
procedure Given_An_Empty_Calculator;
-- @when ^I enter "(.*)"$
procedure When_I_Enter (Value : String)
with Pre => Value /= "";

24
src/bdd-asserts.ads
View File

@ -32,12 +32,32 @@ with GNAT.Source_Info;
package BDD.Asserts is
package BAG renames BDD.Asserts_Generic;
package Integer_Asserts is new BAG.Asserts (Integer, Integer'Image, "=");
package Integer_Equals
is new BAG.Asserts (Integer, Integer'Image, "=", "=");
procedure Assert
(Val1, Val2 : Integer;
Msg : String := "";
Location : String := GNAT.Source_Info.Source_Location;
Entity : String := GNAT.Source_Info.Enclosing_Entity)
renames Integer_Asserts.Assert;
renames Integer_Equals.Assert;
package Integer_Less_Than
is new BAG.Asserts (Integer, Integer'Image, "<", "<");
procedure Assert_Less_Than
(Val1, Val2 : Integer;
Msg : String := "";
Location : String := GNAT.Source_Info.Source_Location;
Entity : String := GNAT.Source_Info.Enclosing_Entity)
renames Integer_Less_Than.Assert;
function Identity (Str : String) return String is (Str);
package String_Equals
is new BAG.Asserts (String, Identity, "=", "=");
procedure Assert
(Val1, Val2 : String;
Msg : String := "";
Location : String := GNAT.Source_Info.Source_Location;
Entity : String := GNAT.Source_Info.Enclosing_Entity)
renames String_Equals.Assert;
end BDD.Asserts;

8
src/bdd-asserts_generic.adb
View File

@ -58,7 +58,7 @@ package body BDD.Asserts_Generic is
Id := Id + 1;
Messages.Include (Actual, Full);
raise Assertion_Error with Actual;
raise Unexpected_Result with Actual;
end Raise_Assertion_Error;
-----------------
@ -93,9 +93,11 @@ package body BDD.Asserts_Generic is
Entity : String := GNAT.Source_Info.Enclosing_Entity)
is
begin
if not (Val1 = Val2) then
if not Operator (Val1, Val2) then
Raise_Assertion_Error
(Msg, Image (Val1) & " /= " & Image (Val2), Location, Entity);
(Msg,
Image (Val1) & ' ' & Operator_Image & ' ' & Image (Val2),
Location, Entity);
end if;
end Assert;
end Asserts;

7
src/bdd-asserts_generic.ads
View File

@ -28,6 +28,8 @@ with GNAT.Source_Info;
package BDD.Asserts_Generic is
Unexpected_Result : exception;
procedure Raise_Assertion_Error
(Msg : String;
Details : String;
@ -43,9 +45,10 @@ package BDD.Asserts_Generic is
-- below).
generic
type T is limited private;
type T (<>) is limited private;
with function Image (V : T) return String;
with function "=" (V1, V2 : T) return Boolean is <>;
with function Operator (V1, V2 : T) return Boolean;
Operator_Image : String;
package Asserts is

147
src/bdd-features.adb
View File

@ -21,13 +21,18 @@
-- --
------------------------------------------------------------------------------
with Ada.Exceptions; use Ada.Exceptions;
with Ada.Strings.Fixed; use Ada.Strings, Ada.Strings.Fixed;
with Ada.Unchecked_Deallocation;
with BDD.Asserts_Generic; use BDD.Asserts_Generic;
with GNATCOLL.Traces; use GNATCOLL.Traces;
with GNATCOLL.Utils; use GNATCOLL.Utils;
package body BDD.Features is
Me : constant Trace_Handle := Create ("BDD.FEATURES");
Substitution_Re : constant Pattern_Matcher := Compile ("<([^>]+)>");
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Match_Array, Match_Array_Access);
@ -127,6 +132,8 @@ package body BDD.Features is
----------
procedure Free (Self : in out Scenario_Record) is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Scenario_Array, Scenario_Array_Access);
begin
Trace (Me, "Free scenario index=" & Self.Index'Img);
Self.Name := Null_Unbounded_String;
@ -134,6 +141,7 @@ package body BDD.Features is
Self.Index := 1;
Self.Kind := Kind_Scenario;
Self.Feature := No_Feature;
Unchecked_Free (Self.Example_Scenarios);
Self.Steps.Clear;
end Free;
@ -219,8 +227,9 @@ package body BDD.Features is
(Scenario : BDD.Features.Scenario;
Step : not null access Step_Record'Class))
is
SR : constant access Scenario_Record := Self.Get;
begin
for S of Self.Get.Steps loop
for S of SR.Steps loop
Callback (Self, S);
end loop;
end Foreach_Step;
@ -441,6 +450,19 @@ package body BDD.Features is
Self.Table.Add_Row_As_String (Row);
end Add_To_Table;
---------------------
-- Add_Example_Row --
---------------------
procedure Add_Example_Row (Self : Scenario; Row : String) is
SR : constant access Scenario_Record := Self.Get;
begin
if SR.Examples = No_Table then
SR.Examples := Create;
end if;
SR.Examples.Add_Row_As_String (Row);
end Add_Example_Row;
-----------
-- Table --
-----------
@ -500,4 +522,127 @@ package body BDD.Features is
return False;
end Should_Execute;
---------
-- Run --
---------
procedure Run
(Step : not null access Step_Record'Class;
Execute : Boolean;
Step_Runners : Step_Runner_Lists.List)
is
Text : constant String := To_String (Step.Text);
First : Integer := Text'First;
begin
Step.Set_Status (Status_Undefined);
-- Skip the leading 'Given|Then|...' keywords, which are irrelevant
-- for the purpose of the match
while First <= Text'Last
and then not Is_Whitespace (Text (First))
loop
First := First + 1;
end loop;
Skip_Blanks (Text, First);
for R of Step_Runners loop
begin
-- Run the step, or at least check whether it is defined.
if Execute then
Step.Set_Status (Status_Passed);
else
Step.Set_Status (Status_Skipped);
end if;
-- Will set status to undefined if necessary
R (Step, Text (First .. Text'Last), Execute => Execute);
exit when Step.Status /= Status_Undefined;
exception
when E : Unexpected_Result =>
Step.Set_Status (Status_Failed, Get_Message (E));
exit;
when E : others =>
Step.Set_Status (Status_Failed, Exception_Information (E));
exit;
end;
end loop;
end Run;
----------------------
-- Foreach_Scenario --
----------------------
procedure Foreach_Scenario
(Self : Scenario;
Callback : not null access procedure (Scenario : BDD.Features.Scenario))
is
SR : constant access Scenario_Record := Self.Get;
Tmp : Scenario;
Tmp_Step : Step;
function Substitute (Text : String; Row : Positive) return String;
-- Update the text of S to substitute text with the examples.
-- This always properly restores the original text
function Substitute (Text : String; Row : Positive) return String is
T : Unbounded_String := To_Unbounded_String (Text);
Matches : Match_Array (0 .. 1);
begin
loop
declare
Tmp : constant String := To_String (T);
begin
Match (Substitution_Re, Tmp, Matches);
exit when Matches (0) = No_Match;
Replace_Slice
(T, Matches (0).First, Matches (0).Last,
By => SR.Examples.Get
(Column => Tmp (Matches (1).First .. Matches (1).Last),
Row => Row));
end;
end loop;
return To_String (T);
end Substitute;
begin
case SR.Kind is
when Kind_Background | Kind_Scenario =>
Callback (Self);
when Kind_Outline =>
if SR.Example_Scenarios = null then
SR.Example_Scenarios := new Scenario_Array
(1 .. SR.Examples.Height);
for Row in SR.Example_Scenarios'Range loop
Trace (Me, "Create new scenario");
Tmp := Create
(Feature => Self.Get_Feature,
Kind => Kind_Scenario,
Name => Self.Name,
Line => Self.Line,
Index => Self.Index);
for S of SR.Steps loop
Tmp_Step := Create
(Text => Substitute (To_String (S.Text), Row),
Line => S.Line);
Tmp_Step.Multiline := S.Multiline;
Tmp_Step.Table := S.Table;
Tmp.Add (Tmp_Step);
end loop;
SR.Example_Scenarios (Row) := Tmp;
end loop;
end if;
for Row in SR.Example_Scenarios'Range loop
Callback (SR.Example_Scenarios (Row));
end loop;
end case;
end Foreach_Scenario;
end BDD.Features;

49
src/bdd-features.ads
View File

@ -89,6 +89,29 @@ package BDD.Features is
-- True is returned if the subprogram associated with the step definition
-- should be executed.
type Step_Runner is access procedure
(Step : not null access BDD.Features.Step_Record'Class;
Text : String;
Execute : Boolean);
-- Run a step, and sets its status.
-- If Execute is False, then we only check whether the step is known, but
-- it is not run. No exception is raised in this mode.
-- Text must be Step.Text, minus the leading 'Given|Then|...' words.
-- This procedure is expected to raise exceptions when a test fails.
package Step_Runner_Lists is new Ada.Containers.Doubly_Linked_Lists
(Step_Runner);
procedure Run
(Step : not null access Step_Record'Class;
Execute : Boolean;
Step_Runners : Step_Runner_Lists.List);
-- Run a specific step, as part of a scenario.
-- Step_Runner is used to find the definition of each step as provided by
-- the user.
-- If Execute is False, the step is only tested to see whether there is a
-- valid definition for it, but is not actually executed.
-------------
-- Feature --
-------------
@ -153,12 +176,25 @@ package BDD.Features is
procedure Add (Self : Scenario; S : not null access Step_Record'Class);
-- Add a new step
procedure Add_Example_Row (Self : Scenario; Row : String)
with Pre => Self.Kind = Kind_Outline;
-- Add a new row to the examples associated with a scenario outline.
procedure Foreach_Step
(Self : Scenario;
Callback : not null access procedure
(Scenario : BDD.Features.Scenario;
Step : not null access Step_Record'Class));
-- Iterate over each step
-- Iterate over each step.
-- In the case of an outline, it returns the template steps, which are not
-- suitable for execution. Their text is exactly as was entered by the user
procedure Foreach_Scenario
(Self : Scenario;
Callback : not null access procedure (Scenario : BDD.Features.Scenario));
-- Calls Callback for each scenario that can be generated through Self.
-- In general, this is Self only, but an outline scenario will in fact
-- generate one scenario per line in the examples.
procedure Set_Status (Self : Scenario; Status : BDD.Scenario_Status);
function Status (Self : Scenario) return BDD.Scenario_Status;
@ -202,6 +238,9 @@ private
No_Feature : constant Feature :=
(Feature_Pointers.Null_Ref with null record);
type Scenario_Array; -- Can't instantiate doubly_linked_Lists
type Scenario_Array_Access is access all Scenario_Array;
type Scenario_Record is new Refcounted with record
Name : Ada.Strings.Unbounded.Unbounded_String;
Line : Positive := 1;
@ -211,8 +250,12 @@ private
Longuest_Step : Integer := -1;
Status : BDD.Scenario_Status;
Feature : BDD.Features.Feature;
end record;
Examples : BDD.Tables.Table;
Example_Scenarios : Scenario_Array_Access;
-- For outlines, the list of all examples to be run, and the scenarios
-- we are generating for them.
end record;
overriding procedure Free (Self : in out Scenario_Record);
package Scenario_Pointers is new GNATCOLL.Refcount.Smart_Pointers
@ -222,4 +265,6 @@ private
No_Scenario : constant Scenario :=
(Scenario_Pointers.Null_Ref with null record);
type Scenario_Array is array (Natural range <>) of Scenario;
end BDD.Features;

22
src/bdd-formatters.adb
View File

@ -115,16 +115,34 @@ package body BDD.Formatters is
Step : not null access BDD.Features.Step_Record'Class);
-- Display a step for a scenario
procedure Show_Scenario (Scenario : BDD.Features.Scenario);
-- Display the details for one of the scenarios (either the scenario
-- from the toplevel, or one of the scenarios generated from an outline)
procedure Show_Step
(Scenario : BDD.Features.Scenario;
Step : not null access BDD.Features.Step_Record'Class) is
begin
Display_Step (Self, Scenario, Step);
end Show_Step;
procedure Show_Scenario (Scenario : BDD.Features.Scenario) is
begin
Scenario.Foreach_Step (Show_Step'Access);
New_Line;
end Show_Scenario;
begin
Display_Scenario_Header (Self, Scenario);
Scenario.Foreach_Step (Show_Step'Access);
New_Line;
case Scenario.Kind is
when Kind_Scenario | Kind_Background =>
Scenario.Foreach_Step (Show_Step'Access);
New_Line;
when Kind_Outline =>
Scenario.Foreach_Scenario (Show_Scenario'Access);
end case;
end Display_Scenario_And_Steps;
----------------------

2
src/bdd-formatters.ads
View File

@ -40,7 +40,7 @@ package BDD.Formatters is
procedure Scenario_Start
(Self : in out Formatter;
Scenario : BDD.Features.Scenario) is null;
-- Display information about a feature and ascenario just before the
-- Display information about a feature and a scenario just before the
-- scenario is run.
procedure Scenario_Completed

6
src/bdd-parser.adb
View File

@ -185,7 +185,7 @@ package body BDD.Parser is
Step.Add_To_Table (Buffer (First_Char .. Line_E));
when In_Examples =>
Trace (Me, "MANU Example=" & Buffer (First_Char .. Line_E));
Scenar.Add_Example_Row (Buffer (First_Char .. Line_E));
when others =>
raise Syntax_Error with "Tables only allowed in"
@ -314,7 +314,9 @@ package body BDD.Parser is
(Text => Buffer (First_Char .. Line_E),
Line => Line);
if State = In_Scenario then
if State = In_Scenario
or else State = In_Outline
then
Scenar.Add (Step);
else
Background.Add (Step);

122
src/bdd-runner.adb
View File

@ -21,10 +21,6 @@
-- --
------------------------------------------------------------------------------
with Ada.Assertions;
with Ada.Exceptions; use Ada.Exceptions;
with GNATCOLL.Utils; use GNATCOLL.Utils;
package body BDD.Runner is
--------------
@ -134,67 +130,43 @@ package body BDD.Runner is
Step : not null access Step_Record'Class);
-- Run a specific step of the scenario
procedure Run_Scenario_And_Background (Nested : BDD.Features.Scenario);
-- Execute the background scenario, and then Scenario itself.
-- In the case of outline scenarios, this is called once for each line
-- in the examples, since we want to execute the background for each.
--------------
-- Run_Step --
--------------
procedure Run_Step
(Scenario : BDD.Features.Scenario;
Step : not null access Step_Record'Class)
is
Execute : constant Boolean := Scenario.Status = Status_Passed;
Text : constant String := Step.Text;
First : Integer := Text'First;
begin
Step.Set_Status (Status_Undefined);
-- Skip the leading 'Given|Then|...' keywords, which are irrelevant
-- for the purpose of the match
while First <= Text'Last
and then not Is_Whitespace (Text (First))
loop
First := First + 1;
end loop;
Skip_Blanks (Text, First);
for R of Self.Runners loop
begin
-- Run the step, or at least check whether it is defined.
if Execute then
Step.Set_Status (Status_Passed);
else
Step.Set_Status (Status_Skipped);
end if;
-- Will set status to undefined if necessary
R (Step, Text (First .. Text'Last), Execute => Execute);
exit when Step.Status /= Status_Undefined;
exception
when E : Ada.Assertions.Assertion_Error =>
Step.Set_Status (Status_Failed, Exception_Message (E));
exit;
when E : others =>
Step.Set_Status (Status_Failed, Exception_Information (E));
exit;
end;
end loop;
Step.Run (Execute, Self.Runners);
if Execute then
if Show_Steps then
Self.Steps_Stats (Step.Status) :=
Self.Steps_Stats (Step.Status) + 1;
end if;
Scenario.Set_Status (Step.Status);
end if;
if Show_Steps then
Self.Steps_Stats (Step.Status) :=
Self.Steps_Stats (Step.Status) + 1;
Self.Format.Step_Completed (Scenario, Step);
end if;
end Run_Step;
begin
if Scenario.Kind = Kind_Scenario then
Scenario.Set_Status (Status_Passed);
---------------------------------
-- Run_Scenario_And_Background --
---------------------------------
procedure Run_Scenario_And_Background (Nested : BDD.Features.Scenario) is
Is_Nested : constant Boolean := Nested /= Scenario;
begin
Nested.Set_Status (Status_Passed);
if Background /= No_Scenario then
Show_Steps := Scenario.Get_Feature.Id /= Self.Current_Feature_Id;
@ -209,25 +181,61 @@ package body BDD.Runner is
end if;
if Background.Status = Status_Passed then
Scenario.Set_Status (Status_Passed);
Nested.Set_Status (Status_Passed);
else
Scenario.Set_Status (Status_Skipped);
Nested.Set_Status (Status_Skipped);
end if;
end if;
Show_Steps := True;
Self.Format.Scenario_Start (Scenario);
Scenario.Foreach_Step (Run_Step'Access);
Self.Format.Scenario_Completed (Scenario);
Self.Scenario_Stats (Scenario.Status) :=
Self.Scenario_Stats (Scenario.Status) + 1;
if not Is_Nested then
Self.Format.Scenario_Start (Nested);
Nested.Foreach_Step (Run_Step'Access);
Self.Format.Scenario_Completed (Nested);
Self.Scenario_Stats (Nested.Status) :=
Self.Scenario_Stats (Nested.Status) + 1;
else
Nested.Foreach_Step (Run_Step'Access);
end if;
if Is_Nested then
case Nested.Status is
when Status_Passed | Status_Undefined | Status_Skipped =>
null; -- Do not change the status of Scenario
when Status_Failed =>
Scenario.Set_Status (Status_Failed);
end case;
end if;
if Scenario.Get_Feature.Id /= Self.Current_Feature_Id then
Self.Features_Count := Self.Features_Count + 1;
Self.Current_Feature_Id := Scenario.Get_Feature.Id;
end if;
end if;
end Run_Scenario_And_Background;
begin
case Scenario.Kind is
when Kind_Scenario =>
Run_Scenario_And_Background (Scenario);
when Kind_Background =>
null;
when Kind_Outline =>
Scenario.Set_Status (Status_Passed);
Self.Format.Scenario_Start (Scenario);
Scenario.Foreach_Scenario
(Run_Scenario_And_Background'Access);
Self.Format.Scenario_Completed (Scenario);
Self.Scenario_Stats (Scenario.Status) :=
Self.Scenario_Stats (Scenario.Status) + 1;
end case;
end Scenario_End;
---------------------

14
src/bdd-runner.ads
View File

@ -24,7 +24,6 @@
-- Manipulating features files
with Ada.Calendar; use Ada.Calendar;
with Ada.Containers.Doubly_Linked_Lists;
with BDD.Features; use BDD.Features;
with BDD.Formatters; use BDD.Formatters;
with BDD.Parser; use BDD.Parser;
@ -76,16 +75,6 @@ package BDD.Runner is
Background : BDD.Features.Scenario;
Scenario : BDD.Features.Scenario);
type Step_Runner is access procedure
(Step : not null access BDD.Features.Step_Record'Class;
Text : String;
Execute : Boolean);
-- Run a step, and sets its status.
-- If Execute is False, then we only check whether the step is known, but
-- it is not run. No exception is raised in this mode.
-- Text must be Step.Text, minus the leading 'Given|Then|...' words.
-- This procedure is expected to raise exceptions when a test fails.
procedure Add_Step_Runner
(Self : in out Feature_Runner;
Runner : not null Step_Runner);
@ -93,9 +82,6 @@ package BDD.Runner is
-- Any number of those can be registered.
private
package Step_Runner_Lists is new Ada.Containers.Doubly_Linked_Lists
(Step_Runner);
type Feature_Runner is new BDD.Parser.Abstract_Feature_Runner with record
Files : GNATCOLL.VFS.File_Array_Access;
Format : access BDD.Formatters.Formatter'Class;

2
src/bdd-tables.ads
View File

@ -85,7 +85,7 @@ package BDD.Tables is
procedure Display
(Self : Table; File : Ada.Text_IO.File_Type; Prefix : String := "");
-- Display the table in File.
-- Each line is leaded by a Prefix.
-- Each line is lead by a Prefix.
private
package String_Vectors is new Ada.Containers.Indefinite_Vectors