MindStream. As we write software under FireMonkey. Part 5. Testing

    Part 1.
    Part 2.
    Part 3. DUnit + FireMonkey
    Part 3.1. Based on GUIRunner
    Part 4. Serialization

    Hello, dear Khabrovites.

    In this post I want to talk about the changes that have occurred with our project, as well as about the technologies and techniques that we used to achieve our goals.

    Now our project looks like this:



    The diagram can be saved in Json, as well as restored from Json, which I wrote about in a previous article.
    Json of the picture drawn below and saved in PNG thanks to the program:
    {
    	"type": "msDiagramms.TmsDiagramms",
    	"id": 1,
    	"fields": {
    		"f_Items": [{
    			"type": "msDiagramm.TmsDiagramm",
    			"id": 2,
    			"fields": {
    				"fName": "¹1",
    				"f_Items": [{
    					"type": "msRoundedRectangle.TmsRoundedRectangle",
    					"id": 3,
    					"fields": {
    						"FStartPoint": [[110,
    						186],
    						110,
    						186],
    						"f_Items": []
    					}
    				},
    				{
    					"type": "msRoundedRectangle.TmsRoundedRectangle",
    					"id": 4,
    					"fields": {
    						"FStartPoint": [[357,
    						244],
    						357,
    						244],
    						"f_Items": []
    					}
    				},
    				{
    					"type": "msTriangle.TmsTriangle",
    					"id": 5,
    					"fields": {
    						"FStartPoint": [[244,
    						58],
    						244,
    						58],
    						"f_Items": []
    					}
    				},
    				{
    					"type": "msLineWithArrow.TmsLineWithArrow",
    					"id": 6,
    					"fields": {
    						"FFinishPoint": [[236,
    						110],
    						236,
    						110],
    						"FStartPoint": [[156,
    						175],
    						156,
    						175],
    						"f_Items": []
    					}
    				},
    				{
    					"type": "msLineWithArrow.TmsLineWithArrow",
    					"id": 7,
    					"fields": {
    						"FFinishPoint": [[262,
    						109],
    						262,
    						109],
    						"FStartPoint": [[327,
    						199],
    						327,
    						199],
    						"f_Items": []
    					}
    				},
    				{
    					"type": "msUseCaseLikeEllipse.TmsUseCaseLikeEllipse",
    					"id": 8,
    					"fields": {
    						"FStartPoint": [[52,
    						334],
    						52,
    						334],
    						"f_Items": []
    					}
    				},
    				{
    					"type": "msUseCaseLikeEllipse.TmsUseCaseLikeEllipse",
    					"id": 9,
    					"fields": {
    						"FStartPoint": [[171,
    						336],
    						171,
    						336],
    						"f_Items": []
    					}
    				},
    				{
    					"type": "msLineWithArrow.TmsLineWithArrow",
    					"id": 10,
    					"fields": {
    						"FFinishPoint": [[98,
    						232],
    						98,
    						232],
    						"FStartPoint": [[62,
    						300],
    						62,
    						300],
    						"f_Items": []
    					}
    				},
    				{
    					"type": "msLineWithArrow.TmsLineWithArrow",
    					"id": 11,
    					"fields": {
    						"FFinishPoint": [[133,
    						233],
    						133,
    						233],
    						"FStartPoint": [[167,
    						299],
    						167,
    						299],
    						"f_Items": []
    					}
    				},
    				{
    					"type": "msRectangle.TmsRectangle",
    					"id": 12,
    					"fields": {
    						"FStartPoint": [[302,
    						395],
    						302,
    						395],
    						"f_Items": []
    					}
    				},
    				{
    					"type": "msRectangle.TmsRectangle",
    					"id": 13,
    					"fields": {
    						"FStartPoint": [[458,
    						389],
    						458,
    						389],
    						"f_Items": []
    					}
    				},
    				{
    					"type": "msLineWithArrow.TmsLineWithArrow",
    					"id": 14,
    					"fields": {
    						"FFinishPoint": [[361,
    						292],
    						361,
    						292],
    						"FStartPoint": [[308,
    						351],
    						308,
    						351],
    						"f_Items": []
    					}
    				},
    				{
    					"type": "msLineWithArrow.TmsLineWithArrow",
    					"id": 15,
    					"fields": {
    						"FFinishPoint": [[389,
    						292],
    						389,
    						292],
    						"FStartPoint": [[455,
    						344],
    						455,
    						344],
    						"f_Items": []
    					}
    				},
    				{
    					"type": "msCircle.TmsCircle",
    					"id": 16,
    					"fields": {
    						"FStartPoint": [[58,
    						51],
    						58,
    						51],
    						"f_Items": []
    					}
    				},
    				{
    					"type": "msLineWithArrow.TmsLineWithArrow",
    					"id": 17,
    					"fields": {
    						"FFinishPoint": [[88,
    						94],
    						88,
    						94],
    						"FStartPoint": [[108,
    						141],
    						108,
    						141],
    						"f_Items": []
    					}
    				}]
    			}
    		}]
    	}
    }
    




    Each figure has become able to “be a diagram." That is, we can select a shape and build “inside” a new chart. More clearly demonstrated below.

    The TmsPicker object is responsible for the ability to "fall inward." The TmsUpToParrent object is responsible for returning to the parent diagram.

    image

    We also got a ToolBar, in which all shapes intended for drawing are dynamically drawn, and the ability to create special shapes, for example, for a moving object (under the red square)



    , is implemented : We also implemented control over the creation / deletion of objects. Detailed description
    here .
    After the application finishes, we get the following log:
    MindStream.exe.objects.log
    Неосвобождено объектов: 0
    TmsPaletteShape Неосвобождено: 0 Максимально распределено: 5
    TmsPaletteShapeCreator Неосвобождено: 0 Максимально распределено: 1
    TmsUpArrow Неосвобождено: 0 Максимально распределено: 1
    TmsDashDotLine Неосвобождено: 0 Максимально распределено: 164
    TmsLine Неосвобождено: 0 Максимально распределено: 278
    TmsRectangle Неосвобождено: 0 Максимально распределено: 144
    TmsCircle Неосвобождено: 0 Максимально распределено: 908
    TmsLineWithArrow Неосвобождено: 0 Максимально распределено: 309
    TmsDiagrammsController Неосвобождено: 0 Максимально распределено: 1
    TmsStringList Неосвобождено: 0 Максимально распределено: 3
    TmsCompletedShapeCreator Неосвобождено: 0 Максимально распределено: 2
    TmsRoundedRectangle Неосвобождено: 0 Максимально распределено: 434
    TmsTriangleDirectionRight Неосвобождено: 0 Максимально распределено: 5
    TmsGreenCircle Неосвобождено: 0 Максимально распределено: 850
    TmsSmallTriangle Неосвобождено: 0 Максимально распределено: 761
    TmsShapeCreator Неосвобождено: 0 Максимально распределено: 1
    TmsDashLine Неосвобождено: 0 Максимально распределено: 868
    TmsGreenRectangle Неосвобождено: 0 Максимально распределено: 759
    TmsDiagramm Неосвобождено: 0 Максимально распределено: 910
    TmsDownArrow Неосвобождено: 0 Максимально распределено: 1
    TmsDotLine Неосвобождено: 0 Максимально распределено: 274
    TmsDiagramms Неосвобождено: 0 Максимально распределено: 3
    TmsDiagrammsHolder Неосвобождено: 0 Максимально распределено: 18
    TmsPointCircle Неосвобождено: 0 Максимально распределено: 717
    TmsUseCaseLikeEllipse Неосвобождено: 0 Максимально распределено: 397
    TmsBlackTriangle Неосвобождено: 0 Максимально распределено: 43
    TmsRedRectangle Неосвобождено: 0 Максимально распределено: 139
    TmsMoverIcon Неосвобождено: 0 Максимально распределено: 220
    TmsTriangle Неосвобождено: 0 Максимально распределено: 437

    Well and most importantly, we covered some of the code with tests. To date, there are 174.



    At the same time, the following drawings are born on saving tests in PNG:
    imageimageimage

    The size of the “standard” of checking the drawing of the red circle: 1048x2049 pixels. File size 1.7 MB.
    However, the details are further.

    Let's start in the reverse order.

    Tests.



    First of all, connect DUnit to the project. To do this, add one line to the project, after which it looks like this:
    program MindStream;
    uses
      FMX.Forms,
      …
      ;
    begin
      Application.Initialize;
      Application.CreateForm(TfmMain, fmMain);
      // Подключаем свой GUI_Runner, который в свою очередь найдет все зарегестрированные тесты
      u_fmGUITestRunner.RunRegisteredTestsModeless;
      Application.Run;
    end.
    

    Now let's check the health of DUnit with FirstTest.
    unit FirstTest;
    interfaceuses
      TestFrameWork;
    typeTFirstTest = class(TTestCase)
      publishedprocedureDoIt;end; // TFirstTestimplementationuses
      SysUtils;
    procedureTFirstTest.DoIt;begin
      Check(true);
    end;
    initialization
    TestFrameWork.RegisterTest(TFirstTest.Suite);
    end.
    

    The next step is to add the first tests, however, we will immediately divide them by classification:
    integration;
    modular.

    Let's start with the integration. The first test will find out if all our pieces are registered:
    unit RegisteredShapesTest;
    interfaceuses
      TestFrameWork;
    typeTRegisteredShapesTest = class(TTestCase)
      publishedprocedureShapesRegistredCount;procedureTestFirstShape;procedureTestIndexOfTmsLine;end; // TRegisteredShapesTestimplementationuses
      SysUtils,
      msRegisteredShapes,
      msShape,
      msLine,
      FMX.Objects,
      FMX.Graphics;
    procedureTRegisteredShapesTest.ShapesRegistredCount;var
      l_Result: integer;
    begin
      l_Result := 0;
      TmsRegisteredShapes.IterateShapes(
        procedure(aShapeClass: RmsShape)beginInc(l_Result);end);
      CheckTrue(l_Result = 23, ' Expected 23 - Get ' + IntToStr(l_Result));
    end;
    procedureTRegisteredShapesTest.TestFirstShape;begin
      CheckTrue(TmsRegisteredShapes.Instance.First = TmsLine);
    end;
    procedureTRegisteredShapesTest.TestIndexOfTmsLine;begin
      CheckTrue(TmsRegisteredShapes.Instance.IndexOf(TmsLine) = 0);
    end;
    initialization
      TestFrameWork.RegisterTest(TRegisteredShapesTest.Suite);
    end.
    

    We will write two more such tests to check the number of figures that we need:
    ...
    typeTUtilityShapesTest = class(TTestCase)
      publishedprocedureShapesRegistredCount;procedureTestFirstShape;procedureTestIndexOfTmsLine;end; // TUtilityShapesTest
    ...
    procedureTUtilityShapesTest.ShapesRegistredCount;var
      l_Result: integer;
    begin
      l_Result := 0;
      TmsUtilityShapes.IterateShapes(
        procedure(aShapeClass: RmsShape)beginAssert(aShapeClass.IsForToolbar);
          Inc(l_Result);
        end);
      CheckTrue(l_Result = 5, ' Expected 5 - Get ' + IntToStr(l_Result));
    end;
    …
      TForToolbarShapesTest = class(TTestCase)
      publishedprocedureShapesRegistredCount;procedureTestFirstShape;procedureTestIndexOfTmsLine;end; // TForToolbarShapesTestprocedureTForToolbarShapesTest.ShapesRegistredCount;var
      l_Result: integer;
    begin
      l_Result := 0;
      TmsShapesForToolbar.IterateShapes(
        procedure(aShapeClass: RmsShape)beginAssert(aShapeClass.IsForToolbar);
          Inc(l_Result);
        end);
      CheckTrue(l_Result = 18, ' Expected 18 - Get ' + IntToStr(l_Result));
    end;
    

    Now let's move on to modular ones.
    To begin, we write the base class of the unit test.
    type
      TmsShapeClassCheck = TmsShapeClassLambda;
      TmsDiagrammCheck = reference toprocedure(const aDiagramm: ImsDiagramm);
      TmsDiagrammSaveTo = reference toprocedure(const aFileName: String; const aDiagramm: ImsDiagramm);// контекст тестирования хранит в себе всю уникальную информацию для  каждого теста
      TmsShapeTestContext = record
        rMethodName: string;
        rSeed: Integer;
        rDiagrammName: String;
        rShapesCount: Integer;
        rShapeClass: RmsShape;
        constructorCreate(aMethodName: string;
        aSeed: Integer; aDiagrammName: string; aShapesCount: Integer; aShapeClass: RmsShape);end; // TmsShapeTestContext
      TmsShapeTestPrim = classabstract(TTestCase)
      protected// контекст тестирования хранит в себе всю уникальную информацию для  каждого теста
        f_Context: TmsShapeTestContext;
        f_TestSerializeMethodName: String;
        f_Coords: arrayof TPoint;
      protectedclassfunctionComputerName: AnsiString;
        functionTestResultsFileName:String; virtual;
        functionMakeFileName(const aTestName: string; const aTestFolder: string):String; virtual;
        procedureCreateDiagrammAndCheck(aCheck: TmsDiagrammCheck; const aName: String);// Процедура проверки результатов теста с эталонномprocedureCheckFileWithEtalon(const aFileName: String);procedureSaveDiagramm(const aFileName: String; const aDiagramm: ImsDiagramm);virtual;
        procedureSaveDiagrammAndCheck(const aDiagramm: ImsDiagramm; aSaveTo: TmsDiagrammSaveTo);procedureOutToFileAndCheck(aLambda: TmsLogLambda);procedureSetUp;override;
        functionShapesCount: Integer;
        procedureCreateDiagrammWithShapeAndSaveAndCheck;functionTestSerializeMethodName:String;
        procedureDeserializeDiargammAndCheck(aCheck: TmsDiagrammCheck);procedureTestDeSerializeForShapeClass;procedureTestDeSerializeViaShapeCheckForShapeClass;publicclassprocedureCheckShapes(aCheck: TmsShapeClassCheck);constructorCreate(const aContext: TmsShapeTestContext);end; // TmsShapeTestPrimfunctionTmsShapeTestPrim.MakeFileName(const aTestName: string; const aTestFolder: string):String;
    var
      l_Folder: String;
    begin
      l_Folder := ExtractFilePath(ParamStr(0)) + 'TestResults\' + aTestFolder;
      ForceDirectories(l_Folder);
      Result := l_Folder + ClassName + '_' + aTestName + '_' + f_Context.rShapeClass.ClassName;
    end;
    procedureTmsShapeTestPrim.CheckFileWithEtalon(const aFileName: String);var
      l_FileNameEtalon: String;
    begin
      l_FileNameEtalon := aFileName + '.etalon' + ExtractFileExt(aFileName);
      if FileExists(l_FileNameEtalon) thenbegin
        CheckTrue(msCompareFiles(l_FileNameEtalon, aFileName));
      end// FileExists(l_FileNameEtalon)elsebegin
        CopyFile(PWideChar(aFileName), PWideChar(l_FileNameEtalon), True);
      end; // FileExists(l_FileNameEtalon)end;
    const
      c_JSON = 'JSON\';
    functionTmsShapeTestPrim.TestResultsFileName:String;
    begin
      Result := MakeFileName(Name, c_JSON);
    end;
    classfunctionTmsShapeTestPrim.ComputerName: AnsiString;
    var
      l_CompSize: Integer;
    begin
      l_CompSize := MAX_COMPUTERNAME_LENGTH + 1;
      SetLength(Result, l_CompSize);
      Win32Check(GetComputerNameA(PAnsiChar(Result), LongWord(l_CompSize)));
      SetLength(Result, l_CompSize);
    end;
    procedureTmsShapeTestPrim.SaveDiagramm(const aFileName: String; const aDiagramm: ImsDiagramm);begin
      aDiagramm.SaveTo(aFileName);
    end;
    procedureTmsShapeTestPrim.SaveDiagrammAndCheck(const aDiagramm: ImsDiagramm; aSaveTo: TmsDiagrammSaveTo);var
      l_FileNameTest: String;
    begin
      l_FileNameTest := TestResultsFileName;
      aSaveTo(l_FileNameTest, aDiagramm);
      CheckFileWithEtalon(l_FileNameTest);
    end;
    functionTmsShapeTestPrim.ShapesCount: Integer;
    begin
      Result := f_Context.rShapesCount;
    end;
    constructorTmsShapeTestContext.Create(aMethodName: string; aSeed: Integer; aDiagrammName: string; aShapesCount: Integer;
      aShapeClass: RmsShape);begin
      rMethodName := aMethodName;
      rSeed := aSeed;
      rDiagrammName := aDiagrammName;
      rShapesCount := aShapesCount;
      rShapeClass := aShapeClass;
    end;
    procedureTmsShapeTestPrim.SetUp;var
      l_Index: Integer;
      l_X: Integer;
      l_Y: Integer;
    begininherited;
      RandSeed := f_Context.rSeed;
      SetLength(f_Coords, ShapesCount);
      for l_Index := 0to Pred(ShapesCount) dobegin
        l_X := Random(c_MaxCanvasWidth);
        l_Y := Random(c_MaxCanvasHeight);
        f_Coords[l_Index] := TPoint.Create(l_X, l_Y);
      end; // for l_Indexend;
    procedureTmsShapeTestPrim.CreateDiagrammAndCheck(aCheck: TmsDiagrammCheck; const aName: String);var
      l_Diagramm: ImsDiagramm;
    begin
      l_Diagramm := TmsDiagramm.Create(aName);
      try
        aCheck(l_Diagramm);
      finally
        l_Diagramm := nil;
      end; // try..finallyend;
    procedureTmsShapeTestPrim.CreateDiagrammWithShapeAndSaveAndCheck;begin
      CreateDiagrammAndCheck(
        procedure(const aDiagramm: ImsDiagramm)varl_P: TPoint;
        beginfor l_P in f_Coords do
            aDiagramm.AddShape(TmsCompletedShapeCreator.Create(f_Context.rShapeClass)
              .CreateShape(TmsMakeShapeContext.Create(TPointF.Create(l_P.X, l_P.Y), nil, nil))).AddNewDiagramm;
          SaveDiagrammAndCheck(aDiagramm, SaveDiagramm);
        end, f_Context.rDiagrammName);
    end;
    functionTmsCustomShapeTest.MakeFileName(const aTestName: string; const aFileExtension: string):String;
    begin
      Result := inherited + '.json';
    end;
    functionTmsShapeTestPrim.TestSerializeMethodName:String;
    begin
      Result := f_TestSerializeMethodName + 'TestSerialize';
    end;
    procedureTmsShapeTestPrim.DeserializeDiargammAndCheck(aCheck: TmsDiagrammCheck);begin
      CreateDiagrammAndCheck(
        procedure(const aDiagramm: ImsDiagramm)beginaDiagramm.LoadFrom(MakeFileName(TestSerializeMethodName, c_JSON));// - берём результаты от ПРЕДЫДУЩИХ тестов, НЕКОШЕРНО с точки зрения TDD// НО! Чертовски эффективно.
          aCheck(aDiagramm);
        end, '');
    end;
    procedureTmsShapeTestPrim.TestDeSerializeForShapeClass;begin
      DeserializeDiargammAndCheck(
        procedure(const aDiagramm: ImsDiagramm)beginSaveDiagrammAndCheck(aDiagramm, SaveDiagramm);end);
    end;
    constructorTmsShapeTestPrim.Create(const aContext: TmsShapeTestContext);begininherited Create(aContext.rMethodName);
      f_Context := aContext;
      FTestName := f_Context.rShapeClass.ClassName + '.' + aContext.rMethodName;
      f_TestSerializeMethodName := f_Context.rShapeClass.ClassName + '.';
    end;
    procedureTmsShapeTestPrim.TestDeSerializeViaShapeCheckForShapeClass;begin
      DeserializeDiargammAndCheck(
        procedure(const aDiagramm: ImsDiagramm)varl_Shape: ImsShape;
          l_Index: Integer;
        begin
          Check(aDiagramm.Name = f_Context.rDiagrammName);
          Check(Length(f_Coords) = aDiagramm.ItemsCount);
          l_Index := 0;
          for l_Shape in aDiagramm dobegin
            Check(l_Shape.ClassType = f_Context.rShapeClass);
            Check(l_Shape.StartPoint.X = f_Coords[l_Index].X);
            Check(l_Shape.StartPoint.Y = f_Coords[l_Index].Y);
            Inc(l_Index);
          end; // for l_Shapeend);
    end;
    procedureTmsShapeTestPrim.OutToFileAndCheck(aLambda: TmsLogLambda);var
      l_FileNameTest: String;
    begin
      l_FileNameTest := TestResultsFileName;
      TmsLog.Log(l_FileNameTest,
        procedure(aLog: TmsLog)beginaLambda(aLog);end);
      CheckFileWithEtalon(l_FileNameTest);
    end;
    classprocedureTmsShapeTestPrim.CheckShapes(aCheck: TmsShapeClassCheck);begin
      TmsRegisteredShapes.IterateShapes(
        procedure(aShapeClass: RmsShape)beginifnotaShapeClass.IsToolthenaCheck(aShapeClass);end);
    end;
    

    Well, now briefly about how it all works.
    Although our class, although it is abstract, all logic is hidden here. It is inherited from TTestCase from DUnit, which means that, if desired, any descendant can be registered for testing, realizing, thanks to inheritance, unique settings that are not included in the context.

    Sam washed away the testing (as we see it; and this is not at all TDD) we described in great detail on the example of testing the simplest calculator in our blog .

    In a nutshell - the use of testing using standards involves saving the values ​​and test result to a file, which we then compare with the reference. If the files do not match, then the test “failed”. This begs the question: where do we get the reference file? And here we have two options: either we will create it by hand, or (as I did) if the standard does not exist, then we create it automatically based on the file of the test result, since we assume (we manually check in the old fashioned way by eye) that the tests are us obviously right.

    As an attentive reader noted, lambdas and anonymous methods are used in full in the class . This, for us, is one way to uphold the DRY principle., where this is not enough, we use - inheritance. I won’t say which of them is the main one (rather, the combination and ability to recognize where which technique is better is important), but I can say for sure that we adhere to the principle by 95%. The remaining 5 are rather laziness or common sense.

    I’ll stop tormenting with theory and show descendant classes:
      RmsShapeTest = classof TmsShapeTestPrim;
      TmsCustomShapeTest = class(TmsShapeTestPrim)
      protectedfunctionMakeFileName(const aTestName: string; const aFileExtension: string):String; override;
      publishedprocedureTestSerialize;end; // TmsCustomShapeTestfunctionTmsCustomShapeTest.MakeFileName(const aTestName: string; const aFileExtension: string):String;
    begin
      Result := inherited + '.json';
    end;
    procedureTmsCustomShapeTest.TestSerialize;begin
      CreateDiagrammWithShapeAndSaveAndCheck;
    end;
    

    As you can see, not much has changed. In fact, we just said how to change the name of the result. This is because we will use the base class for all tests. However, only the following will check serialization, another class will “result” in * .png.
    TmsDiagrammTest = class(TmsCustomShapeTest)
      protectedprocedureSaveDiagramm(const aFileName: String; const aDiagramm: ImsDiagramm);override;
      publishedprocedureTestDeSerialize;end; // TmsDiagrammTestprocedureTmsDiagrammTest.SaveDiagramm(const aFileName: String; const aDiagramm: ImsDiagramm);var
      l_Diagramms: ImsDiagramms;
    begin
      l_Diagramms := TmsDiagramms.Create;
      try
        l_Diagramms.AddDiagramm(aDiagramm);
        l_Diagramms.SaveTo(aFileName);
      finally
        l_Diagramms := nil;
      end; // try..finallyend;
    procedureTmsDiagrammTest.TestDeSerialize;var
      l_Diagramms: ImsDiagramms;
      l_FileName: String;
    begin
      l_Diagramms := TmsDiagramms.Create;
      try
        l_Diagramms.LoadFrom(MakeFileName(TestSerializeMethodName, c_JSON));
        // - берём результаты от ПРЕДЫДУЩИХ тестов, НЕКОШЕРНО с точки зрения TDD// НО! Чертовски эффективно.
        l_FileName := TestResultsFileName;
        l_Diagramms.SaveTo(l_FileName);
        CheckFileWithEtalon(l_FileName);
      finally
        l_Diagramms := nil;
      end; // try..finallyend;
    


    Test figures.
    TmsShapeTest = class(TmsCustomShapeTest)
      publishedprocedureTestDeSerialize;procedureTestDeSerializeViaShapeCheck;procedureTestShapeName;procedureTestDiagrammName;end; // TmsShapeTestprocedureTmsShapeTest.TestDeSerializeViaShapeCheck;begin
      TestDeSerializeViaShapeCheckForShapeClass;
    end;
    procedureTmsShapeTest.TestDeSerialize;begin
      TestDeSerializeForShapeClass;
    end;
    procedureTmsShapeTest.TestShapeName;begin
      OutToFileAndCheck(
        procedure(aLog: TmsLog)beginaLog.ToLog(f_Context.rShapeClass.ClassName);end);
    end;
    procedureTmsShapeTest.TestDiagrammName;begin
      OutToFileAndCheck(
        procedure(aLog: TmsLog)beginaLog.ToLog(f_Context.rDiagrammName);end);
    end;
    


    About the save test in png, the only important line here:
    functionTTestSaveToPNG.TestResultsFileName:String;
    const
      c_PNG = 'PNG\';
    begin// Так как мы с коллегой работаем на разных мониторах, соответственно, с разными расширениями, мы тут немножко читим. Опять же, учитывая здравый смысл. 
      Result := MakeFileName(Name, c_PNG + ComputerName + '\');
    end;
    


    Full text of the module:
    unit msShapeTest;
    interfaceuses
      TestFramework,
      msDiagramm,
      msShape,
      msRegisteredShapes,
      System.Types,
      System.Classes,
      msCoreObjects,
      msInterfaces;
    type
      TmsShapeClassCheck = TmsShapeClassLambda;
      TmsDiagrammCheck = reference toprocedure(const aDiagramm: ImsDiagramm);
      TmsDiagrammSaveTo = reference toprocedure(const aFileName: String; const aDiagramm: ImsDiagramm);
      TmsShapeTestContext = record
        rMethodName: string;
        rSeed: Integer;
        rDiagrammName: String;
        rShapesCount: Integer;
        rShapeClass: RmsShape;
        constructorCreate(aMethodName: string;
        aSeed: Integer; aDiagrammName: string; aShapesCount: Integer; aShapeClass: RmsShape);end; // TmsShapeTestContext
      TmsShapeTestPrim = classabstract(TTestCase)
      protected
        f_Context: TmsShapeTestContext;
        f_TestSerializeMethodName: String;
        f_Coords: arrayof TPoint;
      protectedclassfunctionComputerName: AnsiString;
        functionTestResultsFileName:String; virtual;
        functionMakeFileName(const aTestName: string; const aTestFolder: string):String; virtual;
        procedureCreateDiagrammAndCheck(aCheck: TmsDiagrammCheck; const aName: String);procedureCheckFileWithEtalon(const aFileName: String);procedureSaveDiagramm(const aFileName: String; const aDiagramm: ImsDiagramm);virtual;
        procedureSaveDiagrammAndCheck(const aDiagramm: ImsDiagramm; aSaveTo: TmsDiagrammSaveTo);procedureOutToFileAndCheck(aLambda: TmsLogLambda);procedureSetUp;override;
        functionShapesCount: Integer;
        procedureCreateDiagrammWithShapeAndSaveAndCheck;functionTestSerializeMethodName:String;
        procedureDeserializeDiargammAndCheck(aCheck: TmsDiagrammCheck);procedureTestDeSerializeForShapeClass;procedureTestDeSerializeViaShapeCheckForShapeClass;publicclassprocedureCheckShapes(aCheck: TmsShapeClassCheck);constructorCreate(const aContext: TmsShapeTestContext);end; // TmsShapeTestPrim
      RmsShapeTest = classof TmsShapeTestPrim;
      TmsCustomShapeTest = class(TmsShapeTestPrim)
      protectedfunctionMakeFileName(const aTestName: string; const aFileExtension: string):String; override;
      publishedprocedureTestSerialize;end; // TmsCustomShapeTestTmsDiagrammTest = class(TmsCustomShapeTest)
      protectedprocedureSaveDiagramm(const aFileName: String; const aDiagramm: ImsDiagramm);override;
      publishedprocedureTestDeSerialize;end; // TmsDiagrammTestTmsShapeTest = class(TmsCustomShapeTest)
      publishedprocedureTestDeSerialize;procedureTestDeSerializeViaShapeCheck;procedureTestShapeName;procedureTestDiagrammName;end; // TmsShapeTestimplementationuses
      System.SysUtils,
      Winapi.Windows,
      System.Rtti,
      System.TypInfo,
      FMX.Objects,
      msSerializeInterfaces,
      msDiagrammMarshal,
      msDiagrammsMarshal,
      msStringList,
      msDiagramms,
      Math,
      msStreamUtils,
      msTestConstants,
      msShapeCreator,
      msCompletedShapeCreator;
    functionTmsShapeTestPrim.MakeFileName(const aTestName: string; const aTestFolder: string):String;
    var
      l_Folder: String;
    begin
      l_Folder := ExtractFilePath(ParamStr(0)) + 'TestResults\' + aTestFolder;
      ForceDirectories(l_Folder);
      Result := l_Folder + ClassName + '_' + aTestName + '_' + f_Context.rShapeClass.ClassName;
    end;
    procedureTmsShapeTestPrim.CheckFileWithEtalon(const aFileName: String);var
      l_FileNameEtalon: String;
    begin
      l_FileNameEtalon := aFileName + '.etalon' + ExtractFileExt(aFileName);
      if FileExists(l_FileNameEtalon) thenbegin
        CheckTrue(msCompareFiles(l_FileNameEtalon, aFileName));
      end// FileExists(l_FileNameEtalon)elsebegin
        CopyFile(PWideChar(aFileName), PWideChar(l_FileNameEtalon), True);
      end; // FileExists(l_FileNameEtalon)end;
    const
      c_JSON = 'JSON\';
    functionTmsShapeTestPrim.TestResultsFileName:String;
    begin
      Result := MakeFileName(Name, c_JSON);
    end;
    classfunctionTmsShapeTestPrim.ComputerName: AnsiString;
    var
      l_CompSize: Integer;
    begin
      l_CompSize := MAX_COMPUTERNAME_LENGTH + 1;
      SetLength(Result, l_CompSize);
      Win32Check(GetComputerNameA(PAnsiChar(Result), LongWord(l_CompSize)));
      SetLength(Result, l_CompSize);
    end;
    procedureTmsShapeTestPrim.SaveDiagramm(const aFileName: String; const aDiagramm: ImsDiagramm);begin
      aDiagramm.SaveTo(aFileName);
    end;
    procedureTmsShapeTestPrim.SaveDiagrammAndCheck(const aDiagramm: ImsDiagramm; aSaveTo: TmsDiagrammSaveTo);var
      l_FileNameTest: String;
    begin
      l_FileNameTest := TestResultsFileName;
      aSaveTo(l_FileNameTest, aDiagramm);
      CheckFileWithEtalon(l_FileNameTest);
    end;
    functionTmsShapeTestPrim.ShapesCount: Integer;
    begin
      Result := f_Context.rShapesCount;
    end;
    constructorTmsShapeTestContext.Create(aMethodName: string; aSeed: Integer; aDiagrammName: string; aShapesCount: Integer;
      aShapeClass: RmsShape);begin
      rMethodName := aMethodName;
      rSeed := aSeed;
      rDiagrammName := aDiagrammName;
      rShapesCount := aShapesCount;
      rShapeClass := aShapeClass;
    end;
    procedureTmsShapeTestPrim.SetUp;var
      l_Index: Integer;
      l_X: Integer;
      l_Y: Integer;
    begininherited;
      RandSeed := f_Context.rSeed;
      SetLength(f_Coords, ShapesCount);
      for l_Index := 0to Pred(ShapesCount) dobegin
        l_X := Random(c_MaxCanvasWidth);
        l_Y := Random(c_MaxCanvasHeight);
        f_Coords[l_Index] := TPoint.Create(l_X, l_Y);
      end; // for l_Indexend;
    procedureTmsShapeTestPrim.CreateDiagrammAndCheck(aCheck: TmsDiagrammCheck; const aName: String);var
      l_Diagramm: ImsDiagramm;
    begin
      l_Diagramm := TmsDiagramm.Create(aName);
      try
        aCheck(l_Diagramm);
      finally
        l_Diagramm := nil;
      end; // try..finallyend;
    procedureTmsShapeTestPrim.CreateDiagrammWithShapeAndSaveAndCheck;begin
      CreateDiagrammAndCheck(
        procedure(const aDiagramm: ImsDiagramm)varl_P: TPoint;
        beginfor l_P in f_Coords do
            aDiagramm.AddShape(TmsCompletedShapeCreator.Create(f_Context.rShapeClass)
              .CreateShape(TmsMakeShapeContext.Create(TPointF.Create(l_P.X, l_P.Y), nil, nil))).AddNewDiagramm;
          SaveDiagrammAndCheck(aDiagramm, SaveDiagramm);
        end, f_Context.rDiagrammName);
    end;
    functionTmsCustomShapeTest.MakeFileName(const aTestName: string; const aFileExtension: string):String;
    begin
      Result := inherited + '.json';
    end;
    procedureTmsCustomShapeTest.TestSerialize;begin
      CreateDiagrammWithShapeAndSaveAndCheck;
    end;
    functionTmsShapeTestPrim.TestSerializeMethodName:String;
    begin
      Result := f_TestSerializeMethodName + 'TestSerialize';
    end;
    procedureTmsShapeTestPrim.DeserializeDiargammAndCheck(aCheck: TmsDiagrammCheck);begin
      CreateDiagrammAndCheck(
        procedure(const aDiagramm: ImsDiagramm)beginaDiagramm.LoadFrom(MakeFileName(TestSerializeMethodName, c_JSON));// - берём результаты от ПРЕДЫДУЩИХ тестов, НЕКОШЕРНО с точки зрения TDD// НО! Чертовски эффективно.
          aCheck(aDiagramm);
        end, '');
    end;
    procedureTmsShapeTestPrim.TestDeSerializeForShapeClass;begin
      DeserializeDiargammAndCheck(
        procedure(const aDiagramm: ImsDiagramm)beginSaveDiagrammAndCheck(aDiagramm, SaveDiagramm);end);
    end;
    procedureTmsShapeTest.TestDeSerialize;begin
      TestDeSerializeForShapeClass;
    end;
    constructorTmsShapeTestPrim.Create(const aContext: TmsShapeTestContext);begininherited Create(aContext.rMethodName);
      f_Context := aContext;
      FTestName := f_Context.rShapeClass.ClassName + '.' + aContext.rMethodName;
      f_TestSerializeMethodName := f_Context.rShapeClass.ClassName + '.';
    end;
    procedureTmsShapeTestPrim.TestDeSerializeViaShapeCheckForShapeClass;begin
      DeserializeDiargammAndCheck(
        procedure(const aDiagramm: ImsDiagramm)varl_Shape: ImsShape;
          l_Index: Integer;
        begin
          Check(aDiagramm.Name = f_Context.rDiagrammName);
          Check(Length(f_Coords) = aDiagramm.ItemsCount);
          l_Index := 0;
          for l_Shape in aDiagramm dobegin
            Check(l_Shape.ClassType = f_Context.rShapeClass);
            Check(l_Shape.StartPoint.X = f_Coords[l_Index].X);
            Check(l_Shape.StartPoint.Y = f_Coords[l_Index].Y);
            Inc(l_Index);
          end; // for l_Shapeend);
    end;
    procedureTmsShapeTest.TestDeSerializeViaShapeCheck;begin
      TestDeSerializeViaShapeCheckForShapeClass;
    end;
    procedureTmsShapeTestPrim.OutToFileAndCheck(aLambda: TmsLogLambda);var
      l_FileNameTest: String;
    begin
      l_FileNameTest := TestResultsFileName;
      TmsLog.Log(l_FileNameTest,
        procedure(aLog: TmsLog)beginaLambda(aLog);end);
      CheckFileWithEtalon(l_FileNameTest);
    end;
    procedureTmsShapeTest.TestShapeName;begin
      OutToFileAndCheck(
        procedure(aLog: TmsLog)beginaLog.ToLog(f_Context.rShapeClass.ClassName);end);
    end;
    procedureTmsShapeTest.TestDiagrammName;begin
      OutToFileAndCheck(
        procedure(aLog: TmsLog)beginaLog.ToLog(f_Context.rDiagrammName);end);
    end;
    classprocedureTmsShapeTestPrim.CheckShapes(aCheck: TmsShapeClassCheck);begin
      TmsRegisteredShapes.IterateShapes(
        procedure(aShapeClass: RmsShape)beginifnotaShapeClass.IsToolthenaCheck(aShapeClass);end);
    end;
    // TmsDiagrammTestprocedureTmsDiagrammTest.SaveDiagramm(const aFileName: String; const aDiagramm: ImsDiagramm);var
      l_Diagramms: ImsDiagramms;
    begin
      l_Diagramms := TmsDiagramms.Create;
      try
        l_Diagramms.AddDiagramm(aDiagramm);
        l_Diagramms.SaveTo(aFileName);
      finally
        l_Diagramms := nil;
      end; // try..finallyend;
    procedureTmsDiagrammTest.TestDeSerialize;var
      l_Diagramms: ImsDiagramms;
      l_FileName: String;
    begin
      l_Diagramms := TmsDiagramms.Create;
      try
        l_Diagramms.LoadFrom(MakeFileName(TestSerializeMethodName, c_JSON));
        // - берём результаты от ПРЕДЫДУЩИХ тестов, НЕКОШЕРНО с точки зрения TDD// НО! Чертовски эффективно.
        l_FileName := TestResultsFileName;
        l_Diagramms.SaveTo(l_FileName);
        CheckFileWithEtalon(l_FileName);
      finally
        l_Diagramms := nil;
      end; // try..finallyend;
    end.
    


    The class for the save test in * .png looks like this:
    unit TestSaveToPNG;
    interfaceuses
      TestFrameWork,
      msShapeTest,
      msInterfaces;
    typeTTestSaveToPNG = class(TmsShapeTestPrim)
      protectedfunctionMakeFileName(const aTestName: string; const aTestFolder: string):String; override;
        functionTestResultsFileName:String; override;
        procedureSaveDiagramm(const aFileName: String; const aDiagramm: ImsDiagramm);override;
      publishedprocedureCreateDiagrammWithShapeAndSaveToPNG_AndCheck;end; // TTestSaveToPNGimplementationuses
      SysUtils,
      System.Types,
      msRegisteredShapes,
      FMX.Graphics;
    { TTestSaveToPNG }procedureTTestSaveToPNG.SaveDiagramm(const aFileName: String; const aDiagramm: ImsDiagramm);begin
      aDiagramm.SaveToPng(aFileName);
    end;
    procedureTTestSaveToPNG.CreateDiagrammWithShapeAndSaveToPNG_AndCheck;begin
      CreateDiagrammWithShapeAndSaveAndCheck;
    end;
    functionTTestSaveToPNG.MakeFileName(const aTestName: string; const aTestFolder: string):String;
    begin
      Result := inherited + '.png';
    end;
    functionTTestSaveToPNG.TestResultsFileName:String;
    const
      c_PNG = 'PNG\';
    begin
      Result := MakeFileName(Name, c_PNG + ComputerName + '\');
    end;
    initializationend.
    

    Again, an attentive reader who worked / works with DUnit will notice that there are no registration of test classes. So, we screw them now to the project, nothing will happen.

    We introduce a new class, which will be a “test suite” or, as the DUnit team called it, TestSuite.

    Here it is - "our special magic."

    We will inherit a new class from TestSuite. Moreover, we will “make” each class unique.
    unit msShapeTestSuite;
    interfaceuses
      TestFramework,
      msShape,
      msShapeTest;
    typeTmsParametrizedShapeTestSuite = class(TTestSuite)
      privateconstructorCreatePrim;protectedclassfunctionTestClass: RmsShapeTest; virtual; abstract;
      publicprocedureAddTests(TestClass: TTestCaseClass);override;
        classfunctionCreate: ITest;
      end; // TmsParametrizedShapeTestSuiteTmsShapesTest = class(TmsParametrizedShapeTestSuite)
      protectedclassfunctionTestClass: RmsShapeTest; override;
      end; // TmsShapesTestTmsDiagrammsTest = class(TmsParametrizedShapeTestSuite)
      protectedclassfunctionTestClass: RmsShapeTest; override;
      end; // TmsDiagrammsTestTmsDiagrammsToPNGTest = class(TmsParametrizedShapeTestSuite)
      protectedclassfunctionTestClass: RmsShapeTest; override;
      end; // TmsDiagrammsTestimplementationuses
      System.TypInfo,
      System.Rtti,
      SysUtils,
      TestSaveToPNG;
    // TmsShapesTestclassfunctionTmsShapesTest.TestClass: RmsShapeTest;
    begin
      Result := TmsShapeTest;
    end;
    // TmsDiagrammsTestclassfunctionTmsDiagrammsTest.TestClass: RmsShapeTest;
    begin
      Result := TmsDiagrammTest;
    end;
    // TmsParametrizedShapeTestSuiteconstructorTmsParametrizedShapeTestSuite.CreatePrim;begininherited Create(TestClass);
    end;
    classfunctionTmsParametrizedShapeTestSuite.Create: ITest;
    begin
      Result := CreatePrim;
    end;
    procedureTmsParametrizedShapeTestSuite.AddTests(TestClass: TTestCaseClass);begin
      Assert(TestClass.InheritsFrom(TmsShapeTestPrim));
      RandSeed := 10;
      TmsShapeTestPrim.CheckShapes(
        procedure(aShapeClass: RmsShape)varl_Method: TRttiMethod;
          l_DiagrammName: String;
          l_Seed: Integer;
          l_ShapesCount: Integer;
        begin
          l_Seed := Random(High(l_Seed));
          l_DiagrammName := 'Диаграмма ' + IntToStr(Random(10));
          l_ShapesCount := Random(1000) + 1;
          for l_Method in TRttiContext.Create.GetType(TestClass).GetMethods doif (l_Method.Visibility = mvPublished) then
              AddTest(RmsShapeTest(TestClass).Create(TmsShapeTestContext.Create(l_Method.Name, l_Seed, l_DiagrammName, l_ShapesCount,
                aShapeClass)));
        end);
    end;
    { TmsDiagrammsToPNGTest }classfunctionTmsDiagrammsToPNGTest.TestClass: RmsShapeTest;
    begin
      Result := TTestSaveToPNG;
    end;
    initialization// Вот где регистрация !!!
    RegisterTest(TmsShapesTest.Create);
    RegisterTest(TmsDiagrammsTest.Create);
    RegisterTest(TmsDiagrammsToPNGTest.Create);
    end.
    

    The greatest value in the explanation requires only one method. We will analyze it line by line.
    procedureTmsParametrizedShapeTestSuite.AddTests(TestClass: TTestCaseClass);begin// Контракт
      Assert(TestClass.InheritsFrom(TmsShapeTestPrim));
      // Задаем Random
      RandSeed := 10;
      // Создаем тесты с учетом контекста тестирования
      TmsShapeTestPrim.CheckShapes(
        procedure(aShapeClass: RmsShape)varl_Method: TRttiMethod;
          l_DiagrammName: String;
          l_Seed: Integer;
          l_ShapesCount: Integer;
        begin// Создаем “уникальный” контекст! Важно!// Задаем Random
          l_Seed := Random(High(l_Seed));
          // Формируем уникальное имя для диаграммы
          l_DiagrammName := 'Диаграмма ' + IntToStr(Random(10));
          // Задаем погрешность количества фигур
          l_ShapesCount := Random(1000) + 1;
          // Применяем новый RTTI. Для решения нужных нам проблем (всё вот так просто :), ну и далее вызываем нужный нам тест, с нужными нам параметрами (контекстом))for l_Method in TRttiContext.Create.GetType(TestClass).GetMethods doif (l_Method.Visibility = mvPublished) then
              AddTest(RmsShapeTest(TestClass).Create(TmsShapeTestContext.Create(l_Method.Name, 
    																			l_Seed, 
    																			l_DiagrammName, 
    																			l_ShapesCount, 
    																			aShapeClass)));
        end);
    end;
    

    Thanks to everyone who read, as always, comments and comments are welcome.

    Repository

    Also popular now: