Wiki
Clone wikiMindStream / Статьи на русском / MindStream. Как мы пишем ПО под FireMonkey. Часть 5. Тестирование
В этом посте я хочу рассказать об изменениях, которые произошли с нашим проектом, а также о технологиях и приемах, которые мы использовали для достижения наших целей.
Сейчас наш проект выглядит так:
Диаграмму можно сохранить в Json, а также восстановить из Json, о чём я писал в предыдущей статье.
Json картинки, нарисованной ниже и сохраненной в PNG благодаря программе:
#!json { "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, в котором динамически рисуются все фигуры, предназначенные для рисования, и реализована возможность создавать специальные фигуры, например, для объекта перемещения (под красным квадратом):
Также нами был реализован контроль за созданием\освобождением объектов. Детальное описание тут. После окончания работы приложения получаем такой лог:
Неосвобождено объектов: 0 TmsPaletteShape Неосвобождено: 0 Максимально распределено: 5 TmsPaletteShapeCreator Неосвобождено: 0 Максимально распределено: 1 TmsUpArrow Неосвобождено: 0 Максимально распределено: 1 TmsDashDotLine Неосвобождено: 0 Максимально распределено: 164 TmsLine Неосвобождено: 0 Максимально распределено: 278 TmsRectangle Неосвобождено: 0 Максимально распределено: 144 TmsCircle Неосвобождено: 0 Максимально распределено: 908 TmsLineWithArrow Неосвобождено: 0 Максимально распределено: 309 TmsDiagrammsController Неосвобождено: 0 Максимально распределено: 1 TmsStringList Неосвобождено: 0 Максимально распределено: 3 TmsCompletedShapeCreator Неосвобождено: 0 Максимально распределено: 2 TmsRoundedRectangle Неосвобождено: 0 Максимально распределено: 434 TmsTriangleDirectionRight Неосвобождено: 0 Максимально распределено: 5 TmsGreenCircle Неосвобождено: 0 Максимально распределено: 850 TmsSmallTriangle Неосвобождено: 0 Максимально распределено: 761 TmsShapeCreator Неосвобождено: 0 Максимально распределено: 1 TmsDashLine Неосвобождено: 0 Максимально распределено: 868 TmsGreenRectangle Неосвобождено: 0 Максимально распределено: 759 TmsDiagramm Неосвобождено: 0 Максимально распределено: 910 TmsDownArrow Неосвобождено: 0 Максимально распределено: 1 TmsDotLine Неосвобождено: 0 Максимально распределено: 274 TmsDiagramms Неосвобождено: 0 Максимально распределено: 3 TmsDiagrammsHolder Неосвобождено: 0 Максимально распределено: 18 TmsPointCircle Неосвобождено: 0 Максимально распределено: 717 TmsUseCaseLikeEllipse Неосвобождено: 0 Максимально распределено: 397 TmsBlackTriangle Неосвобождено: 0 Максимально распределено: 43 TmsRedRectangle Неосвобождено: 0 Максимально распределено: 139 TmsMoverIcon Неосвобождено: 0 Максимально распределено: 220 TmsTriangle Неосвобождено: 0 Максимально распределено: 437
Ну и самое главное, часть кода мы покрыли тестами. На сегодняшний день их 174.
При этом на тестах сохранения в PNG рождаются такие рисунки:
Размер “эталона” проверки рисований красного круга: 1048x2049 пикселей. Размер файла 1.7 MB. Однако о деталях дальше.
Начнем в обратном порядке.
Тесты.
Первым делом подключим DUnit к проекту. Для этого добавим одну строчку в проект, после чего он выглядит так:
#!delphi program MindStream; uses FMX.Forms, … ; begin Application.Initialize; Application.CreateForm(TfmMain, fmMain); // Подключаем свой GUI_Runner, который в свою очередь найдет все зарегестрированные тесты u_fmGUITestRunner.RunRegisteredTestsModeless; Application.Run; end.
Теперь проверим работоспособность DUnit с помощью FirstTest.
#!delphi 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.
Следующим шагом добавим первые тесты, однако сразу разделим их по классификации: интеграционные; модульные.
Начнем с интеграционных. Первым тестом узнаем, все ли наши фигуры зарегистрированы:
#!delphi 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.
Ещё два подобных теста напишем для проверки количества фигур, которые нам необходимы:
#!delphi ... 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;
Теперь перейдем к модульным. Для начала напишем базовый класс модульного теста.
#!delphi 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, скорее, лень или здравый смысл.
Перестану мучить теорией и покажу классы потомки:
#!delphi 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.
#!delphi 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;
Тест фигур.
#!delphi 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, единственная важная строчка тут:
#!delphi function TTestSaveToPNG.TestResultsFileName: String; const c_PNG = 'PNG\'; begin // Так как мы с коллегой работаем на разных мониторах, соответственно, с разными расширениями, мы тут немножко читим. Опять же, учитывая здравый смысл. Result := MakeFileName(Name, c_PNG + ComputerName + '\'); end;
Класс для теста сохранения в *.png выглядит так:
#!delphi unit TestSaveToPNG; interface uses TestFrameWork, msShapeTest, msInterfaces; type TTestSaveToPNG = class(TmsShapeTestPrim) protected function MakeFileName(const aTestName: string; const aTestFolder: string): String; override; function TestResultsFileName: String; override; procedure SaveDiagramm(const aFileName: String; const aDiagramm: ImsDiagramm); override; published procedure CreateDiagrammWithShapeAndSaveToPNG_AndCheck; end; // TTestSaveToPNG implementation uses SysUtils, System.Types, msRegisteredShapes, FMX.Graphics; { TTestSaveToPNG } procedure TTestSaveToPNG.SaveDiagramm(const aFileName: String; const aDiagramm: ImsDiagramm); begin aDiagramm.SaveToPng(aFileName); end; procedure TTestSaveToPNG.CreateDiagrammWithShapeAndSaveToPNG_AndCheck; begin CreateDiagrammWithShapeAndSaveAndCheck; end; function TTestSaveToPNG.MakeFileName(const aTestName: string; const aTestFolder: string): String; begin Result := inherited + '.png'; end; function TTestSaveToPNG.TestResultsFileName: String; const c_PNG = 'PNG\'; begin Result := MakeFileName(Name, c_PNG + ComputerName + '\'); end; initialization end.
Опять же, внимательный читатель, который работал/работает с DUnit, заметит, что нет регистрации классов тестирования. А значит, прикрути мы их сейчас к проекту, ничего не случится.
Введём новый класс, который будет собой представлять “набор тестов” или, как его назвала команда DUnit, TestSuite.
Вот она — «наша особая магия».
Мы унаследуем новый класс от TestSuite. При этом “сделаем” каждый класс уникальным.
#!delphi unit msShapeTestSuite; interface uses TestFramework, msShape, msShapeTest; type TmsParametrizedShapeTestSuite = class(TTestSuite) private constructor CreatePrim; protected class function TestClass: RmsShapeTest; virtual; abstract; public procedure AddTests(TestClass: TTestCaseClass); override; class function Create: ITest; end; // TmsParametrizedShapeTestSuite TmsShapesTest = class(TmsParametrizedShapeTestSuite) protected class function TestClass: RmsShapeTest; override; end; // TmsShapesTest TmsDiagrammsTest = class(TmsParametrizedShapeTestSuite) protected class function TestClass: RmsShapeTest; override; end; // TmsDiagrammsTest TmsDiagrammsToPNGTest = class(TmsParametrizedShapeTestSuite) protected class function TestClass: RmsShapeTest; override; end; // TmsDiagrammsTest implementation uses System.TypInfo, System.Rtti, SysUtils, TestSaveToPNG; // TmsShapesTest class function TmsShapesTest.TestClass: RmsShapeTest; begin Result := TmsShapeTest; end; // TmsDiagrammsTest class function TmsDiagrammsTest.TestClass: RmsShapeTest; begin Result := TmsDiagrammTest; end; // TmsParametrizedShapeTestSuite constructor TmsParametrizedShapeTestSuite.CreatePrim; begin inherited Create(TestClass); end; class function TmsParametrizedShapeTestSuite.Create: ITest; begin Result := CreatePrim; end; procedure TmsParametrizedShapeTestSuite.AddTests(TestClass: TTestCaseClass); begin Assert(TestClass.InheritsFrom(TmsShapeTestPrim)); RandSeed := 10; TmsShapeTestPrim.CheckShapes( procedure(aShapeClass: RmsShape) var l_Method: TRttiMethod; l_DiagrammName: String; l_Seed: Integer; l_ShapesCount: Integer; begin l_Seed := Random(High(l_Seed)); l_DiagrammName := 'Диаграмма ' + IntToStr(Random(10)); l_ShapesCount := Random(1000) + 1; for l_Method in TRttiContext.Create.GetType(TestClass).GetMethods do if (l_Method.Visibility = mvPublished) then AddTest(RmsShapeTest(TestClass).Create(TmsShapeTestContext.Create(l_Method.Name, l_Seed, l_DiagrammName, l_ShapesCount, aShapeClass))); end); end; { TmsDiagrammsToPNGTest } class function TmsDiagrammsToPNGTest.TestClass: RmsShapeTest; begin Result := TTestSaveToPNG; end; initialization // Вот где регистрация !!! RegisterTest(TmsShapesTest.Create); RegisterTest(TmsDiagrammsTest.Create); RegisterTest(TmsDiagrammsToPNGTest.Create); end.
Наибольшую ценность в объяснении требует лишь один метод. Разберем его по строчкам.
#!delphi procedure TmsParametrizedShapeTestSuite.AddTests(TestClass: TTestCaseClass); begin // Контракт Assert(TestClass.InheritsFrom(TmsShapeTestPrim)); // Задаем Random RandSeed := 10; // Создаем тесты с учетом контекста тестирования TmsShapeTestPrim.CheckShapes( procedure(aShapeClass: RmsShape) var l_Method: TRttiMethod; l_DiagrammName: String; l_Seed: Integer; l_ShapesCount: Integer; begin // Создаем “уникальный” контекст! Важно! // Задаем Random l_Seed := Random(High(l_Seed)); // Формируем уникальное имя для диаграммы l_DiagrammName := 'Диаграмма ' + IntToStr(Random(10)); // Задаем погрешность количества фигур l_ShapesCount := Random(1000) + 1; // Применяем новый RTTI. Для решения нужных нам проблем (всё вот так просто :), ну и далее вызываем нужный нам тест, с нужными нам параметрами (контекстом)) for l_Method in TRttiContext.Create.GetType(TestClass).GetMethods do if (l_Method.Visibility = mvPublished) then AddTest(RmsShapeTest(TestClass).Create(TmsShapeTestContext.Create(l_Method.Name, l_Seed, l_DiagrammName, l_ShapesCount, aShapeClass))); end); end;
Спасибо всем кто дочитал, как всегда, замечания и комментарии — приветствуются.
Updated