MindStream. Как мы пишем ПО под FireMonkey. Часть 3. DUnit + FireMonkey

Часть 1.
Часть 2.

Здравствуйте.

В этой статье я хочу познакомить читателей с процессом переноса 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.VCL\Unit1.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

Мой комментарий к комиту когда я разобрался :)

FSuite, Ещё не создана, так как Application.CreateForm на самом деле, если его не пнуть явно — «не создает сука, нормальных форм, а лишь ссылки на будущие классы. Что соответственно влияет на члены класса, которые совсем не nil, как им бы положено быть»

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. Проект располагается в репозитории MindStream\FMX.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

Часть 3.1