пятница, 13 февраля 2015 г.

MindStream. Part 5. Testing

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:






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

Комментариев нет:

Отправить комментарий