MindStream. As we write software under FireMonkey. Part 5. Testing
Part 1.
Part 2.
Part 3. DUnit + FireMonkey
Part 3.1. Based on GUIRunner
Part 4. Serialization
Hello, dear Khabrovites.
In this post I want to talk about the changes that have occurred with our project, as well as about the technologies and techniques that we used to achieve our goals.
Now our project looks like this:
The diagram can be saved in Json, as well as restored from Json, which I wrote about in a previous article.
Each figure has become able to “be a diagram." That is, we can select a shape and build “inside” a new chart. More clearly demonstrated below.
The TmsPicker object is responsible for the ability to "fall inward." The TmsUpToParrent object is responsible for returning to the parent diagram.
We also got a ToolBar, in which all shapes intended for drawing are dynamically drawn, and the ability to create special shapes, for example, for a moving object (under the red square)
, is implemented : We also implemented control over the creation / deletion of objects. Detailed description
here .
After the application finishes, we get the following log:
Well and most importantly, we covered some of the code with tests. To date, there are 174.
At the same time, the following drawings are born on saving tests in PNG:
The size of the “standard” of checking the drawing of the red circle: 1048x2049 pixels. File size 1.7 MB.
However, the details are further.
Let's start in the reverse order.
Tests.
First of all, connect DUnit to the project. To do this, add one line to the project, after which it looks like this:
Now let's check the health of DUnit with FirstTest.
The next step is to add the first tests, however, we will immediately divide them by classification:
integration;
modular.
Let's start with the integration. The first test will find out if all our pieces are registered:
We will write two more such tests to check the number of figures that we need:
Now let's move on to modular ones.
To begin, we write the base class of the unit test.
Well, now briefly about how it all works.
Although our class, although it is abstract, all logic is hidden here. It is inherited from TTestCase from DUnit, which means that, if desired, any descendant can be registered for testing, realizing, thanks to inheritance, unique settings that are not included in the context.
Sam washed away the testing (as we see it; and this is not at all TDD) we described in great detail on the example of testing the simplest calculator in our blog .
In a nutshell - the use of testing using standards involves saving the values and test result to a file, which we then compare with the reference. If the files do not match, then the test “failed”. This begs the question: where do we get the reference file? And here we have two options: either we will create it by hand, or (as I did) if the standard does not exist, then we create it automatically based on the file of the test result, since we assume (we manually check in the old fashioned way by eye) that the tests are us obviously right.
As an attentive reader noted, lambdas and anonymous methods are used in full in the class . This, for us, is one way to uphold the DRY principle., where this is not enough, we use - inheritance. I won’t say which of them is the main one (rather, the combination and ability to recognize where which technique is better is important), but I can say for sure that we adhere to the principle by 95%. The remaining 5 are rather laziness or common sense.
I’ll stop tormenting with theory and show descendant classes:
As you can see, not much has changed. In fact, we just said how to change the name of the result. This is because we will use the base class for all tests. However, only the following will check serialization, another class will “result” in * .png.
Test figures.
About the save test in png, the only important line here:
The class for the save test in * .png looks like this:
Again, an attentive reader who worked / works with DUnit will notice that there are no registration of test classes. So, we screw them now to the project, nothing will happen.
We introduce a new class, which will be a “test suite” or, as the DUnit team called it, TestSuite.
Here it is - "our special magic."
We will inherit a new class from TestSuite. Moreover, we will “make” each class unique.
The greatest value in the explanation requires only one method. We will analyze it line by line.
Thanks to everyone who read, as always, comments and comments are welcome.
Repository
Part 2.
Part 3. DUnit + FireMonkey
Part 3.1. Based on GUIRunner
Part 4. Serialization
Hello, dear Khabrovites.
In this post I want to talk about the changes that have occurred with our project, as well as about the technologies and techniques that we used to achieve our goals.
Now our project looks like this:
The diagram can be saved in Json, as well as restored from Json, which I wrote about in a previous article.
Json of the picture drawn below and saved in PNG thanks to the program:
{
"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": []
}
}]
}
}]
}
}
Each figure has become able to “be a diagram." That is, we can select a shape and build “inside” a new chart. More clearly demonstrated below.
The TmsPicker object is responsible for the ability to "fall inward." The TmsUpToParrent object is responsible for returning to the parent diagram.
We also got a ToolBar, in which all shapes intended for drawing are dynamically drawn, and the ability to create special shapes, for example, for a moving object (under the red square)
, is implemented : We also implemented control over the creation / deletion of objects. Detailed description
here .
After the application finishes, we get the following log:
MindStream.exe.objects.log
Неосвобождено объектов: 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
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
Well and most importantly, we covered some of the code with tests. To date, there are 174.
At the same time, the following drawings are born on saving tests in PNG:
The size of the “standard” of checking the drawing of the red circle: 1048x2049 pixels. File size 1.7 MB.
However, the details are further.
Let's start in the reverse order.
Tests.
First of all, connect DUnit to the project. To do this, add one line to the project, after which it looks like this:
program MindStream;
uses
FMX.Forms,
…
;
begin
Application.Initialize;
Application.CreateForm(TfmMain, fmMain);
// Подключаем свой GUI_Runner, который в свою очередь найдет все зарегестрированные тесты
u_fmGUITestRunner.RunRegisteredTestsModeless;
Application.Run;
end.
Now let's check the health of DUnit with FirstTest.
unit FirstTest;
interfaceuses
TestFrameWork;
typeTFirstTest = class(TTestCase)
publishedprocedureDoIt;end; // TFirstTestimplementationuses
SysUtils;
procedureTFirstTest.DoIt;begin
Check(true);
end;
initialization
TestFrameWork.RegisterTest(TFirstTest.Suite);
end.
The next step is to add the first tests, however, we will immediately divide them by classification:
integration;
modular.
Let's start with the integration. The first test will find out if all our pieces are registered:
unit RegisteredShapesTest;
interfaceuses
TestFrameWork;
typeTRegisteredShapesTest = class(TTestCase)
publishedprocedureShapesRegistredCount;procedureTestFirstShape;procedureTestIndexOfTmsLine;end; // TRegisteredShapesTestimplementationuses
SysUtils,
msRegisteredShapes,
msShape,
msLine,
FMX.Objects,
FMX.Graphics;
procedureTRegisteredShapesTest.ShapesRegistredCount;var
l_Result: integer;
begin
l_Result := 0;
TmsRegisteredShapes.IterateShapes(
procedure(aShapeClass: RmsShape)beginInc(l_Result);end);
CheckTrue(l_Result = 23, ' Expected 23 - Get ' + IntToStr(l_Result));
end;
procedureTRegisteredShapesTest.TestFirstShape;begin
CheckTrue(TmsRegisteredShapes.Instance.First = TmsLine);
end;
procedureTRegisteredShapesTest.TestIndexOfTmsLine;begin
CheckTrue(TmsRegisteredShapes.Instance.IndexOf(TmsLine) = 0);
end;
initialization
TestFrameWork.RegisterTest(TRegisteredShapesTest.Suite);
end.
We will write two more such tests to check the number of figures that we need:
...
typeTUtilityShapesTest = class(TTestCase)
publishedprocedureShapesRegistredCount;procedureTestFirstShape;procedureTestIndexOfTmsLine;end; // TUtilityShapesTest
...
procedureTUtilityShapesTest.ShapesRegistredCount;var
l_Result: integer;
begin
l_Result := 0;
TmsUtilityShapes.IterateShapes(
procedure(aShapeClass: RmsShape)beginAssert(aShapeClass.IsForToolbar);
Inc(l_Result);
end);
CheckTrue(l_Result = 5, ' Expected 5 - Get ' + IntToStr(l_Result));
end;
…
TForToolbarShapesTest = class(TTestCase)
publishedprocedureShapesRegistredCount;procedureTestFirstShape;procedureTestIndexOfTmsLine;end; // TForToolbarShapesTestprocedureTForToolbarShapesTest.ShapesRegistredCount;var
l_Result: integer;
begin
l_Result := 0;
TmsShapesForToolbar.IterateShapes(
procedure(aShapeClass: RmsShape)beginAssert(aShapeClass.IsForToolbar);
Inc(l_Result);
end);
CheckTrue(l_Result = 18, ' Expected 18 - Get ' + IntToStr(l_Result));
end;
Now let's move on to modular ones.
To begin, we write the base class of the unit test.
type
TmsShapeClassCheck = TmsShapeClassLambda;
TmsDiagrammCheck = reference toprocedure(const aDiagramm: ImsDiagramm);
TmsDiagrammSaveTo = reference toprocedure(const aFileName: String; const aDiagramm: ImsDiagramm);// контекст тестирования хранит в себе всю уникальную информацию для каждого теста
TmsShapeTestContext = record
rMethodName: string;
rSeed: Integer;
rDiagrammName: String;
rShapesCount: Integer;
rShapeClass: RmsShape;
constructorCreate(aMethodName: string;
aSeed: Integer; aDiagrammName: string; aShapesCount: Integer; aShapeClass: RmsShape);end; // TmsShapeTestContext
TmsShapeTestPrim = classabstract(TTestCase)
protected// контекст тестирования хранит в себе всю уникальную информацию для каждого теста
f_Context: TmsShapeTestContext;
f_TestSerializeMethodName: String;
f_Coords: arrayof TPoint;
protectedclassfunctionComputerName: AnsiString;
functionTestResultsFileName:String; virtual;
functionMakeFileName(const aTestName: string; const aTestFolder: string):String; virtual;
procedureCreateDiagrammAndCheck(aCheck: TmsDiagrammCheck; const aName: String);// Процедура проверки результатов теста с эталонномprocedureCheckFileWithEtalon(const aFileName: String);procedureSaveDiagramm(const aFileName: String; const aDiagramm: ImsDiagramm);virtual;
procedureSaveDiagrammAndCheck(const aDiagramm: ImsDiagramm; aSaveTo: TmsDiagrammSaveTo);procedureOutToFileAndCheck(aLambda: TmsLogLambda);procedureSetUp;override;
functionShapesCount: Integer;
procedureCreateDiagrammWithShapeAndSaveAndCheck;functionTestSerializeMethodName:String;
procedureDeserializeDiargammAndCheck(aCheck: TmsDiagrammCheck);procedureTestDeSerializeForShapeClass;procedureTestDeSerializeViaShapeCheckForShapeClass;publicclassprocedureCheckShapes(aCheck: TmsShapeClassCheck);constructorCreate(const aContext: TmsShapeTestContext);end; // TmsShapeTestPrimfunctionTmsShapeTestPrim.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;
procedureTmsShapeTestPrim.CheckFileWithEtalon(const aFileName: String);var
l_FileNameEtalon: String;
begin
l_FileNameEtalon := aFileName + '.etalon' + ExtractFileExt(aFileName);
if FileExists(l_FileNameEtalon) thenbegin
CheckTrue(msCompareFiles(l_FileNameEtalon, aFileName));
end// FileExists(l_FileNameEtalon)elsebegin
CopyFile(PWideChar(aFileName), PWideChar(l_FileNameEtalon), True);
end; // FileExists(l_FileNameEtalon)end;
const
c_JSON = 'JSON\';
functionTmsShapeTestPrim.TestResultsFileName:String;
begin
Result := MakeFileName(Name, c_JSON);
end;
classfunctionTmsShapeTestPrim.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;
procedureTmsShapeTestPrim.SaveDiagramm(const aFileName: String; const aDiagramm: ImsDiagramm);begin
aDiagramm.SaveTo(aFileName);
end;
procedureTmsShapeTestPrim.SaveDiagrammAndCheck(const aDiagramm: ImsDiagramm; aSaveTo: TmsDiagrammSaveTo);var
l_FileNameTest: String;
begin
l_FileNameTest := TestResultsFileName;
aSaveTo(l_FileNameTest, aDiagramm);
CheckFileWithEtalon(l_FileNameTest);
end;
functionTmsShapeTestPrim.ShapesCount: Integer;
begin
Result := f_Context.rShapesCount;
end;
constructorTmsShapeTestContext.Create(aMethodName: string; aSeed: Integer; aDiagrammName: string; aShapesCount: Integer;
aShapeClass: RmsShape);begin
rMethodName := aMethodName;
rSeed := aSeed;
rDiagrammName := aDiagrammName;
rShapesCount := aShapesCount;
rShapeClass := aShapeClass;
end;
procedureTmsShapeTestPrim.SetUp;var
l_Index: Integer;
l_X: Integer;
l_Y: Integer;
begininherited;
RandSeed := f_Context.rSeed;
SetLength(f_Coords, ShapesCount);
for l_Index := 0to Pred(ShapesCount) dobegin
l_X := Random(c_MaxCanvasWidth);
l_Y := Random(c_MaxCanvasHeight);
f_Coords[l_Index] := TPoint.Create(l_X, l_Y);
end; // for l_Indexend;
procedureTmsShapeTestPrim.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..finallyend;
procedureTmsShapeTestPrim.CreateDiagrammWithShapeAndSaveAndCheck;begin
CreateDiagrammAndCheck(
procedure(const aDiagramm: ImsDiagramm)varl_P: TPoint;
beginfor 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;
functionTmsCustomShapeTest.MakeFileName(const aTestName: string; const aFileExtension: string):String;
begin
Result := inherited + '.json';
end;
functionTmsShapeTestPrim.TestSerializeMethodName:String;
begin
Result := f_TestSerializeMethodName + 'TestSerialize';
end;
procedureTmsShapeTestPrim.DeserializeDiargammAndCheck(aCheck: TmsDiagrammCheck);begin
CreateDiagrammAndCheck(
procedure(const aDiagramm: ImsDiagramm)beginaDiagramm.LoadFrom(MakeFileName(TestSerializeMethodName, c_JSON));// - берём результаты от ПРЕДЫДУЩИХ тестов, НЕКОШЕРНО с точки зрения TDD// НО! Чертовски эффективно.
aCheck(aDiagramm);
end, '');
end;
procedureTmsShapeTestPrim.TestDeSerializeForShapeClass;begin
DeserializeDiargammAndCheck(
procedure(const aDiagramm: ImsDiagramm)beginSaveDiagrammAndCheck(aDiagramm, SaveDiagramm);end);
end;
constructorTmsShapeTestPrim.Create(const aContext: TmsShapeTestContext);begininherited Create(aContext.rMethodName);
f_Context := aContext;
FTestName := f_Context.rShapeClass.ClassName + '.' + aContext.rMethodName;
f_TestSerializeMethodName := f_Context.rShapeClass.ClassName + '.';
end;
procedureTmsShapeTestPrim.TestDeSerializeViaShapeCheckForShapeClass;begin
DeserializeDiargammAndCheck(
procedure(const aDiagramm: ImsDiagramm)varl_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 dobegin
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_Shapeend);
end;
procedureTmsShapeTestPrim.OutToFileAndCheck(aLambda: TmsLogLambda);var
l_FileNameTest: String;
begin
l_FileNameTest := TestResultsFileName;
TmsLog.Log(l_FileNameTest,
procedure(aLog: TmsLog)beginaLambda(aLog);end);
CheckFileWithEtalon(l_FileNameTest);
end;
classprocedureTmsShapeTestPrim.CheckShapes(aCheck: TmsShapeClassCheck);begin
TmsRegisteredShapes.IterateShapes(
procedure(aShapeClass: RmsShape)beginifnotaShapeClass.IsToolthenaCheck(aShapeClass);end);
end;
Well, now briefly about how it all works.
Although our class, although it is abstract, all logic is hidden here. It is inherited from TTestCase from DUnit, which means that, if desired, any descendant can be registered for testing, realizing, thanks to inheritance, unique settings that are not included in the context.
Sam washed away the testing (as we see it; and this is not at all TDD) we described in great detail on the example of testing the simplest calculator in our blog .
In a nutshell - the use of testing using standards involves saving the values and test result to a file, which we then compare with the reference. If the files do not match, then the test “failed”. This begs the question: where do we get the reference file? And here we have two options: either we will create it by hand, or (as I did) if the standard does not exist, then we create it automatically based on the file of the test result, since we assume (we manually check in the old fashioned way by eye) that the tests are us obviously right.
As an attentive reader noted, lambdas and anonymous methods are used in full in the class . This, for us, is one way to uphold the DRY principle., where this is not enough, we use - inheritance. I won’t say which of them is the main one (rather, the combination and ability to recognize where which technique is better is important), but I can say for sure that we adhere to the principle by 95%. The remaining 5 are rather laziness or common sense.
I’ll stop tormenting with theory and show descendant classes:
RmsShapeTest = classof TmsShapeTestPrim;
TmsCustomShapeTest = class(TmsShapeTestPrim)
protectedfunctionMakeFileName(const aTestName: string; const aFileExtension: string):String; override;
publishedprocedureTestSerialize;end; // TmsCustomShapeTestfunctionTmsCustomShapeTest.MakeFileName(const aTestName: string; const aFileExtension: string):String;
begin
Result := inherited + '.json';
end;
procedureTmsCustomShapeTest.TestSerialize;begin
CreateDiagrammWithShapeAndSaveAndCheck;
end;
As you can see, not much has changed. In fact, we just said how to change the name of the result. This is because we will use the base class for all tests. However, only the following will check serialization, another class will “result” in * .png.
TmsDiagrammTest = class(TmsCustomShapeTest)
protectedprocedureSaveDiagramm(const aFileName: String; const aDiagramm: ImsDiagramm);override;
publishedprocedureTestDeSerialize;end; // TmsDiagrammTestprocedureTmsDiagrammTest.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..finallyend;
procedureTmsDiagrammTest.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..finallyend;
Test figures.
TmsShapeTest = class(TmsCustomShapeTest)
publishedprocedureTestDeSerialize;procedureTestDeSerializeViaShapeCheck;procedureTestShapeName;procedureTestDiagrammName;end; // TmsShapeTestprocedureTmsShapeTest.TestDeSerializeViaShapeCheck;begin
TestDeSerializeViaShapeCheckForShapeClass;
end;
procedureTmsShapeTest.TestDeSerialize;begin
TestDeSerializeForShapeClass;
end;
procedureTmsShapeTest.TestShapeName;begin
OutToFileAndCheck(
procedure(aLog: TmsLog)beginaLog.ToLog(f_Context.rShapeClass.ClassName);end);
end;
procedureTmsShapeTest.TestDiagrammName;begin
OutToFileAndCheck(
procedure(aLog: TmsLog)beginaLog.ToLog(f_Context.rDiagrammName);end);
end;
About the save test in png, the only important line here:
functionTTestSaveToPNG.TestResultsFileName:String;
const
c_PNG = 'PNG\';
begin// Так как мы с коллегой работаем на разных мониторах, соответственно, с разными расширениями, мы тут немножко читим. Опять же, учитывая здравый смысл.
Result := MakeFileName(Name, c_PNG + ComputerName + '\');
end;
Full text of the module:
unit msShapeTest;
interfaceuses
TestFramework,
msDiagramm,
msShape,
msRegisteredShapes,
System.Types,
System.Classes,
msCoreObjects,
msInterfaces;
type
TmsShapeClassCheck = TmsShapeClassLambda;
TmsDiagrammCheck = reference toprocedure(const aDiagramm: ImsDiagramm);
TmsDiagrammSaveTo = reference toprocedure(const aFileName: String; const aDiagramm: ImsDiagramm);
TmsShapeTestContext = record
rMethodName: string;
rSeed: Integer;
rDiagrammName: String;
rShapesCount: Integer;
rShapeClass: RmsShape;
constructorCreate(aMethodName: string;
aSeed: Integer; aDiagrammName: string; aShapesCount: Integer; aShapeClass: RmsShape);end; // TmsShapeTestContext
TmsShapeTestPrim = classabstract(TTestCase)
protected
f_Context: TmsShapeTestContext;
f_TestSerializeMethodName: String;
f_Coords: arrayof TPoint;
protectedclassfunctionComputerName: AnsiString;
functionTestResultsFileName:String; virtual;
functionMakeFileName(const aTestName: string; const aTestFolder: string):String; virtual;
procedureCreateDiagrammAndCheck(aCheck: TmsDiagrammCheck; const aName: String);procedureCheckFileWithEtalon(const aFileName: String);procedureSaveDiagramm(const aFileName: String; const aDiagramm: ImsDiagramm);virtual;
procedureSaveDiagrammAndCheck(const aDiagramm: ImsDiagramm; aSaveTo: TmsDiagrammSaveTo);procedureOutToFileAndCheck(aLambda: TmsLogLambda);procedureSetUp;override;
functionShapesCount: Integer;
procedureCreateDiagrammWithShapeAndSaveAndCheck;functionTestSerializeMethodName:String;
procedureDeserializeDiargammAndCheck(aCheck: TmsDiagrammCheck);procedureTestDeSerializeForShapeClass;procedureTestDeSerializeViaShapeCheckForShapeClass;publicclassprocedureCheckShapes(aCheck: TmsShapeClassCheck);constructorCreate(const aContext: TmsShapeTestContext);end; // TmsShapeTestPrim
RmsShapeTest = classof TmsShapeTestPrim;
TmsCustomShapeTest = class(TmsShapeTestPrim)
protectedfunctionMakeFileName(const aTestName: string; const aFileExtension: string):String; override;
publishedprocedureTestSerialize;end; // TmsCustomShapeTestTmsDiagrammTest = class(TmsCustomShapeTest)
protectedprocedureSaveDiagramm(const aFileName: String; const aDiagramm: ImsDiagramm);override;
publishedprocedureTestDeSerialize;end; // TmsDiagrammTestTmsShapeTest = class(TmsCustomShapeTest)
publishedprocedureTestDeSerialize;procedureTestDeSerializeViaShapeCheck;procedureTestShapeName;procedureTestDiagrammName;end; // TmsShapeTestimplementationuses
System.SysUtils,
Winapi.Windows,
System.Rtti,
System.TypInfo,
FMX.Objects,
msSerializeInterfaces,
msDiagrammMarshal,
msDiagrammsMarshal,
msStringList,
msDiagramms,
Math,
msStreamUtils,
msTestConstants,
msShapeCreator,
msCompletedShapeCreator;
functionTmsShapeTestPrim.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;
procedureTmsShapeTestPrim.CheckFileWithEtalon(const aFileName: String);var
l_FileNameEtalon: String;
begin
l_FileNameEtalon := aFileName + '.etalon' + ExtractFileExt(aFileName);
if FileExists(l_FileNameEtalon) thenbegin
CheckTrue(msCompareFiles(l_FileNameEtalon, aFileName));
end// FileExists(l_FileNameEtalon)elsebegin
CopyFile(PWideChar(aFileName), PWideChar(l_FileNameEtalon), True);
end; // FileExists(l_FileNameEtalon)end;
const
c_JSON = 'JSON\';
functionTmsShapeTestPrim.TestResultsFileName:String;
begin
Result := MakeFileName(Name, c_JSON);
end;
classfunctionTmsShapeTestPrim.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;
procedureTmsShapeTestPrim.SaveDiagramm(const aFileName: String; const aDiagramm: ImsDiagramm);begin
aDiagramm.SaveTo(aFileName);
end;
procedureTmsShapeTestPrim.SaveDiagrammAndCheck(const aDiagramm: ImsDiagramm; aSaveTo: TmsDiagrammSaveTo);var
l_FileNameTest: String;
begin
l_FileNameTest := TestResultsFileName;
aSaveTo(l_FileNameTest, aDiagramm);
CheckFileWithEtalon(l_FileNameTest);
end;
functionTmsShapeTestPrim.ShapesCount: Integer;
begin
Result := f_Context.rShapesCount;
end;
constructorTmsShapeTestContext.Create(aMethodName: string; aSeed: Integer; aDiagrammName: string; aShapesCount: Integer;
aShapeClass: RmsShape);begin
rMethodName := aMethodName;
rSeed := aSeed;
rDiagrammName := aDiagrammName;
rShapesCount := aShapesCount;
rShapeClass := aShapeClass;
end;
procedureTmsShapeTestPrim.SetUp;var
l_Index: Integer;
l_X: Integer;
l_Y: Integer;
begininherited;
RandSeed := f_Context.rSeed;
SetLength(f_Coords, ShapesCount);
for l_Index := 0to Pred(ShapesCount) dobegin
l_X := Random(c_MaxCanvasWidth);
l_Y := Random(c_MaxCanvasHeight);
f_Coords[l_Index] := TPoint.Create(l_X, l_Y);
end; // for l_Indexend;
procedureTmsShapeTestPrim.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..finallyend;
procedureTmsShapeTestPrim.CreateDiagrammWithShapeAndSaveAndCheck;begin
CreateDiagrammAndCheck(
procedure(const aDiagramm: ImsDiagramm)varl_P: TPoint;
beginfor 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;
functionTmsCustomShapeTest.MakeFileName(const aTestName: string; const aFileExtension: string):String;
begin
Result := inherited + '.json';
end;
procedureTmsCustomShapeTest.TestSerialize;begin
CreateDiagrammWithShapeAndSaveAndCheck;
end;
functionTmsShapeTestPrim.TestSerializeMethodName:String;
begin
Result := f_TestSerializeMethodName + 'TestSerialize';
end;
procedureTmsShapeTestPrim.DeserializeDiargammAndCheck(aCheck: TmsDiagrammCheck);begin
CreateDiagrammAndCheck(
procedure(const aDiagramm: ImsDiagramm)beginaDiagramm.LoadFrom(MakeFileName(TestSerializeMethodName, c_JSON));// - берём результаты от ПРЕДЫДУЩИХ тестов, НЕКОШЕРНО с точки зрения TDD// НО! Чертовски эффективно.
aCheck(aDiagramm);
end, '');
end;
procedureTmsShapeTestPrim.TestDeSerializeForShapeClass;begin
DeserializeDiargammAndCheck(
procedure(const aDiagramm: ImsDiagramm)beginSaveDiagrammAndCheck(aDiagramm, SaveDiagramm);end);
end;
procedureTmsShapeTest.TestDeSerialize;begin
TestDeSerializeForShapeClass;
end;
constructorTmsShapeTestPrim.Create(const aContext: TmsShapeTestContext);begininherited Create(aContext.rMethodName);
f_Context := aContext;
FTestName := f_Context.rShapeClass.ClassName + '.' + aContext.rMethodName;
f_TestSerializeMethodName := f_Context.rShapeClass.ClassName + '.';
end;
procedureTmsShapeTestPrim.TestDeSerializeViaShapeCheckForShapeClass;begin
DeserializeDiargammAndCheck(
procedure(const aDiagramm: ImsDiagramm)varl_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 dobegin
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_Shapeend);
end;
procedureTmsShapeTest.TestDeSerializeViaShapeCheck;begin
TestDeSerializeViaShapeCheckForShapeClass;
end;
procedureTmsShapeTestPrim.OutToFileAndCheck(aLambda: TmsLogLambda);var
l_FileNameTest: String;
begin
l_FileNameTest := TestResultsFileName;
TmsLog.Log(l_FileNameTest,
procedure(aLog: TmsLog)beginaLambda(aLog);end);
CheckFileWithEtalon(l_FileNameTest);
end;
procedureTmsShapeTest.TestShapeName;begin
OutToFileAndCheck(
procedure(aLog: TmsLog)beginaLog.ToLog(f_Context.rShapeClass.ClassName);end);
end;
procedureTmsShapeTest.TestDiagrammName;begin
OutToFileAndCheck(
procedure(aLog: TmsLog)beginaLog.ToLog(f_Context.rDiagrammName);end);
end;
classprocedureTmsShapeTestPrim.CheckShapes(aCheck: TmsShapeClassCheck);begin
TmsRegisteredShapes.IterateShapes(
procedure(aShapeClass: RmsShape)beginifnotaShapeClass.IsToolthenaCheck(aShapeClass);end);
end;
// TmsDiagrammTestprocedureTmsDiagrammTest.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..finallyend;
procedureTmsDiagrammTest.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..finallyend;
end.
The class for the save test in * .png looks like this:
unit TestSaveToPNG;
interfaceuses
TestFrameWork,
msShapeTest,
msInterfaces;
typeTTestSaveToPNG = class(TmsShapeTestPrim)
protectedfunctionMakeFileName(const aTestName: string; const aTestFolder: string):String; override;
functionTestResultsFileName:String; override;
procedureSaveDiagramm(const aFileName: String; const aDiagramm: ImsDiagramm);override;
publishedprocedureCreateDiagrammWithShapeAndSaveToPNG_AndCheck;end; // TTestSaveToPNGimplementationuses
SysUtils,
System.Types,
msRegisteredShapes,
FMX.Graphics;
{ TTestSaveToPNG }procedureTTestSaveToPNG.SaveDiagramm(const aFileName: String; const aDiagramm: ImsDiagramm);begin
aDiagramm.SaveToPng(aFileName);
end;
procedureTTestSaveToPNG.CreateDiagrammWithShapeAndSaveToPNG_AndCheck;begin
CreateDiagrammWithShapeAndSaveAndCheck;
end;
functionTTestSaveToPNG.MakeFileName(const aTestName: string; const aTestFolder: string):String;
begin
Result := inherited + '.png';
end;
functionTTestSaveToPNG.TestResultsFileName:String;
const
c_PNG = 'PNG\';
begin
Result := MakeFileName(Name, c_PNG + ComputerName + '\');
end;
initializationend.
Again, an attentive reader who worked / works with DUnit will notice that there are no registration of test classes. So, we screw them now to the project, nothing will happen.
We introduce a new class, which will be a “test suite” or, as the DUnit team called it, TestSuite.
Here it is - "our special magic."
We will inherit a new class from TestSuite. Moreover, we will “make” each class unique.
unit msShapeTestSuite;
interfaceuses
TestFramework,
msShape,
msShapeTest;
typeTmsParametrizedShapeTestSuite = class(TTestSuite)
privateconstructorCreatePrim;protectedclassfunctionTestClass: RmsShapeTest; virtual; abstract;
publicprocedureAddTests(TestClass: TTestCaseClass);override;
classfunctionCreate: ITest;
end; // TmsParametrizedShapeTestSuiteTmsShapesTest = class(TmsParametrizedShapeTestSuite)
protectedclassfunctionTestClass: RmsShapeTest; override;
end; // TmsShapesTestTmsDiagrammsTest = class(TmsParametrizedShapeTestSuite)
protectedclassfunctionTestClass: RmsShapeTest; override;
end; // TmsDiagrammsTestTmsDiagrammsToPNGTest = class(TmsParametrizedShapeTestSuite)
protectedclassfunctionTestClass: RmsShapeTest; override;
end; // TmsDiagrammsTestimplementationuses
System.TypInfo,
System.Rtti,
SysUtils,
TestSaveToPNG;
// TmsShapesTestclassfunctionTmsShapesTest.TestClass: RmsShapeTest;
begin
Result := TmsShapeTest;
end;
// TmsDiagrammsTestclassfunctionTmsDiagrammsTest.TestClass: RmsShapeTest;
begin
Result := TmsDiagrammTest;
end;
// TmsParametrizedShapeTestSuiteconstructorTmsParametrizedShapeTestSuite.CreatePrim;begininherited Create(TestClass);
end;
classfunctionTmsParametrizedShapeTestSuite.Create: ITest;
begin
Result := CreatePrim;
end;
procedureTmsParametrizedShapeTestSuite.AddTests(TestClass: TTestCaseClass);begin
Assert(TestClass.InheritsFrom(TmsShapeTestPrim));
RandSeed := 10;
TmsShapeTestPrim.CheckShapes(
procedure(aShapeClass: RmsShape)varl_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 doif (l_Method.Visibility = mvPublished) then
AddTest(RmsShapeTest(TestClass).Create(TmsShapeTestContext.Create(l_Method.Name, l_Seed, l_DiagrammName, l_ShapesCount,
aShapeClass)));
end);
end;
{ TmsDiagrammsToPNGTest }classfunctionTmsDiagrammsToPNGTest.TestClass: RmsShapeTest;
begin
Result := TTestSaveToPNG;
end;
initialization// Вот где регистрация !!!
RegisterTest(TmsShapesTest.Create);
RegisterTest(TmsDiagrammsTest.Create);
RegisterTest(TmsDiagrammsToPNGTest.Create);
end.
The greatest value in the explanation requires only one method. We will analyze it line by line.
procedureTmsParametrizedShapeTestSuite.AddTests(TestClass: TTestCaseClass);begin// Контракт
Assert(TestClass.InheritsFrom(TmsShapeTestPrim));
// Задаем Random
RandSeed := 10;
// Создаем тесты с учетом контекста тестирования
TmsShapeTestPrim.CheckShapes(
procedure(aShapeClass: RmsShape)varl_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 doif (l_Method.Visibility = mvPublished) then
AddTest(RmsShapeTest(TestClass).Create(TmsShapeTestContext.Create(l_Method.Name,
l_Seed,
l_DiagrammName,
l_ShapesCount,
aShapeClass)));
end);
end;
Thanks to everyone who read, as always, comments and comments are welcome.
Repository