Original in Russian: http://habrahabr.ru/post/248027/
Table of contents
Hello, dear readership.
In this post I want to tell about the changes in our project and also about the technologies and methods we’ve used to achieve our goals.
Now our project looks as follows:
Each shape is now capable of “being the diagram”. It means we can choose a shape and build a new diagram “inside”. It is clearly demonstrated below.
The object TmsPicker is responsible for the capability of “falling into”. The object TmsUpToParrent is responsible for the returning to the parent diagram.
We’ve also got ToolBar in which all shapes intended for drawing are drawn dynamically. It also realizes the capability of creating special shapes, for example, for the object of transfer (under the red square):
We’ve also implemented control of creating and destructing of the objects. The detailed description is given here.
When the work is completed, we have the following log:
And the most important thing is that we’ve covered part of the code with tests. Currently, there are 174 of them.
At the same time such drawings appear on saving tests in PNG :
Then we check if DUnit works using FirstTest.
Then we check if DUnit works using FirstTest.
Next, we add first tests but at once classify them as integration or unit ones.
Let’s start with the integration tests. Using the first test we’ll find out whether all our shapes are registered:
We write two more tests to check the number of shapes we need:
And now we pass on to the unit tests.
To begin with, we write the base class of the unit test.
And now I’ll briefly tell about how it all works.
Although our class is an abstract one, the whole logic is hidden here. It is inherited from TTestCase in DUnit, therefore, if you like, any descendant can be registered for testing by realizing through inheritance the unique configurations, that are not included in the context.
The sense of testing (as we understand it; and it is not TDD at all) has been described in detail in our blog by the example of testing of the elementary calculator.
In brief – using the testing with etalons means saving values and the result of the test in file, which is compared to the etalon afterwards. If files do not coincide, the test failed. This raises a question: where will we get the etalon file? We have two ways: either we create it with our own hands or (as I did), if etalon is not available, we create it automatically on the basis of the file of testing results, since we suppose (we check manually as usual in the old way by eye) that our tests are obviously correct.
The attentive reader might have noticed that lambdas and anonymous methods are fully used in the class. For us it is one of the ways to support the DRY-principle. Where it is not enough, we use inheritance. I would not say which of them is the main one (more likely, it is important to combine and recognize the most appropriate method), but I can say for sure – we follow the principle by 95%. The remaining 5% are rather laziness or common sense.
I’ll stop teasing you with theory and show you descendant classes:
As we can see, not many things have changed. In fact, we’ve just said how to change the name of the result. It has been done because we’ll use base class for all tests. Anyway, only the following ones will check serialization, the other class will “result” in *.png.
The test of the shapes.
The only important line about the test of saving in *.png is here:
The whole text of the unit:
The class for test of saving in *.png looks like this:
Again, an attentive reader who works or worked with DUnit will notice there is no registration of testing classes. This means, if we add them to the project now, nothing will take place.
We’ll introduce a new class, a “set of tests”, or, as DUnit-team has called it, TestSuite.
Here it is, our “special magic”.
The new class is inherited from TestSuite and each class is “made” unique.
The explanation of only one method will be of special value. Let’s analyze it line by line.
Thanks to everybody who have read this far and, as always, criticism and commentaries are welcome.
Repository
Table of contents
Hello, dear readership.
In this post I want to tell about the changes in our project and also about the technologies and methods we’ve used to achieve our goals.
Now our project looks as follows:
Json of the picture drawn below and saved in PNG using 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 shape is now capable of “being the diagram”. It means we can choose a shape and build a new diagram “inside”. It is clearly demonstrated below.
The object TmsPicker is responsible for the capability of “falling into”. The object TmsUpToParrent is responsible for the returning to the parent diagram.
We’ve also got ToolBar in which all shapes intended for drawing are drawn dynamically. It also realizes the capability of creating special shapes, for example, for the object of transfer (under the red square):
We’ve also implemented control of creating and destructing of the objects. The detailed description is given here.
When the work is completed, we have the following log:
Lost objects: 0 TmsPaletteShape Lost: 0 Max objects of class used: 5 TmsPaletteShapeCreator Lost: 0 Max objects of class used: 1 TmsUpArrow Lost: 0 Max objects of class used: 1 TmsDashDotLine Lost: 0 Max objects of class used: 164 TmsLine Lost: 0 Max objects of class used: 278 TmsRectangle Lost: 0 Max objects of class used: 144 TmsCircle Lost: 0 Max objects of class used: 908 TmsLineWithArrow Lost: 0 Max objects of class used: 309 TmsDiagrammsController Lost: 0 Max objects of class used: 1 TmsStringList Lost: 0 Max objects of class used: 3 TmsCompletedShapeCreator Lost: 0 Max objects of class used: 2 TmsRoundedRectangle Lost: 0 Max objects of class used: 434 TmsTriangleDirectionRight Lost: 0 Max objects of class used: 5 TmsGreenCircle Lost: 0 Max objects of class used: 850 TmsSmallTriangle Lost: 0 Max objects of class used: 761 TmsShapeCreator Lost: 0 Max objects of class used: 1 TmsDashLine Lost: 0 Max objects of class used: 868 TmsGreenRectangle Lost: 0 Max objects of class used: 759 TmsDiagramm Lost: 0 Max objects of class used: 910 TmsDownArrow Lost: 0 Max objects of class used: 1 TmsDotLine Lost: 0 Max objects of class used: 274 TmsDiagramms Lost: 0 Max objects of class used: 3 TmsDiagrammsHolder Lost: 0 Max objects of class used: 18 TmsPointCircle Lost: 0 Max objects of class used: 717 TmsUseCaseLikeEllipse Lost: 0 Max objects of class used: 397 TmsBlackTriangle Lost: 0 Max objects of class used: 43 TmsRedRectangle Lost: 0 Max objects of class used: 139 TmsMoverIcon Lost: 0 Max objects of class used: 220 TmsTriangle Lost: 0 Max objects of class used: 437
And the most important thing is that we’ve covered part of the code with tests. Currently, there are 174 of them.
At the same time such drawings appear on saving tests in PNG :
The size of the “etalon” of checking the drawing of a red circle: 1048x2049 pixels. The file size is 1.7 MB.
But the details will be given further.
Let us start in reverse order.
The tests.
First of all, we add DUnit to the project. To do this, we add one line to the project, and then it looks like this:
program MindStream; uses FMX.Forms, … ; begin Application.Initialize; Application.CreateForm(TfmMain, fmMain); // We add our GUI_Runner that will, in its turn, find all unregistered tests u_fmGUITestRunner.RunRegisteredTestsModeless; Application.Run; end.
Then we check if DUnit works using 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.
Then we check if DUnit works using 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.
Next, we add first tests but at once classify them as integration or unit ones.
Let’s start with the integration tests. Using the first test we’ll find out whether all our shapes 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 write two more tests to check the number of shapes 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;
And now we pass on to the unit tests.
To begin with, 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);
// The context of testing stores all unique information for each test
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
// The context of testing stores all unique information for each test
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);
// The procedure of checking the results of the test with the etalone
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));
// We use the results of the PREVIOUS tests, which is incorrect in terms of TDD
// BUT! It is terribly effective.
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;
And now I’ll briefly tell about how it all works.
Although our class is an abstract one, the whole logic is hidden here. It is inherited from TTestCase in DUnit, therefore, if you like, any descendant can be registered for testing by realizing through inheritance the unique configurations, that are not included in the context.
The sense of testing (as we understand it; and it is not TDD at all) has been described in detail in our blog by the example of testing of the elementary calculator.
In brief – using the testing with etalons means saving values and the result of the test in file, which is compared to the etalon afterwards. If files do not coincide, the test failed. This raises a question: where will we get the etalon file? We have two ways: either we create it with our own hands or (as I did), if etalon is not available, we create it automatically on the basis of the file of testing results, since we suppose (we check manually as usual in the old way by eye) that our tests are obviously correct.
The attentive reader might have noticed that lambdas and anonymous methods are fully used in the class. For us it is one of the ways to support the DRY-principle. Where it is not enough, we use inheritance. I would not say which of them is the main one (more likely, it is important to combine and recognize the most appropriate method), but I can say for sure – we follow the principle by 95%. The remaining 5% are rather laziness or common sense.
I’ll stop teasing you with theory and show you descendant 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 we can see, not many things have changed. In fact, we’ve just said how to change the name of the result. It has been done because we’ll use base class for all tests. Anyway, only the following ones will check serialization, the other 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));
// We use the results of the PREVIOUS tests, which is incorrect in terms of TDD
// BUT! It is terribly effective.
l_FileName := TestResultsFileName;
l_Diagramms.SaveTo(l_FileName);
CheckFileWithEtalon(l_FileName);
finally
l_Diagramms := nil;
end; // try..finally
end;
The test of the 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;
The only important line about the test of saving in *.png is here:
function TTestSaveToPNG.TestResultsFileName: String; const c_PNG = 'PNG\'; begin // Since my college and I work on different monitors and so with different resolutions, we’re cheating a bit. Again, taking the common sense into account. Result := MakeFileName(Name, c_PNG + ComputerName + '\'); end;
The whole text of the unit:
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));
// We use the results of the PREVIOUS tests, which is incorrect in terms of TDD
// BUT! It is terribly effective.
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));
// We use the results of the PREVIOUS tests, which is incorrect in terms of TDD
// BUT! It is terribly effective.
l_FileName := TestResultsFileName;
l_Diagramms.SaveTo(l_FileName);
CheckFileWithEtalon(l_FileName);
finally
l_Diagramms := nil;
end; // try..finally
end;
end.
The class for test of saving 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 works or worked with DUnit will notice there is no registration of testing classes. This means, if we add them to the project now, nothing will take place.
We’ll introduce a new class, a “set of tests”, or, as DUnit-team has called it, TestSuite.
Here it is, our “special magic”.
The new class is inherited from TestSuite and each class is “made” 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 := 'Diagram ' + 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
// That is where the registration is!!!
RegisterTest(TmsShapesTest.Create);
RegisterTest(TmsDiagrammsTest.Create);
RegisterTest(TmsDiagrammsToPNGTest.Create);
end.
The explanation of only one method will be of special value. Let’s analyze it line by line.
procedure TmsParametrizedShapeTestSuite.AddTests(TestClass: TTestCaseClass);
begin
// The contract
Assert(TestClass.InheritsFrom(TmsShapeTestPrim));
// We set Random
RandSeed := 10;
// We create tests taking into account the context of testing
TmsShapeTestPrim.CheckShapes(
procedure(aShapeClass: RmsShape)
var
l_Method: TRttiMethod;
l_DiagrammName: String;
l_Seed: Integer;
l_ShapesCount: Integer;
begin
// We create the “unique” context! It is important!
// We set Random
l_Seed := Random(High(l_Seed));
// We generate the unique name for the diagram
l_DiagrammName := 'Diagram ' + IntToStr(Random(10));
// We set discrepancy in the number of shapes
l_ShapesCount := Random(1000) + 1;
// We apply the new RTTI to solve our problems (it is really that simple) and then call the required test with required parameters (context)
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;
Thanks to everybody who have read this far and, as always, criticism and commentaries are welcome.
Repository
Комментариев нет:
Отправить комментарий