В предыдущем материале «Выбор СУБД для мобильного Delphi-приложения», как следует из его названия, был показан первый этап в разработке той подсистемы приложения, что отвечает за хранение и бо?льшую часть обработки его данных; уточнение про «бо?льшую часть» сделано неспроста, т. к. в итоге обозначенный выбор пал на СУБД Interbase именно из-за возможности применять хранимые процедуры (ХП), которые и стали сосредоточением основной логики по работе с данными, оставляя за Делфи-кодом несложную задачу по их вызову.
Для лучшего понимания необходимости тестирования в данном конкретном случае, нужно отметить, что в описанном проекте изначально была задана довольно высокая планка качества, поддержание которой в части функционала, реализованного в процедурах, достиглось, в том числе, за счёт автотестов, проверяющих ключевые ХП (они ответственны за критический для приложения функционал – систему рекомендаций). Именно один из способов организации такого тестирования – на основе DUnitX и XML – и является предметом статьи.
<?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
– это тестовый набор (fixture, в терминах библиотеки) из 2-х тестов, второй из которых выполнится пару раз – с обоими указанными вариантами параметров. Однако полностью такой стандартный способ нам не подходит, потому что количество тестов и значения параметров к ним задаются статически, на этапе компиляции, а требуется формировать динамически как перечень тестовых наборов (по одному на каждый XML-файл), так и список тестов в каждом из них (беря из соответствующего файла по тегу «Тест»).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
и TXMLFixtureProvider
, нужны для встраивания в существующую систему плагинов и интересны только реализацией своих методов. Следующий, TDBTests
, тоже малоинтересен, т. к. по большому счёту выделен в иерархии с целью инкапсулировать БД-специфичные вещи, поэтому стоит перейти сразу к наследнику – TXMLBasedDBTests
. Его обязанности привязаны к этапам его жизни:DetermineTestIndexes
, возвращающего индексы дочерних узлов узла «Тесты» (см. XML-фрагмент выше). При его реализации обойтись малой кровью – просто узнав количество узлов-потомков и вернув, условно, последовательность индексов от 1 до N – не получится, потому что, прежде всего, некоторые узлы являются комментариями, а также возможно временное отключение теста (вместо его удаления из файла).Setup
Test
, которому передаются полученные на первом этапе индексы. Каждому его вызову предшествует TestSetup
, а после завершения следует 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;
К сожалению, не доступен сервер mySQL