diff --git a/src/bdd-features.adb b/src/bdd-features.adb index d09160a..c0b497e 100644 --- a/src/bdd-features.adb +++ b/src/bdd-features.adb @@ -23,8 +23,10 @@ with Ada.Strings.Fixed; use Ada.Strings, Ada.Strings.Fixed; with Ada.Unchecked_Deallocation; +with GNATCOLL.Traces; use GNATCOLL.Traces; package body BDD.Features is + Me : constant Trace_Handle := Create ("BDD.FEATURES"); protected type Ids is procedure Get_Next (Id : out Integer); @@ -61,13 +63,16 @@ package body BDD.Features is function Create (File : GNATCOLL.VFS.Virtual_File; Name : String) - return not null access Feature_Record + return Feature is - Self : constant Feature := new Feature_Record; + R : constant not null access Feature_Record := new Feature_Record; + Self : Feature; begin - Self.Name := new String'(Trim (Name, Both)); - Self.File := File; - Feature_Ids.Get_Next (Self.Id); + Self.Set (R); + R.Name := new String'(Trim (Name, Both)); + R.File := File; + Feature_Ids.Get_Next (R.Id); + Trace (Me, "Create feature " & R.Id'Img); return Self; end Create; @@ -77,56 +82,41 @@ package body BDD.Features is procedure Free (Self : in out Feature_Record) is begin + Trace (Me, "Free feature" & Self.Id'Img); Self.File := No_File; Self.Id := -1; Free (Self.Name); Self.Description := Null_Unbounded_String; end Free; - ---------- - -- Free -- - ---------- - - procedure Free (Self : in out Feature) is - procedure Unchecked_Free is new Ada.Unchecked_Deallocation - (Feature_Record'Class, Feature); - begin - if Self /= null then - Free (Self.all); - Unchecked_Free (Self); - end if; - end Free; - ---------- -- Name -- ---------- - function Name (Self : not null access Feature_Record) return String is + function Name (Self : Feature) return String is begin - if Self.Name = null then + if Self.Get.Name = null then return ""; end if; - return Self.Name.all; + return Self.Get.Name.all; end Name; ---------- -- File -- ---------- - function File - (Self : not null access Feature_Record) - return GNATCOLL.VFS.Virtual_File is + function File (Self : Feature) return GNATCOLL.VFS.Virtual_File is begin - return Self.File; + return Self.Get.File; end File; -------- -- Id -- -------- - function Id (Self : not null access Feature_Record) return Integer is + function Id (Self : Feature) return Integer is begin - return Self.Id; + return Self.Get.Id; end Id; ---------- @@ -135,74 +125,85 @@ package body BDD.Features is procedure Free (Self : in out Scenario_Record) is begin + Trace (Me, "Free scenario index=" & Self.Index'Img); Self.Name := Null_Unbounded_String; Self.Line := 1; Self.Index := 1; Self.Kind := Kind_Scenario; + Self.Feature := No_Feature; 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 : not null access Scenario_Record) return String is + function Name (Self : Scenario) return String is begin - return To_String (Self.Name); + return To_String (Self.Get.Name); end Name; ---------- -- Line -- ---------- - function Line (Self : not null access Scenario_Record) return Positive is + function Line (Self : Scenario) return Positive is begin - return Self.Line; + return Self.Get.Line; end Line; ----------- -- Index -- ----------- - function Index (Self : not null access Scenario_Record) return Positive is + function Index (Self : Scenario) return Positive is begin - return Self.Index; + return Self.Get.Index; end Index; ---------- -- Kind -- ---------- - function Kind - (Self : not null access Scenario_Record) return Scenario_Kind is + function Kind (Self : Scenario) return Scenario_Kind is begin - return Self.Kind; + return Self.Get.Kind; end Kind; + ----------------- + -- Get_Feature -- + ----------------- + + function Get_Feature (Self : Scenario) return Feature'Class is + begin + return Self.Get.Feature; + end Get_Feature; + + ---------------- + -- Set_Status -- + ---------------- + + procedure Set_Status (Self : Scenario; Status : BDD.Scenario_Status) is + begin + Self.Get.Status := Status; + end Set_Status; + + ------------ + -- Status -- + ------------ + + function Status (Self : Scenario) return BDD.Scenario_Status is + begin + return Self.Get.Status; + end Status; + --------- -- Add -- --------- - procedure Add - (Self : not null access Scenario_Record; - S : not null access Step_Record'Class) - is + procedure Add (Self : Scenario; S : not null access Step_Record'Class) is begin - Self.Steps.Append (S); + Self.Get.Steps.Append (S); end Add; ------------------ @@ -210,12 +211,12 @@ package body BDD.Features is ------------------ procedure Foreach_Step - (Self : not null access Scenario_Record; + (Self : Scenario; Callback : not null access procedure (S : not null access Step_Record'Class)) is begin - for S of Self.Steps loop + for S of Self.Get.Steps loop Callback (S); end loop; end Foreach_Step; @@ -224,55 +225,59 @@ package body BDD.Features is -- Longuest_Step -- ------------------- - function Longuest_Step - (Self : not null access Scenario_Record) return Natural is + function Longuest_Step (Self : Scenario) return Natural is + R : constant not null access Scenario_Record'Class := Self.Get; 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)); + if R.Longuest_Step = -1 then + R.Longuest_Step := Length (R.Name) + Cst_Scenario'Length + 1; + for S of R.Steps loop + R.Longuest_Step := Integer'Max (R.Longuest_Step, Length (S.Text)); end loop; end if; - return Self.Longuest_Step; + return R.Longuest_Step; end Longuest_Step; - -------------------- - -- Set_Attributes -- - -------------------- + ------------ + -- Create -- + ------------ - procedure Set_Attributes - (Self : not null access Scenario_Record; + function Create + (Feature : BDD.Features.Feature'Class; Kind : Scenario_Kind; Name : String; Line : Positive; - Index : Positive) is + Index : Positive) return Scenario + is + Self : Scenario; + R : constant not null access Scenario_Record := new Scenario_Record; begin - Self.Name := To_Unbounded_String (Trim (Name, Both)); - Self.Line := Line; - Self.Index := Index; - Self.Kind := Kind; - end Set_Attributes; + Self.Set (R); + R.Name := To_Unbounded_String (Trim (Name, Both)); + R.Line := Line; + R.Index := Index; + R.Kind := Kind; + R.Feature := BDD.Features.Feature (Feature); + Trace (Me, "Create scenario index=" & Index'Img); + return Self; + end Create; ----------------- -- Description -- ----------------- - function Description - (Self : not null access Feature_Record) return String is + function Description (Self : Feature) return String is begin - return To_String (Self.Description); + return To_String (Self.Get.Description); end Description; ------------------------ -- Add_To_Description -- ------------------------ - procedure Add_To_Description - (Self : not null access Feature_Record; Descr : String) is + procedure Add_To_Description (Self : Feature; Descr : String) is begin -- Indent the description as it will be displayed - Append (Self.Description, " " & Descr & ASCII.LF); + Append (Self.Get.Description, " " & Descr & ASCII.LF); end Add_To_Description; ------------ @@ -287,6 +292,7 @@ package body BDD.Features is Self.Text := To_Unbounded_String (Text); Self.Line := Line; Self.Status := Status_Undefined; + Trace (Me, "Create step at line" & Line'Img); return Self; end Create; @@ -333,6 +339,7 @@ package body BDD.Features is procedure Free (Self : in out Step_Record) is begin + Trace (Me, "Free step at line" & Self.Line'Img); Self.Text := Null_Unbounded_String; Self.Multiline := Null_Unbounded_String; Self.Line := 1; diff --git a/src/bdd-features.ads b/src/bdd-features.ads index 069f955..090a763 100644 --- a/src/bdd-features.ads +++ b/src/bdd-features.ads @@ -25,6 +25,7 @@ with Ada.Containers.Doubly_Linked_Lists; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; +with GNATCOLL.Refcount; use GNATCOLL.Refcount; package BDD.Features is @@ -34,6 +35,7 @@ package BDD.Features is type Step_Record (<>) is tagged private; type Step is access all Step_Record'Class; + -- A step is owned by its scenario, so must not be freed explictly. function Create (Text : String; Line : Positive) return not null access Step_Record; @@ -46,10 +48,6 @@ package BDD.Features is -- 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; @@ -62,90 +60,80 @@ package BDD.Features is (Self : not null access Step_Record) return BDD.Scenario_Status; -- Set the status for a specific step - -------------- - -- Scenario -- - -------------- - - 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 : not null access Scenario_Record; - Kind : Scenario_Kind; - Name : String; - Line : Positive; - Index : Positive); - -- Set the line of the feature file at which the scenario is defined, and - -- its index within its Feature. - - 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 - - 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 -- ------------- - type Feature_Record (<>) is tagged limited private; - type Feature is access all Feature_Record'Class; + type Feature is tagged private; -- An object that represents a single feature and all its scenarios. -- A specific features file might contain several features, but this object -- only represents one of them. - -- - -- This type has a discriminant to force the allocation through Create, - -- which ensures the feature has a unique id. + -- This is a ref-counted type + + No_Feature : constant Feature; function Create (File : GNATCOLL.VFS.Virtual_File; - Name : String) - return not null access Feature_Record; + Name : String) return Feature; -- Create and initialize a new feature - procedure Free (Self : in out Feature); - procedure Free (Self : in out Feature_Record); - -- Free the memory associated with Self - - function Id (Self : not null access Feature_Record) return Integer; + function Id (Self : Feature) return Integer; -- Set a unique id for the feature - function Name (Self : not null access Feature_Record) return String; + function Name (Self : Feature) return String; -- The name of the feature - function File - (Self : not null access Feature_Record) return GNATCOLL.VFS.Virtual_File; + function File (Self : Feature) return GNATCOLL.VFS.Virtual_File; -- The file in which the feature is defined - function Description (Self : not null access Feature_Record) return String; - procedure Add_To_Description - (Self : not null access Feature_Record; Descr : String); + function Description (Self : Feature) return String; + procedure Add_To_Description (Self : Feature; Descr : String); -- Add some description information. Add_Description will be called once -- for each line in the description. + -------------- + -- Scenario -- + -------------- + + type Scenario is tagged private; + -- A scenario to be run within a feature. + -- This is a ref-counted type. + + No_Scenario : constant Scenario; + + type Scenario_Kind is (Kind_Scenario, Kind_Background, Kind_Outline); + + function Create + (Feature : BDD.Features.Feature'Class; + Kind : Scenario_Kind; + Name : String; + Line : Positive; + Index : Positive) return Scenario; + -- Creates a new scenario. + + 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 Get_Feature (Self : Scenario) return Feature'Class; + -- Retrieve the attributes of Self + + procedure Add (Self : Scenario; S : not null access Step_Record'Class); + -- Add a new step + + procedure Foreach_Step + (Self : Scenario; + Callback : not null access procedure + (S : not null access Step_Record'Class)); + -- Iterate over each step + + procedure Set_Status (Self : Scenario; Status : BDD.Scenario_Status); + function Status (Self : Scenario) return BDD.Scenario_Status; + -- Set the status for a specific step + + function Longuest_Step (Self : Scenario) return Natural; + -- The length of the longuest step (for display purposes) + private type Step_Record is tagged record Line : Positive; @@ -158,22 +146,42 @@ private 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; + procedure Free (Self : in out Step_Record); + procedure Free (Self : in out Step); + -- Free the memory associated with Self - 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. - - type Feature_Record is tagged limited record + type Feature_Record is new GNATCOLL.Refcount.Refcounted with record File : GNATCOLL.VFS.Virtual_File; Name : GNAT.Strings.String_Access; Id : Integer; Description : Ada.Strings.Unbounded.Unbounded_String; end record; + overriding procedure Free (Self : in out Feature_Record); + package Feature_Pointers is new GNATCOLL.Refcount.Smart_Pointers + (Feature_Record); + type Feature is new Feature_Pointers.Ref with null record; + + No_Feature : constant Feature := + (Feature_Pointers.Null_Ref with null record); + + type Scenario_Record is new Refcounted with record + Name : Ada.Strings.Unbounded.Unbounded_String; + Line : Positive := 1; + Index : Positive := 1; + Kind : Scenario_Kind := Kind_Scenario; + Steps : Step_List; + Longuest_Step : Integer := -1; + Status : BDD.Scenario_Status; + Feature : BDD.Features.Feature; + end record; + + overriding procedure Free (Self : in out Scenario_Record); + + package Scenario_Pointers is new GNATCOLL.Refcount.Smart_Pointers + (Scenario_Record); + type Scenario is new Scenario_Pointers.Ref with null record; + + No_Scenario : constant Scenario := + (Scenario_Pointers.Null_Ref with null record); + end BDD.Features; diff --git a/src/bdd-formatters.adb b/src/bdd-formatters.adb index a4057c1..2b8e6a4 100644 --- a/src/bdd-formatters.adb +++ b/src/bdd-formatters.adb @@ -21,6 +21,7 @@ -- -- ------------------------------------------------------------------------------ +with Ada.Containers; use Ada.Containers; with Ada.Text_IO; use Ada.Text_IO; with GNATCOLL.Utils; use GNATCOLL.Utils; @@ -30,51 +31,42 @@ package body BDD.Formatters is 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) - return String; + 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; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class); + (Self : Formatter'Class; Scenario : BDD.Features.Scenario); procedure Display_Location (Self : Formatter'Class; - Feature : not null access BDD.Features.Feature_Record'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; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class); + Scenario : BDD.Features.Scenario); -- 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); + (Self : in out Formatter'Class; + Scenario : BDD.Features.Scenario); -- 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; + Scenario : BDD.Features.Scenario; 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; - Scenario : not null access BDD.Features.Scenario_Record'Class); + Scenario : BDD.Features.Scenario); -- 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; + (Scenario : BDD.Features.Scenario; 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 @@ -99,13 +91,9 @@ package body BDD.Formatters is -- Scenario_Name -- ------------------- - function Scenario_Name - (Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class) - return String - is + function Scenario_Name (Scenario : BDD.Features.Scenario) return String is begin - return +Feature.File.Relative_Path (Features_Directory) + return +Scenario.Get_Feature.File.Relative_Path (Features_Directory) & "#" & Image (Scenario.Index, 1) & ":" & Image (Scenario.Line, 1); end Scenario_Name; @@ -115,9 +103,8 @@ package body BDD.Formatters is -------------------------------- 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) + (Self : in out Formatter'Class; + Scenario : BDD.Features.Scenario) is procedure Show_Step (Step : not null access BDD.Features.Step_Record'Class); @@ -126,10 +113,10 @@ package body BDD.Formatters is procedure Show_Step (Step : not null access BDD.Features.Step_Record'Class) is begin - Display_Step (Self, Feature, Scenario, Step); + Display_Step (Self, Scenario, Step); end Show_Step; begin - Display_Scenario_Header (Self, Feature, Scenario); + Display_Scenario_Header (Self, Scenario); Scenario.Foreach_Step (Show_Step'Access); New_Line; end Display_Scenario_And_Steps; @@ -140,14 +127,13 @@ package body BDD.Formatters is procedure Display_Location (Self : Formatter'Class; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class) + Scenario : BDD.Features.Scenario) is begin Self.Term.Set_Color (Term => Ada.Text_IO.Standard_Output, Foreground => Grey); - Put ("# " & Scenario_Name (Feature, Scenario)); + Put ("# " & Scenario_Name (Scenario)); Self.Term.Set_Color (Term => Ada.Text_IO.Standard_Output, Style => Reset_All); @@ -160,7 +146,7 @@ package body BDD.Formatters is procedure Display_Location (Self : Formatter'Class; - Feature : not null access BDD.Features.Feature_Record'Class; + Scenario : BDD.Features.Scenario; Step : not null access BDD.Features.Step_Record'Class; Extra : String := "") is @@ -170,7 +156,7 @@ package body BDD.Formatters is Foreground => Grey); Put ("# " & Extra - & (+Feature.File.Relative_Path (Features_Directory)) + & (+Scenario.Get_Feature.File.Relative_Path (Features_Directory)) & ":" & Image (Step.Line, 1)); Self.Term.Set_Color (Term => Ada.Text_IO.Standard_Output, @@ -183,7 +169,7 @@ package body BDD.Formatters is ------------------- procedure Put_And_Align - (Scenario : not null access BDD.Features.Scenario_Record'Class; + (Scenario : BDD.Features.Scenario; Text : String) is Long : constant Natural := Scenario.Longuest_Step + Step_Indent'Length; @@ -198,14 +184,13 @@ package body BDD.Formatters is procedure Display_Progress (Self : in out Formatter'Class; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class) + Scenario : BDD.Features.Scenario) is Width : constant Integer := Self.Term.Get_Width; begin if Width /= -1 then declare - N : constant String := Scenario_Name (Feature, Scenario); + N : constant String := Scenario_Name (Scenario); begin Self.Term.Beginning_Of_Line; Self.Term.Clear_To_End_Of_Line; @@ -245,19 +230,19 @@ package body BDD.Formatters is procedure Display_Scenario_Header (Self : in out Formatter'Class; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class) + Scenario : BDD.Features.Scenario) is + F : constant Feature'Class := Scenario.Get_Feature; 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; + if F.Id /= Self.Last_Displayed_Feature_Id then + Put_Line (Cst_Features & ' ' & F.Name); + Put_Line (F.Description); + Self.Last_Displayed_Feature_Id := F.Id; end if; Put_And_Align (Scenario, Scenario_Indent & Cst_Scenario & ' ' & Scenario.Name); - Display_Location (Self, Feature, Scenario); + Display_Location (Self, Scenario); end Display_Scenario_Header; ------------------ @@ -266,8 +251,7 @@ package body BDD.Formatters is 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; + Scenario : BDD.Features.Scenario; Step : not null access BDD.Features.Step_Record'Class) is begin @@ -280,20 +264,19 @@ package body BDD.Formatters is Self.Term.Set_Color (Term => Ada.Text_IO.Standard_Output, Style => Reset_All); - Display_Location (Self, Feature, Step); + Display_Location (Self, Scenario, Step); else case Step.Status is when Status_Passed => - Display_Location (Self, Feature, Step, "[OK] "); + Display_Location (Self, Scenario, Step, "[OK] "); when Status_Failed => - Display_Location (Self, Feature, Step, "[FAILED] "); + Display_Location (Self, Scenario, Step, "[FAILED] "); when Status_Undefined => - Display_Location (Self, Feature, Step, "[UNDEFINED] "); + Display_Location (Self, Scenario, Step, "[UNDEFINED] "); when Status_Skipped => - Display_Location (Self, Feature, Step, "[SKIPPED] "); + Display_Location (Self, Scenario, Step, "[SKIPPED] "); end case; end if; - end Display_Step; -------------------- @@ -302,13 +285,10 @@ package body BDD.Formatters is overriding procedure Scenario_Start (Self : in out Formatter_Full; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class) + Scenario : BDD.Features.Scenario) is begin - Clear_Progress (Self); - Display_Scenario_Header (Self, Feature, Scenario); - Display_Progress (Self, Feature, Scenario); + Display_Scenario_Header (Self, Scenario); end Scenario_Start; ------------------------ @@ -317,13 +297,10 @@ package body BDD.Formatters is overriding procedure Scenario_Completed (Self : in out Formatter_Full; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class; - Status : BDD.Scenario_Status) + Scenario : BDD.Features.Scenario) is - pragma Unreferenced (Feature, Scenario, Status); + pragma Unreferenced (Self, Scenario); begin - Clear_Progress (Self); New_Line; end Scenario_Completed; @@ -333,11 +310,10 @@ package body BDD.Formatters is 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; + Scenario : BDD.Features.Scenario; Step : not null access BDD.Features.Step_Record'Class) is begin - Display_Step (Self, Feature, Scenario, Step); + Display_Step (Self, Scenario, Step); end Step_Completed; ------------------------ @@ -346,17 +322,14 @@ package body BDD.Formatters is overriding procedure Scenario_Completed (Self : in out Formatter_Dots; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class; - Status : BDD.Scenario_Status) + Scenario : BDD.Features.Scenario) is - pragma Unreferenced (Feature, Scenario); begin Self.Term.Set_Color (Term => Ada.Text_IO.Standard_Output, - Foreground => BDD.Step_Colors (Status)); + Foreground => BDD.Step_Colors (Scenario.Status)); - case Status is + case Scenario.Status is when Status_Passed => Put ("."); when Status_Failed => Put ("F"); when Status_Undefined => Put ("U"); @@ -366,19 +339,40 @@ package body BDD.Formatters is Self.Term.Set_Color (Term => Ada.Text_IO.Standard_Output, Style => Reset_All); + + if Scenario.Status /= Status_Passed then + Self.Failed.Append (Scenario); + end if; end Scenario_Completed; + ---------------------------- + -- All_Features_Completed -- + ---------------------------- + + overriding procedure All_Features_Completed + (Self : in out Formatter_Dots) + is + begin + if Self.Failed.Length /= 0 then + New_Line; + New_Line; + for S of Self.Failed loop + Display_Scenario_And_Steps (Self, S); + end loop; + Self.Failed.Clear; + end if; + end All_Features_Completed; + -------------------- -- Scenario_Start -- -------------------- overriding procedure Scenario_Start (Self : in out Formatter_Quiet; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class) + Scenario : BDD.Features.Scenario) is begin - Display_Progress (Self, Feature, Scenario); + Display_Progress (Self, Scenario); end Scenario_Start; ------------------------ @@ -387,11 +381,9 @@ package body BDD.Formatters is overriding procedure Scenario_Completed (Self : in out Formatter_Quiet; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class; - Status : BDD.Scenario_Status) + Scenario : BDD.Features.Scenario) is - pragma Unreferenced (Feature, Scenario, Status); + pragma Unreferenced (Scenario); begin Clear_Progress (Self); end Scenario_Completed; @@ -402,11 +394,10 @@ package body BDD.Formatters is procedure Scenario_Start (Self : in out Formatter_Hide_Passed; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class) + Scenario : BDD.Features.Scenario) is begin - Display_Progress (Self, Feature, Scenario); + Display_Progress (Self, Scenario); end Scenario_Start; ------------------------ @@ -415,18 +406,16 @@ package body BDD.Formatters is overriding procedure Scenario_Completed (Self : in out Formatter_Hide_Passed; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class; - Status : BDD.Scenario_Status) + Scenario : BDD.Features.Scenario) is begin - case Status is + case Scenario.Status is when Status_Passed | Status_Skipped => null; when Status_Failed | Status_Undefined => Clear_Progress (Self); - Display_Scenario_And_Steps (Self, Feature, Scenario); + Display_Scenario_And_Steps (Self, Scenario); end case; end Scenario_Completed; diff --git a/src/bdd-formatters.ads b/src/bdd-formatters.ads index d684158..bdf381b 100644 --- a/src/bdd-formatters.ads +++ b/src/bdd-formatters.ads @@ -23,6 +23,7 @@ -- The formatters are used to display output for the user +private with Ada.Containers.Doubly_Linked_Lists; with BDD.Features; use BDD.Features; with GNATCOLL.Terminal; use GNATCOLL.Terminal; @@ -38,26 +39,27 @@ package BDD.Formatters is procedure Scenario_Start (Self : in out Formatter; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class) is null; + Scenario : BDD.Features.Scenario) is null; -- Display information about a feature and ascenario just before the -- scenario is run. procedure Scenario_Completed (Self : in out Formatter; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class; - Status : BDD.Scenario_Status) is null; - -- Called when a scenario has completed + Scenario : BDD.Features.Scenario) is null; + -- Called when a scenario has completed. + -- Its status has already been set 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; + Scenario : BDD.Features.Scenario; Step : not null access BDD.Features.Step_Record'Class) is null; -- Called when a step has completed. -- Step.Status has been set appropriately + procedure All_Features_Completed (Self : in out Formatter) is null; + -- Called when all features have been full run. + -- This can be used to display summaries + function Create_Formatter return not null access Formatter'Class; -- Create the formatter to use, depending on BDD.Output @@ -71,17 +73,13 @@ package BDD.Formatters is overriding procedure Scenario_Start (Self : in out Formatter_Full; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class); + Scenario : BDD.Features.Scenario); overriding procedure Scenario_Completed (Self : in out Formatter_Full; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class; - Status : BDD.Scenario_Status); + Scenario : BDD.Features.Scenario); 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; + Scenario : BDD.Features.Scenario; Step : not null access BDD.Features.Step_Record'Class); ---------- @@ -92,9 +90,8 @@ package BDD.Formatters is overriding procedure Scenario_Completed (Self : in out Formatter_Dots; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class; - Status : BDD.Scenario_Status); + Scenario : BDD.Features.Scenario); + overriding procedure All_Features_Completed (Self : in out Formatter_Dots); ----------- -- Quiet -- @@ -104,13 +101,10 @@ package BDD.Formatters is overriding procedure Scenario_Start (Self : in out Formatter_Quiet; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class); + Scenario : BDD.Features.Scenario); overriding procedure Scenario_Completed (Self : in out Formatter_Quiet; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class; - Status : BDD.Scenario_Status); + Scenario : BDD.Features.Scenario); ----------------- -- Hide_Passed -- @@ -120,24 +114,28 @@ package BDD.Formatters is overriding procedure Scenario_Start (Self : in out Formatter_Hide_Passed; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class); + Scenario : BDD.Features.Scenario); overriding procedure Scenario_Completed (Self : in out Formatter_Hide_Passed; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class; - Status : BDD.Scenario_Status); + Scenario : BDD.Features.Scenario); 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; + Term : GNATCOLL.Terminal.Terminal_Info_Access; Last_Displayed_Feature_Id : Integer := -1; - Progress_Displayed : Boolean := False; + 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_Dots is new Formatter with record + Failed : Scenario_Lists.List; + -- Failed scenarios, so that we can display them in the end + + end record; type Formatter_Quiet is new Formatter with null record; type Formatter_Hide_Passed is new Formatter with null record; diff --git a/src/bdd-parser.adb b/src/bdd-parser.adb index 34fb7b4..60e5d16 100644 --- a/src/bdd-parser.adb +++ b/src/bdd-parser.adb @@ -42,8 +42,8 @@ package body BDD.Parser is In_String, In_Outline, In_Examples); State : State_Type := None; - F : BDD.Features.Feature; - Scenar : BDD.Features.Scenario; + F : BDD.Features.Feature := No_Feature; + Scenar : BDD.Features.Scenario := No_Scenario; Step : BDD.Features.Step; Buffer : GNAT.Strings.String_Access := File.Read_File; Index : Integer := Buffer'First; @@ -70,8 +70,8 @@ package body BDD.Parser is case State is when In_Scenario | In_Outline | In_Examples => Step := null; - Runner.Scenario_End (F, Scenar); - Free (Scenar); + Runner.Scenario_End (Scenar); + Scenar := No_Scenario; State := In_Feature; when others => @@ -88,7 +88,7 @@ package body BDD.Parser is Finish_Scenario; if State /= None then Runner.Feature_End (F); - Free (F); + F := No_Feature; end if; State := None; @@ -204,7 +204,7 @@ package body BDD.Parser is & Image (Line, 1); end if; - if Scenar /= null then + if Scenar /= No_Scenario then raise Syntax_Error with "Background must be defined before all" & " Scenario, at " & File.Display_Full_Name & ":" & Image (Line, 1); @@ -212,13 +212,13 @@ package body BDD.Parser is Finish_Scenario; - Scenar := new Scenario_Record; - Scenar.Set_Attributes - (Name => Get_Line_End (First_Char + Cst_Background'Length), - Kind => Kind_Background, - Line => Line, - Index => Positive'Last); - Runner.Scenario_Start (F, Scenar); + Scenar := Create + (Feature => F, + Name => Get_Line_End (First_Char + Cst_Background'Length), + Kind => Kind_Background, + Line => Line, + Index => Positive'Last); + Runner.Scenario_Start (Scenar); State := In_Scenario; elsif Starts_With (Buffer (First_Char .. Line_E), Cst_Scenario) then @@ -231,13 +231,13 @@ 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, - Line => Line, - Index => Index_In_Feature); - Runner.Scenario_Start (F, Scenar); + Scenar := Create + (Feature => F, + Name => Get_Line_End (First_Char + Cst_Scenario'Length), + Kind => Kind_Scenario, + Line => Line, + Index => Index_In_Feature); + Runner.Scenario_Start (Scenar); State := In_Scenario; elsif Starts_With (Buffer (First_Char .. Line_E), @@ -252,13 +252,13 @@ 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, - Line => Line, + Scenar := Create + (Feature => F, + Name => Get_Line_End (First_Char + Cst_Scenario_Outline'Length), + Kind => Kind_Outline, + Line => Line, Index => Index_In_Feature); - Runner.Scenario_Start (F, Scenar); + Runner.Scenario_Start (Scenar); State := In_Outline; elsif Starts_With (Buffer (First_Char .. Line_E), Cst_Scenarios) then @@ -283,7 +283,7 @@ 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 Scenar = null then + if Scenar = No_Scenario then raise Syntax_Error with "Step must be defined with in a" & " Scenario at " & File.Display_Full_Name & ":" & Image (Line, 1); diff --git a/src/bdd-parser.ads b/src/bdd-parser.ads index f6d25e0..92e0c09 100644 --- a/src/bdd-parser.ads +++ b/src/bdd-parser.ads @@ -36,28 +36,26 @@ package BDD.Parser is procedure Feature_Start (Self : in out Abstract_Feature_Runner; - Feature : not null access BDD.Features.Feature_Record'Class) is null; + Feature : BDD.Features.Feature) is null; -- Called on the first line of a feature. -- At this stage, only the name and file or the feature are known, but none -- of its scenarios procedure Scenario_Start (Self : in out Abstract_Feature_Runner; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class) is null; + Scenario : BDD.Features.Scenario) 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. procedure Scenario_End (Self : in out Abstract_Feature_Runner; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class) is null; + Scenario : BDD.Features.Scenario) is null; -- Called when the last step in a scenario has been seen. procedure Feature_End (Self : in out Abstract_Feature_Runner; - Feature : not null access BDD.Features.Feature_Record'Class) is null; + Feature : BDD.Features.Feature) is null; -- Called when the last line of a feature has been seen. type Feature_Parser is tagged private; diff --git a/src/bdd-runner.adb b/src/bdd-runner.adb index e4a78e2..a202dca 100644 --- a/src/bdd-runner.adb +++ b/src/bdd-runner.adb @@ -103,35 +103,42 @@ package body BDD.Runner is overriding procedure Scenario_End (Self : in out Feature_Runner; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class) + Scenario : BDD.Features.Scenario) is - 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 + case Scenario.Status is when Status_Passed => -- ??? Simulate a run delay 0.2; - S.Set_Status (Status_Undefined); - Status := Status_Undefined; + if Scenario.Line = 5 then + S.Set_Status (Status_Passed); + elsif Scenario.Line = 10 then + S.Set_Status (Status_Failed); + elsif Scenario.Line = 11 then + S.Set_Status (Status_Undefined); + else + S.Set_Status (Status_Passed); + end if; + + Scenario.Set_Status (S.Status); when Status_Failed | Status_Skipped | Status_Undefined => S.Set_Status (Status_Skipped); end case; - Self.Format.Step_Completed (Feature, Scenario, S); + Self.Format.Step_Completed (Scenario, S); end Run_Step; begin if Scenario.Kind = Kind_Scenario then - Self.Format.Scenario_Start (Feature, Scenario); + Scenario.Set_Status (Status_Passed); + Self.Format.Scenario_Start (Scenario); Scenario.Foreach_Step (Run_Step'Access); - Self.Format.Scenario_Completed (Feature, Scenario, Status); + Self.Format.Scenario_Completed (Scenario); end if; end Scenario_End; diff --git a/src/bdd-runner.ads b/src/bdd-runner.ads index 24ca775..0af80d5 100644 --- a/src/bdd-runner.ads +++ b/src/bdd-runner.ads @@ -65,8 +65,7 @@ package BDD.Runner is overriding procedure Scenario_End (Self : in out Feature_Runner; - Feature : not null access BDD.Features.Feature_Record'Class; - Scenario : not null access BDD.Features.Scenario_Record'Class); + Scenario : BDD.Features.Scenario); private type Feature_Runner is new BDD.Parser.Abstract_Feature_Runner with record diff --git a/src/bdd.adb b/src/bdd.adb index 750e6be..def256e 100644 --- a/src/bdd.adb +++ b/src/bdd.adb @@ -147,6 +147,7 @@ package body BDD is Format.Init (Term); Features.Run (Format, Parser); + Format.All_Features_Completed; exception when GNAT.Command_Line.Exit_From_Command_Line