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

Generate code from the step definitions 

We now also generate a project file for the driver, compile it, and
run it for our first calculator testsuite.
This commit is contained in:
Emmanuel Briot 2014-05-28 18:27:43 +02:00
parent 29668421fc
commit 1197e90be6
22 changed files with 698 additions and 229 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
Makefile Normal file
View File

@ -0,0 +1,14 @@
all: build
build:
gprbuild -Pgnatbdd.gpr
# Adding new scenarios does not erquire recompiling the driver
test: build_driver
./obj/driver
# Driver only needs to be recompiled when the step definitions change
build_driver: features/step_definitions/*
obj/gnatbdd
gprbuild -P obj/driver.gpr

9
features/first.feature Normal file
View File

@ -0,0 +1,9 @@
Feature: A first feature
This is not very useful, we are just testing that we can execute basic
calculator tests.
Scenario: Simple additions
When I enter "1"
And I enter "2"
And I enter "+"
Then I should read 3

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

Binary file not shown.

41
features/step_definitions/calculator.adb Normal file
View File

@ -0,0 +1,41 @@
with Ada.Characters.Handling; use Ada.Characters.Handling;
package body Calculator is
Stack : array (1 .. 5) of Integer;
Stack_Top : Integer := Stack'First;
procedure Enter (Value : String) is
begin
if Is_Digit (Value (Value'First)) then
if Stack_Top <= Stack'Last then
Stack (Stack_Top) := Integer'Value (Value);
Stack_Top := Stack_Top + 1;
else
raise Constraint_Error with "Calculator stack overflow";
end if;
else
if Value (Value'First) = '+' then
if Stack_Top < Stack'First + 2 then
raise Constraint_Error with "Calculator stack underflow";
else
Stack (Stack_Top - 2) :=
Stack (Stack_Top - 2) + Stack (Stack_Top - 1);
Stack_Top := Stack_Top - 1;
end if;
else
raise Program_Error with "Unknown operation: " & Value;
end if;
end if;
end Enter;
function Peek return Integer is
begin
if Stack_Top = Stack'First then
raise Constraint_Error with "Calculator stack is empty";
end if;
return Stack (Stack_Top - 1);
end Peek;
end Calculator;

6
features/step_definitions/calculator.ads Normal file
View File

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

16
features/step_definitions/mysteps1.adb Normal file
View File

@ -0,0 +1,16 @@
with BDD.Asserts; use BDD.Asserts;
with Calculator; use Calculator;
package body MySteps1 is
procedure When_I_Enter (Value : String) is
begin
Enter (Value);
end When_I_Enter;
procedure Then_I_Should_Read (Result : Integer) is
begin
Assert (Result, Peek, "checking top of the stack");
end Then_I_Should_Read;
end MySteps1;

10
features/step_definitions/mysteps1.ads Normal file
View File

@ -0,0 +1,10 @@
package MySteps1 is
-- @when ^I enter "(.*)"$
procedure When_I_Enter (Value : String)
with Pre => Value /= "";
-- @then ^I should read (\d+)$
procedure Then_I_Should_Read (Result : Integer);
end MySteps1;

6
gnatbdd.gpr
View File

@ -1,15 +1,11 @@
with "gnatcoll";
project GNATBDD is
for Main use ("main.adb", "driver.adb");
for Main use ("gnatbdd.adb");
for Languages use ("Ada");
for Source_Dirs use ("src");
for Object_Dir use "obj";
package Builder is
for Executable ("main.adb") use "gnattdd";
end Builder;
package Compiler is
for Switches ("Ada") use ("-g", "-gnata", "-gnatVa", "-gnatQ",
"-gnatyg0", "-gnatwaCJe", "-gnat2012",

33
src/bdd-steps.ads → src/bdd-asserts.ads
View File

@ -21,24 +21,23 @@
-- --
------------------------------------------------------------------------------
-- This package provides support for matching steps with actual subprograms
-- registered by the user
-- An assertion library for use with GNATBDD
--
-- Each of these subprograms raises an Assert_Error with enough information
-- to make the exception message useful.
with BDD.Features; use BDD.Features;
with BDD.Asserts_Generic; use BDD.Asserts_Generic;
with GNAT.Source_Info;
package BDD.Steps is
package BDD.Asserts is
package BAG renames BDD.Asserts_Generic;
procedure Run_Step
(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 Integer_Asserts 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;
end BDD.Steps;
end BDD.Asserts;

103
src/bdd-asserts_generic.adb Normal file
View File

@ -0,0 +1,103 @@
-----------------------------------------------------------------------------
-- 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.Assertions; use Ada.Assertions;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Hash;
with GNATCOLL.Utils; use GNATCOLL.Utils;
package body BDD.Asserts_Generic is
package String_Maps is new Ada.Containers.Indefinite_Hashed_Maps
(String, String, Ada.Strings.Hash, "=", "=");
Messages : String_Maps.Map;
Id : Positive := 1; -- a unique id for all raised exceptions
---------------------------
-- Raise_Assertion_Error --
---------------------------
procedure Raise_Assertion_Error
(Msg : String;
Details : String;
Location : String;
Entity : String)
is
Full : constant String :=
(if Msg /= "" then Msg & ASCII.LF else "")
& Details & ASCII.LF & "at " & Entity & " " & Location;
M : constant String :=
'@' & Image (Id, Min_Width => 0) & '@' & Msg & Details;
Actual : String renames
M (M'First .. M'First + Integer'Min (M'Length - 1, 200));
begin
-- Preserve as much as possible of the message (in case this exception
-- is handled by code other than GNATBdd), but insert a unique id at
-- the beginning so that we can retrieve the full message from the map.
Id := Id + 1;
Messages.Include (Actual, Full);
raise Assertion_Error with Actual;
end Raise_Assertion_Error;
-----------------
-- Get_Message --
-----------------
function Get_Message (E : Exception_Occurrence) return String is
Actual : constant String := Exception_Message (E);
C : constant String_Maps.Cursor := Messages.Find (Actual);
begin
if not String_Maps.Has_Element (C) then
return Actual;
else
return String_Maps.Element (C);
end if;
end Get_Message;
-------------
-- Asserts --
-------------
package body Asserts is
------------
-- Assert --
------------
procedure Assert
(Val1, Val2 : T;
Msg : String := "";
Location : String := GNAT.Source_Info.Source_Location;
Entity : String := GNAT.Source_Info.Enclosing_Entity)
is
begin
if not (Val1 = Val2) then
Raise_Assertion_Error
(Msg, Image (Val1) & " /= " & Image (Val2), Location, Entity);
end if;
end Assert;
end Asserts;
end BDD.Asserts_Generic;

66
src/bdd-asserts_generic.ads Normal file
View File

@ -0,0 +1,66 @@
-----------------------------------------------------------------------------
-- 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/>. --
-- --
------------------------------------------------------------------------------
-- An assertion library for use with GNATBDD
with Ada.Exceptions; use Ada.Exceptions;
with GNAT.Source_Info;
package BDD.Asserts_Generic is
procedure Raise_Assertion_Error
(Msg : String;
Details : String;
Location : String;
Entity : String);
-- Raises an assertion error, storing the full message in a temporary
-- location since exception messages are limited in length and would not
-- show the whole message
function Get_Message (E : Exception_Occurrence) return String;
-- Retrieve the whole message from the exception (which should have been
-- raises by Raise_Assert_Error above, or one of the Assert procedures
-- below).
generic
type T is limited private;
with function Image (V : T) return String;
with function "=" (V1, V2 : T) return Boolean is <>;
package Asserts is
procedure Assert
(Val1, Val2 : T;
Msg : String := "";
Location : String := GNAT.Source_Info.Source_Location;
Entity : String := GNAT.Source_Info.Enclosing_Entity);
-- Compare two elements for equality.
-- You could provide a detailed message through Msg, which will help
-- understand the error later on.
-- You are not expected to provide actual values for Location and
-- Entity, which are used to automatically retrieve the location where
-- the error occurred.
end Asserts;
end BDD.Asserts_Generic;

288
src/bdd-codegen.adb
View File

@ -21,9 +21,12 @@
-- --
------------------------------------------------------------------------------
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Regpat; use GNAT.Regpat;
with GNATCOLL.Utils; use GNATCOLL.Utils;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Unchecked_Deallocation;
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Regpat; use GNAT.Regpat;
with GNATCOLL.Utils; use GNATCOLL.Utils;
package body BDD.Codegen is
@ -34,31 +37,63 @@ package body BDD.Codegen is
& "\s*"
& "(\(" -- group 2: paramter list, including surrounding parens
& "(.*?)" -- group 3: list of parameters
& "\))?;", -- end of group 2
& "\))?(\s+with .*?)?;", -- end of group 2
Case_Insensitive or Single_Line);
Cst_Package_Re : constant Pattern_Matcher :=
Compile ("^package ([_\.\w]+)", Case_Insensitive);
Cst_Comment_Re : constant Pattern_Matcher :=
Compile ("--\s*@(given|then|when)\s+");
type Generated_Data is record
Matchers : Unbounded_String;
-- Code extract that, for a given step, checks all known step definition
-- and execute the corresponding subprogram if needed.
Regexps : Unbounded_String;
-- Code extract that declares all the regexps used by the step
-- definitions.
Withs : Unbounded_String;
-- Code extract for the "with" clauses
Steps_Count : Natural := 0;
-- Number of registered steps.
Max_Parameter_Count : Natural := 0;
-- Number of parameters for the step that requires the most of them.
end record;
function Trim (S : String) return String;
-- Trim all whitespaces (including ASCII.LF and ASCII.CR, as opposed to
-- what Ada.Strings.Fixed does) at both ends of S
function Escape (S : String) return String;
-- Return a version of S encoded for an Ada string (double quotes are
-- duplicated for instance).
function String_To_Type (Typ, Value : String) return String;
-- Generate code to converts a string (parsed from a regexp) into another
-- Ada type
procedure Check_Steps
(Self : in out Steps_Finder'Class;
File : Virtual_File);
File : Virtual_File;
Data : in out Generated_Data);
-- Check whether File contains any step definition, and register those.
-- The pattern looks for "Step_Regexp"
procedure Parse_Subprogram_Def
(Contents : String;
Package_Name : String;
Regexp : String_Access;
Pos : in out Integer);
Regexp : String;
Found : in out Boolean;
Pos : in out Integer;
Data : in out Generated_Data);
-- Parse a single procedure definition (the one starting just after Pos)
-- Pos is left after the declaration (if the latter could
-- be parsed).
-- Found is set to True if at least one step definition was found, and left
-- unchanged otherwise
type Param_Description is record
Name : GNAT.Strings.String_Access;
@ -67,6 +102,24 @@ package body BDD.Codegen is
type Param_List is array (Natural range <>) of Param_Description;
type Param_List_Access is access all Param_List;
procedure Free (Self : in out Param_List_Access);
----------
-- Free --
----------
procedure Free (Self : in out Param_List_Access) is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Param_List, Param_List_Access);
begin
if Self /= null then
for P in Self'Range loop
Free (Self (P).Name);
Free (Self (P).Of_Type);
end loop;
Unchecked_Free (Self);
end if;
end Free;
----------
-- Free --
@ -96,6 +149,51 @@ package body BDD.Codegen is
return S (First .. Last);
end Trim;
------------
-- Escape --
------------
function Escape (S : String) return String is
Count : Natural := 0;
S2_Idx : Natural;
begin
for C in S'Range loop
if S (C) = '"' then
Count := Count + 1;
end if;
end loop;
if Count = 0 then
return S;
end if;
return S2 : String (S'First .. S'Last + Count) do
S2_Idx := S2'First;
for C in S'Range loop
S2 (S2_Idx) := S (C);
if S (C) = '"' then
S2 (S2_Idx + 1) := '"';
S2_Idx := S2_Idx + 2;
else
S2_Idx := S2_Idx + 1;
end if;
end loop;
end return;
end Escape;
--------------------
-- String_To_Type --
--------------------
function String_To_Type (Typ, Value : String) return String is
begin
if To_Lower (Typ) = "string" then
return Value;
else
return Typ & "'Value (" & Value & ")";
end if;
end String_To_Type;
--------------------------
-- Parse_Subprogram_Def --
--------------------------
@ -103,23 +201,23 @@ package body BDD.Codegen is
procedure Parse_Subprogram_Def
(Contents : String;
Package_Name : String;
Regexp : String_Access;
Pos : in out Integer)
Regexp : String;
Found : in out Boolean;
Pos : in out Integer;
Data : in out Generated_Data)
is
Matches : Match_Array (0 .. 3);
Subprogram : String_Access;
Subprogram : GNAT.Strings.String_Access;
Colon : Integer;
List : Param_List_Access;
Expected_Params : Natural;
begin
Put_Line ("MANU Found " & Regexp.all);
-- Check this is a valid regular expression
begin
declare
Re : constant Pattern_Matcher := Compile (Regexp.all);
Re : constant Pattern_Matcher := Compile (Regexp);
begin
Expected_Params := Paren_Count (Re);
end;
@ -128,7 +226,7 @@ package body BDD.Codegen is
Put_Line
(Standard_Error,
"Error: invalid regular expression for step '"
& Regexp.all & "'");
& Regexp & "'");
return;
end;
@ -139,8 +237,8 @@ package body BDD.Codegen is
then
Put_Line
(Standard_Error,
"Error: The step definition for '" & Regexp.all & "' must be"
& " following immediately by its subprogram");
"Error: The step definition for '" & Regexp & "' must be"
& " followed immediately by its subprogram");
return;
end if;
@ -148,7 +246,7 @@ package body BDD.Codegen is
if Matches (1) = No_Match then
Put_Line
(Standard_Error,
"Could not find name of subprogram for '" & Regexp.all & "'");
"Could not find name of subprogram for '" & Regexp & "'");
return;
end if;
@ -158,8 +256,6 @@ package body BDD.Codegen is
(Package_Name & '.'
& Contents (Matches (1).First .. Matches (1).Last));
Put_Line ("MANU in subprogram " & Subprogram.all);
-- Parse the list of parameters
if Matches (3) /= No_Match then
@ -178,16 +274,13 @@ package body BDD.Codegen is
Put_Line
(Standard_Error,
"Error while parsing subprogram declaration for step '"
& Regexp.all & "'");
& Regexp & "'");
return;
end if;
List (P) :=
(Name => new String'(Trim (D (D'First .. Colon - 1))),
Of_Type => new String'(Trim (D (Colon + 1 .. D'Last))));
Put_Line ("MANU Param Name=" & List (P).Name.all
& " Type=" & List (P).Of_Type.all);
end;
end loop;
@ -201,9 +294,69 @@ package body BDD.Codegen is
Put_Line
(Standard_Error,
"Mismatch between the number of parenthesis in the regexp and the"
& " subprogram parameters for step '" & Regexp.all & "'");
& " subprogram parameters for step '" & Regexp & "'");
Free (List);
Free (Subprogram);
return;
end if;
-- Generate code for matchers
Found := True;
Data.Steps_Count := Data.Steps_Count + 1;
Data.Max_Parameter_Count := Integer'Max
(Data.Max_Parameter_Count, List'Length);
if Data.Steps_Count /= 1 then
Append (Data.Matchers, " els");
else
Append (Data.Matchers, " ");
end if;
Append (Data.Matchers,
"if Step.Should_Execute (Text, Matches, Re_"
& Image (Data.Steps_Count, Min_Width => 0) & ") then"
& ASCII.LF
& " if Execute then" & ASCII.LF
& " " & Subprogram.all);
if List'Length = 0 then
Append (Data.Matchers, ";");
else
for L in List'Range loop
if L /= List'First then
Append (Data.Matchers, ",");
else
Append (Data.Matchers, "(");
end if;
Append (Data.Matchers,
ASCII.LF & " "
& List (L).Name.all
& " => "
& String_To_Type
(List (L).Of_Type.all,
"Text (Matches ("
& Image (1 + L - List'First, Min_Width => 0)
& ").First .. Matches ("
& Image (1 + L - List'First, Min_Width => 0)
& ").Last)"));
end loop;
Append (Data.Matchers, ");");
end if;
Append (Data.Matchers,
ASCII.LF & " end if;" & ASCII.LF);
-- Generate code for regexps
Append (Data.Regexps,
" Re_"
& Image (Data.Steps_Count, Min_Width => 0)
& " : constant Pattern_Matcher := Compile" & ASCII.LF
& " (""" & Escape (Regexp) & """);" & ASCII.LF);
Free (Subprogram);
Free (List);
end Parse_Subprogram_Def;
-----------------
@ -212,16 +365,17 @@ package body BDD.Codegen is
procedure Check_Steps
(Self : in out Steps_Finder'Class;
File : Virtual_File)
File : Virtual_File;
Data : in out Generated_Data)
is
pragma Unreferenced (Self);
Contents : String_Access := File.Read_File;
Pos : Integer;
Contents : GNAT.Strings.String_Access := File.Read_File;
Pos, Start : Integer;
Matches : Match_Array (0 .. 1);
Last : Integer;
Pack : String_Access;
Regexp : String_Access;
Pack_Start, Pack_End : Integer;
Found : Boolean := False;
begin
if Contents /= null then
Pos := Contents'First;
@ -232,8 +386,8 @@ package body BDD.Codegen is
return;
end if;
Pack := new String'
(Contents (Matches (1).First .. Matches (1).Last));
Pack_Start := Matches (1).First;
Pack_End := Matches (1).Last;
while Pos <= Contents'Last loop
Match (Cst_Comment_Re, Contents.all, Matches, Data_First => Pos);
@ -243,11 +397,23 @@ package body BDD.Codegen is
Skip_Blanks (Contents.all, Pos);
Last := EOL (Contents (Pos .. Contents'Last));
Regexp := new String'(Contents (Pos .. Last - 1));
Start := Pos;
Pos := Last + 1; -- After ASCII.LF
Parse_Subprogram_Def (Contents.all, Pack.all, Regexp, Pos);
Parse_Subprogram_Def
(Contents.all,
Package_Name => Contents (Pack_Start .. Pack_End),
Regexp => Contents (Start .. Last - 1),
Found => Found,
Data => Data,
Pos => Pos);
end loop;
if Found then
Append (Data.Withs,
"with " & Contents (Pack_Start .. Pack_End)
& ';' & ASCII.LF);
end if;
Free (Contents);
end if;
end Check_Steps;
@ -263,14 +429,68 @@ package body BDD.Codegen is
is
Files : File_Array_Access := Directory.Read_Dir_Recursive
(Extension => Extension, Filter => Files_Only);
Data : Generated_Data;
F : File_Type;
begin
if Files /= null then
for F in Files'Range loop
Check_Steps (Self, File => Files (F));
Check_Steps (Self, File => Files (F), Data => Data);
end loop;
Unchecked_Free (Files);
end if;
Create (F, Out_File, "obj/driver.adb");
Put_Line (F, "-- Automatically generated");
Put_Line (F, "with BDD; use BDD;");
Put_Line (F, "with BDD.Main; use BDD.Main;");
Put_Line (F, "with BDD.Features; use BDD.Features;");
Put_Line (F, "with BDD.Runner; use BDD.Runner;");
Put_Line (F, "with GNAT.Regpat; use GNAT.Regpat;");
Put_Line (F, To_String (Data.Withs));
Put_Line (F, "procedure Driver is");
New_Line (F);
Put_Line (F, To_String (Data.Regexps));
Put_Line (F, " procedure Run_Steps");
Put_Line
(F,
" (Step : not null access BDD.Features.Step_Record'Class;");
Put_Line (F, " Text : String;");
Put_Line (F, " Execute : Boolean)");
Put_Line (F, " is");
Put_Line (F, " Matches : aliased Match_Array (0 .. "
& Image (Data.Max_Parameter_Count, Min_Width => 0)
& ");");
Put_Line (F, " begin");
Put (F, To_String (Data.Matchers));
Put_Line (F, " else");
Put_Line (F, " Step.Set_Status (Status_Undefined);");
Put_Line (F, " end if;");
Put_Line (F, " end Run_Steps;");
New_Line (F);
Put_Line (F, " Runner : Feature_Runner;");
Put_Line (F, "begin");
Put_Line
(F, " Runner.Add_Step_Runner (Run_Steps'Unrestricted_Access);");
Put_Line (F, " BDD.Main.Main (Runner);");
Put_Line (F, "end Driver;");
Close (F);
Create (F, Out_File, "obj/driver.gpr");
Put_Line (F, "with ""gnatcoll"";");
Put_Line (F, "project Driver is");
Put_Line (F, " for Main use (""driver.adb"");");
Put_Line (F, " for Source_Dirs use (""."",");
Put_Line (F, " ""../src/"",");
Put_Line (F, " """ & Directory.Display_Full_Name & "/**"");");
Put_Line (F, " package Binder is");
Put_Line (F, " for Switches (""Ada"") use (""-E"", ""-g"");");
Put_Line (F, " end Binder;");
Put_Line (F, " package Compiler is");
Put_Line (F, " for Switches (""Ada"") use (""-g"");");
Put_Line (F, " end Compiler;");
Put_Line (F, "end Driver;");
Close (F);
end Discover_Steps;
end BDD.Codegen;

20
src/bdd-features.adb
View File

@ -480,4 +480,24 @@ package body BDD.Features is
end if;
end Match_Info;
--------------------
-- Should_Execute --
--------------------
function Should_Execute
(Self : not null access Step_Record'Class;
Text : String;
Matches : in out GNAT.Regpat.Match_Array;
Regexp : GNAT.Regpat.Pattern_Matcher)
return Boolean
is
begin
Match (Regexp, Text, Matches);
if Matches (0) /= No_Match then
Self.Set_Match_Info (Matches);
return True;
end if;
return False;
end Should_Execute;
end BDD.Features;

12
src/bdd-features.ads
View File

@ -77,6 +77,18 @@ package BDD.Features is
-- Set the information about what part of the step's text matches the
-- regexp.
function Should_Execute
(Self : not null access Step_Record'Class;
Text : String;
Matches : in out GNAT.Regpat.Match_Array;
Regexp : GNAT.Regpat.Pattern_Matcher)
return Boolean;
-- Check whether we know how to execute the step (whether it matches any
-- of the definition), and set it up for proper execution.
-- Text is text of the step minus the leading 'given', 'when',...
-- True is returned if the subprogram associated with the step definition
-- should be executed.
-------------
-- Feature --
-------------

61
src/bdd-main.adb Normal file
View File

@ -0,0 +1,61 @@
-----------------------------------------------------------------------------
-- 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 BDD.Formatters; use BDD.Formatters;
with BDD.Parser; use BDD.Parser;
with BDD.Runner; use BDD.Runner;
with GNAT.Command_Line; use GNAT.Command_Line;
with GNATCOLL.Terminal; use GNATCOLL.Terminal;
with GNATCOLL.Traces; use GNATCOLL.Traces;
package body BDD.Main is
----------
-- Main --
----------
procedure Main (Self : in out BDD.Runner.Feature_Runner) is
Parser : BDD.Parser.Feature_Parser;
Format : access BDD.Formatters.Formatter'Class;
Term : constant Terminal_Info_Access := new Terminal_Info;
begin
GNATCOLL.Traces.Parse_Config_File;
BDD.Command_Line_Switches;
Self.Discover (+BDD.Features_File_Ext.all, BDD.Features_Directory);
Term.Init_For_Stdout (Colors => BDD.Colors);
Format := BDD.Formatters.Create_Formatter;
Format.Init (Term);
Self.Run (Format, Parser);
exception
when GNAT.Command_Line.Exit_From_Command_Line
| GNAT.Command_Line.Invalid_Switch
| GNAT.Command_Line.Invalid_Parameter
=>
null;
end Main;
end BDD.Main;

16
src/driver.adb → src/bdd-main.ads
View File

@ -21,12 +21,14 @@
-- --
------------------------------------------------------------------------------
-- An example test driver.
-- Such code would be automatically generated by gnattdd
-- Provides command line interface and main program
with BDD; use BDD;
with BDD.Runner;
procedure Driver is
begin
BDD.Main;
end Driver;
package BDD.Main is
procedure Main (Self : in out BDD.Runner.Feature_Runner);
-- The main loop, which discovers and then runs all the tests
-- Self should have been initialized with Add_Step_Runner first
end BDD.Main;

54
src/bdd-runner.adb
View File

@ -21,8 +21,8 @@
-- --
------------------------------------------------------------------------------
with Ada.Assertions;
with Ada.Exceptions; use Ada.Exceptions;
with BDD.Steps; use BDD.Steps;
with GNATCOLL.Utils; use GNATCOLL.Utils;
package body BDD.Runner is
@ -143,12 +143,7 @@ package body BDD.Runner is
First : Integer := Text'First;
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;
Step.Set_Status (Status_Undefined);
-- Skip the leading 'Given|Then|...' keywords, which are irrelevant
-- for the purpose of the match
@ -160,19 +155,28 @@ package body BDD.Runner is
end loop;
Skip_Blanks (Text, First);
begin
-- Will set status to undefined if necessary
BDD.Steps.Run_Step
(Step, Text (First .. Text'Last), Execute => Execute);
-- if Step.Status = Status_Undefined then
-- -- ??? Could run some predefined steps here
-- null;
-- end if;
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;
exception
when E : others =>
Step.Set_Status (Status_Failed, Exception_Information (E));
end;
-- 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;
if Execute then
if Show_Steps then
@ -226,4 +230,16 @@ package body BDD.Runner is
end if;
end Scenario_End;
---------------------
-- Add_Step_Runner --
---------------------
procedure Add_Step_Runner
(Self : in out Feature_Runner;
Runner : not null Step_Runner)
is
begin
Self.Runners.Append (Runner);
end Add_Step_Runner;
end BDD.Runner;

22
src/bdd-runner.ads
View File

@ -24,6 +24,7 @@
-- 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;
@ -75,7 +76,26 @@ 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);
-- Add one more function that tests for step definitions.
-- 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;
@ -85,6 +105,8 @@ private
Features_Count : Natural := 0;
Current_Feature_Id : Integer := -1;
Runners : Step_Runner_Lists.List;
Start : Ada.Calendar.Time;
end record;

108
src/bdd-steps.adb
View File

@ -1,108 +0,0 @@
-----------------------------------------------------------------------------
-- 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 GNAT.Regpat; use GNAT.Regpat;
package body BDD.Steps is
Re_1 : constant Pattern_Matcher := Compile
("^a user named '(.*)'$");
Re_2 : constant Pattern_Matcher := Compile
("^I am sitting at my desk$");
Re_3 : constant Pattern_Matcher := Compile
("^I should create great software$");
procedure Do_Step_1 (Name : String);
procedure Do_Step_2;
procedure Do_Step_3;
---------------
-- Do_Step_1 --
---------------
procedure Do_Step_1 (Name : String) is
pragma Unreferenced (Name);
begin
null;
end Do_Step_1;
---------------
-- Do_Step_2 --
---------------
procedure Do_Step_2 is
begin
raise Constraint_Error;
end Do_Step_2;
---------------
-- Do_Step_3 --
---------------
procedure Do_Step_3 is
begin
raise Constraint_Error;
end Do_Step_3;
--------------
-- Run_Step --
--------------
procedure Run_Step
(Step : not null access BDD.Features.Step_Record'Class;
Text : String;
Execute : Boolean)
is
Matches : Match_Array (0 .. 10);
begin
Match (Re_1, Text, Matches);
if Matches (0) /= No_Match then
Step.Set_Match_Info (Matches);
if Execute then
Do_Step_1 (Name => Text (Matches (1).First .. Matches (1).Last));
end if;
return;
end if;
Match (Re_2, Text, Matches);
if Matches (0) /= No_Match then
Step.Set_Match_Info (Matches);
if Execute then
Do_Step_2;
end if;
return;
end if;
Match (Re_3, Text, Matches);
if Matches (0) /= No_Match then
Step.Set_Match_Info (Matches);
if Execute then
Do_Step_3;
end if;
return;
end if;
Step.Set_Status (Status_Undefined);
end Run_Step;
end BDD.Steps;

33
src/bdd.adb
View File

@ -21,12 +21,8 @@
-- --
------------------------------------------------------------------------------
with BDD.Formatters; use BDD.Formatters;
with BDD.Parser; use BDD.Parser;
with BDD.Runner; use BDD.Runner;
with GNAT.Command_Line; use GNAT.Command_Line;
with GNATCOLL.Terminal; use GNATCOLL.Terminal;
with GNATCOLL.Traces; use GNATCOLL.Traces;
package body BDD is
@ -127,33 +123,4 @@ package body BDD is
Getopt (Config, Callback'Unrestricted_Access);
end Command_Line_Switches;
----------
-- Main --
----------
procedure Main is
Features : BDD.Runner.Feature_Runner;
Parser : BDD.Parser.Feature_Parser;
Format : access BDD.Formatters.Formatter'Class;
Term : constant Terminal_Info_Access := new Terminal_Info;
begin
GNATCOLL.Traces.Parse_Config_File;
BDD.Command_Line_Switches;
Features.Discover (+BDD.Features_File_Ext.all, BDD.Features_Directory);
Term.Init_For_Stdout (Colors => BDD.Colors);
Format := BDD.Formatters.Create_Formatter;
Format.Init (Term);
Features.Run (Format, Parser);
exception
when GNAT.Command_Line.Exit_From_Command_Line
| GNAT.Command_Line.Invalid_Switch
| GNAT.Command_Line.Invalid_Parameter
=>
null;
end Main;
end BDD;

3
src/bdd.ads
View File

@ -79,7 +79,4 @@ package BDD is
procedure Command_Line_Switches;
-- Handles the command line switches
procedure Main;
-- The main loop, which discovers and then runs all the tests
end BDD;

6
src/main.adb → src/gnatbdd.adb
View File

@ -1,16 +1,16 @@
-- This subprogram generates the test driver by including all the
-- step definitions provided by the user, as well as the predefined
-- steps, regular epressions and mockups.
-- steps, regular expressions and mockups.
with BDD.Codegen; use BDD.Codegen;
with GNATCOLL.VFS; use GNATCOLL.VFS;
procedure Main is
procedure Gnatbdd is
Finder : Steps_Finder;
begin
Discover_Steps
(Finder,
Extension => ".ads",
Directory => Create_From_Base ("features/step_definitions"));
end Main;
end Gnatbdd;