MindStream. Как мы пишем ПО под FireMonkey. Часть 5. Тестирование16.01.2015 07:48

Часть 1.Часть 2.Часть 3. DUnit + FireMonkeyЧасть 3.1. По мотивам GUIRunnerЧасть 4. SerializationЗдравствуйте, дорогие хабровчане.

В этом посте я хочу рассказать об изменениях, которые произошли с нашим проектом, а также о технологиях и приемах, которые мы использовали для достижения наших целей.

Сейчас наш проект выглядит так:

Диаграмму можно сохранить в Json, а также восстановить из Json, о чём я писал в предыдущей статье.

Json картинки, нарисованной ниже и сохраненной в PNG благодаря программе: { «type»: «msDiagramms.TmsDiagramms», «id»: 1, «fields»: { «f_Items»: [{ «type»: «msDiagramm.TmsDiagramm», «id»: 2, «fields»: { «fName»:»¹1», «f_Items»: [{ «type»: «msRoundedRectangle.TmsRoundedRectangle», «id»: 3, «fields»: { «FStartPoint»: [[110, 186], 110, 186], «f_Items»: [] } }, { «type»: «msRoundedRectangle.TmsRoundedRectangle», «id»: 4, «fields»: { «FStartPoint»: [[357, 244], 357, 244], «f_Items»: [] } }, { «type»: «msTriangle.TmsTriangle», «id»: 5, «fields»: { «FStartPoint»: [[244, 58], 244, 58], «f_Items»: [] } }, { «type»: «msLineWithArrow.TmsLineWithArrow», «id»: 6, «fields»: { «FFinishPoint»: [[236, 110], 236, 110], «FStartPoint»: [[156, 175], 156, 175], «f_Items»: [] } }, { «type»: «msLineWithArrow.TmsLineWithArrow», «id»: 7, «fields»: { «FFinishPoint»: [[262, 109], 262, 109], «FStartPoint»: [[327, 199], 327, 199], «f_Items»: [] } }, { «type»: «msUseCaseLikeEllipse.TmsUseCaseLikeEllipse», «id»: 8, «fields»: { «FStartPoint»: [[52, 334], 52, 334], «f_Items»: [] } }, { «type»: «msUseCaseLikeEllipse.TmsUseCaseLikeEllipse», «id»: 9, «fields»: { «FStartPoint»: [[171, 336], 171, 336], «f_Items»: [] } }, { «type»: «msLineWithArrow.TmsLineWithArrow», «id»: 10, «fields»: { «FFinishPoint»: [[98, 232], 98, 232], «FStartPoint»: [[62, 300], 62, 300], «f_Items»: [] } }, { «type»: «msLineWithArrow.TmsLineWithArrow», «id»: 11, «fields»: { «FFinishPoint»: [[133, 233], 133, 233], «FStartPoint»: [[167, 299], 167, 299], «f_Items»: [] } }, { «type»: «msRectangle.TmsRectangle», «id»: 12, «fields»: { «FStartPoint»: [[302, 395], 302, 395], «f_Items»: [] } }, { «type»: «msRectangle.TmsRectangle», «id»: 13, «fields»: { «FStartPoint»: [[458, 389], 458, 389], «f_Items»: [] } }, { «type»: «msLineWithArrow.TmsLineWithArrow», «id»: 14, «fields»: { «FFinishPoint»: [[361, 292], 361, 292], «FStartPoint»: [[308, 351], 308, 351], «f_Items»: [] } }, { «type»: «msLineWithArrow.TmsLineWithArrow», «id»: 15, «fields»: { «FFinishPoint»: [[389, 292], 389, 292], «FStartPoint»: [[455, 344], 455, 344], «f_Items»: [] } }, { «type»: «msCircle.TmsCircle», «id»: 16, «fields»: { «FStartPoint»: [[58, 51], 58, 51], «f_Items»: [] } }, { «type»: «msLineWithArrow.TmsLineWithArrow», «id»: 17, «fields»: { «FFinishPoint»: [[88, 94], 88, 94], «FStartPoint»: [[108, 141], 108, 141], «f_Items»: [] } }] } }] } } Каждая фигура стала обладать возможностью «быть диаграммой». То есть, мы можем выбрать фигуру и построить «внутри» новую диаграмму. Более наглядно продемонстрировано ниже.

Объект TmsPicker отвечает за возможность «проваливания внутрь». Объект TmsUpToParrent отвечает за возвращение к родительской диаграмме.

Также у нас появился ToolBar, в котором динамически рисуются все фигуры, предназначенные для рисования, и реализована возможность создавать специальные фигуры, например, для объекта перемещения (под красным квадратом):

Также нами был реализован контроль за созданием\освобождением объектов. Детальное описаниетут.После окончания работы приложения получаем такой лог:

MindStream.exe.objects.log Неосвобождено объектов: 0TmsPaletteShape Неосвобождено: 0 Максимально распределено: 5TmsPaletteShapeCreator Неосвобождено: 0 Максимально распределено: 1TmsUpArrow Неосвобождено: 0 Максимально распределено: 1TmsDashDotLine Неосвобождено: 0 Максимально распределено: 164TmsLine Неосвобождено: 0 Максимально распределено: 278TmsRectangle Неосвобождено: 0 Максимально распределено: 144TmsCircle Неосвобождено: 0 Максимально распределено: 908TmsLineWithArrow Неосвобождено: 0 Максимально распределено: 309TmsDiagrammsController Неосвобождено: 0 Максимально распределено: 1TmsStringList Неосвобождено: 0 Максимально распределено: 3TmsCompletedShapeCreator Неосвобождено: 0 Максимально распределено: 2TmsRoundedRectangle Неосвобождено: 0 Максимально распределено: 434TmsTriangleDirectionRight Неосвобождено: 0 Максимально распределено: 5TmsGreenCircle Неосвобождено: 0 Максимально распределено: 850TmsSmallTriangle Неосвобождено: 0 Максимально распределено: 761TmsShapeCreator Неосвобождено: 0 Максимально распределено: 1TmsDashLine Неосвобождено: 0 Максимально распределено: 868TmsGreenRectangle Неосвобождено: 0 Максимально распределено: 759TmsDiagramm Неосвобождено: 0 Максимально распределено: 910TmsDownArrow Неосвобождено: 0 Максимально распределено: 1TmsDotLine Неосвобождено: 0 Максимально распределено: 274TmsDiagramms Неосвобождено: 0 Максимально распределено: 3TmsDiagrammsHolder Неосвобождено: 0 Максимально распределено: 18TmsPointCircle Неосвобождено: 0 Максимально распределено: 717TmsUseCaseLikeEllipse Неосвобождено: 0 Максимально распределено: 397TmsBlackTriangle Неосвобождено: 0 Максимально распределено: 43TmsRedRectangle Неосвобождено: 0 Максимально распределено: 139TmsMoverIcon Неосвобождено: 0 Максимально распределено: 220TmsTriangle Неосвобождено: 0 Максимально распределено: 437

Ну и самое главное, часть кода мы покрыли тестами. На сегодняшний день их 174.

При этом на тестах сохранения в PNG рождаются такие рисунки:

Размер «эталона» проверки рисований красного круга: 1048×2049 пикселей. Размер файла 1.7 MB.Однако о деталях дальше.Начнем в обратном порядке.

Тесты.

Первым делом подключим DUnit к проекту. Для этого добавим одну строчку в проект, после чего он выглядит так:

program MindStream;

uses FMX.Forms, … ;

begin Application.Initialize; Application.CreateForm (TfmMain, fmMain); // Подключаем свой GUI_Runner, который в свою очередь найдет все зарегестрированные тесты u_fmGUITestRunner.RunRegisteredTestsModeless; Application.Run; end. Теперь проверим работоспособность DUnit с помощью FirstTest. unit FirstTest;

interface

uses TestFrameWork;

type TFirstTest = class (TTestCase) published procedure DoIt; end; // TFirstTest

implementation

uses SysUtils;

procedure TFirstTest.DoIt; begin Check (true); end;

initialization

TestFrameWork.RegisterTest (TFirstTest.Suite);

end. Следующим шагом добавим первые тесты, однако сразу разделим их по классификации: интеграционные; модульные.Начнем с интеграционных. Первым тестом узнаем, все ли наши фигуры зарегистрированы:

unit RegisteredShapesTest;

interface

uses TestFrameWork;

type TRegisteredShapesTest = class (TTestCase) published procedure ShapesRegistredCount; procedure TestFirstShape; procedure TestIndexOfTmsLine; end; // TRegisteredShapesTest

implementation

uses SysUtils, msRegisteredShapes, msShape, msLine, FMX.Objects, FMX.Graphics;

procedure TRegisteredShapesTest.ShapesRegistredCount; var l_Result: integer; begin l_Result:= 0; TmsRegisteredShapes.IterateShapes ( procedure (aShapeClass: RmsShape) begin Inc (l_Result); end); CheckTrue (l_Result = 23, ' Expected 23 — Get ' + IntToStr (l_Result)); end;

procedure TRegisteredShapesTest.TestFirstShape; begin CheckTrue (TmsRegisteredShapes.Instance.First = TmsLine); end;

procedure TRegisteredShapesTest.TestIndexOfTmsLine; begin CheckTrue (TmsRegisteredShapes.Instance.IndexOf (TmsLine) = 0); end;

initialization TestFrameWork.RegisterTest (TRegisteredShapesTest.Suite); end. Ещё два подобных теста напишем для проверки количества фигур, которые нам необходимы: … type TUtilityShapesTest = class (TTestCase) published procedure ShapesRegistredCount; procedure TestFirstShape; procedure TestIndexOfTmsLine; end; // TUtilityShapesTest … procedure TUtilityShapesTest.ShapesRegistredCount; var l_Result: integer; begin l_Result:= 0; TmsUtilityShapes.IterateShapes ( procedure (aShapeClass: RmsShape) begin Assert (aShapeClass.IsForToolbar); Inc (l_Result); end); CheckTrue (l_Result = 5, ' Expected 5 — Get ' + IntToStr (l_Result)); end; … TForToolbarShapesTest = class (TTestCase) published procedure ShapesRegistredCount; procedure TestFirstShape; procedure TestIndexOfTmsLine; end; // TForToolbarShapesTest

procedure TForToolbarShapesTest.ShapesRegistredCount; var l_Result: integer; begin l_Result:= 0; TmsShapesForToolbar.IterateShapes ( procedure (aShapeClass: RmsShape) begin Assert (aShapeClass.IsForToolbar); Inc (l_Result); end); CheckTrue (l_Result = 18, ' Expected 18 — Get ' + IntToStr (l_Result)); end; Теперь перейдем к модульным.Для начала напишем базовый класс модульного теста. type TmsShapeClassCheck = TmsShapeClassLambda;

TmsDiagrammCheck = reference to procedure (const aDiagramm: ImsDiagramm); TmsDiagrammSaveTo = reference to procedure (const aFileName: String; const aDiagramm: ImsDiagramm);

// контекст тестирования хранит в себе всю уникальную информацию для каждого теста TmsShapeTestContext = record rMethodName: string; rSeed: Integer; rDiagrammName: String; rShapesCount: Integer; rShapeClass: RmsShape; constructor Create (aMethodName: string; aSeed: Integer; aDiagrammName: string; aShapesCount: Integer; aShapeClass: RmsShape); end; // TmsShapeTestContext

TmsShapeTestPrim = class abstract (TTestCase) protected // контекст тестирования хранит в себе всю уникальную информацию для каждого теста f_Context: TmsShapeTestContext; f_TestSerializeMethodName: String; f_Coords: array of TPoint; protected class function ComputerName: AnsiString; function TestResultsFileName: String; virtual; function MakeFileName (const aTestName: string; const aTestFolder: string): String; virtual; procedure CreateDiagrammAndCheck (aCheck: TmsDiagrammCheck; const aName: String); // Процедура проверки результатов теста с эталонном procedure CheckFileWithEtalon (const aFileName: String); procedure SaveDiagramm (const aFileName: String; const aDiagramm: ImsDiagramm); virtual; procedure SaveDiagrammAndCheck (const aDiagramm: ImsDiagramm; aSaveTo: TmsDiagrammSaveTo); procedure OutToFileAndCheck (aLambda: TmsLogLambda); procedure SetUp; override; function ShapesCount: Integer; procedure CreateDiagrammWithShapeAndSaveAndCheck; function TestSerializeMethodName: String; procedure DeserializeDiargammAndCheck (aCheck: TmsDiagrammCheck); procedure TestDeSerializeForShapeClass; procedure TestDeSerializeViaShapeCheckForShapeClass; public class procedure CheckShapes (aCheck: TmsShapeClassCheck); constructor Create (const aContext: TmsShapeTestContext); end; // TmsShapeTestPrim

function TmsShapeTestPrim.MakeFileName (const aTestName: string; const aTestFolder: string): String; var l_Folder: String; begin l_Folder:= ExtractFilePath (ParamStr (0)) + 'TestResults\' + aTestFolder; ForceDirectories (l_Folder); Result:= l_Folder + ClassName + '_' + aTestName + '_' + f_Context.rShapeClass.ClassName; end;

procedure TmsShapeTestPrim.CheckFileWithEtalon (const aFileName: String); var l_FileNameEtalon: String; begin l_FileNameEtalon:= aFileName + '.etalon' + ExtractFileExt (aFileName); if FileExists (l_FileNameEtalon) then begin CheckTrue (msCompareFiles (l_FileNameEtalon, aFileName)); end // FileExists (l_FileNameEtalon) else begin CopyFile (PWideChar (aFileName), PWideChar (l_FileNameEtalon), True); end; // FileExists (l_FileNameEtalon) end;

const c_JSON = 'JSON\';

function TmsShapeTestPrim.TestResultsFileName: String; begin Result:= MakeFileName (Name, c_JSON); end;

class function TmsShapeTestPrim.ComputerName: AnsiString; var l_CompSize: Integer; begin l_CompSize:= MAX_COMPUTERNAME_LENGTH + 1; SetLength (Result, l_CompSize);

Win32Check (GetComputerNameA (PAnsiChar (Result), LongWord (l_CompSize))); SetLength (Result, l_CompSize); end;

procedure TmsShapeTestPrim.SaveDiagramm (const aFileName: String; const aDiagramm: ImsDiagramm); begin aDiagramm.SaveTo (aFileName); end;

procedure TmsShapeTestPrim.SaveDiagrammAndCheck (const aDiagramm: ImsDiagramm; aSaveTo: TmsDiagrammSaveTo); var l_FileNameTest: String; begin l_FileNameTest:= TestResultsFileName; aSaveTo (l_FileNameTest, aDiagramm); CheckFileWithEtalon (l_FileNameTest); end;

function TmsShapeTestPrim.ShapesCount: Integer; begin Result:= f_Context.rShapesCount; end;

constructor TmsShapeTestContext.Create (aMethodName: string; aSeed: Integer; aDiagrammName: string; aShapesCount: Integer; aShapeClass: RmsShape); begin rMethodName:= aMethodName; rSeed:= aSeed; rDiagrammName:= aDiagrammName; rShapesCount:= aShapesCount; rShapeClass:= aShapeClass; end;

procedure TmsShapeTestPrim.SetUp; var l_Index: Integer; l_X: Integer; l_Y: Integer; begin inherited; RandSeed:= f_Context.rSeed; SetLength (f_Coords, ShapesCount); for l_Index:= 0 to Pred (ShapesCount) do begin l_X:= Random (c_MaxCanvasWidth); l_Y:= Random (c_MaxCanvasHeight); f_Coords[l_Index] := TPoint.Create (l_X, l_Y); end; // for l_Index end;

procedure TmsShapeTestPrim.CreateDiagrammAndCheck (aCheck: TmsDiagrammCheck; const aName: String); var l_Diagramm: ImsDiagramm; begin l_Diagramm:= TmsDiagramm.Create (aName); try aCheck (l_Diagramm); finally l_Diagramm:= nil; end; // try…finally end;

procedure TmsShapeTestPrim.CreateDiagrammWithShapeAndSaveAndCheck; begin CreateDiagrammAndCheck ( procedure (const aDiagramm: ImsDiagramm) var l_P: TPoint; begin for l_P in f_Coords do aDiagramm.AddShape (TmsCompletedShapeCreator.Create (f_Context.rShapeClass) .CreateShape (TmsMakeShapeContext.Create (TPointF.Create (l_P.X, l_P.Y), nil, nil))).AddNewDiagramm;

SaveDiagrammAndCheck (aDiagramm, SaveDiagramm); end, f_Context.rDiagrammName); end;

function TmsCustomShapeTest.MakeFileName (const aTestName: string; const aFileExtension: string): String; begin Result:= inherited + '.json'; end;

function TmsShapeTestPrim.TestSerializeMethodName: String; begin Result:= f_TestSerializeMethodName + 'TestSerialize'; end;

procedure TmsShapeTestPrim.DeserializeDiargammAndCheck (aCheck: TmsDiagrammCheck); begin CreateDiagrammAndCheck ( procedure (const aDiagramm: ImsDiagramm) begin aDiagramm.LoadFrom (MakeFileName (TestSerializeMethodName, c_JSON)); // — берём результаты от ПРЕДЫДУЩИХ тестов, НЕКОШЕРНО с точки зрения TDD // НО! Чертовски эффективно. aCheck (aDiagramm); end, ''); end;

procedure TmsShapeTestPrim.TestDeSerializeForShapeClass; begin DeserializeDiargammAndCheck ( procedure (const aDiagramm: ImsDiagramm) begin SaveDiagrammAndCheck (aDiagramm, SaveDiagramm); end); end;

constructor TmsShapeTestPrim.Create (const aContext: TmsShapeTestContext); begin inherited Create (aContext.rMethodName); f_Context:= aContext; FTestName:= f_Context.rShapeClass.ClassName + '.' + aContext.rMethodName; f_TestSerializeMethodName:= f_Context.rShapeClass.ClassName + '.'; end;

procedure TmsShapeTestPrim.TestDeSerializeViaShapeCheckForShapeClass; begin DeserializeDiargammAndCheck ( procedure (const aDiagramm: ImsDiagramm) var l_Shape: ImsShape; l_Index: Integer; begin Check (aDiagramm.Name = f_Context.rDiagrammName); Check (Length (f_Coords) = aDiagramm.ItemsCount); l_Index:= 0; for l_Shape in aDiagramm do begin Check (l_Shape.ClassType = f_Context.rShapeClass); Check (l_Shape.StartPoint.X = f_Coords[l_Index].X); Check (l_Shape.StartPoint.Y = f_Coords[l_Index].Y); Inc (l_Index); end; // for l_Shape end); end;

procedure TmsShapeTestPrim.OutToFileAndCheck (aLambda: TmsLogLambda); var l_FileNameTest: String; begin l_FileNameTest:= TestResultsFileName; TmsLog.Log (l_FileNameTest, procedure (aLog: TmsLog) begin aLambda (aLog); end); CheckFileWithEtalon (l_FileNameTest); end;

class procedure TmsShapeTestPrim.CheckShapes (aCheck: TmsShapeClassCheck); begin TmsRegisteredShapes.IterateShapes ( procedure (aShapeClass: RmsShape) begin if not aShapeClass.IsTool then aCheck (aShapeClass); end); end; Ну, а теперь кратко о том, как это все работает.Хоть наш класс, хоть и является абстрактным, однако вся логика спрятана именно тут. Он унаследован от TTestCase из DUnit, а значит, при желании, любой потомок сможет быть зарегистрирован для тестирования, реализуя, благодаря наследованию, уникальные настройки, которые не входят в контекст.Сам смыл тестирования (как мы его видим; и это совсем не TDD) мы очень детально описали на примере тестирования простейшего калькулятора в нашем блоге.

В двух словах — использование тестирования с помощью эталонов предполагает сохранение значений и результата теста в файл, который мы затем сравниваем с эталонным. Если файлы не совпадают, то тест «провалился». Тут возникает вопрос: откуда мы возьмем эталонный файл? И здесь у нас два варианта: либо мы его создадим руками, либо (как поступил я) если эталона не существует, то мы создаем его автоматически на основе файла результата тестирования, так как допускаем (проверяем вручную по старинке на глаз), что тесты у нас заведомо правильные.

Как заметил внимательный читатель, в классе вовсю используются лямбды и анонимные методы. Это, для нас, один из способов поддерживать принцип DRY, там, где этого недостаточно, мы используем — наследование. Не скажу, кто из них главный (скорее, важна комбинация и умение распознать, где какой прием лучше), но могу точно сказать — мы придерживаемся принципа на 95%. Остальные 5, скорее, лень или здравый смысл.

Перестану мучить теорией и покажу классы потомки:

RmsShapeTest = class of TmsShapeTestPrim;

TmsCustomShapeTest = class (TmsShapeTestPrim) protected function MakeFileName (const aTestName: string; const aFileExtension: string): String; override; published procedure TestSerialize; end; // TmsCustomShapeTest

function TmsCustomShapeTest.MakeFileName (const aTestName: string; const aFileExtension: string): String; begin Result:= inherited + '.json'; end;

procedure TmsCustomShapeTest.TestSerialize; begin CreateDiagrammWithShapeAndSaveAndCheck; end; Как видим, изменилось не много. По сути, мы просто сказали, как изменить имя результата. Сделано так потому, что мы будем использовать базовый класс для всех тестов. Однако, лишь следующие будут проверять сериализацию, другой класс будет «результировать» в *.png. TmsDiagrammTest = class (TmsCustomShapeTest) protected procedure SaveDiagramm (const aFileName: String; const aDiagramm: ImsDiagramm); override; published procedure TestDeSerialize; end; // TmsDiagrammTest

procedure TmsDiagrammTest.SaveDiagramm (const aFileName: String; const aDiagramm: ImsDiagramm); var l_Diagramms: ImsDiagramms; begin l_Diagramms:= TmsDiagramms.Create; try l_Diagramms.AddDiagramm (aDiagramm); l_Diagramms.SaveTo (aFileName); finally l_Diagramms:= nil; end; // try…finally end;

procedure TmsDiagrammTest.TestDeSerialize; var l_Diagramms: ImsDiagramms; l_FileName: String; begin l_Diagramms:= TmsDiagramms.Create; try l_Diagramms.LoadFrom (MakeFileName (TestSerializeMethodName, c_JSON)); // — берём результаты от ПРЕДЫДУЩИХ тестов, НЕКОШЕРНО с точки зрения TDD // НО! Чертовски эффективно. l_FileName:= TestResultsFileName; l_Diagramms.SaveTo (l_FileName); CheckFileWithEtalon (l_FileName); finally l_Diagramms:= nil; end; // try…finally end; Тест фигур.

TmsShapeTest = class (TmsCustomShapeTest) published procedure TestDeSerialize; procedure TestDeSerializeViaShapeCheck; procedure TestShapeName; procedure TestDiagrammName; end; // TmsShapeTest

procedure TmsShapeTest.TestDeSerializeViaShapeCheck; begin TestDeSerializeViaShapeCheckForShapeClass; end;

procedure TmsShapeTest.TestDeSerialize; begin TestDeSerializeForShapeClass; end;

procedure TmsShapeTest.TestShapeName; begin OutToFileAndCheck ( procedure (aLog: TmsLog) begin aLog.ToLog (f_Context.rShapeClass.ClassName); end); end;

procedure TmsShapeTest.TestDiagrammName; begin OutToFileAndCheck ( procedure (aLog: TmsLog) begin aLog.ToLog (f_Context.rDiagrammName); end); end; Про тест сохранения в png, единственная важная строчка тут:

function TTestSaveToPNG.TestResultsFileName: String; const c_PNG = 'PNG\'; begin // Так как мы с коллегой работаем на разных мониторах, соответственно, с разными расширениями, мы тут немножко читим. Опять же, учитывая здравый смысл. Result:= MakeFileName (Name, c_PNG + ComputerName + '\'); end; Полный текст модуля: unit msShapeTest;

interface

uses TestFramework, msDiagramm, msShape, msRegisteredShapes, System.Types, System.Classes, msCoreObjects, msInterfaces;

type TmsShapeClassCheck = TmsShapeClassLambda;

TmsDiagrammCheck = reference to procedure (const aDiagramm: ImsDiagramm); TmsDiagrammSaveTo = reference to procedure (const aFileName: String; const aDiagramm: ImsDiagramm);

TmsShapeTestContext = record rMethodName: string; rSeed: Integer; rDiagrammName: String; rShapesCount: Integer; rShapeClass: RmsShape; constructor Create (aMethodName: string; aSeed: Integer; aDiagrammName: string; aShapesCount: Integer; aShapeClass: RmsShape); end; // TmsShapeTestContext

TmsShapeTestPrim = class abstract (TTestCase) protected f_Context: TmsShapeTestContext; f_TestSerializeMethodName: String; f_Coords: array of TPoint; protected class function ComputerName: AnsiString; function TestResultsFileName: String; virtual; function MakeFileName (const aTestName: string; const aTestFolder: string): String; virtual; procedure CreateDiagrammAndCheck (aCheck: TmsDiagrammCheck; const aName: String); procedure CheckFileWithEtalon (const aFileName: String); procedure SaveDiagramm (const aFileName: String; const aDiagramm: ImsDiagramm); virtual; procedure SaveDiagrammAndCheck (const aDiagramm: ImsDiagramm; aSaveTo: TmsDiagrammSaveTo); procedure OutToFileAndCheck (aLambda: TmsLogLambda); procedure SetUp; override; function ShapesCount: Integer; procedure CreateDiagrammWithShapeAndSaveAndCheck; function TestSerializeMethodName: String; procedure DeserializeDiargammAndCheck (aCheck: TmsDiagrammCheck); procedure TestDeSerializeForShapeClass; procedure TestDeSerializeViaShapeCheckForShapeClass; public class procedure CheckShapes (aCheck: TmsShapeClassCheck); constructor Create (const aContext: TmsShapeTestContext); end; // TmsShapeTestPrim

RmsShapeTest = class of TmsShapeTestPrim;

TmsCustomShapeTest = class (TmsShapeTestPrim) protected function MakeFileName (const aTestName: string; const aFileExtension: string): String; override; published procedure TestSerialize; end; // TmsCustomShapeTest

TmsDiagrammTest = class (TmsCustomShapeTest) protected procedure SaveDiagramm (const aFileName: String; const aDiagramm: ImsDiagramm); override; published procedure TestDeSerialize; end; // TmsDiagrammTest

TmsShapeTest = class (TmsCustomShapeTest) published procedure TestDeSerialize; procedure TestDeSerializeViaShapeCheck; procedure TestShapeName; procedure TestDiagrammName; end; // TmsShapeTest

implementation

uses System.SysUtils, Winapi.Windows, System.Rtti, System.TypInfo, FMX.Objects, msSerializeInterfaces, msDiagrammMarshal, msDiagrammsMarshal, msStringList, msDiagramms, Math, msStreamUtils, msTestConstants, msShapeCreator, msCompletedShapeCreator;