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

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

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

    В этой статье я хочу познакомить читателей с процессом переноса VCL кода в FireMonkey. В стандартной поставке Delphi, начиная по-моему с версии 2009, проект DUnit идёт из коробки.

    Однако писался он в далекие времена VCL. И хотя и позволяет тестировать код написанный для FireMonkey (Благодаря консольному выводу), но у него нет «няшного» GUIRunner'a, к которому многие из нас привыкли, ведь в нём очень быстро и легко можно «убрать» те тесты которые мы не хотим запускать «именно сейчас».

    image




    Для тех кто совсем или мало знаком с 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, нажимаем кнопку запуска тестов, в результате чего видим:

    image


    Последнее что нам осталось сделать, это обработать действия пользователя, во время изменения состояния узла:

    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;
    

    Изменим состояние у чекбоксов некоторых узлов:

    image


    Код теста на котором я собственно проводил тестирования:

    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
    Поделиться публикацией
    Похожие публикации
    AdBlock похитил этот баннер, но баннеры не зубы — отрастут

    Подробнее
    Реклама
    Комментарии 0

    Только полноправные пользователи могут оставлять комментарии. Войдите, пожалуйста.