Add initial support for tables

This commit is contained in:
Emmanuel Briot 2014-02-07 18:09:21 +01:00
parent 424668575d
commit 3d047da00b
8 changed files with 392 additions and 6 deletions

View File

@ -193,6 +193,7 @@ the steps can be configured, namely **multi-line strings** and **tables**.
When I log in as "Jack"
Then I should see the home page
Leading and trailing spaces are ignored for each cell in the table.
Background scenario
-------------------

View File

@ -408,4 +408,30 @@ package body BDD.Features is
end case;
end Prefix;
------------------
-- Add_To_Table --
------------------
procedure Add_To_Table
(Self : not null access Step_Record'Class; Row : String)
is
begin
if Self.Table = No_Table then
Self.Table := Create;
end if;
Self.Table.Add_Row_As_String (Row);
end Add_To_Table;
-----------
-- Table --
-----------
function Table
(Self : not null access Step_Record) return BDD.Tables.Table
is
begin
return Self.Table;
end Table;
end BDD.Features;

View File

@ -25,6 +25,7 @@
with Ada.Containers.Doubly_Linked_Lists;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with BDD.Tables; use BDD.Tables;
with GNATCOLL.Refcount; use GNATCOLL.Refcount;
package BDD.Features is
@ -48,9 +49,14 @@ package BDD.Features is
-- Add some contents to the final multi-line string.
-- Text is always added a ASCII.LF
procedure Add_To_Table
(Self : not null access Step_Record'Class; Row : String);
-- Add a new row to the table 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;
function Table (Self : not null access Step_Record) return BDD.Tables.Table;
-- Return the components of the step
procedure Set_Status
@ -144,6 +150,7 @@ private
Text : Ada.Strings.Unbounded.Unbounded_String;
Multiline : Ada.Strings.Unbounded.Unbounded_String;
Status : BDD.Scenario_Status;
Table : BDD.Tables.Table;
end record;
package Step_Lists is new Ada.Containers.Doubly_Linked_Lists (Step);

View File

@ -23,6 +23,7 @@
with Ada.Containers; use Ada.Containers;
with Ada.Text_IO; use Ada.Text_IO;
with BDD.Tables; use BDD.Tables;
with GNATCOLL.Utils; use GNATCOLL.Utils;
package body BDD.Formatters is
@ -303,6 +304,14 @@ package body BDD.Formatters is
Put_Line (" """"""");
end if;
if Step.Table /= No_Table then
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Foreground => BDD.Step_Colors (Step.Status));
Step.Table.Display
(Ada.Text_IO.Standard_Output, Prefix => " ");
end if;
end;
Self.Term.Set_Color

View File

@ -176,14 +176,14 @@ package body BDD.Parser is
elsif Buffer (First_Char) = '|' then
case State is
when In_Background | In_Scenario | In_Outline =>
if Step /= null then
Trace (Me, "MANU Table=" & Buffer (First_Char .. Line_E));
else
if Step = null then
raise Syntax_Error with "Tables only allowed in"
& " steps, at " & File.Display_Full_Name & ":"
& Image (Line, 1);
end if;
Step.Add_To_Table (Buffer (First_Char .. Line_E));
when In_Examples =>
Trace (Me, "MANU Example=" & Buffer (First_Char .. Line_E));

View File

@ -149,7 +149,7 @@ package body BDD.Runner is
case Scenario.Status is
when Status_Passed =>
-- ??? Simulate a run
delay 0.2;
-- delay 0.2;
if Step.Line >= 25 and then Step.Line <= 26 then
Step.Set_Status (Status_Passed);
elsif Step.Line = 47 then
@ -162,8 +162,11 @@ package body BDD.Runner is
Step.Set_Status (Status_Passed);
end if;
Self.Steps_Stats (Step.Status) :=
Self.Steps_Stats (Step.Status) + 1;
if Show_Steps then
Self.Steps_Stats (Step.Status) :=
Self.Steps_Stats (Step.Status) + 1;
end if;
Scenario.Set_Status (Step.Status);
when Status_Failed | Status_Skipped | Status_Undefined =>

236
src/bdd-tables.adb Normal file
View File

@ -0,0 +1,236 @@
-----------------------------------------------------------------------------
-- G N A T C O L L --
-- --
-- Copyright (C) 2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
-- Software Foundation; either version 3, or (at your option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
------------------------------------------------------------------------------
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with GNATCOLL.Utils; use GNATCOLL.Utils;
package body BDD.Tables is
------------
-- Create --
------------
function Create return Table is
Self : Table;
R : constant access Table_Record := new Table_Record;
begin
Self.Set (R);
return Self;
end Create;
-----------------------
-- Add_Row_As_String --
-----------------------
procedure Add_Row_As_String
(Self : Table;
Row : String)
is
Rows : constant Unbounded_String_Array :=
Split (Row, '|', Omit_Empty_Lines => False);
R : Integer;
begin
if Self.Get.Names.Is_Empty then
for Col in Rows'First + 1 .. Rows'Last loop
Self.Set_Column_Name
(Col - 1,
Trim (To_String (Rows (Col)), Ada.Strings.Both));
end loop;
else
R := Self.Height + 1;
for Col in Rows'First + 1 .. Rows'Last loop
Self.Put
(Row => R, Column => Col - 1,
Value => Trim (To_String (Rows (Col)), Ada.Strings.Both));
end loop;
end if;
end Add_Row_As_String;
---------------------
-- Set_Column_Name --
---------------------
procedure Set_Column_Name
(Self : Table;
Column : Positive;
Name : String)
is
R : constant not null access Table_Record := Self.Get;
begin
R.Names.Reserve_Capacity
(Ada.Containers.Count_Type (Integer'Max (Column, Self.Width)));
if Column > R.Names.Last_Index then
R.Names.Insert (Column, Name);
else
R.Names.Replace_Element (Column, Name);
end if;
end Set_Column_Name;
---------
-- Put --
---------
procedure Put
(Self : Table;
Column : Positive;
Row : Positive;
Value : String)
is
procedure Do_Update (R : in out String_Vectors.Vector);
procedure Do_Update (R : in out String_Vectors.Vector) is
begin
R.Insert (Column, Value);
end Do_Update;
begin
if Row > Integer (Self.Get.Rows.Length) then
declare
R : String_Vectors.Vector;
begin
R.Reserve_Capacity
(Ada.Containers.Count_Type (Integer'Max (Column, Self.Width)));
Self.Get.Rows.Append (R);
end;
end if;
Self.Get.Rows.Update_Element (Row, Do_Update'Unrestricted_Access);
end Put;
---------
-- Get --
---------
function Get
(Self : Table;
Column : Positive;
Row : Positive)
return String
is
begin
return Self.Get.Rows.Element (Row).Element (Column);
end Get;
---------
-- Get --
---------
function Get
(Self : Table;
Column : String;
Row : Positive)
return String is
begin
return Self.Get (Self.Column_Number (Column), Row);
end Get;
-----------
-- Width --
-----------
function Width (Self : Table) return Natural is
begin
return Natural (Self.Get.Names.Length);
end Width;
------------
-- Height --
------------
function Height (Self : Table) return Natural is
begin
return Natural (Self.Get.Rows.Length);
end Height;
-------------------
-- Column_Number --
-------------------
function Column_Number (Self : Table; Name : String) return Natural is
Index : Positive := 1;
begin
for C of Self.Get.Names loop
if C = Name then
return Index;
end if;
Index := Index + 1;
end loop;
return 0;
end Column_Number;
-------------
-- Display --
-------------
procedure Display
(Self : Table; File : Ada.Text_IO.File_Type; Prefix : String := "")
is
R : constant access Table_Record := Self.Get;
W : constant Integer := Self.Width;
Widths : array (1 .. W) of Natural := (others => 0);
Idx : Integer;
begin
Idx := Widths'First;
for N of R.Names loop
Widths (Idx) := Integer'Max (Widths (Idx), N'Length);
Idx := Idx + 1;
end loop;
for Row_Content of R.Rows loop
Idx := Widths'First;
for V of Row_Content loop
Widths (Idx) := Integer'Max (Widths (Idx), V'Length);
Idx := Idx + 1;
end loop;
end loop;
Put (File, Prefix);
Idx := Widths'First;
for N of R.Names loop
Put (File, "| "
& N
& (1 .. Widths (Idx) - N'Length => ' ')
& " ");
Idx := Idx + 1;
end loop;
Put_Line (File, "|");
for Row_Content of R.Rows loop
Put (File, Prefix);
Idx := Widths'First;
for V of Row_Content loop
Put (File, "| "
& V
& (1 .. Widths (Idx) - V'Length => ' ')
& " ");
Idx := Idx + 1;
end loop;
Put_Line (File, "|");
end loop;
end Display;
end BDD.Tables;

104
src/bdd-tables.ads Normal file
View File

@ -0,0 +1,104 @@
-----------------------------------------------------------------------------
-- G N A T C O L L --
-- --
-- Copyright (C) 2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
-- Software Foundation; either version 3, or (at your option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
------------------------------------------------------------------------------
with Ada.Containers.Indefinite_Vectors;
with Ada.Containers.Vectors;
with Ada.Text_IO; use Ada.Text_IO;
with GNATCOLL.Refcount; use GNATCOLL.Refcount;
package BDD.Tables is
type Table is tagged private;
-- A reference-counted representation of a feature table
No_Table : constant Table;
function Create return Table;
-- Create a new empty table
procedure Add_Row_As_String
(Self : Table;
Row : String);
-- Add a row to the table. Row must be formatted as in:
-- | Col1 | Col2 | Col3 |
--
-- When this is the first row added, the contents provides the name of
-- the columns. If Set_Column_Name has already been called, Row is never
-- assumed to contain the title of the columns.
procedure Set_Column_Name
(Self : Table;
Column : Positive;
Name : String);
-- Set the name of the Column-th column
procedure Put
(Self : Table;
Column : Positive;
Row : Positive;
Value : String);
-- Set the value in the table.
function Get
(Self : Table;
Column : Positive;
Row : Positive)
return String;
function Get
(Self : Table;
Column : String;
Row : Positive)
return String;
-- Get an element from the table.
-- The column can be specified as a string to use the name of the column.
function Column_Number (Self : Table; Name : String) return Natural;
-- Return the number for the column with a specific Name, or 0 if not found
function Width (Self : Table) return Natural;
function Height (Self : Table) return Natural;
-- Return the size of the table
procedure Display
(Self : Table; File : Ada.Text_IO.File_Type; Prefix : String := "");
-- Display the table in File.
-- Each line is leaded by a Prefix.
private
package String_Vectors is new Ada.Containers.Indefinite_Vectors
(Positive, String);
package Row_Vectors is new Ada.Containers.Vectors
(Positive, String_Vectors.Vector, String_Vectors."=");
type Table_Record is new GNATCOLL.Refcount.Refcounted with record
Names : String_Vectors.Vector;
Rows : Row_Vectors.Vector; -- does not include column titles
end record;
package Table_Pointers is new GNATCOLL.Refcount.Smart_Pointers
(Table_Record);
type Table is new Table_Pointers.Ref with null record;
No_Table : constant Table := (Table_Pointers.Null_Ref with null record);
end BDD.Tables;