<?xml version="1.0" encoding="utf-8"?> <> <__> <_> < ="SHOPPING_LIST"/> </_> </__> <__/> <> <!-- .--> <>...</> ... <!--2 , .--> <> <_> < ="SHOPPING_LIST"> <> <ID ="">1</ID> <NAME =""> </NAME> <ADD_DATE ="__">1.2.2015</ADD_DATE> </> </> < ="LIST_ITEM"> <> <ID ="">1</ID> <LIST_ID ="">1</LIST_ID> <GOODS_ID ="">107</GOODS_ID> <AMOUNT ="">1</AMOUNT> <ADD_DATE ="__">25.2.2015 15:12</ADD_DATE> </> ... </> </_> < ="RECOMMEND_GOODS_TO_EMPTY_LIST" _=""> <> <_> <TARGET_DATE ="__">16.9.2014</TARGET_DATE> </_> </> ... <> <_> <TARGET_DATE ="__">1.3.2015</TARGET_DATE> </_> <> <> <GOODS_ID ="">107</GOODS_ID> <RECOMMENDATION_ID ="">0</RECOMMENDATION_ID> <ACCURACY ="">0.75</ACCURACY> </> </> </> ... </> </> <>...</> ... </> </>
[TestFixture] TTestSet = class public [SetupFixture] procedure Setup; [TearDownFixture] procedure Teardown; [Setup] procedure TestSetup; [TearDown] procedure TestTeardown; [Test] procedure Test1; [Test] [TestCase(' 1', '1,1')] [TestCase(' 2', '2,2')] procedure Test2(const IntegerParameter: Integer; const StringParameter: string); end;
TTestSet
is a test suite (fixture, in terms of a library) of 2 tests, the second of which will be executed a couple of times - with both specified options of parameters. However, this standard method does not suit us completely, because the number of tests and parameter values are statically set at the compilation stage, and we need to dynamically generate both a list of test cases (one for each XML file) and a list of tests in each of them (taking from the corresponding file on the tag "Test").
unit Tests.XMLFixtureProviderPlugin; interface implementation uses DUnitX.TestFramework, DUnitX.Utils, DUnitX.Extensibility, ... Xml.XMLDoc, {$IFDEF MSWINDOWS} Xml.Win.msxmldom {$ELSE} Xml.omnixmldom {$ENDIF}; type TXMLFixtureProviderPlugin = class(TInterfacedObject, IPlugin) protected procedure GetPluginFeatures(const context: IPluginLoadContext); end; TXMLFixtureProvider = class(TInterfacedObject, IFixtureProvider) protected procedure GenerateTests(const Fixture: ITestFixture; const FileName: string); procedure Execute(const context: IFixtureProviderContext); end; TDBTests = class abstract { , , , «», , . } ... public procedure Setup; virtual; procedure Teardown; virtual; procedure TestSetup; virtual; abstract; procedure TestTeardown; virtual; abstract; procedure Test(const TestIndex: Integer); virtual; abstract; end; TXMLBasedDBTests = class(TDBTests) private const TestsTag = ''; ... private FFileName: string; FXML: TXMLDocument; // , XML. ... public procedure AfterConstruction; override; { AfterConstruction – Setup . : https://github.com/VSoftTechnologies/DUnitX/commit/267111f4feec77d51bf2307a194f44106d499680#diff-745fb4ee38a43631f57d1b6ef88e0ffcR212 } destructor Destroy; override; [SetupFixture] procedure Setup; override; [TearDownFixture] procedure Teardown; override; [Setup] procedure TestSetup; override; [TearDown] procedure TestTeardown; override; [Test] procedure Test(const TestIndex: Integer); override; function DetermineTestIndexes: TArray<Integer>; property FileName: string read FFileName write FFileName; end; // ... initialization TDUnitX.RegisterPlugin(TXMLFixtureProviderPlugin.Create); end.
TXMLFixtureProviderPlugin
and TXMLFixtureProvider
, are needed for embedding plugins into the existing system and are only interesting with the implementation of their methods. The next, TDBTests
, is also of little interest, since by and large it is highlighted in the hierarchy in order to encapsulate the database-specific things, so you should go directly to the heir - TXMLBasedDBTests
. His duties are tied to the stages of his life:
DetermineTestIndexes
method, which returns the indices of the child nodes of the Tests node (see the XML fragment above). With its implementation, it is not possible to do a little blood-just knowing the number of nodes-descendants and returning, conditionally, the sequence of indices from 1 to N — will not work, because, first of all, some of the nodes are comments, and it is also possible to temporarily disable the test (instead of removing it from file).
Setup
Test
is repeatedly executed, to which the indices obtained at the first stage are transmitted. Each of his TestSetup
preceded by TestSetup
, and after completion is followed by TestTeardown
.Teardown
TXMLFixtureProviderPlugin
procedure TXMLFixtureProviderPlugin.GetPluginFeatures(const context: IPluginLoadContext); begin context.RegisterFixtureProvider(TXMLFixtureProvider.Create); end;
TXMLFixtureProvider
procedure TXMLFixtureProvider.Execute(const context: IFixtureProviderContext); var XMLDirectory, XMLFile: string; begin {$IFDEF MSWINDOWS} XMLDirectory := { .}; {$ELSE} XMLDirectory := TPath.GetDocumentsPath; {$ENDIF} for XMLFile in TDirectory.GetFiles(XMLDirectory, '*.xml') do GenerateTests ( context.CreateFixture(TXMLBasedDBTests, TPath.GetFileNameWithoutExtension(XMLFile), ''), XMLFile ); end; procedure TXMLFixtureProvider.GenerateTests(const Fixture: ITestFixture; const FileName: string); procedure FillSetupAndTeardownMethods(const RTTIMethod: TRttiMethod); var Method: TMethod; TestMethod: TTestMethod; begin Method.Data := Fixture.FixtureInstance; Method.Code := RTTIMethod.CodeAddress; TestMethod := TTestMethod(Method); if RTTIMethod.HasAttributeOfType<SetupFixtureAttribute> then Fixture.SetSetupFixtureMethod(RTTIMethod.Name, TestMethod); if RTTIMethod.HasAttributeOfType<TearDownFixtureAttribute> then Fixture.SetTearDownFixtureMethod(RTTIMethod.Name, TestMethod, RTTIMethod.IsDestructor); if RTTIMethod.HasAttributeOfType<SetupAttribute> then Fixture.SetSetupTestMethod(RTTIMethod.Name, TestMethod); if RTTIMethod.HasAttributeOfType<TearDownAttribute> then Fixture.SetTearDownTestMethod(RTTIMethod.Name, TestMethod); end; var XMLTests: TXMLBasedDBTests; RTTIContext: TRttiContext; RTTIMethod: TRttiMethod; TestIndex: Integer; begin XMLTests := Fixture.FixtureInstance as TXMLBasedDBTests; XMLTests.FileName := FileName; RTTIContext := TRttiContext.Create; try for RTTIMethod in RTTIContext.GetType(Fixture.TestClass).GetMethods do begin FillSetupAndTeardownMethods(RTTIMethod); if RTTIMethod.HasAttributeOfType<TestAttribute> then for TestIndex in XMLTests.DetermineTestIndexes do Fixture.AddTestCase( RTTIMethod.Name, TestIndex.ToString, '', '', RTTIMethod, True, [TestIndex] ); end; finally RTTIContext.Free; end; end;
TDBTests
procedure TDBTests.Setup; begin // . ... end; procedure TDBTests.Teardown; begin // . ... end;
TXMLBasedDBTests
procedure TXMLBasedDBTests.AfterConstruction; begin inherited; // FXML. ... FXML.DOMVendor := GetDOMVendor({$IFDEF MSWINDOWS} SMSXML {$ELSE} sOmniXmlVendor {$ENDIF}); // . ... end; destructor TXMLBasedDBTests.Destroy; begin // . ... inherited; end; function TXMLBasedDBTests.DetermineTestIndexes: TArray<Integer>; var TestsNode: IXMLNode; TestIndex: Integer; TestIndexList: TList<Integer>; begin FXML.LoadFromFile(FFileName); try TestsNode := FXML.DocumentElement.ChildNodes[TestsTag]; TestIndexList := TList<Integer>.Create; try for TestIndex := 0 to TestsNode.ChildNodes.Count - 1 do if { ?} then TestIndexList.Add(TestIndex); Result := TestIndexList.ToArray; finally TestIndexList.Free; end; finally FXML.Active := False; end; end; procedure TXMLBasedDBTests.Setup; begin inherited; FXML.LoadFromFile(FFileName); end; procedure TXMLBasedDBTests.Teardown; begin FXML.Active := False; inherited; end; procedure TXMLBasedDBTests.TestSetup; begin inherited; // «__». ... end; procedure TXMLBasedDBTests.TestTeardown; begin inherited; // «__». ... end; procedure TXMLBasedDBTests.Test(const TestIndex: Integer); var TestNode: IXMLNode; begin inherited; TestNode := FXML.DocumentElement.ChildNodes[TestsTag].ChildNodes[TestIndex]; // . ... end;
Source: https://habr.com/ru/post/333548/