├── Source ├── DelphiSpecI18n.rc ├── DelphiSpec.StepDefinitions.pas ├── DelphiSpec.Attributes.pas ├── DelphiSpecI18n.xml ├── DelphiSpec.DataTable.pas ├── DelphiSpec.DUnit.pas ├── DelphiSpec.Assert.pas ├── DelphiSpec.Core.pas ├── DelphiSpec.DUnitX.pas ├── DelphiSpec.Scenario.pas └── DelphiSpec.Parser.pas ├── Demo ├── Features │ ├── spamfilter.feature │ ├── accounts.feature │ └── calculator.feature ├── DelphiSpecDemo.dpr ├── SampleCalculator.pas ├── SampleSpamFilterStepDefs.pas ├── SampleCalculatorStepDefs.pas ├── DelphiSpecDUnitXDemo.dpr ├── SampleAccountsStepDefs.pas ├── DelphiSpecDUnitXDemo.dproj └── DelphiSpecDemo.dproj ├── AUTHORS.md ├── README.md ├── Tests ├── DelphiSpecTests.dpr ├── DelphiSpec.Test.Languages.pas ├── DelphiSpec.Test.Scenario.pas └── DelphiSpecTests.dproj ├── .gitignore └── LICENSE /Source/DelphiSpecI18n.rc: -------------------------------------------------------------------------------- 1 | DelphiSpecLanguages RCDATA DelphiSpecI18n.xml 2 | -------------------------------------------------------------------------------- /Demo/Features/spamfilter.feature: -------------------------------------------------------------------------------- 1 | Feature: Spam Filter 2 | 3 | Scenario: Blacklist 4 | Given I have a blacklist: 5 | """ 6 | m@mail.com 7 | 123@mail.com 8 | """ 9 | And I have empty inbox 10 | When I receive an email from "m@mail.com" 11 | Then my inbox is empty 12 | -------------------------------------------------------------------------------- /AUTHORS.md: -------------------------------------------------------------------------------- 1 | # Authors 2 | In chronological order. 3 | 4 | - Roman Yankovsky [@RomanYankovsky](https://github.com/RomanYankovsky) 5 | - Stefan Glienke [@sglienke](https://github.com/sglienke) 6 | - Vincent Parrett [@vincentparrett](https://github.com/vincentparrett) 7 | - Samuel Santos [@SamuelsSantos](https://github.com/SamuelsSantos) 8 | - Johni Douglas Marangon [@johnidm](https://github.com/johnidm) 9 | -------------------------------------------------------------------------------- /Source/DelphiSpec.StepDefinitions.pas: -------------------------------------------------------------------------------- 1 | unit DelphiSpec.StepDefinitions; 2 | 3 | interface 4 | 5 | type 6 | TStepDefinitionsClass = class of TStepDefinitions; 7 | TStepDefinitions = class 8 | public 9 | procedure SetUp; virtual; 10 | procedure TearDown; virtual; 11 | end; 12 | 13 | implementation 14 | 15 | { TStepDefinitions } 16 | 17 | procedure TStepDefinitions.SetUp; 18 | begin 19 | // nothing 20 | end; 21 | 22 | procedure TStepDefinitions.TearDown; 23 | begin 24 | // nothing 25 | end; 26 | 27 | end. 28 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # DelphiSpec 2 | 3 | DelphiSpec is a library for running automated tests written in plain language. Because they're 4 | written in plain language, they can be read by anyone on your team. Because they can be 5 | read by anyone, you can use them to help improve communication, collaboration and trust on 6 | your team. 7 | 8 | DelphiSpec was inspired by [Cucumber](http://cukes.info/) and is using its own implementation of [Gherkin](https://github.com/cucumber/gherkin/wiki). 9 | 10 | ## Copyright 11 | 12 | Copyright (c) 2013 Roman Yankovsky. See LICENSE for details. 13 | -------------------------------------------------------------------------------- /Demo/Features/accounts.feature: -------------------------------------------------------------------------------- 1 | Feature: Accounts 2 | 3 | Background: 4 | Given users exist: 5 | | id | name | password | 6 | | 1 | Roman | pass1 | 7 | | 2 | Other | pass2 | 8 | 9 | Scenario: Correct Login 10 | Given my name is "Roman" 11 | And my password is "pass1" 12 | When I login 13 | Then I have access to private messages 14 | 15 | Scenario: Incorrect Login 16 | Given my name is "Roman" 17 | And my password is "pass2" 18 | When I login 19 | Then access denied 20 | 21 | Scenario: Remove user 22 | Given my name is "Roman" 23 | And my password is "pass1" 24 | But user "Roman" has been removed 25 | When I login 26 | Then access denied 27 | -------------------------------------------------------------------------------- /Tests/DelphiSpecTests.dpr: -------------------------------------------------------------------------------- 1 | program DelphiSpecTests; 2 | { 3 | 4 | Delphi DUnit Test Project 5 | ------------------------- 6 | This project contains the DUnit test framework and the GUI/Console test runners. 7 | Add "CONSOLE_TESTRUNNER" to the conditional defines entry in the project options 8 | to use the console test runner. Otherwise the GUI test runner will be used by 9 | default. 10 | 11 | } 12 | 13 | {$IFDEF CONSOLE_TESTRUNNER} 14 | {$APPTYPE CONSOLE} 15 | {$ENDIF} 16 | 17 | uses 18 | DUnitTestRunner, 19 | DelphiSpec.Test.Scenario in 'DelphiSpec.Test.Scenario.pas', 20 | DelphiSpec.Test.Languages in 'DelphiSpec.Test.Languages.pas'; 21 | 22 | {$R *.RES} 23 | 24 | begin 25 | ReportMemoryLeaksOnShutdown := True; 26 | 27 | DUnitTestRunner.RunRegisteredTests; 28 | end. 29 | 30 | -------------------------------------------------------------------------------- /Demo/DelphiSpecDemo.dpr: -------------------------------------------------------------------------------- 1 | program DelphiSpecDemo; 2 | 3 | {$IFDEF CONSOLE_TESTRUNNER} 4 | {$APPTYPE CONSOLE} 5 | {$ENDIF} 6 | 7 | {$R 'DelphiSpecI18n.res' '..\Source\DelphiSpecI18n.rc'} 8 | 9 | uses 10 | DUnitTestRunner, 11 | SampleCalculator in 'SampleCalculator.pas', 12 | SampleCalculatorStepDefs in 'SampleCalculatorStepDefs.pas', 13 | SampleAccountsStepDefs in 'SampleAccountsStepDefs.pas', 14 | SampleSpamFilterStepDefs in 'SampleSpamFilterStepDefs.pas', 15 | Generics.Collections, 16 | DelphiSpec.Core, 17 | DelphiSpec.Scenario, 18 | DelphiSpec.DUnit; 19 | 20 | var 21 | Features: TFeatureList; 22 | begin 23 | ReportMemoryLeaksOnShutdown := True; 24 | 25 | Features := ReadFeatures('features', True, 'EN'); 26 | try 27 | CreateDUnitTests(Features); 28 | DUnitTestRunner.RunRegisteredTests; 29 | finally 30 | Features.Free; 31 | end; 32 | end. 33 | 34 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Compiled source # 2 | ################### 3 | *.com 4 | *.class 5 | *.dll 6 | *.exe 7 | *.o 8 | *.so 9 | 10 | # Packages # 11 | ############ 12 | # it's better to unpack these files and commit the raw source 13 | # git has its own built in compression methods 14 | *.7z 15 | *.dmg 16 | *.gz 17 | *.iso 18 | *.jar 19 | *.rar 20 | *.tar 21 | *.zip 22 | 23 | # Logs and databases # 24 | ###################### 25 | *.log 26 | *.sql 27 | *.sqlite 28 | 29 | # OS generated files # 30 | ###################### 31 | .DS_Store 32 | .DS_Store? 33 | ._* 34 | .Spotlight-V100 35 | .Trashes 36 | ehthumbs.db 37 | Thumbs.db 38 | 39 | # Delphi files # 40 | ################ 41 | *.dcu 42 | *.dproj.local 43 | *.identcache 44 | __history 45 | Win32 46 | *.res 47 | *.dsk 48 | *.~* 49 | *.drc 50 | *.map 51 | *.rsm 52 | 53 | # DUnit files # 54 | ############### 55 | dunit.ini 56 | 57 | # DUnitX files # 58 | ############### 59 | dunitx-results.xml -------------------------------------------------------------------------------- /Demo/Features/calculator.feature: -------------------------------------------------------------------------------- 1 | Feature: Calculator 2 | In order to avoid silly mistakes 3 | As a math idiot 4 | I want to be told the sum and the multiplication of two numbers 5 | 6 | Scenario: Add two numbers (fails) 7 | Given I have entered 50 in calculator 8 | And I have entered 50 in calculator 9 | When I press Add 10 | Then the result should be 120 on the screen 11 | 12 | Scenario Outline: Add two numbers 13 | Given I have entered in calculator 14 | And I have entered in calculator 15 | When I press Add 16 | Then the result should be on the screen 17 | 18 | Examples: 19 | | num1 | num2 | sum | 20 | | 1 | 2 | 3 | 21 | | 4 | 5 | 9 | 22 | | 3 | 1 | 4 | 23 | 24 | Scenario: Multiply three numbers 25 | Given I have entered 5 in calculator 26 | And I have entered 5 in calculator 27 | And I have entered 4 in calculator 28 | WHEN I press mul 29 | Then the result should be 100 on the screen 30 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License 2 | 3 | Copyright (c) 2013 Roman Yankovsky 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining 6 | a copy of this software and associated documentation files (the 7 | "Software"), to deal in the Software without restriction, including 8 | without limitation the rights to use, copy, modify, merge, publish, 9 | distribute, sublicense, and/or sell copies of the Software, and to 10 | permit persons to whom the Software is furnished to do so, subject to 11 | the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be 14 | included in all copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 20 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 21 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 22 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -------------------------------------------------------------------------------- /Demo/SampleCalculator.pas: -------------------------------------------------------------------------------- 1 | unit SampleCalculator; 2 | 3 | interface 4 | 5 | uses 6 | Generics.Collections; 7 | 8 | type 9 | TCalculator = class 10 | private 11 | FData: TStack; 12 | FValue: Integer; 13 | public 14 | constructor Create; 15 | destructor Destroy; override; 16 | 17 | procedure Add; 18 | procedure Mul; 19 | procedure Push(Value: Integer); 20 | 21 | property Value: Integer read FValue; 22 | end; 23 | 24 | implementation 25 | 26 | { TCalculator } 27 | 28 | procedure TCalculator.Add; 29 | var 30 | I: Integer; 31 | begin 32 | FValue := 0; 33 | for I := 0 to FData.Count - 1 do 34 | FValue := FValue + FData.Pop; 35 | end; 36 | 37 | constructor TCalculator.Create; 38 | begin 39 | inherited; 40 | FData := TStack.Create; 41 | end; 42 | 43 | destructor TCalculator.Destroy; 44 | begin 45 | FData.Free; 46 | inherited; 47 | end; 48 | 49 | procedure TCalculator.Mul; 50 | var 51 | I: Integer; 52 | begin 53 | FValue := 1; 54 | for I := 0 to FData.Count - 1 do 55 | FValue := FValue * FData.Pop; 56 | end; 57 | 58 | procedure TCalculator.Push(Value: Integer); 59 | begin 60 | FData.Push(Value); 61 | end; 62 | 63 | end. 64 | -------------------------------------------------------------------------------- /Source/DelphiSpec.Attributes.pas: -------------------------------------------------------------------------------- 1 | unit DelphiSpec.Attributes; 2 | 3 | interface 4 | 5 | type 6 | TDelphiSpecAttribute = class(TCustomAttribute) 7 | protected 8 | FText: string; 9 | public 10 | constructor Create(const Text: string); reintroduce; 11 | 12 | property Text: string read FText; 13 | end; 14 | 15 | FeatureAttribute = class(TDelphiSpecAttribute); 16 | 17 | TDelphiSpecStepAttributeClass = class of TDelphiSpecStepAttribute; 18 | TDelphiSpecStepAttribute = class(TDelphiSpecAttribute) 19 | public 20 | constructor Create; overload; 21 | class function Prefix: string; 22 | end; 23 | 24 | Given_Attribute = class(TDelphiSpecStepAttribute); 25 | 26 | When_Attribute = class(TDelphiSpecStepAttribute); 27 | 28 | Then_Attribute = class(TDelphiSpecStepAttribute); 29 | 30 | implementation 31 | 32 | { TDelphiSpecAttribute } 33 | 34 | constructor TDelphiSpecAttribute.Create(const Text: string); 35 | begin 36 | FText := Text; 37 | end; 38 | 39 | { TDelphiSpecStepAttribute } 40 | 41 | constructor TDelphiSpecStepAttribute.Create; 42 | begin 43 | end; 44 | 45 | class function TDelphiSpecStepAttribute.Prefix: string; 46 | begin 47 | Result := ClassName; 48 | SetLength(Result, Length(Result) - 9); 49 | end; 50 | 51 | end. 52 | -------------------------------------------------------------------------------- /Demo/SampleSpamFilterStepDefs.pas: -------------------------------------------------------------------------------- 1 | unit SampleSpamFilterStepDefs; 2 | 3 | interface 4 | 5 | uses 6 | DelphiSpec.Attributes, DelphiSpec.StepDefinitions; 7 | 8 | type 9 | [Feature('spam filter')] 10 | TSpamFilterSteps = class(TStepDefinitions) 11 | private 12 | FBlackList: string; 13 | FMailCount: Integer; 14 | public 15 | procedure Given_I_have_a_blacklist(const Text: string); 16 | procedure Given_I_have_empty_inbox; 17 | 18 | [When_('I receive an email from "(.*)"')] 19 | procedure ReceiveEmail(const From: string); 20 | 21 | procedure Then_my_inbox_is_empty; 22 | end; 23 | 24 | implementation 25 | 26 | uses 27 | StrUtils, DelphiSpec.Core, DelphiSpec.Assert; 28 | 29 | { TFilterSteps } 30 | 31 | procedure TSpamFilterSteps.Given_I_have_a_blacklist(const Text: string); 32 | begin 33 | FBlackList := Text; 34 | end; 35 | 36 | procedure TSpamFilterSteps.Given_I_have_empty_inbox; 37 | begin 38 | FMailCount := 0; 39 | end; 40 | 41 | procedure TSpamFilterSteps.ReceiveEmail(const From: string); 42 | begin 43 | if not ContainsStr(FBlackList, From) then 44 | Inc(FMailCount); 45 | end; 46 | 47 | procedure TSpamFilterSteps.Then_my_inbox_is_empty; 48 | begin 49 | Assert.AreEqual(0, FMailCount, 'Inbox should be empty'); 50 | end; 51 | 52 | initialization 53 | RegisterStepDefinitionsClass(TSpamFilterSteps); 54 | 55 | end. 56 | -------------------------------------------------------------------------------- /Tests/DelphiSpec.Test.Languages.pas: -------------------------------------------------------------------------------- 1 | unit DelphiSpec.Test.Languages; 2 | 3 | interface 4 | 5 | uses 6 | TestFramework, DelphiSpec.Parser; 7 | 8 | type 9 | Test_TDelphiSpecLanguages = class(TTestCase) 10 | published 11 | procedure Test_CheckStepKind; 12 | procedure Test_GetStepText; 13 | end; 14 | 15 | implementation 16 | 17 | { Test_TDelphiSpecLanguages } 18 | 19 | procedure Test_TDelphiSpecLanguages.Test_CheckStepKind; 20 | begin 21 | self.CheckTrue(TDelphiSpecLanguages.CheckStepKind(skFeature, 'Feature: EN feature', 'EN')); 22 | self.CheckFalse(TDelphiSpecLanguages.CheckStepKind(skGiven, 'Feature: EN feature', 'EN')); 23 | self.CheckTrue(TDelphiSpecLanguages.CheckStepKind(skFeature, 'Funcionalidade: PT_BR feature', 'PT_BR')); 24 | 25 | self.CheckFalse(TDelphiSpecLanguages.CheckStepKind(skAnd, 'Então in PT_BR is then', 'PT_BR')); 26 | self.CheckFalse(TDelphiSpecLanguages.CheckStepKind(skAnd, 'Esboço do Cenário: in PT_BR is ScenarioOutline', 'PT_BR')); 27 | self.CheckFalse(TDelphiSpecLanguages.CheckStepKind(skAnd, 'Exemplos: in PT_BR is Examples', 'PT_BR')); 28 | end; 29 | 30 | procedure Test_TDelphiSpecLanguages.Test_GetStepText; 31 | begin 32 | self.CheckEquals('EN feature', TDelphiSpecLanguages.GetStepText(skFeature, 'Feature: EN feature', 'EN')); 33 | self.CheckEquals('PT_BR given', TDelphiSpecLanguages.GetStepText(skGiven, 'Dado PT_BR given', 'PT_BR')); 34 | end; 35 | 36 | initialization 37 | RegisterTest(Test_TDelphiSpecLanguages.Suite); 38 | 39 | end. 40 | -------------------------------------------------------------------------------- /Source/DelphiSpecI18n.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | Funktionalität 5 | Grundlage 6 | Szenario 7 | Szenariogrundriss 8 | Angenommen 9 | Gegeben sei 10 | Gegeben seien 11 | Wenn 12 | Dann 13 | Und 14 | Aber 15 | Beispiele 16 | 17 | 18 | Feature 19 | Background 20 | Scenario 21 | Scenario Outline 22 | Given 23 | When 24 | Then 25 | And 26 | But 27 | Examples 28 | 29 | 30 | Funcionalidade 31 | Conhecimento 32 | Cenário 33 | Esboço do Cenário 34 | Dado 35 | Quando 36 | Então 37 | e 38 | Mas 39 | Exemplos 40 | 41 | 42 | Функция 43 | Функционал 44 | Сценарий 45 | Структура сценария 46 | Предыстория 47 | Контекст 48 | Допустим 49 | Дано 50 | Когда 51 | Если 52 | Тогда 53 | То 54 | И 55 | К тому же 56 | Но 57 | А 58 | Примеры 59 | 60 | 61 | -------------------------------------------------------------------------------- /Demo/SampleCalculatorStepDefs.pas: -------------------------------------------------------------------------------- 1 | unit SampleCalculatorStepDefs; 2 | 3 | interface 4 | 5 | uses 6 | SampleCalculator, DelphiSpec.Attributes, DelphiSpec.StepDefinitions; 7 | 8 | type 9 | [Feature('calculator')] 10 | TSampleCalculatorSteps = class(TStepDefinitions) 11 | private 12 | FCalc: TCalculator; 13 | public 14 | procedure SetUp; override; 15 | procedure TearDown; override; 16 | 17 | // [Given_('I have entered (.*) in calculator')] 18 | // [Given_('I have entered $value in calculator')] 19 | // [Given_] 20 | procedure Given_I_have_entered_value_in_calculator(Value: Integer); 21 | 22 | // [When_('I press Add')] 23 | // [When_] 24 | procedure When_I_press_add; 25 | 26 | // [When_('I press Mul')] 27 | // [When_] 28 | procedure When_I_press_mul; 29 | 30 | // [Then_('the result should be (.*) on the screen')] 31 | // [Then_('the result should be $value on the screen')] 32 | // [Then_] 33 | procedure Then_the_result_should_be_value_on_the_screen(Value: Integer); 34 | end; 35 | 36 | implementation 37 | 38 | uses 39 | SysUtils, DelphiSpec.Core, DelphiSpec.Assert; 40 | 41 | { TSampleCalculatorSteps } 42 | 43 | procedure TSampleCalculatorSteps.When_I_press_add; 44 | begin 45 | FCalc.Add; 46 | end; 47 | 48 | procedure TSampleCalculatorSteps.Given_I_have_entered_value_in_calculator(Value: Integer); 49 | begin 50 | FCalc.Push(Value); 51 | end; 52 | 53 | procedure TSampleCalculatorSteps.When_I_press_mul; 54 | begin 55 | FCalc.Mul; 56 | end; 57 | 58 | procedure TSampleCalculatorSteps.SetUp; 59 | begin 60 | FCalc := TCalculator.Create; 61 | end; 62 | 63 | procedure TSampleCalculatorSteps.TearDown; 64 | begin 65 | FCalc.Free; 66 | end; 67 | 68 | procedure TSampleCalculatorSteps.Then_the_result_should_be_value_on_the_screen(Value: Integer); 69 | begin 70 | Assert.AreEqual(Value, FCalc.Value, 'Incorrect result on calculator screen'); 71 | end; 72 | 73 | initialization 74 | RegisterStepDefinitionsClass(TSampleCalculatorSteps); 75 | 76 | end. 77 | -------------------------------------------------------------------------------- /Demo/DelphiSpecDUnitXDemo.dpr: -------------------------------------------------------------------------------- 1 | program DelphiSpecDUnitXDemo; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | 6 | {$R 'DelphiSpecI18n.res' '..\Source\DelphiSpecI18n.rc'} 7 | 8 | uses 9 | SysUtils, 10 | Classes, 11 | DelphiSpec.Core, 12 | DelphiSpec.Scenario, 13 | Generics.Collections, 14 | DUnitX.AutoDetect.Console, 15 | DUnitX.Loggers.Console, 16 | DUnitX.Loggers.Xml.NUnit, 17 | DUnitX.TestRunner, 18 | DUnitX.TestFramework, 19 | SampleAccountsStepDefs in 'SampleAccountsStepDefs.pas', 20 | SampleCalculator in 'SampleCalculator.pas', 21 | SampleCalculatorStepDefs in 'SampleCalculatorStepDefs.pas', 22 | SampleSpamFilterStepDefs in 'SampleSpamFilterStepDefs.pas', 23 | DelphiSpec.DUnitX in '..\Source\DelphiSpec.DUnitX.pas'; 24 | 25 | var 26 | runner : ITestRunner; 27 | results : IRunResults; 28 | logger : ITestLogger; 29 | nunitLogger : ITestLogger; 30 | Features: TObjectList; 31 | begin 32 | ReportMemoryLeaksOnShutdown := True; 33 | 34 | Features := ReadFeatures('features', True, 'EN'); 35 | try 36 | try 37 | RegisterFeaturesWithDUnitX('DunitXDemo',Features); 38 | //Create the runner 39 | runner := TDUnitX.CreateRunner; 40 | runner.UseRTTI := True; 41 | //tell the runner how we will log things 42 | logger := TDUnitXConsoleLogger.Create(false); 43 | nunitLogger := TDUnitXXMLNUnitFileLogger.Create; 44 | runner.AddLogger(logger); 45 | runner.AddLogger(nunitLogger); 46 | 47 | 48 | //Run tests 49 | results := runner.Execute; 50 | 51 | {$IFNDEF CI} 52 | //We don't want this happening when running under CI. 53 | System.Write('Done.. press key to quit.'); 54 | System.Readln; 55 | {$ENDIF} 56 | finally 57 | Features.Free; 58 | end; 59 | except 60 | on E: Exception do 61 | begin 62 | System.Writeln(E.ClassName, ': ', E.Message); 63 | {$IFNDEF CI} 64 | //We don't want this happening when running under CI. 65 | System.Write('Done.. press key to quit.'); 66 | System.Readln; 67 | {$ENDIF} 68 | end; 69 | end; 70 | end. 71 | -------------------------------------------------------------------------------- /Source/DelphiSpec.DataTable.pas: -------------------------------------------------------------------------------- 1 | unit DelphiSpec.DataTable; 2 | 3 | interface 4 | 5 | uses 6 | SysUtils, Classes, Generics.Collections; 7 | 8 | type 9 | IDataTable = interface 10 | function GetRowCount: Integer; 11 | function GetColCount: Integer; 12 | function GetValue(Col, Row: Integer): string; 13 | 14 | property Values[Col, Row: Integer]: string read GetValue; default; 15 | property RowCount: Integer read GetRowCount; 16 | property ColCount: Integer read GetColCount; 17 | end; 18 | 19 | EDataTableException = class(Exception); 20 | TDataTable = class(TInterfacedObject, IDataTable) 21 | private 22 | FColumns: TObjectList; 23 | function GetRowCount: Integer; 24 | function GetColCount: Integer; 25 | function GetValue(Col, Row: Integer): string; 26 | public 27 | constructor Create(const ColCount: Integer); reintroduce; 28 | destructor Destroy; override; 29 | 30 | procedure AddRow(const Values: array of string); 31 | 32 | property Values[Col, Row: Integer]: string read GetValue; default; 33 | property RowCount: Integer read GetRowCount; 34 | property ColCount: Integer read GetColCount; 35 | end; 36 | 37 | implementation 38 | 39 | { TDataTable } 40 | 41 | procedure TDataTable.AddRow(const Values: array of string); 42 | var 43 | I: Integer; 44 | begin 45 | if Length(Values) <> FColumns.Count then 46 | raise EDataTableException.Create('Column count mismatch'); 47 | 48 | for I := 0 to High(Values) do 49 | FColumns[I].Add(Values[I]); 50 | end; 51 | 52 | constructor TDataTable.Create(const ColCount: Integer); 53 | var 54 | I: Integer; 55 | begin 56 | inherited Create; 57 | FColumns := TObjectList.Create(True); 58 | 59 | for I := 0 to ColCount - 1 do 60 | FColumns.Add(TStringList.Create); 61 | end; 62 | 63 | destructor TDataTable.Destroy; 64 | begin 65 | FColumns.Free; 66 | inherited; 67 | end; 68 | 69 | function TDataTable.GetColCount: Integer; 70 | begin 71 | Result := FColumns.Count; 72 | end; 73 | 74 | function TDataTable.GetRowCount: Integer; 75 | begin 76 | Result := FColumns[0].Count; 77 | end; 78 | 79 | function TDataTable.GetValue(Col, Row: Integer): string; 80 | begin 81 | Result := FColumns[Col][Row]; 82 | end; 83 | 84 | end. 85 | -------------------------------------------------------------------------------- /Source/DelphiSpec.DUnit.pas: -------------------------------------------------------------------------------- 1 | unit DelphiSpec.DUnit; 2 | 3 | interface 4 | 5 | uses 6 | Generics.Collections, DelphiSpec.Scenario; 7 | 8 | procedure CreateDUnitTests(Features: TFeatureList); 9 | 10 | implementation 11 | 12 | uses 13 | TestFramework, DelphiSpec.StepDefinitions, DelphiSpec.Assert; 14 | 15 | type 16 | TDelphiSpecTestSuite = class(TTestSuite) 17 | public 18 | constructor Create(const Name: string; Scenarios: TScenarioList); overload; virtual; 19 | end; 20 | 21 | TDelphiSpecTestCase = class(TAbstractTest) 22 | protected 23 | FScenario: TScenario; 24 | procedure RunTest(testResult: TTestResult); override; 25 | public 26 | constructor Create(Scenario: TScenario); overload; virtual; 27 | end; 28 | 29 | procedure CreateDUnitTests(Features: TFeatureList); 30 | var 31 | Feature: TFeature; 32 | Suite: TDelphiSpecTestSuite; 33 | ScenarioOutline: TScenarioOutline; 34 | begin 35 | for Feature in Features do 36 | begin 37 | Suite := TDelphiSpecTestSuite.Create(Feature.Name, Feature.Scenarios); 38 | 39 | for ScenarioOutline in Feature.ScenarioOutlines do 40 | Suite.AddSuite(TDelphiSpecTestSuite.Create(ScenarioOutline.Name, ScenarioOutline.Scenarios)); 41 | 42 | RegisterTest(Suite); 43 | end; 44 | end; 45 | 46 | { TDelphiSpecTestCase } 47 | 48 | constructor TDelphiSpecTestCase.Create(Scenario: TScenario); 49 | begin 50 | inherited Create(Scenario.Name); 51 | FScenario := Scenario; 52 | end; 53 | 54 | procedure TDelphiSpecTestCase.RunTest(testResult: TTestResult); 55 | var 56 | StepDefs: TStepDefinitions; 57 | begin 58 | StepDefs := FScenario.Feature.StepDefinitionsClass.Create; 59 | try 60 | StepDefs.SetUp; 61 | try 62 | if Assigned(FScenario.Feature.Background) then 63 | FScenario.Feature.Background.Execute(StepDefs); 64 | 65 | try 66 | FScenario.Execute(StepDefs); 67 | except 68 | on E: EScenarioStepException do 69 | raise ETestFailure.Create(E.Message); 70 | on E: EDelphiSpecTestFailure do 71 | raise ETestFailure.Create(E.Message); 72 | end; 73 | finally 74 | StepDefs.TearDown; 75 | end; 76 | finally 77 | StepDefs.Free; 78 | end; 79 | end; 80 | 81 | { TDelphiSpecTestSuite } 82 | 83 | constructor TDelphiSpecTestSuite.Create(const Name: string; Scenarios: TScenarioList); 84 | var 85 | Scenario: TScenario; 86 | begin 87 | inherited Create(Name); 88 | 89 | for Scenario in Scenarios do 90 | self.AddTest(TDelphiSpecTestCase.Create(Scenario)); 91 | end; 92 | 93 | end. 94 | -------------------------------------------------------------------------------- /Source/DelphiSpec.Assert.pas: -------------------------------------------------------------------------------- 1 | unit DelphiSpec.Assert; 2 | 3 | interface 4 | 5 | uses 6 | SysUtils; 7 | 8 | type 9 | EDelphiSpecTestFailure = class(EAbort); 10 | 11 | Assert = class 12 | private 13 | class function GetNotEqualsErrorMsg(Left, Right: string; Msg: string): string; static; 14 | {$IF CompilerVersion < 23} 15 | class function ReturnAddress: Pointer; static; 16 | {$IFEND} 17 | public 18 | class procedure Fail(const Msg: string; ErrorAddress: Pointer = nil); static; 19 | 20 | class procedure IsFalse(const Value: Boolean; const Msg: string = ''); static; 21 | class procedure IsTrue(const Value: Boolean; const Msg: string = ''); static; 22 | 23 | class procedure AreEqual(const Expected, Actual: Integer; const Msg: string = ''); overload; static; 24 | class procedure AreEqual(const Expected, Actual: string; const Msg: string = ''); overload; static; 25 | class procedure AreEqual(const Expected, Actual: T; const Msg: string); overload; static; 26 | end; 27 | 28 | implementation 29 | 30 | uses 31 | Generics.Defaults; 32 | 33 | const 34 | IsNotEqualToFmt = '%s<%s> is not equal to <%s>'; 35 | 36 | { Assert } 37 | 38 | class procedure Assert.AreEqual(const Expected, Actual: Integer; const Msg: string); 39 | begin 40 | if Expected <> Actual then 41 | Fail(GetNotEqualsErrorMsg(IntToStr(Expected), IntToStr(Actual), Msg), ReturnAddress); 42 | end; 43 | 44 | class procedure Assert.AreEqual(const Expected, Actual, Msg: string); 45 | begin 46 | if Expected <> Actual then 47 | Fail(GetNotEqualsErrorMsg(Expected, Actual, Msg), ReturnAddress); 48 | end; 49 | 50 | class procedure Assert.AreEqual(const Expected, Actual: T; const Msg: string); 51 | var 52 | Comparer: IComparer; 53 | begin 54 | Comparer := TComparer.Default; 55 | if Comparer.Compare(Expected, Actual) <> 0 then 56 | Fail(Msg, ReturnAddress); 57 | end; 58 | 59 | class procedure Assert.Fail(const Msg: string; ErrorAddress: Pointer); 60 | begin 61 | if ErrorAddress <> nil then 62 | raise EDelphiSpecTestFailure.Create(Msg) at ErrorAddress 63 | else 64 | raise EDelphiSpecTestFailure.Create(Msg) at ReturnAddress; 65 | end; 66 | 67 | class function Assert.GetNotEqualsErrorMsg(Left, Right, Msg: string): string; 68 | begin 69 | if Msg <> '' then 70 | Msg := Msg + ', '; 71 | 72 | Result := Format(IsNotEqualToFmt, [Msg, Left, Right]) 73 | end; 74 | 75 | class procedure Assert.IsFalse(const Value: Boolean; const Msg: string); 76 | begin 77 | if Value then 78 | Fail(GetNotEqualsErrorMsg('False', 'True', Msg), ReturnAddress); 79 | end; 80 | 81 | class procedure Assert.IsTrue(const Value: Boolean; const Msg: string); 82 | begin 83 | if not Value then 84 | Fail(GetNotEqualsErrorMsg('True', 'False', Msg), ReturnAddress); 85 | end; 86 | 87 | {$IF CompilerVersion < 23} 88 | class function Assert.ReturnAddress: Pointer; 89 | asm 90 | mov eax,[ebp+4] 91 | end; 92 | {$IFEND} 93 | 94 | end. 95 | -------------------------------------------------------------------------------- /Demo/SampleAccountsStepDefs.pas: -------------------------------------------------------------------------------- 1 | unit SampleAccountsStepDefs; 2 | 3 | interface 4 | 5 | uses 6 | Generics.Collections, DelphiSpec.Attributes, DelphiSpec.StepDefinitions; 7 | 8 | type 9 | [Feature('accounts')] 10 | TSampleAccountSteps = class(TStepDefinitions) 11 | private type 12 | TUserInfo = record 13 | Name: string; 14 | Password: string; 15 | Id: Integer; 16 | end; 17 | private 18 | FName, FPassword: string; 19 | FUsers: TList; 20 | FAccessGranted: Boolean; 21 | public 22 | procedure SetUp; override; 23 | procedure TearDown; override; 24 | 25 | procedure Given_users_exist(Table: TArray); 26 | 27 | [Given_('my name is "(.*)"')] 28 | procedure EnterName(const Value: string); 29 | 30 | [Given_('my password is "(.*)"')] 31 | procedure EnterPassword(const Value: string); 32 | 33 | [Given_('user "(.*)" has been removed')] 34 | procedure RemoveUser(const Name: string); 35 | 36 | procedure When_I_login; 37 | 38 | procedure Then_I_have_access_to_private_messages; 39 | procedure Then_Access_Denied; 40 | end; 41 | 42 | implementation 43 | 44 | uses 45 | DelphiSpec.Core, DelphiSpec.Assert; 46 | 47 | { TSampleAccountSteps } 48 | 49 | procedure TSampleAccountSteps.EnterName(const Value: string); 50 | begin 51 | FName := Value; 52 | end; 53 | 54 | procedure TSampleAccountSteps.EnterPassword(const Value: string); 55 | begin 56 | FPassword := Value; 57 | end; 58 | 59 | procedure TSampleAccountSteps.Given_users_exist(Table: TArray); 60 | var 61 | I: Integer; 62 | begin 63 | for I := Low(Table) to High(Table) do 64 | FUsers.Add(Table[I]); 65 | end; 66 | 67 | procedure TSampleAccountSteps.RemoveUser(const Name: string); 68 | var 69 | I: Integer; 70 | begin 71 | for I := 0 to FUsers.Count - 1 do 72 | if (FUsers[I].Name = FName) then 73 | begin 74 | FUsers.Delete(I); 75 | Break; 76 | end; 77 | end; 78 | 79 | procedure TSampleAccountSteps.SetUp; 80 | begin 81 | FUsers := TList.Create; 82 | FAccessGranted := False; 83 | end; 84 | 85 | procedure TSampleAccountSteps.TearDown; 86 | begin 87 | FUsers.Free; 88 | end; 89 | 90 | procedure TSampleAccountSteps.Then_Access_Denied; 91 | begin 92 | Assert.IsFalse(FAccessGranted, 'Access granted'); 93 | end; 94 | 95 | procedure TSampleAccountSteps.Then_I_have_access_to_private_messages; 96 | begin 97 | Assert.IsTrue(FAccessGranted, 'Access denied'); 98 | end; 99 | 100 | procedure TSampleAccountSteps.When_I_login; 101 | var 102 | I: Integer; 103 | begin 104 | for I := 0 to FUsers.Count - 1 do 105 | if (FUsers[I].Name = FName) and (FUsers[I].Password = FPassword) then 106 | begin 107 | FAccessGranted := True; 108 | Break; 109 | end; 110 | end; 111 | 112 | initialization 113 | RegisterStepDefinitionsClass(TSampleAccountSteps); 114 | 115 | end. 116 | -------------------------------------------------------------------------------- /Source/DelphiSpec.Core.pas: -------------------------------------------------------------------------------- 1 | unit DelphiSpec.Core; 2 | 3 | interface 4 | 5 | uses 6 | Generics.Collections, DelphiSpec.StepDefinitions, DelphiSpec.Scenario; 7 | 8 | function ReadFeatures(const Path: string; Recursive: Boolean; const LangCode: string): TFeatureList; 9 | 10 | function GetStepDefinitionsClass(const Name: string): TStepDefinitionsClass; 11 | procedure RegisterStepDefinitionsClass(StepDefinitionsClass: TStepDefinitionsClass); 12 | function CheckStepClassExists(const Name: string): Boolean; 13 | 14 | implementation 15 | 16 | uses 17 | SysUtils, IOUtils, Rtti, DelphiSpec.Attributes, DelphiSpec.Parser; 18 | 19 | const 20 | FileMask = '*.feature'; 21 | 22 | var 23 | __StepDefsClassList: TDictionary; 24 | 25 | procedure RegisterStepDefinitionsClass(StepDefinitionsClass: TStepDefinitionsClass); 26 | var 27 | RttiContext: TRttiContext; 28 | RttiType: TRttiType; 29 | RttiAttr: TCustomAttribute; 30 | begin 31 | __StepDefsClassList.Add(AnsiLowerCase(StepDefinitionsClass.ClassName), StepDefinitionsClass); 32 | 33 | RttiContext := TRttiContext.Create; 34 | try 35 | RttiType := RttiContext.GetType(StepDefinitionsClass); 36 | 37 | for RttiAttr in RttiType.GetAttributes do 38 | if RttiAttr is FeatureAttribute then 39 | __StepDefsClassList.Add(AnsiLowerCase(FeatureAttribute(RttiAttr).Text), StepDefinitionsClass); 40 | finally 41 | RttiContext.Free; 42 | end; 43 | end; 44 | 45 | function GetStepDefinitionsClass(const Name: string): TStepDefinitionsClass; 46 | begin 47 | Result := __StepDefsClassList[AnsiLowerCase(Name)]; 48 | end; 49 | 50 | function CheckStepClassExists(const Name: string): Boolean; 51 | begin 52 | Result:= 53 | __StepDefsClassList.ContainsKey( AnsiLowerCase(Name) ); 54 | end; 55 | 56 | function ReadFeatures(const Path: string; Recursive: Boolean; const LangCode: string): TFeatureList; 57 | var 58 | FileName: string; 59 | Parser: TDelphiSpecParser; 60 | SearchMode: TSearchOption; 61 | begin 62 | if Recursive then 63 | SearchMode := TSearchOption.soAllDirectories 64 | else 65 | SearchMode := TSearchOption.soTopDirectoryOnly; 66 | 67 | Result := TFeatureList.Create(True); 68 | try 69 | Parser := TDelphiSpecParser.Create(LangCode); 70 | try 71 | for FileName in TDirectory.GetFiles(Path, FileMask, SearchMode) do 72 | try 73 | Parser.Execute(FileName, Result); 74 | except 75 | on E: EDelphiSpecSyntaxError do 76 | raise Exception.CreateFmt('Syntax error: line %d at %s', [E.LineNo, FileName]); 77 | on E: EDelphiSpecUnexpectedEof do 78 | raise Exception.CreateFmt('Unexpected end of file at %s', [FileName]); 79 | on E: EDelphiSpecClassNotFound do 80 | raise Exception.CreateFmt('Class not implemented for feature %s in the file %s', [E.FeatureName, FileName]); 81 | end; 82 | finally 83 | Parser.Free; 84 | end; 85 | except 86 | FreeAndNil(Result); 87 | raise; 88 | end; 89 | end; 90 | 91 | initialization 92 | __StepDefsClassList := TDictionary.Create; 93 | 94 | finalization 95 | __StepDefsClassList.Free; 96 | 97 | end. 98 | -------------------------------------------------------------------------------- /Source/DelphiSpec.DUnitX.pas: -------------------------------------------------------------------------------- 1 | unit DelphiSpec.DUnitX; 2 | 3 | interface 4 | 5 | uses 6 | Generics.Collections, 7 | DelphiSpec.Scenario, 8 | DUnitX.Extensibility; 9 | 10 | procedure RegisterFeaturesWithDUnitX(const RootName: string; const Features: TFeatureList); 11 | 12 | implementation 13 | 14 | uses 15 | DUnitX.TestFramework, 16 | DelphiSpec.Assert, 17 | DelphiSpec.StepDefinitions; 18 | 19 | var 20 | _Features: TFeatureList; 21 | _RootName: string; 22 | 23 | procedure RegisterFeaturesWithDUnitX(const RootName: string; const Features: TFeatureList); 24 | begin 25 | _RootName := rootName; 26 | _Features := Features; 27 | end; 28 | 29 | type 30 | TDelphiSpecFixtureProvider = class(TInterfacedObject,IFixtureProvider) 31 | protected 32 | procedure Execute(const Context: IFixtureProviderContext); 33 | end; 34 | 35 | TDelphiSpecPlugin = class(TInterfacedObject,IPlugin) 36 | protected 37 | procedure GetPluginFeatures(const Context: IPluginLoadContext); 38 | end; 39 | 40 | TDUnitXScenario = class 41 | private 42 | FScenario: TScenario; 43 | public 44 | constructor Create(const Scenario : TScenario); 45 | public 46 | procedure Execute; 47 | end; 48 | 49 | { TDelphiSpecPlugin } 50 | 51 | procedure TDelphiSpecPlugin.GetPluginFeatures(const Context: IPluginLoadContext); 52 | begin 53 | Context.RegisterFixtureProvider(TDelphiSpecFixtureProvider.Create); 54 | end; 55 | 56 | { TDelphiSpecFixtureProvider } 57 | 58 | procedure TDelphiSpecFixtureProvider.Execute(const Context: IFixtureProviderContext); 59 | var 60 | Feature: TFeature; 61 | ScenarioOutline: TScenarioOutline; 62 | 63 | RootFixture: ITestFixture; 64 | 65 | FeatureFixture: ITestFixture; 66 | OutlineFixture: ITestFixture; 67 | ScenarioFixture: ITestFixture; 68 | 69 | procedure BuildTests(const ParentFixture: ITestFixture; const Scenarios: TScenarioList); 70 | var 71 | FixtureInstance: TDUnitXScenario; 72 | TestMethod: TTestMethod; 73 | Method: TMethod; 74 | Scenario: TScenario; 75 | begin 76 | for Scenario in Scenarios do 77 | begin 78 | FixtureInstance := TDUnitXScenario.Create(Scenario); 79 | ScenarioFixture := parentFixture.AddChildFixture(FixtureInstance, Scenario.Name, ''); 80 | 81 | Method.Data := FixtureInstance; 82 | Method.Code := @TDUnitXScenario.Execute; 83 | 84 | TestMethod := TTestMethod(Method); 85 | ScenarioFixture.AddTest('', TestMethod, Scenario.Name, ''); 86 | end; 87 | end; 88 | 89 | begin 90 | if (_Features = nil) or (_Features.Count < 1) then 91 | Exit; 92 | 93 | RootFixture := Context.CreateFixture(TObject, _RootName, ''); 94 | 95 | for Feature in _Features do 96 | begin 97 | FeatureFixture := RootFixture.AddChildFixture(TObject, Feature.Name, ''); 98 | BuildTests(FeatureFixture, Feature.Scenarios); 99 | 100 | for ScenarioOutline in Feature.ScenarioOutlines do 101 | begin 102 | OutlineFixture := FeatureFixture.AddChildFixture(TObject, ScenarioOutline.Name, ''); 103 | BuildTests(OutlineFixture, ScenarioOutline.Scenarios); 104 | end; 105 | end; 106 | end; 107 | 108 | { TDUnitXScenario } 109 | 110 | constructor TDUnitXScenario.Create(const Scenario: TScenario); 111 | begin 112 | FScenario := Scenario; 113 | end; 114 | 115 | procedure TDUnitXScenario.Execute; 116 | var 117 | StepDefs: TStepDefinitions; 118 | begin 119 | StepDefs := FScenario.Feature.StepDefinitionsClass.Create; 120 | try 121 | StepDefs.SetUp; 122 | try 123 | if Assigned(FScenario.Feature.Background) then 124 | FScenario.Feature.Background.Execute(StepDefs); 125 | 126 | try 127 | FScenario.Execute(StepDefs); 128 | except 129 | on E: EScenarioStepException do 130 | raise ETestFailure.Create(E.Message); 131 | on E: EDelphiSpecTestFailure do 132 | raise ETestFailure.Create(E.Message); 133 | end; 134 | finally 135 | StepDefs.TearDown; 136 | end; 137 | finally 138 | StepDefs.Free; 139 | end; 140 | end; 141 | 142 | initialization 143 | TDUnitX.RegisterPlugin(TDelphiSpecPlugin.Create); 144 | 145 | end. 146 | -------------------------------------------------------------------------------- /Demo/DelphiSpecDUnitXDemo.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {8E0C32BF-3239-46A9-B07D-1351C52B2D1F} 4 | 13.4 5 | None 6 | DelphiSpecDUnitXDemo.dpr 7 | True 8 | Debug 9 | Win32 10 | 1 11 | Console 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | None 44 | 3081 45 | $(DUnitX);..\Source;$(DCC_UnitSearchPath) 46 | System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 47 | bindcompfmx;fmx;rtl;dbrtl;DbxClientDriver;bindcomp;inetdb;DBXInterBaseDriver;xmlrtl;DbxCommonDriver;bindengine;soaprtl;CustomIPTransport;dsnap;fmxase;CloudService;inet;fmxobj;inetdbxpress;fmxdae;dbexpress;$(DCC_UsePackage) 48 | $(BDS)\bin\delphi_PROJECTICON.ico 49 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 50 | .\$(Platform)\$(Config) 51 | . 52 | 53 | 54 | RaizeComponentsVclDb;RaizeComponentsVcl;SynEdit_RXE2;vclimg;vclactnband;vcldb;bindcompvcl;addict4_d16;vclie;vcltouch;websnap;vclribbon;VclSmp;vcl;NxCommonDsgn;NxGridDsgn;dsnapcon;vclx;NxGridRun;webdsnap;lmdrtdocking;adortl;lmdrtl;$(DCC_UsePackage) 55 | 56 | 57 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 58 | 1033 59 | madBasic_;FBMiscComponents;IndyCore160;RaizeComponentsVclDb;dwWin7Controls;IndyProtocols160;FrameViewerXE2;RaizeComponentsVcl;inetdbbde;FBDreamRuntime;madDisAsm_;svnui;SynEdit_RXE2;vclimg;fmi;NxCommonRun;vclactnband;vcldb;VSPageR;FBFormDesigner;bindcompvcl;addict4_d16;vclie;madExcept_;vcltouch;websnap;DCEF_XE2;vclribbon;VclSmp;vcl;NxCommonDsgn;NxGridDsgn;IndySystem160;dsnapcon;KWizardR;FBSynEditHighlighters;vclx;NxGridRun;webdsnap;svn;lmdrtdocking;tb2k;VirtualTreesR;SpTBXLib_d16;adortl;EurekaLogCore;lmdrtl;$(DCC_UsePackage) 60 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 61 | 62 | 63 | DEBUG;$(DCC_Define) 64 | false 65 | true 66 | true 67 | true 68 | 69 | 70 | 1033 71 | false 72 | 73 | 74 | false 75 | RELEASE;$(DCC_Define) 76 | 0 77 | false 78 | 79 | 80 | 81 | MainSource 82 | 83 | 84 |
DelphiSpecI18n.res
85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | Cfg_2 93 | Base 94 | 95 | 96 | Base 97 | 98 | 99 | Cfg_1 100 | Base 101 | 102 | 103 | 104 | Delphi.Personality.12 105 | 106 | 107 | 108 | 109 | DelphiSpecDUnitXDemo.dpr 110 | 111 | 112 | False 113 | False 114 | 1 115 | 0 116 | 0 117 | 0 118 | False 119 | False 120 | False 121 | False 122 | False 123 | 3081 124 | 1252 125 | 126 | 127 | 128 | 129 | 1.0.0.0 130 | 131 | 132 | 133 | 134 | 135 | 1.0.0.0 136 | 137 | 138 | 139 | 140 | 141 | False 142 | False 143 | True 144 | 145 | 146 | 12 147 | 148 | 149 | 150 | 151 | -------------------------------------------------------------------------------- /Tests/DelphiSpec.Test.Scenario.pas: -------------------------------------------------------------------------------- 1 | unit DelphiSpec.Test.Scenario; 2 | 3 | interface 4 | 5 | uses 6 | TestFramework, DelphiSpec.Scenario, DelphiSpec.StepDefinitions, 7 | DelphiSpec.DataTable, SysUtils, DelphiSpec.Attributes; 8 | 9 | type 10 | TCustomTestStepsClass = class of TCustomTestSteps; 11 | TCustomTestSteps = class(TStepDefinitions) 12 | private 13 | function GetTestPassed: Boolean; 14 | protected 15 | FTestPassed: Boolean; 16 | FSomeRandomProcCalled: Boolean; 17 | procedure SetTestPassed; 18 | public 19 | procedure SetUp; override; 20 | procedure SomeRandomProc; 21 | property TestPassed: Boolean read GetTestPassed; 22 | end; 23 | 24 | TGivenStepsWithoutAttr = class(TCustomTestSteps) 25 | public 26 | procedure Given_I_want_to_test_it; 27 | end; 28 | 29 | TGivenStepsWithAttr = class(TCustomTestSteps) 30 | public 31 | [Given_('I want to test it')] 32 | procedure TestIt; 33 | end; 34 | 35 | TWhenStepsWithoutAttr = class(TCustomTestSteps) 36 | public 37 | procedure When_I_want_to_test_it; 38 | end; 39 | 40 | TWhenStepsWithAttr = class(TCustomTestSteps) 41 | public 42 | [When_('I want to test it')] 43 | procedure TestIt; 44 | end; 45 | 46 | TThenStepsWithoutAttr = class(TCustomTestSteps) 47 | public 48 | procedure Then_I_want_to_test_it; 49 | end; 50 | 51 | TThenStepsWithAttr = class(TCustomTestSteps) 52 | public 53 | [Then_('I want to test it')] 54 | procedure TestIt; 55 | end; 56 | 57 | TTestParamSteps = class(TCustomTestSteps) 58 | private type 59 | TTableRow = record 60 | Key: Integer; 61 | Value: string; 62 | end; 63 | public 64 | [Then_('the array is (.*)')] 65 | procedure TestArray(Value: TArray); 66 | 67 | [Then_('PyString is')] 68 | [Then_('the string is (.*)')] 69 | procedure TestStr(const Value: string); 70 | 71 | [Then_('Table is')] 72 | procedure TestTable(Value: TArray); 73 | 74 | [Then_('Two dim array is')] 75 | procedure TestTwoDimArray(Value: TArray>); 76 | 77 | procedure Given_I_have_N_apples(const N: Integer); 78 | 79 | [Then_('I have $M apples')] 80 | procedure TestNamedParameter(const M: Integer); 81 | end; 82 | 83 | type 84 | Test_TScenario = class(TTestCase) 85 | strict private 86 | FScenario: TScenario; 87 | private 88 | procedure AddStepAndCheckExecute(StepDefsClass: TCustomTestStepsClass; 89 | Attr: TDelphiSpecStepAttributeClass; const StepText: string; 90 | const PyString: string = ''; DataTable: IDataTable = nil); 91 | public 92 | procedure SetUp; override; 93 | procedure TearDown; override; 94 | published 95 | procedure Test_AddGiven_WithoutAttribute; 96 | procedure Test_AddGiven_WithAttribute; 97 | procedure Test_AddWhen_WithoutAttribute; 98 | procedure Test_AddWhen_WithAttribute; 99 | procedure Test_AddThen_WithoutAttribute; 100 | procedure Test_AddThen_WithAttribute; 101 | 102 | procedure Test_ArrayParameter; 103 | procedure Test_StringParameter; 104 | procedure Test_PyStringParameter; 105 | procedure Test_DataTableParameter; 106 | 107 | procedure Test_NamedParameterInMethodName; 108 | procedure Test_NamedParameterWithDollarSign; 109 | end; 110 | 111 | const 112 | SimpleStepText = 'I want to test it'; 113 | ArrayParamStepText = 'the array is 4,5,6'; 114 | StringParamStepText = 'the string is test string'; 115 | PyStrParamStepText = 'PyString is:'; 116 | TableParamStepText = 'Table is:'; 117 | NamedParamStepText = 'I have 3 apples'; 118 | TwoDimArrayParamStepText = 'Two dim array is:'; 119 | 120 | implementation 121 | 122 | procedure Test_TScenario.SetUp; 123 | begin 124 | FScenario := TScenario.Create(nil, ''); 125 | end; 126 | 127 | procedure Test_TScenario.TearDown; 128 | begin 129 | FScenario.Free; 130 | FScenario := nil; 131 | end; 132 | 133 | procedure Test_TScenario.Test_AddGiven_WithAttribute; 134 | begin 135 | AddStepAndCheckExecute(TGivenStepsWithAttr, Given_Attribute, SimpleStepText); 136 | end; 137 | 138 | procedure Test_TScenario.Test_AddGiven_WithoutAttribute; 139 | begin 140 | AddStepAndCheckExecute(TGivenStepsWithoutAttr, Given_Attribute, SimpleStepText); 141 | end; 142 | 143 | procedure Test_TScenario.Test_AddWhen_WithAttribute; 144 | begin 145 | AddStepAndCheckExecute(TWhenStepsWithAttr, When_Attribute, SimpleStepText); 146 | end; 147 | 148 | procedure Test_TScenario.Test_AddWhen_WithoutAttribute; 149 | begin 150 | AddStepAndCheckExecute(TWhenStepsWithoutAttr, When_Attribute, SimpleStepText); 151 | end; 152 | 153 | procedure Test_TScenario.Test_ArrayParameter; 154 | begin 155 | AddStepAndCheckExecute(TTestParamSteps, Then_Attribute, ArrayParamStepText); 156 | end; 157 | 158 | procedure Test_TScenario.Test_DataTableParameter; 159 | var 160 | Table: TDataTable; 161 | begin 162 | Table := TDataTable.Create(2); 163 | Table.AddRow(['key', 'value']); 164 | Table.AddRow(['1', 'a']); 165 | Table.AddRow(['2', 'b']); 166 | 167 | AddStepAndCheckExecute(TTestParamSteps, Then_Attribute, TableParamStepText, '', Table); 168 | 169 | Table := TDataTable.Create(2); 170 | Table.AddRow(['0', '1']); 171 | Table.AddRow(['2', '3']); 172 | 173 | AddStepAndCheckExecute(TTestParamSteps, Then_Attribute, TwoDimArrayParamStepText, '', Table); 174 | end; 175 | 176 | procedure Test_TScenario.Test_NamedParameterInMethodName; 177 | begin 178 | AddStepAndCheckExecute(TTestParamSteps, Given_Attribute, NamedParamStepText); 179 | end; 180 | 181 | procedure Test_TScenario.Test_NamedParameterWithDollarSign; 182 | begin 183 | AddStepAndCheckExecute(TTestParamSteps, Then_Attribute, NamedParamStepText); 184 | end; 185 | 186 | procedure Test_TScenario.Test_PyStringParameter; 187 | begin 188 | AddStepAndCheckExecute(TTestParamSteps, Then_Attribute, PyStrParamStepText, 'test string'); 189 | end; 190 | 191 | procedure Test_TScenario.Test_StringParameter; 192 | begin 193 | AddStepAndCheckExecute(TTestParamSteps, Then_Attribute, StringParamStepText); 194 | end; 195 | 196 | procedure Test_TScenario.Test_AddThen_WithAttribute; 197 | begin 198 | AddStepAndCheckExecute(TThenStepsWithAttr, Then_Attribute, SimpleStepText); 199 | end; 200 | 201 | procedure Test_TScenario.Test_AddThen_WithoutAttribute; 202 | begin 203 | AddStepAndCheckExecute(TThenStepsWithoutAttr, Then_Attribute, SimpleStepText); 204 | end; 205 | 206 | procedure Test_TScenario.AddStepAndCheckExecute(StepDefsClass: TCustomTestStepsClass; 207 | Attr: TDelphiSpecStepAttributeClass; const StepText: string; const PyString: string = ''; 208 | DataTable: IDataTable = nil); 209 | var 210 | StepDefs: TCustomTestSteps; 211 | begin 212 | if Attr = Given_Attribute then 213 | FScenario.AddGiven(StepText, DataTable, PyString); 214 | if Attr = When_Attribute then 215 | FScenario.AddWhen(StepText, DataTable, PyString); 216 | if Attr = Then_Attribute then 217 | FScenario.AddThen(StepText, DataTable, PyString); 218 | 219 | StepDefs := StepDefsClass.Create; 220 | try 221 | StepDefs.SetUp; 222 | FScenario.Execute(StepDefs); 223 | StepDefs.TearDown; 224 | 225 | Check(StepDefs.TestPassed, Format('"%s" definition has not been executed.', [Attr.Prefix])); 226 | finally 227 | StepDefs.Free; 228 | end; 229 | end; 230 | 231 | { TCustomStepDefinitions } 232 | 233 | function TCustomTestSteps.GetTestPassed: Boolean; 234 | begin 235 | Result := FTestPassed and not FSomeRandomProcCalled; 236 | end; 237 | 238 | procedure TCustomTestSteps.SetTestPassed; 239 | begin 240 | FTestPassed := True; 241 | end; 242 | 243 | procedure TCustomTestSteps.SetUp; 244 | begin 245 | FTestPassed := False; 246 | FSomeRandomProcCalled := False; 247 | end; 248 | 249 | procedure TCustomTestSteps.SomeRandomProc; 250 | begin 251 | FSomeRandomProcCalled := True; 252 | end; 253 | 254 | { TGivenStepsWithoutAttr } 255 | 256 | procedure TGivenStepsWithoutAttr.Given_I_want_to_test_it; 257 | begin 258 | SetTestPassed; 259 | end; 260 | 261 | { TGivenStepsWithAttr } 262 | 263 | procedure TGivenStepsWithAttr.TestIt; 264 | begin 265 | SetTestPassed; 266 | end; 267 | 268 | { TWhenStepsWithAttr } 269 | 270 | procedure TWhenStepsWithAttr.TestIt; 271 | begin 272 | SetTestPassed; 273 | end; 274 | 275 | { TWhenStepsWithoutAttr } 276 | 277 | procedure TWhenStepsWithoutAttr.When_I_want_to_test_it; 278 | begin 279 | SetTestPassed; 280 | end; 281 | 282 | { TThenStepsWithAttr } 283 | 284 | procedure TThenStepsWithAttr.TestIt; 285 | begin 286 | SetTestPassed; 287 | end; 288 | 289 | { TThenStepsWithoutAttr } 290 | 291 | procedure TThenStepsWithoutAttr.Then_I_want_to_test_it; 292 | begin 293 | SetTestPassed; 294 | end; 295 | 296 | { TTestParamSteps } 297 | 298 | procedure TTestParamSteps.Given_I_have_N_apples(const N: Integer); 299 | begin 300 | if N = 3 then 301 | SetTestPassed; 302 | end; 303 | 304 | procedure TTestParamSteps.TestArray(Value: TArray); 305 | begin 306 | if (Length(Value) = 3) and (Value[0] = 4) and (Value[1] = 5) and (Value[2] = 6) then 307 | SetTestPassed; 308 | end; 309 | 310 | procedure TTestParamSteps.TestNamedParameter(const M: Integer); 311 | begin 312 | if M = 3 then 313 | SetTestPassed; 314 | end; 315 | 316 | procedure TTestParamSteps.TestStr(const Value: string); 317 | begin 318 | if SameText(Value, 'test string') then 319 | SetTestPassed; 320 | end; 321 | 322 | procedure TTestParamSteps.TestTable(Value: TArray); 323 | begin 324 | if (Length(Value) = 2) 325 | and (Value[0].Key = 1) and (Value[1].Key = 2) 326 | and (Value[0].Value = 'a') and (Value[1].Value = 'b') then 327 | 328 | SetTestPassed; 329 | end; 330 | 331 | procedure TTestParamSteps.TestTwoDimArray(Value: TArray>); 332 | begin 333 | if (Length(Value) = 2) and (Length(Value[0]) = 2) 334 | and (Value[0][0] = 0) and (Value[0][1] = 1) 335 | and (Value[1][0] = 2) and (Value[1][1] = 3) then 336 | 337 | SetTestPassed; 338 | end; 339 | 340 | initialization 341 | RegisterTest(Test_TScenario.Suite); 342 | 343 | end. 344 | 345 | -------------------------------------------------------------------------------- /Tests/DelphiSpecTests.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {BD9B457A-DA34-4E49-B453-8802711C86BA} 4 | 15.3 5 | None 6 | True 7 | Debug 8 | Win32 9 | 1 10 | Console 11 | DelphiSpecTests.dpr 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | _CONSOLE_TESTRUNNER;$(DCC_Define) 44 | $(BDS)\Source\DUnit\src;$(DCC_UnitSearchPath) 45 | System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) 46 | . 47 | .\$(Platform)\$(Config) 48 | false 49 | false 50 | false 51 | false 52 | false 53 | 54 | 55 | 1033 56 | bindcompfmx;vcldbx;fmx;rtl;dbrtl;IndySystem;bindcomp;inetdbbde;DBXInterBaseDriver;DataSnapCommon;xmlrtl;svnui;DbxCommonDriver;vclimg;IndyProtocols;dbxcds;MetropolisUILiveTile;bindcompdbx;vclactnband;bindengine;vcldb;soaprtl;vcldsnap;bindcompvcl;vclie;vcltouch;DCEF_XE2;CustomIPTransport;VclSmp;dsnap;IndyIPServer;VCLRESTComponents;fmxase;vcl;IndyCore;IndyIPCommon;CodeSiteExpressPkg;inet;fmxobj;vclx;inetdbxpress;webdsnap;svn;fmxdae;RESTComponents;bdertl;dbexpress;adortl;IndyIPClient;$(DCC_UsePackage) 57 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 58 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 59 | 60 | 61 | bindcompfmx;fmx;rtl;dbrtl;IndySystem;bindcomp;DBXInterBaseDriver;DataSnapCommon;xmlrtl;DbxCommonDriver;vclimg;IndyProtocols;dbxcds;MetropolisUILiveTile;bindcompdbx;vclactnband;bindengine;vcldb;soaprtl;vcldsnap;bindcompvcl;vclie;vcltouch;CustomIPTransport;VclSmp;dsnap;IndyIPServer;VCLRESTComponents;fmxase;vcl;IndyCore;IndyIPCommon;inet;fmxobj;vclx;inetdbxpress;webdsnap;fmxdae;RESTComponents;dbexpress;adortl;IndyIPClient;$(DCC_UsePackage) 62 | 63 | 64 | DEBUG;$(DCC_Define) 65 | true 66 | false 67 | true 68 | true 69 | true 70 | 71 | 72 | ..\Source;$(DCC_UnitSearchPath) 73 | None 74 | 1033 75 | false 76 | 77 | 78 | false 79 | RELEASE;$(DCC_Define) 80 | 0 81 | 0 82 | 83 | 84 | 85 | MainSource 86 | 87 | 88 | 89 | 90 | Cfg_2 91 | Base 92 | 93 | 94 | Base 95 | 96 | 97 | Cfg_1 98 | Base 99 | 100 | 101 | 102 | Delphi.Personality.12 103 | 104 | 105 | 106 | 107 | False 108 | False 109 | 1 110 | 0 111 | 0 112 | 0 113 | False 114 | False 115 | False 116 | False 117 | False 118 | 1049 119 | 1251 120 | 121 | 122 | 123 | 124 | 1.0.0.0 125 | 126 | 127 | 128 | 129 | 130 | 1.0.0.0 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | 140 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | 148 | 149 | 150 | 151 | 152 | 153 | 154 | 155 | 156 | 157 | Microsoft Office 2000 Sample Automation Server Wrapper Components 158 | Microsoft Office XP Sample Automation Server Wrapper Components 159 | 160 | 161 | DelphiSpecTests.dpr 162 | 163 | 164 | 165 | 166 | True 167 | False 168 | 169 | 170 | DUnit / Delphi Win32 171 | GUI 172 | 173 | 174 | 175 | 176 | 12 177 | 178 | 179 | 180 | 181 | -------------------------------------------------------------------------------- /Source/DelphiSpec.Scenario.pas: -------------------------------------------------------------------------------- 1 | unit DelphiSpec.Scenario; 2 | 3 | interface 4 | 5 | uses 6 | SysUtils, Classes, Generics.Collections, DelphiSpec.StepDefinitions, DelphiSpec.Attributes, 7 | DelphiSpec.DataTable, Rtti; 8 | 9 | type 10 | TFeature = class; // forward declaration 11 | TScenario = class; // forward declaration 12 | TScenarioOutline = class; // forward declaration; 13 | 14 | TFeatureList = class(TObjectList); 15 | TScenarioList = class(TObjectList); 16 | TScenarioOutlineList = class(TObjectList); 17 | 18 | TValueArray = TArray; 19 | 20 | TFeature = class 21 | private 22 | FName: string; 23 | FBackground: TScenario; 24 | FScenarios: TScenarioList; 25 | FScenarioOutlines: TScenarioOutlineList; 26 | FStepDefsClass: TStepDefinitionsClass; 27 | public 28 | constructor Create(const Name: string; StepDefsClass: TStepDefinitionsClass); reintroduce; 29 | destructor Destroy; override; 30 | 31 | property Background: TScenario read FBackground write FBackground; 32 | property Name: string read FName; 33 | property Scenarios: TScenarioList read FScenarios; 34 | property ScenarioOutlines: TScenarioOutlineList read FScenarioOutlines; 35 | property StepDefinitionsClass: TStepDefinitionsClass read FStepDefsClass; 36 | end; 37 | 38 | EScenarioStepException = class(Exception); 39 | TScenario = class 40 | protected type 41 | TStep = class 42 | strict private 43 | FValue: string; 44 | FDataTable: IDataTable; 45 | FPyString: string; 46 | public 47 | constructor Create(const Value: string; DataTable: IDataTable; const PyString: string); reintroduce; 48 | 49 | property Value: string read FValue; 50 | property DataTable: IDataTable read FDataTable; 51 | property PyString: string read FPyString; 52 | end; 53 | 54 | TStepList = class(TObjectList); 55 | strict private 56 | FName: string; 57 | FFeature: TFeature; 58 | 59 | function ConvertDataTable(DataTable: IDataTable; ParamType: TRttiType): TValue; 60 | function ConvertParamValue(const Value: string; ParamType: TRttiType): TValue; 61 | 62 | procedure FindStep(Step: TStep; StepDefs: TStepDefinitions; AttributeClass: TDelphiSpecStepAttributeClass); 63 | function InvokeStep(Step: TStep; StepDefs: TStepDefinitions; AttributeClass: TDelphiSpecStepAttributeClass; 64 | RttiMethod: TRttiMethod; const Value: string): Boolean; 65 | function PrepareStep(const Step: string; AttributeClass: TDelphiSpecStepAttributeClass; 66 | const MethodName: string; const Params: TArray): string; 67 | protected 68 | FGiven: TStepList; 69 | FWhen: TStepList; 70 | FThen: TStepList; 71 | public 72 | constructor Create(Parent: TFeature; const Name: string); reintroduce; virtual; 73 | destructor Destroy; override; 74 | 75 | procedure AddGiven(const Value: string; DataTable: IDataTable; const PyString: string); 76 | procedure AddWhen(const Value: string; DataTable: IDataTable; const PyString: string); 77 | procedure AddThen(const Value: string; DataTable: IDataTable; const PyString: string); 78 | 79 | procedure Execute(StepDefs: TStepDefinitions); 80 | 81 | property Feature: TFeature read FFeature; 82 | property Name: string read FName; 83 | end; 84 | 85 | TScenarioOutline = class(TScenario) 86 | private 87 | FExamples: IDataTable; 88 | FScenarios: TScenarioList; 89 | FScenariosReady: Boolean; 90 | function GetScenarios: TScenarioList; 91 | procedure PrepareScenarios; 92 | public 93 | constructor Create(Parent: TFeature; const Name: string); override; 94 | destructor Destroy; override; 95 | 96 | procedure SetExamples(Examples: IDataTable); 97 | 98 | property Scenarios: TScenarioList read GetScenarios; 99 | end; 100 | 101 | implementation 102 | 103 | uses 104 | TypInfo, RegularExpressions, StrUtils, Types; 105 | 106 | { TFeature } 107 | 108 | constructor TFeature.Create(const Name: string; StepDefsClass: TStepDefinitionsClass); 109 | begin 110 | inherited Create; 111 | FName := Name; 112 | FBackground := nil; 113 | FScenarios := TScenarioList.Create(True); 114 | FScenarioOutlines := TScenarioOutlineList.Create(True); 115 | FStepDefsClass := StepDefsClass; 116 | end; 117 | 118 | destructor TFeature.Destroy; 119 | begin 120 | FreeAndNil(FBackground); 121 | FScenarioOutlines.Free; 122 | FScenarios.Free; 123 | inherited; 124 | end; 125 | 126 | { TScenario.TScenarioStep } 127 | 128 | constructor TScenario.TStep.Create(const Value: string; 129 | DataTable: IDataTable; const PyString: string); 130 | begin 131 | inherited Create; 132 | FValue := Value; 133 | FDataTable := DataTable; 134 | FPyString := PyString; 135 | end; 136 | 137 | { TScenario } 138 | 139 | procedure TScenario.AddGiven(const Value: string; DataTable: IDataTable; const PyString: string); 140 | begin 141 | if Assigned(DataTable) and (PyString <> '') then 142 | raise EScenarioStepException.Create('Cannot assign both DataTable and PyString to scenario step'); 143 | 144 | FGiven.Add(TStep.Create(Value, DataTable, PyString)); 145 | end; 146 | 147 | procedure TScenario.AddThen(const Value: string; DataTable: IDataTable; const PyString: string); 148 | begin 149 | if Assigned(DataTable) and (PyString <> '') then 150 | raise EScenarioStepException.Create('Cannot assign both DataTable and PyString to scenario step'); 151 | 152 | FThen.Add(TStep.Create(Value, DataTable, PyString)); 153 | end; 154 | 155 | procedure TScenario.AddWhen(const Value: string; DataTable: IDataTable; const PyString: string); 156 | begin 157 | if Assigned(DataTable) and (PyString <> '') then 158 | raise EScenarioStepException.Create('Cannot assign both DataTable and PyString to scenario step'); 159 | 160 | FWhen.Add(TStep.Create(Value, DataTable, PyString)); 161 | end; 162 | 163 | function TScenario.ConvertParamValue(const Value: string; 164 | ParamType: TRttiType): TValue; 165 | const 166 | Delimiter = ','; 167 | var 168 | Strings: TStringDynArray; 169 | Values: TValueArray; 170 | I: Integer; 171 | ElementType: TRttiType; 172 | begin 173 | case ParamType.TypeKind of 174 | TTypeKind.tkInteger: Result := StrToInt(Value); 175 | TTypeKind.tkInt64: Result := StrToInt64(Value); 176 | TTypeKind.tkEnumeration: 177 | Result := TValue.FromOrdinal(ParamType.Handle, GetEnumValue(ParamType.Handle, Value)); 178 | TTypeKind.tkDynArray: 179 | begin 180 | Strings := SplitString(Value, Delimiter); 181 | SetLength(Values, Length(Strings)); 182 | ElementType := (ParamType as TRttiDynamicArrayType).ElementType; 183 | for I := Low(Strings) to High(Strings) do 184 | Values[I] := ConvertParamValue(Trim(Strings[I]), ElementType); 185 | Result := TValue.FromArray(ParamType.Handle, Values); 186 | end; 187 | else 188 | Result := Value; 189 | end; 190 | end; 191 | 192 | constructor TScenario.Create(Parent: TFeature; const Name: string); 193 | begin 194 | inherited Create; 195 | FFeature := Parent; 196 | FName := Name; 197 | 198 | FGiven := TStepList.Create(True); 199 | FWhen := TStepList.Create(True); 200 | FThen := TStepList.Create(True); 201 | end; 202 | 203 | function TScenario.ConvertDataTable(DataTable: IDataTable; 204 | ParamType: TRttiType): TValue; 205 | 206 | function ConvertDataTableToArrayOfRecords(DataTable: IDataTable; 207 | ElementType: TRttiType): TValueArray; 208 | var 209 | I, J: Integer; 210 | RttiField: TRttiField; 211 | begin 212 | SetLength(Result, DataTable.RowCount - 1); 213 | 214 | for I := 0 to DataTable.RowCount - 2 do 215 | begin 216 | TValue.Make(nil, ElementType.Handle, Result[I]); 217 | for J := 0 to DataTable.ColCount - 1 do 218 | begin 219 | RttiField := ElementType.AsRecord.GetField(DataTable.Values[J, 0]); 220 | RttiField.SetValue(Result[I].GetReferenceToRawData, 221 | ConvertParamValue(DataTable.Values[J, I + 1], RttiField.FieldType)); 222 | end; 223 | end; 224 | end; 225 | 226 | function ConvertDataTableToTwoDimArray(DataTable: IDataTable; 227 | ElementType: TRttiType): TValueArray; 228 | var 229 | I, J: Integer; 230 | ArrayLength: Integer; 231 | begin 232 | SetLength(Result, DataTable.RowCount); 233 | 234 | for I := 0 to DataTable.ColCount - 1 do 235 | begin 236 | TValue.Make(nil, ElementType.Handle, Result[I]); 237 | 238 | ArrayLength := DataTable.RowCount; 239 | DynArraySetLength(PPointer(Result[I].GetReferenceToRawData)^, Result[I].TypeInfo, 1, @ArrayLength); 240 | for J := 0 to DataTable.RowCount - 1 do 241 | Result[I].SetArrayElement(J, 242 | ConvertParamValue(DataTable.Values[J, I], (ElementType as TRttiDynamicArrayType).ElementType)); 243 | end; 244 | end; 245 | 246 | var 247 | Values: TValueArray; 248 | ElementType: TRttiType; 249 | begin 250 | ElementType := (ParamType as TRttiDynamicArrayType).ElementType; 251 | case ElementType.TypeKind of 252 | TTypeKind.tkRecord: 253 | Values := ConvertDataTableToArrayOfRecords(DataTable, ElementType); 254 | TTypeKind.tkDynArray: 255 | Values := ConvertDataTableToTwoDimArray(DataTable, ElementType); 256 | end; 257 | 258 | Result := TValue.FromArray(ParamType.Handle, Values); 259 | end; 260 | 261 | destructor TScenario.Destroy; 262 | begin 263 | FGiven.Free; 264 | FWhen.Free; 265 | FThen.Free; 266 | 267 | inherited; 268 | end; 269 | 270 | procedure TScenario.Execute(StepDefs: TStepDefinitions); 271 | var 272 | Step: TStep; 273 | begin 274 | for Step in FGiven do 275 | FindStep(Step, StepDefs, Given_Attribute); 276 | 277 | for Step in FWhen do 278 | FindStep(Step, StepDefs, When_Attribute); 279 | 280 | for Step in FThen do 281 | FindStep(Step, StepDefs, Then_Attribute); 282 | end; 283 | 284 | procedure TScenario.FindStep(Step: TStep; StepDefs: TStepDefinitions; 285 | AttributeClass: TDelphiSpecStepAttributeClass); 286 | var 287 | RttiContext: TRttiContext; 288 | RttiType: TRttiType; 289 | RttiMethod: TRttiMethod; 290 | RttiAttr: TCustomAttribute; 291 | begin 292 | RttiContext := TRttiContext.Create; 293 | try 294 | RttiType := RttiContext.GetType(StepDefs.ClassInfo); 295 | 296 | for RttiMethod in RttiType.GetMethods do 297 | begin 298 | for RttiAttr in RttiMethod.GetAttributes do 299 | if RttiAttr is AttributeClass then 300 | if InvokeStep(Step, StepDefs, AttributeClass, RttiMethod, TDelphiSpecAttribute(RttiAttr).Text) then 301 | Exit; 302 | 303 | if StartsText(AttributeClass.Prefix, RttiMethod.Name) then 304 | if InvokeStep(Step, StepDefs, AttributeClass, RttiMethod, '') then 305 | Exit; 306 | end; 307 | finally 308 | RttiContext.Free; 309 | end; 310 | 311 | raise EScenarioStepException.CreateFmt('Step is not implemented: "%s" (%s)', [Step.Value, AttributeClass.ClassName]); 312 | end; 313 | 314 | function TScenario.InvokeStep(Step: TStep; StepDefs: TStepDefinitions; 315 | AttributeClass: TDelphiSpecStepAttributeClass; RttiMethod: TRttiMethod; 316 | const Value: string): Boolean; 317 | var 318 | RegExMatch: TMatch; 319 | I: Integer; 320 | S: string; 321 | Params: TArray; 322 | Values: TValueArray; 323 | begin 324 | Params := RttiMethod.GetParameters; 325 | S := PrepareStep(Value, AttributeClass, RttiMethod.Name, Params); 326 | RegExMatch := TRegEx.Match(Step.Value, S, [TRegExOption.roIgnoreCase]); 327 | if not RegExMatch.Success then 328 | Exit(False); 329 | 330 | SetLength(Values, RegExMatch.Groups.Count - 1); 331 | if Assigned(Step.DataTable) then 332 | begin 333 | SetLength(Values, Length(Values) + 1); 334 | Values[High(Values)] := ConvertDataTable(Step.DataTable, Params[High(Params)].ParamType); 335 | end; 336 | if Step.PyString <> '' then 337 | begin 338 | SetLength(Values, Length(Values) + 1); 339 | Values[High(Values)] := Step.PyString; 340 | end; 341 | 342 | if Length(Params) <> Length(Values) then 343 | raise EScenarioStepException.CreateFmt('Parameter count does not match: "%s" (%s)', [Step.Value, AttributeClass.ClassName]); 344 | 345 | for I := 0 to RegExMatch.Groups.Count - 2 do 346 | Values[I] := ConvertParamValue(RegExMatch.Groups[I + 1].Value, Params[I].ParamType); 347 | 348 | RttiMethod.Invoke(StepDefs, Values); 349 | Result := True; 350 | end; 351 | 352 | function TScenario.PrepareStep(const Step: string; AttributeClass: TDelphiSpecStepAttributeClass; 353 | const MethodName: string; const Params: TArray): string; 354 | var 355 | I: Integer; 356 | Prefix: string; 357 | begin 358 | Result := Step; 359 | if Result = '' then 360 | begin 361 | Prefix := AttributeClass.Prefix; 362 | if StartsText(Prefix, MethodName) then 363 | begin 364 | Result := RightStr(MethodName, Length(MethodName) - Length(Prefix)); 365 | Result := ReplaceStr(Result, '_', ' '); 366 | for I := 0 to High(Params) do 367 | Result := TRegEx.Replace(Result, '\b' + Params[I].Name + '\b', '$' + Params[I].Name, [TRegExOption.roIgnoreCase]); 368 | end; 369 | end; 370 | Result := TRegEx.Replace(Result, '(\$[a-zA-Z0-9_]*)', '(.*)'); 371 | end; 372 | 373 | { TScenarioOutline } 374 | 375 | constructor TScenarioOutline.Create(Parent: TFeature; const Name: string); 376 | begin 377 | inherited; 378 | FScenariosReady := False; 379 | FExamples := nil; 380 | FScenarios := TScenarioList.Create(True); 381 | end; 382 | 383 | destructor TScenarioOutline.Destroy; 384 | begin 385 | FScenarios.Free; 386 | inherited; 387 | end; 388 | 389 | function TScenarioOutline.GetScenarios: TScenarioList; 390 | begin 391 | if not FScenariosReady then 392 | begin 393 | PrepareScenarios; 394 | FScenariosReady := True; 395 | end; 396 | 397 | Result := FScenarios; 398 | end; 399 | 400 | procedure TScenarioOutline.PrepareScenarios; 401 | 402 | function PutValues(const Step: string; Index: Integer): string; 403 | var 404 | I: Integer; 405 | begin 406 | Result := Step; 407 | 408 | for I := 0 to FExamples.ColCount - 1 do 409 | Result := TRegEx.Replace(Result, '<' + FExamples.Values[I, 0] + '>', 410 | FExamples.Values[I, Index], [TRegExOption.roIgnoreCase]); 411 | end; 412 | 413 | var 414 | I: Integer; 415 | Scenario: TScenario; 416 | Step: TStep; 417 | begin 418 | for I := 1 to FExamples.RowCount - 1 do 419 | begin 420 | Scenario := TScenario.Create(Feature, Name + Format(' [case %d]', [I])); 421 | 422 | for Step in FGiven do 423 | Scenario.AddGiven(PutValues(Step.Value, I), Step.DataTable, PutValues(Step.PyString, I)); 424 | 425 | for Step in FWhen do 426 | Scenario.AddWhen(PutValues(Step.Value, I), Step.DataTable, PutValues(Step.PyString, I)); 427 | 428 | for Step in FThen do 429 | Scenario.AddThen(PutValues(Step.Value, I), Step.DataTable, PutValues(Step.PyString, I)); 430 | 431 | FScenarios.Add(Scenario); 432 | end; 433 | end; 434 | 435 | procedure TScenarioOutline.SetExamples(Examples: IDataTable); 436 | begin 437 | FExamples := Examples; 438 | end; 439 | 440 | end. 441 | -------------------------------------------------------------------------------- /Source/DelphiSpec.Parser.pas: -------------------------------------------------------------------------------- 1 | unit DelphiSpec.Parser; 2 | 3 | interface 4 | 5 | uses 6 | SysUtils, Classes, Generics.Collections, XmlIntf, DelphiSpec.DataTable, 7 | DelphiSpec.Scenario, DelphiSpec.StepDefinitions; 8 | 9 | type 10 | TStepKind = (skFeature, skBackground, skScenario, skScenarioOutline, 11 | skGiven, skAnd, skWhen, skThen, skExamples); 12 | 13 | TDelphiSpecLanguages = class 14 | private 15 | class var FLangXML: IXMLDocument; 16 | class function GetStepKindAsString(StepKind: TStepKind): string; static; 17 | public 18 | class constructor Create; 19 | class function CheckStepKind(StepKind: TStepKind; const S: string; const LangCode: string): Boolean; 20 | class function GetStepText(StepKind: TStepKind; const S: string; const LangCode: string): string; 21 | end; 22 | 23 | TDelphiSpecFileReader = class 24 | private 25 | FLinePos: Integer; 26 | FLines: TStringList; 27 | function GetEof: Boolean; 28 | function GetLineNo: Integer; 29 | public 30 | constructor Create; 31 | destructor Destroy; override; 32 | 33 | procedure LoadFromFile(const FileName: string); 34 | function PeekLine: string; 35 | function ReadLine: string; 36 | 37 | property Eof: Boolean read GetEof; 38 | property LineNo: Integer read GetLineNo; 39 | end; 40 | 41 | EDelphiSpecSyntaxError = class(Exception) 42 | private 43 | FLineNo: Integer; 44 | public 45 | constructor CreateAtLine(LineNo: Integer); overload; 46 | property LineNo: Integer read FLineNo; 47 | end; 48 | 49 | EDelphiSpecClassNotFound = class(Exception) 50 | private 51 | FFeatureName: string; 52 | public 53 | constructor CreateAtClassNotFound(FeatureName: string); overload; 54 | property FeatureName: string read FFeatureName; 55 | end; 56 | 57 | EDelphiSpecUnexpectedEof = class(Exception); 58 | 59 | TDelphiSpecParser = class 60 | private 61 | FLangCode: string; 62 | FReader: TDelphiSpecFileReader; 63 | 64 | procedure CheckEof; 65 | procedure PassEmptyLines; 66 | procedure RaiseSyntaxError; 67 | procedure RaiseClassStepNotFound(FeatureName: string); 68 | 69 | function TryReadDataTable: IDataTable; 70 | function TryReadPyString: string; 71 | 72 | procedure FeatureNode(Feature: TFeature); 73 | procedure BackgroundNode(Feature: TFeature); 74 | procedure ScenarioNode(Scenario: TScenario); 75 | procedure ScenarioOutlineNode(ScenarioOutline: TScenarioOutline); 76 | procedure GivenNode(Scenario: TScenario); 77 | procedure WhenNode(Scenario: TScenario); 78 | procedure ThenNode(Scenario: TScenario); 79 | procedure ExampleNode(ScenarioOutline: TScenarioOutline); 80 | public 81 | constructor Create(const LangCode: string); 82 | destructor Destroy; override; 83 | 84 | procedure Execute(const FileName: string; Features: TFeatureList); 85 | end; 86 | 87 | implementation 88 | 89 | uses 90 | StrUtils, Types, XmlDoc, Variants, 91 | {$IFDEF MSWINDOWS} 92 | Windows, ActiveX, 93 | {$ENDIF} 94 | 95 | DelphiSpec.Core; 96 | 97 | { TDelphiSpecFileReader } 98 | 99 | constructor TDelphiSpecFileReader.Create; 100 | begin 101 | inherited; 102 | FLinePos := 0; 103 | FLines := TStringList.Create; 104 | end; 105 | 106 | destructor TDelphiSpecFileReader.Destroy; 107 | begin 108 | FLines.Free; 109 | inherited; 110 | end; 111 | 112 | function TDelphiSpecFileReader.GetEof: Boolean; 113 | begin 114 | Result := (FLinePos = FLines.Count); 115 | end; 116 | 117 | function TDelphiSpecFileReader.GetLineNo: Integer; 118 | begin 119 | Result := FLinePos; 120 | end; 121 | 122 | procedure TDelphiSpecFileReader.LoadFromFile(const FileName: string); 123 | begin 124 | FLines.LoadFromFile(FileName); 125 | FLinePos := 0; 126 | end; 127 | 128 | function TDelphiSpecFileReader.PeekLine: string; 129 | begin 130 | Result := FLines[FLinePos]; 131 | end; 132 | 133 | function TDelphiSpecFileReader.ReadLine: string; 134 | begin 135 | Result := FLines[FLinePos]; 136 | Inc(FLinePos); 137 | end; 138 | 139 | { TDelphiSpecParser } 140 | 141 | procedure TDelphiSpecParser.BackgroundNode(Feature: TFeature); 142 | begin 143 | if Assigned(Feature.Background) then 144 | RaiseSyntaxError; 145 | 146 | PassEmptyLines; 147 | CheckEof; 148 | 149 | Feature.Background := TScenario.Create(nil, ''); 150 | 151 | GivenNode(Feature.Background); 152 | end; 153 | 154 | procedure TDelphiSpecParser.CheckEof; 155 | begin 156 | if FReader.Eof then 157 | raise EDelphiSpecUnexpectedEof.Create('Unexpected end of file'); 158 | end; 159 | 160 | constructor TDelphiSpecParser.Create(const LangCode: string); 161 | begin 162 | inherited Create; 163 | FLangCode := LangCode; 164 | FReader := TDelphiSpecFileReader.Create; 165 | end; 166 | 167 | destructor TDelphiSpecParser.Destroy; 168 | begin 169 | FReader.Free; 170 | inherited; 171 | end; 172 | 173 | procedure TDelphiSpecParser.ExampleNode(ScenarioOutline: TScenarioOutline); 174 | var 175 | Command: string; 176 | begin 177 | PassEmptyLines; 178 | CheckEof; 179 | 180 | Command := Trim(FReader.ReadLine); 181 | if not TDelphiSpecLanguages.CheckStepKind(skExamples, Command, FLangCode) then 182 | RaiseSyntaxError; 183 | 184 | ScenarioOutline.SetExamples(TryReadDataTable); 185 | end; 186 | 187 | procedure TDelphiSpecParser.Execute(const FileName: string; 188 | Features: TFeatureList); 189 | var 190 | Command, FeatureName: string; 191 | Feature: TFeature; 192 | begin 193 | FReader.LoadFromFile(FileName); 194 | 195 | while not FReader.Eof do 196 | begin 197 | PassEmptyLines; 198 | CheckEof; 199 | 200 | Command := Trim(FReader.ReadLine); 201 | if not TDelphiSpecLanguages.CheckStepKind(skFeature, Command, FLangCode) then 202 | RaiseSyntaxError; 203 | 204 | FeatureName := TDelphiSpecLanguages.GetStepText(skFeature, Command, FLangCode); 205 | 206 | if not ( CheckStepClassExists(FeatureName) ) then 207 | RaiseClassStepNotFound(FeatureName); 208 | 209 | Feature := TFeature.Create(FeatureName, GetStepDefinitionsClass(FeatureName)); 210 | Features.Add(Feature); 211 | FeatureNode(Feature); 212 | end; 213 | 214 | end; 215 | 216 | function TDelphiSpecParser.TryReadDataTable: IDataTable; 217 | const 218 | TableDelimeter = '|'; 219 | 220 | function StrToArray(const S: string): TStringDynArray; 221 | var 222 | I: Integer; 223 | TrimS: string; 224 | begin 225 | TrimS := Trim(S); 226 | Result := SplitString(Copy(TrimS, 2, Length(TrimS) - 2), TableDelimeter); 227 | 228 | for I := Low(Result) to High(Result) do 229 | Result[I] := Trim(Result[I]); 230 | end; 231 | 232 | function TableInNextLine: Boolean; 233 | begin 234 | Result := (not FReader.Eof) and StartsText(TableDelimeter, Trim(FReader.PeekLine)); 235 | end; 236 | 237 | function ReadDataTable: IDataTable; 238 | var 239 | DataTable: TDataTable; 240 | ColumnNames: TStringDynArray; 241 | begin 242 | ColumnNames := StrToArray(FReader.ReadLine); 243 | 244 | DataTable := TDataTable.Create(Length(ColumnNames)); 245 | DataTable.AddRow(ColumnNames); 246 | 247 | while TableInNextLine do 248 | DataTable.AddRow(StrToArray(FReader.ReadLine)); 249 | 250 | Result := DataTable; 251 | end; 252 | 253 | begin 254 | PassEmptyLines; 255 | 256 | if TableInNextLine then 257 | Result := ReadDataTable 258 | else 259 | Result := nil; 260 | end; 261 | 262 | function TDelphiSpecParser.TryReadPyString: string; 263 | const 264 | PyStrMarker = '"""'; 265 | var 266 | Lines: TStringList; 267 | Line, IndentationText: string; 268 | TextStartPos: Integer; 269 | begin 270 | Result := ''; 271 | 272 | PassEmptyLines; 273 | if FReader.Eof or (Trim(FReader.PeekLine) <> PyStrMarker) then 274 | Exit; 275 | 276 | Lines := TStringList.Create; 277 | try 278 | Line := FReader.ReadLine; 279 | 280 | TextStartPos := Pos(PyStrMarker, Line); 281 | IndentationText := Copy(Line, 1, TextStartPos - 1); 282 | 283 | repeat 284 | CheckEof; 285 | 286 | Line := FReader.ReadLine; 287 | if not StartsText(IndentationText, Line) then 288 | RaiseSyntaxError; 289 | 290 | Lines.Add(Copy(Line, TextStartPos, Length(Line) - TextStartPos + 1)); 291 | until Trim(FReader.PeekLine) = PyStrMarker; 292 | 293 | if not StartsText(IndentationText, FReader.ReadLine) then 294 | RaiseSyntaxError; 295 | 296 | Result := Lines.Text; 297 | finally 298 | Lines.Free; 299 | end; 300 | end; 301 | 302 | procedure TDelphiSpecParser.FeatureNode(Feature: TFeature); 303 | var 304 | Command: string; 305 | CommentsAllowed: Boolean; 306 | Scenario: TScenario; 307 | ScenarioOutline: TScenarioOutline; 308 | begin 309 | CommentsAllowed := True; 310 | while not FReader.Eof do 311 | begin 312 | PassEmptyLines; 313 | CheckEof; 314 | 315 | Command := Trim(FReader.ReadLine); 316 | if TDelphiSpecLanguages.CheckStepKind(skBackground, Command, FLangCode) then 317 | begin 318 | BackgroundNode(Feature); 319 | CommentsAllowed := False; 320 | end 321 | else if TDelphiSpecLanguages.CheckStepKind(skScenarioOutline, Command, FLangCode) then 322 | begin 323 | ScenarioOutline := TScenarioOutline.Create(Feature, TDelphiSpecLanguages.GetStepText(skScenarioOutline, Command, FLangCode)); 324 | Feature.ScenarioOutlines.Add(ScenarioOutline); 325 | ScenarioOutlineNode(ScenarioOutline); 326 | CommentsAllowed := False; 327 | end 328 | else if TDelphiSpecLanguages.CheckStepKind(skScenario, Command, FLangCode) then 329 | begin 330 | Scenario := TScenario.Create(Feature, TDelphiSpecLanguages.GetStepText(skScenario, Command, FLangCode)); 331 | Feature.Scenarios.Add(Scenario); 332 | ScenarioNode(Scenario); 333 | CommentsAllowed := False; 334 | end 335 | else if not CommentsAllowed then 336 | RaiseSyntaxError; 337 | end; 338 | end; 339 | 340 | procedure TDelphiSpecParser.GivenNode(Scenario: TScenario); 341 | var 342 | Command: string; 343 | begin 344 | Command := Trim(FReader.ReadLine); 345 | 346 | if TDelphiSpecLanguages.CheckStepKind(skGiven, Command, FLangCode) then 347 | Scenario.AddGiven(TDelphiSpecLanguages.GetStepText(skGiven, Command, FLangCode), TryReadDataTable, TryReadPyString) 348 | else if TDelphiSpecLanguages.CheckStepKind(skAnd, Command, FLangCode) then 349 | Scenario.AddGiven(TDelphiSpecLanguages.GetStepText(skAnd, Command, FLangCode), TryReadDataTable, TryReadPyString) 350 | else 351 | RaiseSyntaxError; 352 | 353 | PassEmptyLines; 354 | CheckEof; 355 | 356 | Command := Trim(FReader.PeekLine); 357 | 358 | if TDelphiSpecLanguages.CheckStepKind(skAnd, Command, FLangCode) then 359 | GivenNode(Scenario); 360 | end; 361 | 362 | procedure TDelphiSpecParser.PassEmptyLines; 363 | begin 364 | while not FReader.Eof do 365 | if Trim(FReader.PeekLine) = '' then 366 | FReader.ReadLine 367 | else 368 | Break; 369 | end; 370 | 371 | procedure TDelphiSpecParser.RaiseClassStepNotFound(FeatureName: string); 372 | begin 373 | raise EDelphiSpecClassNotFound.CreateAtClassNotFound(FeatureName); 374 | end; 375 | 376 | procedure TDelphiSpecParser.RaiseSyntaxError; 377 | begin 378 | raise EDelphiSpecSyntaxError.CreateAtLine(FReader.LineNo); 379 | end; 380 | 381 | procedure TDelphiSpecParser.ScenarioNode(Scenario: TScenario); 382 | begin 383 | PassEmptyLines; 384 | CheckEof; 385 | 386 | GivenNode(Scenario); 387 | WhenNode(Scenario); 388 | ThenNode(Scenario); 389 | end; 390 | 391 | procedure TDelphiSpecParser.ScenarioOutlineNode( 392 | ScenarioOutline: TScenarioOutline); 393 | begin 394 | PassEmptyLines; 395 | CheckEof; 396 | 397 | GivenNode(ScenarioOutline); 398 | WhenNode(ScenarioOutline); 399 | ThenNode(ScenarioOutline); 400 | ExampleNode(ScenarioOutline); 401 | end; 402 | 403 | procedure TDelphiSpecParser.ThenNode(Scenario: TScenario); 404 | var 405 | Command: string; 406 | begin 407 | Command := Trim(FReader.ReadLine); 408 | 409 | if TDelphiSpecLanguages.CheckStepKind(skThen, Command, FLangCode) then 410 | Scenario.AddThen(TDelphiSpecLanguages.GetStepText(skThen, Command, FLangCode), TryReadDataTable, TryReadPyString) 411 | else if TDelphiSpecLanguages.CheckStepKind(skAnd, Command, FLangCode) then 412 | Scenario.AddThen(TDelphiSpecLanguages.GetStepText(skAnd, Command, FLangCode), TryReadDataTable, TryReadPyString) 413 | else 414 | RaiseSyntaxError; 415 | 416 | PassEmptyLines; 417 | if FReader.Eof then 418 | Exit; 419 | 420 | Command := Trim(FReader.PeekLine); 421 | 422 | if TDelphiSpecLanguages.CheckStepKind(skAnd, Command, FLangCode) then 423 | ThenNode(Scenario); 424 | end; 425 | 426 | procedure TDelphiSpecParser.WhenNode(Scenario: TScenario); 427 | var 428 | Command: string; 429 | begin 430 | Command := Trim(FReader.ReadLine); 431 | 432 | if TDelphiSpecLanguages.CheckStepKind(skWhen, Command, FLangCode) then 433 | Scenario.AddWhen(TDelphiSpecLanguages.GetStepText(skWhen, Command, FLangCode), TryReadDataTable, TryReadPyString) 434 | else if TDelphiSpecLanguages.CheckStepKind(skAnd, Command, FLangCode) then 435 | Scenario.AddWhen(TDelphiSpecLanguages.GetStepText(skAnd, Command, FLangCode), TryReadDataTable, TryReadPyString) 436 | else 437 | RaiseSyntaxError; 438 | 439 | PassEmptyLines; 440 | CheckEof; 441 | Command := Trim(FReader.PeekLine); 442 | 443 | if TDelphiSpecLanguages.CheckStepKind(skAnd, Command, FLangCode) then 444 | WhenNode(Scenario); 445 | end; 446 | 447 | { TDelphiSpecLanguages } 448 | 449 | class constructor TDelphiSpecLanguages.Create; 450 | var 451 | Stream: TResourceStream; 452 | begin 453 | {$IFDEF MSWINDOWS} 454 | ActiveX.CoInitialize(nil); 455 | {$ENDIF} 456 | 457 | 458 | Stream := TResourceStream.Create(hInstance, 'DelphiSpecLanguages', RT_RCDATA); 459 | try 460 | FLangXML := NewXmlDocument; 461 | FLangXML.LoadFromStream(Stream); 462 | finally 463 | Stream.Free; 464 | end; 465 | end; 466 | 467 | class function TDelphiSpecLanguages.GetStepKindAsString(StepKind: TStepKind): string; 468 | const 469 | StepNames: array [TStepKind] of string = ( 470 | 'Feature', 'Background', 'Scenario', 'ScenarioOutline', 471 | 'Given', 'And', 'When', 'Then', 'Examples'); 472 | begin 473 | Result := StepNames[StepKind]; 474 | end; 475 | 476 | class function TDelphiSpecLanguages.CheckStepKind(StepKind: TStepKind; const S: string; const LangCode: string): Boolean; 477 | var 478 | I: Integer; 479 | LangNode: IXMLNode; 480 | StepKindName: string; 481 | begin 482 | Result := False; 483 | LangNode := FLangXML.DocumentElement.ChildNodes.FindNode(LangCode); 484 | StepKindName := GetStepKindAsString(StepKind); 485 | 486 | for I := 0 to LangNode.ChildNodes.Count - 1 do 487 | if (LangNode.ChildNodes[I].NodeName = StepKindName) and 488 | (StartsText(LangNode.ChildNodes[I].NodeValue + ' ', S) or StartsText(LangNode.ChildNodes[I].NodeValue + ':', S)) then 489 | begin 490 | Result := True; 491 | Break; 492 | end; 493 | end; 494 | 495 | class function TDelphiSpecLanguages.GetStepText(StepKind: TStepKind; const S: string; const LangCode: string): string; 496 | var 497 | I: Integer; 498 | StepKindName: string; 499 | LangNode: IXMLNode; 500 | begin 501 | Result := ''; 502 | LangNode := FLangXML.DocumentElement.ChildNodes.FindNode(LangCode); 503 | StepKindName := GetStepKindAsString(StepKind); 504 | 505 | for I := 0 to LangNode.ChildNodes.Count - 1 do 506 | if (LangNode.ChildNodes[I].NodeName = StepKindName) and 507 | (StartsText(LangNode.ChildNodes[I].NodeValue + ' ', S) or StartsText(LangNode.ChildNodes[I].NodeValue + ':', S)) then 508 | begin 509 | Result := Trim(Copy(S, Length(VarToStr(LangNode.ChildNodes[I].NodeValue)) + 2)); 510 | Break; 511 | end; 512 | end; 513 | 514 | { EDelphiSpecSyntaxError } 515 | 516 | constructor EDelphiSpecSyntaxError.CreateAtLine(LineNo: Integer); 517 | begin 518 | inherited Create('Syntax error'); 519 | FLineNo := LineNo; 520 | end; 521 | 522 | 523 | { EDelphiSpecClassNoFound } 524 | 525 | constructor EDelphiSpecClassNotFound.CreateAtClassNotFound(FeatureName: string); 526 | begin 527 | inherited Create('Class not found to feature'); 528 | FFeatureName:= FeatureName; 529 | end; 530 | 531 | end. 532 | -------------------------------------------------------------------------------- /Demo/DelphiSpecDemo.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {F5480A9D-E0F2-4B57-B04A-A7E0F3E2448B} 4 | 16.0 5 | None 6 | True 7 | Debug 8 | Win32 9 | 1 10 | Console 11 | DelphiSpecDemo.dpr 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | DelphiSpecDemo 44 | _CONSOLE_TESTRUNNER;$(DCC_Define) 45 | $(BDS)\Source\DUnit\src;..\Source;$(DCC_UnitSearchPath) 46 | System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) 47 | .\$(Platform)\$(Config) 48 | . 49 | false 50 | false 51 | false 52 | false 53 | false 54 | 55 | 56 | 1033 57 | bindcompfmx;vcldbx;fmx;rtl;dbrtl;IndySystem;bindcomp;inetdbbde;DBXInterBaseDriver;DataSnapCommon;xmlrtl;svnui;DbxCommonDriver;vclimg;IndyProtocols;dbxcds;MetropolisUILiveTile;bindcompdbx;vclactnband;soaprtl;vcldb;bindengine;vcldsnap;bindcompvcl;vclie;vcltouch;DCEF_XE2;CustomIPTransport;VclSmp;dsnap;IndyIPServer;VCLRESTComponents;fmxase;vcl;IndyCore;IndyIPCommon;CodeSiteExpressPkg;inet;fmxobj;vclx;inetdbxpress;webdsnap;svn;fmxdae;RESTComponents;bdertl;dbexpress;adortl;IndyIPClient;$(DCC_UsePackage) 58 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 59 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 60 | 61 | 62 | bindcompfmx;fmx;rtl;dbrtl;IndySystem;bindcomp;DBXInterBaseDriver;DataSnapCommon;xmlrtl;DbxCommonDriver;vclimg;IndyProtocols;dbxcds;MetropolisUILiveTile;bindcompdbx;vclactnband;soaprtl;vcldb;bindengine;vcldsnap;bindcompvcl;vclie;vcltouch;CustomIPTransport;VclSmp;dsnap;IndyIPServer;VCLRESTComponents;fmxase;vcl;IndyCore;IndyIPCommon;inet;fmxobj;vclx;inetdbxpress;webdsnap;fmxdae;RESTComponents;dbexpress;adortl;IndyIPClient;$(DCC_UsePackage) 63 | 64 | 65 | DEBUG;$(DCC_Define) 66 | true 67 | false 68 | true 69 | true 70 | true 71 | 72 | 73 | 1033 74 | None 75 | false 76 | 77 | 78 | false 79 | RELEASE;$(DCC_Define) 80 | 0 81 | 0 82 | 83 | 84 | 85 | MainSource 86 | 87 | 88 |
DelphiSpecI18n.res
89 | 90 | 91 | 92 | 93 | 94 | 95 | Cfg_2 96 | Base 97 | 98 | 99 | Base 100 | 101 | 102 | Cfg_1 103 | Base 104 | 105 | 106 | 107 | Delphi.Personality.12 108 | 109 | 110 | 111 | 112 | False 113 | False 114 | 1 115 | 0 116 | 0 117 | 0 118 | False 119 | False 120 | False 121 | False 122 | False 123 | 1049 124 | 1251 125 | 126 | 127 | 128 | 129 | 1.0.0.0 130 | 131 | 132 | 133 | 134 | 135 | 1.0.0.0 136 | 137 | 138 | 139 | 140 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | 148 | 149 | 150 | 151 | 152 | 153 | 154 | 155 | 156 | 157 | 158 | 159 | 160 | 161 | 162 | DelphiSpecDemo.dpr 163 | 164 | 165 | Microsoft Office 2000 Sample Automation Server Wrapper Components 166 | Microsoft Office XP Sample Automation Server Wrapper Components 167 | 168 | 169 | 170 | 171 | 172 | DelphiSpecDemo.exe 173 | true 174 | 175 | 176 | 177 | 178 | true 179 | 180 | 181 | true 182 | 183 | 184 | 185 | 186 | 1 187 | .dylib 188 | 189 | 190 | 0 191 | .bpl 192 | 193 | 194 | 1 195 | .dylib 196 | 197 | 198 | 1 199 | .dylib 200 | 201 | 202 | 203 | 204 | 1 205 | .dylib 206 | 207 | 208 | 0 209 | .dll;.bpl 210 | 211 | 212 | 213 | 214 | 1 215 | 216 | 217 | 1 218 | 219 | 220 | 221 | 222 | 223 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 224 | 1 225 | 226 | 227 | 228 | 229 | res\drawable-normal 230 | 1 231 | 232 | 233 | 234 | 235 | library\lib\x86 236 | 1 237 | 238 | 239 | 240 | 241 | 1 242 | 243 | 244 | 1 245 | 246 | 247 | 248 | 249 | 250 | library\lib\armeabi-v7a 251 | 1 252 | 253 | 254 | 255 | 256 | 1 257 | 258 | 259 | 1 260 | 261 | 262 | 263 | 264 | res\drawable-xlarge 265 | 1 266 | 267 | 268 | 269 | 270 | res\drawable-xhdpi 271 | 1 272 | 273 | 274 | 275 | 276 | 1 277 | 278 | 279 | 1 280 | 281 | 282 | 283 | 284 | res\drawable-xxhdpi 285 | 1 286 | 287 | 288 | 289 | 290 | library\lib\mips 291 | 1 292 | 293 | 294 | 295 | 296 | res\drawable 297 | 1 298 | 299 | 300 | 301 | 302 | 1 303 | 304 | 305 | 1 306 | 307 | 308 | 0 309 | 310 | 311 | 312 | 313 | 1 314 | .framework 315 | 316 | 317 | 0 318 | 319 | 320 | 321 | 322 | res\drawable-small 323 | 1 324 | 325 | 326 | 327 | 328 | 329 | 1 330 | 331 | 332 | Contents\MacOS 333 | 0 334 | 335 | 336 | 337 | 338 | classes 339 | 1 340 | 341 | 342 | 343 | 344 | 345 | 1 346 | 347 | 348 | 1 349 | 350 | 351 | 352 | 353 | res\drawable 354 | 1 355 | 356 | 357 | 358 | 359 | Contents\Resources 360 | 1 361 | 362 | 363 | 364 | 365 | 366 | 1 367 | 368 | 369 | 1 370 | 371 | 372 | 373 | 374 | 1 375 | 376 | 377 | library\lib\armeabi-v7a 378 | 1 379 | 380 | 381 | 0 382 | 383 | 384 | 1 385 | 386 | 387 | 1 388 | 389 | 390 | 391 | 392 | library\lib\armeabi 393 | 1 394 | 395 | 396 | 397 | 398 | res\drawable-large 399 | 1 400 | 401 | 402 | 403 | 404 | 0 405 | 406 | 407 | 0 408 | 409 | 410 | 0 411 | 412 | 413 | 0 414 | 415 | 416 | 0 417 | 418 | 419 | 420 | 421 | 1 422 | 423 | 424 | 1 425 | 426 | 427 | 428 | 429 | res\drawable-ldpi 430 | 1 431 | 432 | 433 | 434 | 435 | res\values 436 | 1 437 | 438 | 439 | 440 | 441 | 1 442 | 443 | 444 | 1 445 | 446 | 447 | 448 | 449 | res\drawable-mdpi 450 | 1 451 | 452 | 453 | 454 | 455 | res\drawable-hdpi 456 | 1 457 | 458 | 459 | 460 | 461 | 1 462 | 463 | 464 | 465 | 466 | 467 | 468 | 469 | 470 | 471 | 472 | True 473 | False 474 | 475 | 476 | DUnit / Delphi Win32 477 | GUI 478 | 479 | 480 | 481 | 482 | 12 483 | 484 | 485 | 486 | 487 | 488 | 489 | 496 | --------------------------------------------------------------------------------