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

Make Scenario an access type 

This is in preparation for storing it long term in the Feature, which
would be useful for some formatters. This also clarifies the life time
of the scenario.
This commit is contained in:
Emmanuel Briot 2014-02-07 11:24:20 +01:00
parent a98955c033
commit f6757fc64b
8 changed files with 162 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

93
src/bdd-features.adb
View File

@ -21,7 +21,8 @@
-- --
------------------------------------------------------------------------------
with Ada.Strings.Fixed; use Ada.Strings, Ada.Strings.Fixed;
with Ada.Strings.Fixed; use Ada.Strings, Ada.Strings.Fixed;
with Ada.Unchecked_Deallocation;
package body BDD.Features is
@ -100,19 +101,34 @@ package body BDD.Features is
-- Free --
----------
procedure Free (Self : in out Scenario) is
procedure Free (Self : in out Scenario_Record) is
begin
Self.Name := Null_Unbounded_String;
Self.Line := 1;
Self.Index := 1;
Self.Kind := Kind_Scenario;
Self.Steps.Clear;
end Free;
----------
-- Free --
----------
procedure Free (Self : in out Scenario) is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Scenario_Record'Class, Scenario);
begin
if Self /= null then
Free (Self.all);
Unchecked_Free (Self);
end if;
end Free;
----------
-- Name --
----------
function Name (Self : Scenario) return String is
function Name (Self : not null access Scenario_Record) return String is
begin
return To_String (Self.Name);
end Name;
@ -121,7 +137,7 @@ package body BDD.Features is
-- Line --
----------
function Line (Self : Scenario) return Positive is
function Line (Self : not null access Scenario_Record) return Positive is
begin
return Self.Line;
end Line;
@ -130,7 +146,7 @@ package body BDD.Features is
-- Index --
-----------
function Index (Self : Scenario) return Positive is
function Index (Self : not null access Scenario_Record) return Positive is
begin
return Self.Index;
end Index;
@ -139,22 +155,34 @@ package body BDD.Features is
-- Kind --
----------
function Kind (Self : Scenario) return Scenario_Kind is
function Kind
(Self : not null access Scenario_Record) return Scenario_Kind is
begin
return Self.Kind;
end Kind;
---------
-- Add --
---------
procedure Add
(Self : not null access Scenario_Record;
S : not null access Step_Record'Class)
is
begin
Self.Steps.Append (S);
end Add;
--------------------
-- Set_Attributes --
--------------------
procedure Set_Attributes
(Self : in out Scenario;
(Self : not null access Scenario_Record;
Kind : Scenario_Kind;
Name : String;
Line : Positive;
Index : Positive)
is
Index : Positive) is
begin
Self.Name := To_Unbounded_String (Trim (Name, Both));
Self.Line := Line;
@ -181,4 +209,51 @@ package body BDD.Features is
Append (Self.Description, " " & Descr & ASCII.LF);
end Add_Description;
--------------
-- Set_Text --
--------------
procedure Set_Text
(Self : not null access Step_Record'Class; Text : String)
is
begin
Append (Self.Text, Text);
end Set_Text;
----------
-- Free --
----------
procedure Free (Self : in out Step_Record) is
begin
Self.Text := Null_Unbounded_String;
end Free;
----------
-- Free --
----------
procedure Free (Self : in out Step) is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Step_Record'Class, Step);
begin
if Self /= null then
Free (Self.all);
Unchecked_Free (Self);
end if;
end Free;
-----------
-- Clear --
-----------
overriding procedure Clear (List : in out Step_List) is
begin
for S of List loop
Free (S);
end loop;
Step_Lists.Clear (Step_Lists.List (List)); -- inherited
end Clear;
end BDD.Features;

47
src/bdd-features.ads
View File

@ -23,24 +23,42 @@
-- A feature and its scenarios.
with Ada.Containers.Doubly_Linked_Lists;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
package BDD.Features is
----------
-- Step --
----------
type Step_Record (<>) is tagged private;
type Step is access all Step_Record'Class;
procedure Set_Text
(Self : not null access Step_Record'Class; Text : String);
-- Set the text of the step
procedure Free (Self : in out Step_Record);
procedure Free (Self : in out Step);
-- Free the memory associated with Self
--------------
-- Scenario --
--------------
type Scenario is tagged private;
type Scenario_Record is tagged private;
type Scenario is access all Scenario_Record'Class;
-- A scenario to be run within a feature
procedure Free (Self : in out Scenario_Record);
procedure Free (Self : in out Scenario);
-- Free the memory associated with Self
type Scenario_Kind is (Kind_Scenario, Kind_Background, Kind_Outline);
procedure Set_Attributes
(Self : in out Scenario;
(Self : not null access Scenario_Record;
Kind : Scenario_Kind;
Name : String;
Line : Positive;
@ -48,12 +66,18 @@ package BDD.Features is
-- Set the line of the feature file at which the scenario is defined, and
-- its index within its Feature.
function Name (Self : Scenario) return String;
function Line (Self : Scenario) return Positive;
function Index (Self : Scenario) return Positive;
function Kind (Self : Scenario) return Scenario_Kind;
function Name (Self : not null access Scenario_Record) return String;
function Line (Self : not null access Scenario_Record) return Positive;
function Index (Self : not null access Scenario_Record) return Positive;
function Kind
(Self : not null access Scenario_Record) return Scenario_Kind;
-- Retrieve the attributes of Self
procedure Add
(Self : not null access Scenario_Record;
S : not null access Step_Record'Class);
-- Add a new step
-------------
-- Feature --
-------------
@ -85,11 +109,20 @@ package BDD.Features is
-- for each line in the description.
private
type Scenario is tagged record
type Step_Record is tagged record
Text : Ada.Strings.Unbounded.Unbounded_String;
end record;
package Step_Lists is new Ada.Containers.Doubly_Linked_Lists (Step);
type Step_List is new Step_Lists.List with null record;
overriding procedure Clear (List : in out Step_List);
type Scenario_Record is tagged record
Name : Ada.Strings.Unbounded.Unbounded_String;
Line : Positive := 1;
Index : Positive := 1;
Kind : Scenario_Kind := Kind_Scenario;
Steps : Step_List;
end record;
-- Make sure this type can be put in a list and automatically reclaim
-- storage when the list is clearer.

32
src/bdd-formatters.adb
View File

@ -28,25 +28,26 @@ package body BDD.Formatters is
function Scenario_Name
(Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class) return String;
Scenario : not null access BDD.Features.Scenario_Record'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);
Scenario : not null access BDD.Features.Scenario_Record'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);
Scenario : not null access BDD.Features.Scenario_Record'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);
Scenario : not null access BDD.Features.Scenario_Record'Class);
-- Display the name of the scenario being run, if supported by the
-- terminal
@ -71,7 +72,8 @@ package body BDD.Formatters is
function Scenario_Name
(Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class) return String
Scenario : not null access BDD.Features.Scenario_Record'Class)
return String
is
begin
return +Feature.File.Relative_Path (Features_Directory)
@ -86,7 +88,7 @@ package body BDD.Formatters is
procedure Display_Location
(Self : Formatter'Class;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class)
Scenario : not null access BDD.Features.Scenario_Record'Class)
is
begin
Self.Term.Set_Color
@ -106,7 +108,7 @@ package body BDD.Formatters is
procedure Display_Progress
(Self : in out Formatter'Class;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class)
Scenario : not null access BDD.Features.Scenario_Record'Class)
is
Width : constant Integer := Self.Term.Get_Width;
begin
@ -153,7 +155,7 @@ package body BDD.Formatters is
procedure Display_Scenario_Header
(Self : in out Formatter'Class;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class)
Scenario : not null access BDD.Features.Scenario_Record'Class)
is
begin
if Feature.Id /= Self.Last_Displayed_Feature_Id then
@ -173,7 +175,7 @@ package body BDD.Formatters is
overriding procedure Scenario_Start
(Self : in out Formatter_Full;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class)
Scenario : not null access BDD.Features.Scenario_Record'Class)
is
begin
Clear_Progress (Self);
@ -188,7 +190,7 @@ package body BDD.Formatters is
overriding procedure Scenario_Completed
(Self : in out Formatter_Full;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class;
Scenario : not null access BDD.Features.Scenario_Record'Class;
Status : BDD.Scenario_Status)
is
pragma Unreferenced (Feature, Scenario, Status);
@ -204,7 +206,7 @@ package body BDD.Formatters is
overriding procedure Scenario_Completed
(Self : in out Formatter_Dots;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class;
Scenario : not null access BDD.Features.Scenario_Record'Class;
Status : BDD.Scenario_Status)
is
pragma Unreferenced (Self, Feature, Scenario);
@ -228,7 +230,7 @@ package body BDD.Formatters is
overriding procedure Scenario_Start
(Self : in out Formatter_Quiet;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class)
Scenario : not null access BDD.Features.Scenario_Record'Class)
is
begin
Display_Progress (Self, Feature, Scenario);
@ -241,7 +243,7 @@ package body BDD.Formatters is
overriding procedure Scenario_Completed
(Self : in out Formatter_Quiet;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class;
Scenario : not null access BDD.Features.Scenario_Record'Class;
Status : BDD.Scenario_Status)
is
pragma Unreferenced (Feature, Scenario, Status);
@ -256,7 +258,7 @@ package body BDD.Formatters is
procedure Scenario_Start
(Self : in out Formatter_Hide_Passed;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class)
Scenario : not null access BDD.Features.Scenario_Record'Class)
is
begin
Display_Progress (Self, Feature, Scenario);
@ -269,7 +271,7 @@ package body BDD.Formatters is
overriding procedure Scenario_Completed
(Self : in out Formatter_Hide_Passed;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class;
Scenario : not null access BDD.Features.Scenario_Record'Class;
Status : BDD.Scenario_Status)
is
begin

18
src/bdd-formatters.ads
View File

@ -39,14 +39,14 @@ package BDD.Formatters is
procedure Scenario_Start
(Self : in out Formatter;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class) is null;
Scenario : not null access BDD.Features.Scenario_Record'Class) is null;
-- Display information about a feature and ascenario just before the
-- scenario is run.
procedure Scenario_Completed
(Self : in out Formatter;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class;
Scenario : not null access BDD.Features.Scenario_Record'Class;
Status : BDD.Scenario_Status) is null;
-- Called when a scenario has completed
@ -64,11 +64,11 @@ package BDD.Formatters is
overriding procedure Scenario_Start
(Self : in out Formatter_Full;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class);
Scenario : not null access BDD.Features.Scenario_Record'Class);
overriding procedure Scenario_Completed
(Self : in out Formatter_Full;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class;
Scenario : not null access BDD.Features.Scenario_Record'Class;
Status : BDD.Scenario_Status);
----------
@ -80,7 +80,7 @@ package BDD.Formatters is
overriding procedure Scenario_Completed
(Self : in out Formatter_Dots;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class;
Scenario : not null access BDD.Features.Scenario_Record'Class;
Status : BDD.Scenario_Status);
-----------
@ -92,11 +92,11 @@ package BDD.Formatters is
overriding procedure Scenario_Start
(Self : in out Formatter_Quiet;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class);
Scenario : not null access BDD.Features.Scenario_Record'Class);
overriding procedure Scenario_Completed
(Self : in out Formatter_Quiet;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class;
Scenario : not null access BDD.Features.Scenario_Record'Class;
Status : BDD.Scenario_Status);
-----------------
@ -108,11 +108,11 @@ package BDD.Formatters is
overriding procedure Scenario_Start
(Self : in out Formatter_Hide_Passed;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class);
Scenario : not null access BDD.Features.Scenario_Record'Class);
overriding procedure Scenario_Completed
(Self : in out Formatter_Hide_Passed;
Feature : BDD.Features.Feature'Class;
Scenario : BDD.Features.Scenario'Class;
Scenario : not null access BDD.Features.Scenario_Record'Class;
Status : BDD.Scenario_Status);
private

6
src/bdd-parser.adb
View File

@ -206,6 +206,8 @@ package body BDD.Parser is
end if;
Finish_Scenario;
Scenar := new Scenario_Record;
Scenar.Set_Attributes
(Name => Get_Line_End (First_Char + Cst_Background'Length),
Kind => Kind_Background,
@ -223,6 +225,8 @@ package body BDD.Parser is
Finish_Scenario;
Index_In_Feature := Index_In_Feature + 1;
Scenar := new Scenario_Record;
Scenar.Set_Attributes
(Name => Get_Line_End (First_Char + Cst_Scenario'Length),
Kind => Kind_Scenario,
@ -242,6 +246,8 @@ package body BDD.Parser is
Finish_Scenario;
Index_In_Feature := Index_In_Feature + 1;
Scenar := new Scenario_Record;
Scenar.Set_Attributes
(Name => Get_Line_End (First_Char + Cst_Scenario_Outline'Length),
Kind => Kind_Outline,

4
src/bdd-parser.ads
View File

@ -44,7 +44,7 @@ package BDD.Parser is
procedure Scenario_Start
(Self : in out Abstract_Feature_Runner;
Feature : in out BDD.Features.Feature'Class;
Scenario : in out BDD.Features.Scenario'Class) is null;
Scenario : not null access BDD.Features.Scenario_Record'Class) is null;
-- Called on the first line of a scenario.
-- At this stage, only the name and location of the scenario are known, but
-- none of its steps.
@ -52,7 +52,7 @@ package BDD.Parser is
procedure Scenario_End
(Self : in out Abstract_Feature_Runner;
Feature : in out BDD.Features.Feature'Class;
Scenario : in out BDD.Features.Scenario'Class) is null;
Scenario : not null access BDD.Features.Scenario_Record'Class) is null;
-- Called when the last step in a scenario has been seen.
procedure Feature_End

4
src/bdd-runner.adb
View File

@ -104,7 +104,7 @@ package body BDD.Runner is
overriding procedure Scenario_Start
(Self : in out Feature_Runner;
Feature : in out BDD.Features.Feature'Class;
Scenario : in out BDD.Features.Scenario'Class)
Scenario : not null access BDD.Features.Scenario_Record'Class)
is
begin
if Scenario.Kind = Kind_Scenario then
@ -119,7 +119,7 @@ package body BDD.Runner is
overriding procedure Scenario_End
(Self : in out Feature_Runner;
Feature : in out BDD.Features.Feature'Class;
Scenario : in out BDD.Features.Scenario'Class)
Scenario : not null access BDD.Features.Scenario_Record'Class)
is
Status : Scenario_Status;
begin

4
src/bdd-runner.ads
View File

@ -66,11 +66,11 @@ package BDD.Runner is
overriding procedure Scenario_Start
(Self : in out Feature_Runner;
Feature : in out BDD.Features.Feature'Class;
Scenario : in out BDD.Features.Scenario'Class);
Scenario : not null access BDD.Features.Scenario_Record'Class);
overriding procedure Scenario_End
(Self : in out Feature_Runner;
Feature : in out BDD.Features.Feature'Class;
Scenario : in out BDD.Features.Scenario'Class);
Scenario : not null access BDD.Features.Scenario_Record'Class);
private
type Feature_Runner is new BDD.Parser.Abstract_Feature_Runner with record