MindStream. Как мы пишем ПО под FireMonkey. Часть 3. DUnit + FireMonkey
Здравствуйте.
В этой статье я хочу познакомить читателей с процессом переноса VCL кода в FireMonkey. В стандартной поставке Delphi, начиная по-моему с версии 2009, проект DUnit идёт из коробки.
Однако писался он в далекие времена VCL. И хотя и позволяет тестировать код написанный для FireMonkey (Благодаря консольному выводу), но у него нет «няшного» GUIRunner'a, к которому многие из нас привыкли, ведь в нём очень быстро и легко можно «убрать» те тесты которые мы не хотим запускать «именно сейчас».
Для тех совсем или мало знаком с DUnit. В обычном режиме из коробки, документация предлагает сделать File->New->Other->Unit Test->TestProject. Далее, Вам необходимо выбрать GUI или консольный вариант. Благодаря этим не столь сложным манипуляциям, у Вас появляется новый проект который должен выглядеть примерно так(по крайне мере «мое» XE7, сгенирировало именно такой код), для GUI:
program Project1Tests;
{
Delphi DUnit Test Project
-------------------------
This project contains the DUnit test framework and the GUI/Console test runners.
Add "CONSOLE_TESTRUNNER" to the conditional defines entry in the project options
to use the console test runner. Otherwise the GUI test runner will be used by
default.
}
{$IFDEF CONSOLE_TESTRUNNER}
{$APPTYPE CONSOLE}
{$ENDIF}
uses
DUnitTestRunner,
TestUnit1 in 'TestUnit1.pas',
Unit1 in '..DUnit.VCLUnit1.pas';
{$R *.RES}
begin
DUnitTestRunner.RunRegisteredTests;
end.
Следом добавляем TestCase, делается это также(File->New->Other->Unit Test->TestCase), в результате должно быть что-то похожее:
unit TestUnit1;
{
Delphi DUnit Test Case
----------------------
This unit contains a skeleton test case class generated by the Test Case Wizard.
Modify the generated code to correctly setup and call the methods from the unit
being tested.
}
interface
uses
TestFramework, System.SysUtils, Vcl.Graphics, Winapi.Windows, System.Variants,
System.Classes, Vcl.Dialogs, Vcl.Controls, Vcl.Forms, Winapi.Messages, Unit1;
type
// Test methods for class TForm1
TestTForm1 = class(TTestCase)
strict private
FForm1: TForm1;
public
procedure SetUp; override;
procedure TearDown; override;
published
procedure TestDoIt;
end;
implementation
procedure TestTForm1.SetUp;
begin
FForm1 := TForm1.Create;
end;
procedure TestTForm1.TearDown;
begin
FForm1.Free;
FForm1 := nil;
end;
procedure TestTForm1.TestDoIt;
var
ReturnValue: Integer;
begin
ReturnValue := FForm1.DoIt;
// TODO: Validate method results
end;
initialization
// Register any test cases with the test runner
RegisterTest(TestTForm1.Suite);
end.
В целом мой пример показывает как легко добавить тестирование, даже для Делфи7. Всё что нам надо, это — вызвать DUnitTestRunner.RunRegisteredTests;. И добавить новые файлы с TestCase в проект. Более детально вопрос тестирования с помощью DUnit рассмотрен тут.
Для реализации я решил, что необходимо просто повторить ребят которые делали DUnit.
Первая проблема(То, что TTreeNode, и TTreeViewItem «совсем не братья» даже говорить не буду, документация всех спасет) с которой я столкнулся была тут:
type
TfmGUITestRunner = class(TForm)
...
protected
FSuite: ITest;
procedure SetSuite(Value: ITest);
...
public
property Suite: ITest read FSuite write SetSuite;
end;
procedure RunTestModeless(aTest: ITest);
var
l_GUI: TfmGUITestRunner;
begin
Application.CreateForm(TfmGUITestRunner, l_GUI);
l_GUI.Suite := aTest;
l_GUI.Show;
end;
procedure TfmGUITestRunner.SetSuite(Value: ITest);
begin
FSuite := Value; // AV здесь
if FSuite <> nil then
InitTree;
end;
Проблема как всегда, “узнается” в дебаге, ну или в документации:). В FireMonkey — Application.CreateForm();, не создает форму. Да, как ни странно. TApplication.CreateForm
AV вылезет в System._IntfCopy(var Dest: IInterface; const Source: IInterface);
А вылезет потому что у нас в Dest будет мусор, а не interface или nil. И проявится это когда мы у предыдущего интерфейса(если он не // nil) будем вычитать 1.
Даже если мы такую строчку пропишем, это до фени
FSuite := nil;
Вот ещё одна ссылка по этому вопросу — . It doesn’t do what it says it does! Я если честно, тоже был немного в шоке, от того что метод который называется «СделатьФорму», не делает её.
Решаем проблему созданием форм явно(l_GUI := TfmGUITestRunner.create(nil) ;) и идём дальше.
Теперь нам необходимо построить дерево тестов на основе TestCase'оф которые добавлены для тестирования. Если Вы обратили внимание, то процесс построения формы начинается с метода RunRegisteredTestsModeless:
procedure RunRegisteredTestsModeless;
begin
RunTestModeless(registeredTests)
end;
Я решил не выносить этот метод в отдельный модуль, как создатели DUnit, поэтому для подключения fmGUITestRunner, вам необходимо указать модуль в коде проекта, ну и собственно вызвать нужный метод. В моем случае код проекта выглядит так:
program FMX.DUnit;
uses
FMX.Forms,
// Форма тестирования
u_fmGUITestRunner in 'u_fmGUITestRunner.pas' {fmGUITestRunner},
// Тесты
u_FirstTest in 'u_FirstTest.pas',
u_TCounter in 'u_TCounter.pas',
u_SecondTest in 'u_SecondTest.pas';
{$R *.res}
begin
Application.Initialize;
// Вызываем метод который я описал
u_fmGUITestRunner.RunRegisteredTestsModeless;
Application.Run;
end.
Внимательный читатель, обратит внимание, что никаких registeredTests мы не добавляли, и совсем нигде не указывали какие тесты будут у нас добавляться. RegisteredTests это «глобальный» метод TestFrameWork, который подключен к нашей форме, возвращает он глобальную переменную — __TestRegistry: ITestSuite;
То как TestCase «попадают» в эту переменную, я оставлю за рамками этой статьи, тем более, что работу провели создатели DUnit. Однако если читатели изъявят интерес к этой теме, то отвечу в коментах. Итак, вернёмся к дереву. Метод для инициализации дерева:
procedure TfmGUITestRunner.InitTree;
begin
FTests.Clear;
FillTestTree(Suite);
TestTree.ExpandAll;
end;
FTests, это список интерфейсных объектов который будет хранить список наших тестов. В свою очередь метод FillTestTree, является перегруженным, сделано это, так как мы не знаем, c корневым элементом дерева мы работаем, или с обычным узлом:
...
procedure FillTestTree(aTest: ITest); overload;
procedure FillTestTree(aRootNode: TTreeViewItem; aTest: ITest); overload;
...
procedure TfmGUITestRunner.FillTestTree(aRootNode: TTreeViewItem; aTest: ITest);
var
l_TestTests: IInterfaceList;
l_Index: Integer;
l_TreeViewItem: TTreeViewItem;
begin
if aTest = nil then
Exit;
l_TreeViewItem := TTreeViewItem.Create(self);
l_TreeViewItem.IsChecked := True;
// Добавляем тест в список, и в свойстве Tag сохраняем его индекс. Опыт работы с БД из прошлой работы :)
l_TreeViewItem.Tag := FTests.Add(aTest);
l_TreeViewItem.Text := aTest.Name;
// Тут я думаю, всё ясно
if aRootNode = nil then
TestTree.AddObject(l_TreeViewItem)
else
aRootNode.AddObject(l_TreeViewItem);
// ITest, содержит метод Tests, который является списком(IInterfaceList) "вложенных" тестов
// Рекурсивно проходимся по всем тестам
l_TestTests := aTest.Tests;
for l_Index := 0 to l_TestTests.Count - 1 do
FillTestTree(l_TreeViewItem, l_TestTests[l_Index] as ITest);
end;
Как видим, в методе мы не только заполнили дерево, но и дали информацию каждому узлу, какой из тестов ему соответствует. Для того что бы получить тест по узлу, напишем метод NodeToTest:
function TfmGUITestRunner.NodeToTest(aNode: TTreeViewItem): ITest;
var
l_Index: Integer;
begin
assert(aNode.Tag >= 0);
l_Index := aNode.Tag;
Result := FTests[l_Index] as ITest;
end;
Теперь добавим «знаний» тестам. В каждом тесте есть переменная GUIObject, типа TObject. SetupGUINodes мы будем вызывать на FormShow.
procedure TfmGUITestRunner.SetupGUINodes(aNode: TTreeViewItem);
var
l_Test: ITest;
l_Index: Integer;
begin
for l_Index := 0 to Pred(aNode.Count) do
begin
// Получаем тест
l_Test := NodeToTest(aNode.Items[l_Index]);
assert(assigned(l_Test));
// Ассоциируем тест с необходимым узлом
l_Test.GUIObject := aNode.Items[l_Index];
SetupGUINodes(aNode.Items[l_Index]);
end;
end;
Для того что-бы получить узел из теста напишем метод:
function TfmGUITestRunner.TestToNode(test: ITest): TTreeViewItem;
begin
assert(assigned(test));
Result := test.GUIObject as TTreeViewItem;
assert(assigned(Result));
end;
То как я «связал» тесты с деревом, мне, да и старшему коллеге не понравилось. Зачем таким путем пошли разработчики DUnit, я догадываюсь. DUnit писался давно, и никаких Generic'ов тогда не было. В будущем мы конечно же это переделаем. В конце статьи я напишу о наших следующих доработках и «хотелках».
Итак — наше дерево строится, тесты находятся в FTests. Тесты и дерево связаны между собой. Пришло время запустить тесты, и обработать результаты. Для того что форма умела это делать, добавим ей реализацию интерфейса ITestListener, описанного в TestFrameWork:
{ ITestListeners get notified of testing events.
See TTestResult.AddListener()
}
ITestListener = interface(IStatusListener)
['{114185BC-B36B-4C68-BDAB-273DBD450F72}']
procedure TestingStarts;
procedure StartTest(test: ITest);
procedure AddSuccess(test: ITest);
procedure AddError(error: TTestFailure);
procedure AddFailure(Failure: TTestFailure);
procedure EndTest(test: ITest);
procedure TestingEnds(testResult :TTestResult);
function ShouldRunTest(test :ITest):Boolean;
end;
Добавим эти методы в описание класса, и реализуем их:
procedure TfmGUITestRunner.TestingStarts;
begin
FTotalTime := 0;
end;
procedure TfmGUITestRunner.StartTest(aTest: ITest);
var
l_Node: TTreeViewItem;
begin
assert(assigned(TestResult));
assert(assigned(aTest));
l_Node := TestToNode(aTest);
assert(assigned(l_Node));
end;
procedure TfmGUITestRunner.AddSuccess(aTest: ITest);
begin
assert(assigned(aTest));
SetTreeNodeFont(TestToNode(aTest), c_ColorOk)
end;
procedure TfmGUITestRunner.AddError(aFailure: TTestFailure);
var
l_ListViewItem: TListViewItem;
begin
SetTreeNodeFont(TestToNode(aFailure.failedTest), c_ColorError);
l_ListViewItem := AddFailureNode(aFailure);
end;
procedure TfmGUITestRunner.AddFailure(aFailure: TTestFailure);
var
l_ListViewItem: TListViewItem;
begin
SetTreeNodeFont(TestToNode(aFailure.failedTest), c_ColorFailure);
l_ListViewItem := AddFailureNode(aFailure);
end;
procedure TfmGUITestRunner.EndTest(test: ITest);
begin
// Закоментил, потому как тут надо обновлять общую информацию о результатах
// тестов. А нам пока нечего показывать.
// И если будет утверждение, то после первого захода сюда, результаты не отображаются
// Пока так, однозначно TODO
// assert(False);
end;
procedure TfmGUITestRunner.TestingEnds(aTestResult: TTestResult);
begin
FTotalTime := aTestResult.TotalTime;
end;
function TfmGUITestRunner.ShouldRunTest(aTest: ITest): Boolean;
var
l_Test: ITest;
begin
// Метод проверяет, стоит ли запускать тест. То как тесты "узнают" о "доступности" опишу ниже
l_Test := aTest;
Result := l_Test.Enabled
end;
Объяснять тут особо нечего. Хотя если будут вопросы, то детально отвечу. В оригинале DUnitRunner при «получении» результата теста, менял картинку у соответствующего узла дерева. Я решил с картинками не морочиться, потому как из коробки их теперь нету, да и добавление картинки к узлу как-то заморочено сделано через стили. Поэтому решил ограничиться изменением FontColor и FontStyle для каждого узла.
Вроде делов на 1 минуту, а потратил пару часов, перекопав всю документацию:
procedure TfmGUITestRunner.SetTreeNodeFont(aNode: TTreeViewItem;
aColor: TAlphaColor);
begin
// Пока не укажешь какие из настроек стиля разрешены к работе, они работать не будут
aNode.StyledSettings := aNode.StyledSettings - [TStyledSetting.ssFontColor, TStyledSetting.ssStyle];
aNode.Font.Style := [TFontStyle.fsBold];
aNode.FontColor := aColor;
end;
Для вывода результатов будем использовать ListView. Особенности TListView в FireMonkey таковы, что список полностью заточен под мобильные приложения. И лишился замечательного свойства Columns. Для добавления ошибок добавим метод AddFailureNode:
function TfmGUITestRunner.AddFailureNode(aFailure: TTestFailure): TListViewItem;
var
l_Item: TListViewItem;
l_Node: TTreeViewItem;
begin
assert(assigned(aFailure));
l_Item := lvFailureListView.Items.Add;
l_Item.Text := aFailure.failedTest.Name + '; ' +
aFailure.thrownExceptionName + '; ' +
aFailure.thrownExceptionMessage + '; ' +
aFailure.LocationInfo + '; ' +
aFailure.AddressInfo + '; ' +
aFailure.StackTrace;
l_Node := TestToNode(aFailure.failedTest);
while l_Node <> nil do
begin
l_Node.Expand;
l_Node := l_Node.ParentItem;
end;
Result := l_Item;
end;
Пора запустить наши тесты, для чего добавим кнопку и метод запуска:
procedure TfmGUITestRunner.btRunAllTestClick(Sender: TObject);
begin
if Suite = nil then
Exit;
ClearResult;
RunTheTest(Suite);
end;
procedure TfmGUITestRunner.RunTheTest(aTest: ITest);
begin
TestResult := TTestResult.Create;
try
TestResult.addListener(self);
aTest.run(TestResult);
finally
FreeAndNil(FTestResult);
end;
end;
Запускаем наш Runner, нажимаем кнопку запуска тестов, в результате чего видим:
Последнее что нам осталось сделать, это обработать действия пользователя, во время изменения состояния узла:
procedure TfmGUITestRunner.TestTreeChangeCheck(Sender: TObject);
begin
SetNodeEnabled(Sender as TTreeViewItem, (Sender as TTreeViewItem).IsChecked);
end;
procedure TfmGUITestRunner.SetNodeEnabled(aNode: TTreeViewItem;
aValue: Boolean);
var
l_Test: ITest;
begin
l_Test := NodeToTest(aNode);
if l_Test <> nil then
l_Test.Enabled := aValue;
end;
Изменим состояние у чекбоксов некоторых узлов:
Код теста на котором я собственно проводил тестирования:
unit u_SecondTest;
interface
uses
TestFrameWork;
type
TSecondTest = class(TTestCase)
published
procedure DoIt;
procedure OtherDoIt;
procedure ErrorTest;
procedure SecondErrorTest;
end; // TFirstTest
implementation
procedure TSecondTest.DoIt;
begin
Check(true);
end;
procedure TSecondTest.ErrorTest;
begin
raise ExceptionClass.Create('Error Message');
end;
procedure TSecondTest.OtherDoIt;
begin
Check(true);
end;
procedure TSecondTest.SecondErrorTest;
begin
Check(False);
end;
initialization
TestFrameWork.RegisterTest(TSecondTest.Suite);
end.
Подведём итоги — на данном этапе, мы получили вполне рабочее приложение для тестирования кода FireMonkey, используя привычный GUIRunner. Проект открытый, так что пользоваться могут все желающие.
Планы на будущее:
Написать метод обхода дерева который будет получать лямбду. Дерево приходится обходить постоянно, а вот действия с каждой веткой разные, поэтому лямбда мне кажется уместной.
Замечания и предложения, от моего старшего коллеги:
Переделать связь Тест-Узел на TDictionary<TTreeViewItem, ITest> docwiki.embarcadero.com/Libraries/XE7/en/System.Generics.Collections.TDictionary
Добавить графический индикатор “прохода тестов”. Кнопки — выделить всё, снять всё и т.д. а также вывод результатов тестирования(время выполнения, количество успешных и провальных и т.д).
Добавить паттерн Декоратор для избавления от «костыля» GUIObject.
В ближайшем будущем мы начнем покрывать тестами наш основной проект — MindStream, а также по чуть-чуть будем доводить до ума Runner. Спасибо всем кто дочитал до конца. Замечания и критика, как всегда приветствуются в комментариях.
p.s. Проект располагается в репозитории MindStreamFMX.DUnit
Ссылки которые я нашел, и которые мне пригодились в процессе:
sourceforge.net/p/radstudiodemos/code/HEAD/tree/branches/RadStudio_XE5_Update/FireMonkey/Delphi/
fire-monkey.ru/
18delphi.blogspot.ru/
www.gunsmoker.ru/
GUI-тестирование «по-русски». Заметка об уровнях тестирования
Ещё раз об «уровнях тестирования»
ну и конечно
docwiki.embarcadero.com/RADStudio/XE7/en/Main_Page
Автор: instigator21
