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

Add support for highlighting the parts of the regexp that match parenthesis

This commit is contained in:
Emmanuel Briot 2014-02-10 10:48:17 +01:00
parent d81d6939ea
commit 2d45334844
8 changed files with 135 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
docs/features.rst
View File

@ -44,7 +44,7 @@ Syntax of the features file
The syntax of the features file is based on the one from Cucumber, which is
a BDD standard tool in the Ruby world. The grammar and syntax in those files
is voluntarily information, since they are meant to be editable and readable
is voluntarily informal, since they are meant to be editable and readable
by people other than software developers.
As a result, this documentation is mostly based on examples. Let's start

35
src/bdd-features.adb
View File

@ -28,6 +28,9 @@ with GNATCOLL.Traces; use GNATCOLL.Traces;
package body BDD.Features is
Me : constant Trace_Handle := Create ("BDD.FEATURES");
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Match_Array, Match_Array_Access);
protected type Ids is
procedure Get_Next (Id : out Integer);
-- Get the next unique id
@ -343,6 +346,10 @@ package body BDD.Features is
Trace (Me, "Free step at line" & Self.Line'Img);
Self.Text := Null_Unbounded_String;
Self.Multiline := Null_Unbounded_String;
Self.Error_Msg := Null_Unbounded_String;
Self.Status := Status_Passed;
Self.Table := No_Table;
Unchecked_Free (Self.Match);
Self.Line := 1;
end Free;
@ -445,4 +452,32 @@ package body BDD.Features is
return Self.Table;
end Table;
--------------------
-- Set_Match_Info --
--------------------
procedure Set_Match_Info
(Self : not null access Step_Record;
Match : GNAT.Regpat.Match_Array)
is
begin
Unchecked_Free (Self.Match);
Self.Match := new Match_Array'(Match);
end Set_Match_Info;
----------------
-- Match_Info --
----------------
function Match_Info
(Self : not null access Step_Record) return GNAT.Regpat.Match_Array
is
begin
if Self.Match /= null then
return Self.Match.all;
else
return Match_Array'(1 .. 0 => No_Match);
end if;
end Match_Info;
end BDD.Features;

12
src/bdd-features.ads
View File

@ -27,6 +27,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;
with GNAT.Regpat; use GNAT.Regpat;
package BDD.Features is
@ -68,6 +69,14 @@ package BDD.Features is
function Error_Msg (Self : not null access Step_Record) return String;
-- Set the status for a specific step
procedure Set_Match_Info
(Self : not null access Step_Record;
Match : GNAT.Regpat.Match_Array);
function Match_Info
(Self : not null access Step_Record) return GNAT.Regpat.Match_Array;
-- Set the information about what part of the step's text matches the
-- regexp.
-------------
-- Feature --
-------------
@ -147,6 +156,8 @@ package BDD.Features is
-- The length of the longuest step (for display purposes)
private
type Match_Array_Access is access GNAT.Regpat.Match_Array;
type Step_Record is tagged record
Line : Positive;
Text : Ada.Strings.Unbounded.Unbounded_String;
@ -154,6 +165,7 @@ private
Error_Msg : Ada.Strings.Unbounded.Unbounded_String;
Status : BDD.Scenario_Status;
Table : BDD.Tables.Table;
Match : Match_Array_Access;
end record;
package Step_Lists is new Ada.Containers.Doubly_Linked_Lists (Step);

79
src/bdd-formatters.adb
View File

@ -25,6 +25,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;
with GNAT.Regpat; use GNAT.Regpat;
package body BDD.Formatters is
@ -66,9 +67,9 @@ package body BDD.Formatters is
-- Display the name of the scenario being run, if supported by the
-- terminal
procedure Put_And_Align
function Text_And_Align
(Scenario : BDD.Features.Scenario;
Text : String);
Text : String) return 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.
@ -169,19 +170,18 @@ package body BDD.Formatters is
New_Line;
end Display_Location;
-------------------
-- Put_And_Align --
-------------------
--------------------
-- Text_And_Align --
--------------------
procedure Put_And_Align
function Text_And_Align
(Scenario : BDD.Features.Scenario;
Text : String)
Text : String) return String
is
Long : constant Natural := Scenario.Longuest_Step + Step_Indent'Length;
begin
Put (Text);
Put ((1 .. 1 + Long - Text'Length => ' '));
end Put_And_Align;
return Text & (1 .. 1 + Long - Text'Length => ' ');
end Text_And_Align;
----------------------
-- Display_Progress --
@ -245,8 +245,9 @@ package body BDD.Formatters is
Self.Last_Displayed_Feature_Id := F.Id;
end if;
Put_And_Align
(Scenario, Scenario_Indent & Scenario.Prefix & ' ' & Scenario.Name);
Put (Text_And_Align
(Scenario,
Scenario_Indent & Scenario.Prefix & ' ' & Scenario.Name));
Display_Location (Self, Scenario);
end Display_Scenario_Header;
@ -278,11 +279,57 @@ package body BDD.Formatters is
end loop;
end Indent;
Info : constant Match_Array := Step.Match_Info;
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
declare
N : constant String :=
Text_And_Align (Scenario, Step_Indent & Step.Text);
H :
array (Step_Indent'Length + 1 .. N'Length) of Boolean :=
(others => False);
First, Last : Integer;
begin
for M in 1 .. Info'Last loop
if Info (M) /= No_Match then
H (Info (M).First + Step_Indent'Length ..
Info (M).Last + Step_Indent'Length) :=
(others => True);
end if;
end loop;
First := N'First + Step_Indent'Length;
Put (N (N'First .. First - 1)); -- indentation
while First <= N'Last loop
Last := First;
while Last <= N'Last and then not H (Last) loop
Last := Last + 1;
end loop;
if First <= Last - 1 then
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Foreground => BDD.Step_Colors (Step.Status));
Put (N (First .. Last - 1));
end if;
First := Last;
while First <= N'Last and then H (First) loop
First := First + 1;
end loop;
if Last <= First - 1 then
Self.Term.Set_Color
(Term => Ada.Text_IO.Standard_Output,
Foreground => BDD.Config_Color);
Put (N (Last .. First - 1));
end if;
end loop;
end;
else
Put (Text_And_Align (Scenario, Step_Indent & Step.Text));
end if;
if Self.Term.Has_Colors then
Display_Location (Self, Scenario, Step);

10
src/bdd-runner.adb
View File

@ -147,24 +147,20 @@ package body BDD.Runner is
procedure Run_Step
(Scenario : BDD.Features.Scenario;
Step : not null access Step_Record'Class)
is
Status : Scenario_Status;
Step : not null access Step_Record'Class) is
begin
case Scenario.Status is
when Status_Passed =>
Step.Set_Status (Status_Passed);
begin
Status := BDD.Steps.Run_Step (Step.Text);
BDD.Steps.Run_Step (Step);
-- if Status = Status_Undefined then
-- if Step.Status = Status_Undefined then
-- -- ??? Could run some predefined steps here
-- null;
-- end if;
Step.Set_Status (Status);
exception
when E : others =>
Step.Set_Status

21
src/bdd-steps.adb
View File

@ -56,22 +56,27 @@ package body BDD.Steps is
-- Run_Step --
--------------
function Run_Step (Step : String) return Scenario_Status is
Matches : Match_Array (0 .. 20);
procedure Run_Step
(Step : not null access BDD.Features.Step_Record'Class)
is
Text : constant String := Step.Text;
Matches : Match_Array (0 .. 10);
begin
Match (Re_1, Step, Matches);
Match (Re_1, Text, Matches);
if Matches (0) /= No_Match then
Do_Step_1 (Name => Step (Matches (1).First .. Matches (1).Last));
return Status_Passed;
Step.Set_Match_Info (Matches);
Do_Step_1 (Name => Text (Matches (1).First .. Matches (1).Last));
return;
end if;
Match (Re_2, Step, Matches);
Match (Re_2, Text, Matches);
if Matches (0) /= No_Match then
Step.Set_Match_Info (Matches);
Do_Step_2;
return Status_Passed;
return;
end if;
return Status_Undefined;
Step.Set_Status (Status_Undefined);
end Run_Step;
end BDD.Steps;

6
src/bdd-steps.ads
View File

@ -24,10 +24,12 @@
-- This package provides support for matching steps with actual subprograms
-- registered by the user
with BDD.Features; use BDD.Features;
package BDD.Steps is
function Run_Step (Step : String) return Scenario_Status;
-- Run a step.
procedure Run_Step (Step : not null access BDD.Features.Step_Record'Class);
-- Run a step, and sets its status
-- This procedure is expected to raise exceptions when a test fails.
end BDD.Steps;

4
src/bdd.ads
View File

@ -72,6 +72,10 @@ package BDD is
Status_Skipped => GNATCOLL.Terminal.Cyan);
-- Mapping status to colors in the output
Config_Color : constant GNATCOLL.Terminal.ANSI_Color :=
GNATCOLL.Terminal.Blue;
-- Color used to highlight the parenthesis groups in steps
procedure Command_Line_Switches;
-- Handles the command line switches