MindStream. How do 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 habrovchane.
In this post I want to talk about the changes that have occurred with our project, as well as the technologies and techniques that we used to achieve our goals.
')
Now our project looks like this:
The diagram can be saved in Json, and also restored from Json, as I wrote in the previous article.
Each figure began to have the ability to be a diagram. That is, we can select a shape and build a “inside” new diagram. More clearly demonstrated below.
The TmsPicker object is responsible for the possibility of “falling inward”. The TmsUpToParrent object is responsible for returning to the parent diagram.
We also have a ToolBar, in which all the figures intended for drawing are dynamically drawn, and the ability to create special figures is implemented, for example, for a moving object (under a red square):
We also implemented control over the creation / release of objects. Detailed description
here
After the application finishes, we get the following log:
And most importantly, we covered part of the code with tests. To date, their 174.
At the same time on the conservation tests in PNG such images are born:
The size of the “standard” of checking the drawing of the red circle: 1048x2049 pixels. File size 1.7 MB.
However, the details further.
Let's start in reverse order.
Tests
First of all, let's connect DUnit to the project. To do this, add one line to the project, after which it looks like this:
Now we’ll check DUnit’s performance with FirstTest.
The next step is to add the first tests, but immediately divide them according to the classification:
integration;
modular.
Let's start with the integration. The first test will find out whether all our figures are registered:
We will write two more similar tests to check the number of pieces we need:
We now turn to modular.
First we write the base class of the unit test.
Well, now briefly about how it all works.
Although our class, although it is abstract, but all the logic is hidden here. It is inherited from TTestCase from DUnit, which means, if desired, any descendant can be registered for testing, implementing, thanks to inheritance, unique settings that are not included in the context.
The test itself (as we see it; and this is not TDD at all) was described in great detail using the example of testing the simplest calculator in our blog .
In a nutshell - the use of testing with the help of standards involves the preservation of values ​​and test result in a file, which we then compare with the reference. If the files do not match, then the test failed. Then the question arises: where do we get the reference file? And here we have two options: either we will create it with our hands, or (as I did) if the standard does not exist, then we create it automatically on the basis of the test result file, since we allow (manually checking the old-fashioned eye) that the tests Us obviously correct.
As the attentive reader noted, lambdas and anonymous methods are used in the class. This, for us, is one of the ways to support the principle of DRY , where this is not enough, we use - inheritance. I will not say which of them is the main one (rather, the combination and the ability to recognize where some technique is better) is important, but I can say for sure - we adhere to the principle of 95%. The remaining 5, rather, laziness or common sense.
I will stop tormenting theory and show descendants classes:
As you can see, not much has changed. In essence, we just said how to change the name of the result. This is done because we will use the base class for all tests. However, only the following will check the serialization, another class will “result” in * .png.
Test shapes.
About the save test in png, the only important line here is:
The class for the save test in * .png looks like this:
Again, an attentive reader who worked / works with DUnit will notice that there is no registration of testing classes. So, we screw them now to the project, nothing will happen.
We will introduce a new class that will be a “test suite” or, as the DUnit team called TestSuite called it.
Here it is - "our special magic."
We will inherit a new class from TestSuite. At the same time, we “make” each class unique.
. .
, , — .
Repository
Part 2.
Part 3. DUnit + FireMonkey
Part 3.1. Based on GUIRunner
Part 4. Serialization
Hello, dear habrovchane.
In this post I want to talk about the changes that have occurred with our project, as well as the technologies and techniques that we used to achieve our goals.
')
Now our project looks like this:
The diagram can be saved in Json, and also restored from Json, as I wrote in the previous article.
Json pictures 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 began to have the ability to be a diagram. That is, we can select a shape and build a “inside” new diagram. More clearly demonstrated below.
The TmsPicker object is responsible for the possibility of “falling inward”. The TmsUpToParrent object is responsible for returning to the parent diagram.
We also have a ToolBar, in which all the figures intended for drawing are dynamically drawn, and the ability to create special figures is implemented, for example, for a moving object (under a red square):
We also implemented control over the creation / release of objects. Detailed description
here
After the application finishes, we get the following log:
MindStream.exe.objects.log
No objects freed: 0
TmsPaletteShape Unallocated: 0 Max Distributed: 5
TmsPaletteShapeCreator Unallocated: 0 Max Distributed: 1
TmsUpArrow Unallocated: 0 Max Distributed: 1
TmsDashDotLine Unallocated: 0 Max Distributed: 164
TmsLine Unreleased: 0 Max Distributed: 278
TmsRectangle Unallocated: 0 Max Distributed: 144
TmsCircle Unallocated: 0 Max Distributed: 908
TmsLineWithArrow Unallocated: 0 Max Distributed: 309
TmsDiagrammsController Unallocated: 0 Max Distributed: 1
TmsStringList Unallocated: 0 Max Distributed: 3
TmsCompletedShapeCreator Unallocated: 0 Max Distributed: 2
TmsRoundedRectangle Unallocated: 0 Max Distributed: 434
TmsTriangleDirectionRight Unreleased: 0 Max Distributed: 5
TmsGreenCircle Unallocated: 0 Max Distributed: 850
TmsSmallTriangle Unreleased: 0 Max Distributed: 761
TmsShapeCreator Unallocated: 0 Max Distributed: 1
TmsDashLine Unreleased: 0 Max Distributed: 868
TmsGreenRectangle Unallocated: 0 Max Distributed: 759
TmsDiagramm Unreleased: 0 Max Distributed: 910
TmsDownArrow Unallocated: 0 Max Distributed: 1
TmsDotLine Unbound: 0 Max Distributed: 274
TmsDiagramms Unreleased: 0 Max Distributed: 3
TmsDiagrammsHolder Unallocated: 0 Max Distributed: 18
TmsPointCircle Unreleased: 0 Max Distributed: 717
TmsUseCaseLikeEllipse Unallocated: 0 Max Distributed: 397
TmsBlackTriangle Unreleased: 0 Max Distributed: 43
TmsRedRectangle Unallocated: 0 Max Distributed: 139
TmsMoverIcon Unallocated: 0 Max Distributed: 220
TmsTriangle Unreleased: 0 Max Distributed: 437
TmsPaletteShape Unallocated: 0 Max Distributed: 5
TmsPaletteShapeCreator Unallocated: 0 Max Distributed: 1
TmsUpArrow Unallocated: 0 Max Distributed: 1
TmsDashDotLine Unallocated: 0 Max Distributed: 164
TmsLine Unreleased: 0 Max Distributed: 278
TmsRectangle Unallocated: 0 Max Distributed: 144
TmsCircle Unallocated: 0 Max Distributed: 908
TmsLineWithArrow Unallocated: 0 Max Distributed: 309
TmsDiagrammsController Unallocated: 0 Max Distributed: 1
TmsStringList Unallocated: 0 Max Distributed: 3
TmsCompletedShapeCreator Unallocated: 0 Max Distributed: 2
TmsRoundedRectangle Unallocated: 0 Max Distributed: 434
TmsTriangleDirectionRight Unreleased: 0 Max Distributed: 5
TmsGreenCircle Unallocated: 0 Max Distributed: 850
TmsSmallTriangle Unreleased: 0 Max Distributed: 761
TmsShapeCreator Unallocated: 0 Max Distributed: 1
TmsDashLine Unreleased: 0 Max Distributed: 868
TmsGreenRectangle Unallocated: 0 Max Distributed: 759
TmsDiagramm Unreleased: 0 Max Distributed: 910
TmsDownArrow Unallocated: 0 Max Distributed: 1
TmsDotLine Unbound: 0 Max Distributed: 274
TmsDiagramms Unreleased: 0 Max Distributed: 3
TmsDiagrammsHolder Unallocated: 0 Max Distributed: 18
TmsPointCircle Unreleased: 0 Max Distributed: 717
TmsUseCaseLikeEllipse Unallocated: 0 Max Distributed: 397
TmsBlackTriangle Unreleased: 0 Max Distributed: 43
TmsRedRectangle Unallocated: 0 Max Distributed: 139
TmsMoverIcon Unallocated: 0 Max Distributed: 220
TmsTriangle Unreleased: 0 Max Distributed: 437
And most importantly, we covered part of the code with tests. To date, their 174.
At the same time on the conservation tests in PNG such images are born:
 |  |  |
The size of the “standard” of checking the drawing of the red circle: 1048x2049 pixels. File size 1.7 MB.
However, the details further.
Let's start in reverse order.
Tests
First of all, let's 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 we’ll check DUnit’s performance with 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. The next step is to add the first tests, but immediately divide them according to the classification:
integration;
modular.
Let's start with the integration. The first test will find out whether all our figures are registered:
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. We will write two more similar tests to check the number of pieces we need:
... 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; We now turn to modular.
First we write the base class of the unit test.
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; Well, now briefly about how it all works.
Although our class, although it is abstract, but all the logic is hidden here. It is inherited from TTestCase from DUnit, which means, if desired, any descendant can be registered for testing, implementing, thanks to inheritance, unique settings that are not included in the context.
The test itself (as we see it; and this is not TDD at all) was described in great detail using the example of testing the simplest calculator in our blog .
In a nutshell - the use of testing with the help of standards involves the preservation of values ​​and test result in a file, which we then compare with the reference. If the files do not match, then the test failed. Then the question arises: where do we get the reference file? And here we have two options: either we will create it with our hands, or (as I did) if the standard does not exist, then we create it automatically on the basis of the test result file, since we allow (manually checking the old-fashioned eye) that the tests Us obviously correct.
As the attentive reader noted, lambdas and anonymous methods are used in the class. This, for us, is one of the ways to support the principle of DRY , where this is not enough, we use - inheritance. I will not say which of them is the main one (rather, the combination and the ability to recognize where some technique is better) is important, but I can say for sure - we adhere to the principle of 95%. The remaining 5, rather, laziness or common sense.
I will stop tormenting theory and show descendants classes:
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; As you can see, not much has changed. In essence, we just said how to change the name of the result. This is done because we will use the base class for all tests. However, only the following will check the serialization, another class will “result” in * .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; Test shapes.
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; About the save test in png, the only important line here is:
function TTestSaveToPNG.TestResultsFileName: String; const c_PNG = 'PNG\'; begin // , , , . , . Result := MakeFileName(Name, c_PNG + ComputerName + '\'); end; Full text of the module:
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; 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; procedure TmsCustomShapeTest.TestSerialize; begin CreateDiagrammWithShapeAndSaveAndCheck; 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; procedure TmsShapeTest.TestDeSerialize; begin TestDeSerializeForShapeClass; 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 TmsShapeTest.TestDeSerializeViaShapeCheck; begin TestDeSerializeViaShapeCheckForShapeClass; 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; 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; class procedure TmsShapeTestPrim.CheckShapes(aCheck: TmsShapeClassCheck); begin TmsRegisteredShapes.IterateShapes( procedure(aShapeClass: RmsShape) begin if not aShapeClass.IsTool then aCheck(aShapeClass); end); 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; end. The class for the save test in * .png looks like this:
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. Again, an attentive reader who worked / works with DUnit will notice that there is no registration of testing classes. So, we screw them now to the project, nothing will happen.
We will introduce a new class that will be a “test suite” or, as the DUnit team called TestSuite called it.
Here it is - "our special magic."
We will inherit a new class from TestSuite. At the same time, we “make” each class unique.
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. . .
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; , , — .
Repository
Source: https://habr.com/ru/post/248027/
All Articles