среда, 9 ноября 2016 г.

#1315. Продолжение "приколов". "Delphi по-немецки"

https://translate.google.com/translate?hl=&sl=ru&tl=de&u=http%3A%2F%2Fprogrammingmindstream.blogspot.fr%2F2014%2F11%2Fmindstream.html&sandbox=1

  Einheit TestmsSerializeController;

 Schnittstelle

 Anwendungen
   Testframework,
   msSerializeController,
   msDiagramm,
   msShape,
   msRegisteredShapes,
   System.Types,
   System.Classes
   ;

 Typ
   TmsShapeClassCheck = TmsShapeClassLambda;

   TmsShapeTestPrim = Klasse abstrakt (TTestCase)
   Öffentlichkeit
     Klasse Verfahren CheckShapes (aÜberprüfen und berichtigen: TmsShapeClassCheck);
   Ende; // TmsShapeTestPrim

   TmsShapeTestContext = record
    rMethodName: string;
    rSeed: Integer;
    rDiagrammName: String;
    rShapesCount: Integer;
    rShapeClass: RmsShape;
    Erstellen Konstruktor (aMethodName: string; aSeed: Integer; aDiagrammName: String; aShapesCount: Integer; aShapeClass: RmsShape);
   Ende; // TmsShapeTestContext

   TmsFileLambda = Verweis auf das Verfahren (aFile: TFileStream);
   TmsDiagrammCheck = Verweis auf das Verfahren (aDiagramm: TmsDiagramm);

   TestTmsSerializeControllerPrim = Klasse abstrakt (TmsShapeTestPrim)
   geschützt
    f_Coords: Array von TPoint;
    f_Context: TmsShapeTestContext;
   geschützt
     Verfahren SetUp;  außer Kraft setzen;
     Verfahren CheckFileWithEtalon (const AFileName: String);
     Funktion MakeFileName (const aTestName: String; aShapeClass: RmsShape): String;
     Funktion TestResultsFileName (aShapeClass: RmsShape): String;
     Verfahren SaveDiagrammAndCheck (aShapeClass: RmsShape; aDiagramm: TmsDiagramm);
     Funktion ShapesCount: Integer;
     Verfahren CreateDiagrammAndCheck (aÜberprüfen und berichtigen: TmsDiagrammCheck; const aName: String);
     Verfahren CreateDiagrammWithShapeAndSaveAndCheck (aShapeClass: RmsShape);
     Funktion TestSerializeMethodName: String;  virtuelle;
     Verfahren DeserializeDiargammAndCheck (aÜberprüfen und berichtigen: TmsDiagrammCheck; aShapeClass: RmsShape);
     Verfahren TestDeSerializeForShapeClass (aShapeClass: RmsShape);
     Verfahren TestDeSerializeViaShapeCheckForShapeClass (aShapeClass: RmsShape);
     Funktion ShapeClass: RmsShape;
     Verfahren OutToFileAndCheck (aLambda: TmsFileLambda);
   Öffentlichkeit
    Erstellen Konstruktor (const aContext: TmsShapeTestContext);  virtuelle;
   Ende; // TestTmsSerializeControllerPrim

   TestTmsSerializeController = Klasse abstrakt (TestTmsSerializeControllerPrim)
   veröffentlicht
     Verfahren TestSerialize;
     Verfahren TestDeSerialize;
     Verfahren TestDeSerializeViaShapeCheck;
     Verfahren TestShapeName;
     Verfahren TestDiagrammName;
   Ende; // TestTmsSerializeController

   TmsParametrizedShapeTest = class (TestTmsSerializeController)
   privat
    f_TestSerializeMethodName: String;
   geschützt
     Funktion TestSerializeMethodName: String;  außer Kraft setzen;
   Öffentlichkeit
    Erstellen Konstruktor (const aContext: TmsShapeTestContext);  außer Kraft setzen;
   Ende; // TmsParametrizedShapeTest

   RmsParametrizedShapeTest = Klasse von TmsParametrizedShapeTest;

   TmsParametrizedShapeTestSuite = class (TTestSuite)
   privat
    Konstruktor CreatePrim;
   Öffentlichkeit
    Verfahren AddTests (Testklasse: TTestCaseClass);  außer Kraft setzen;
    Erstellen Sie Klassenfunktion: ITest;
   Ende; // TmsParametrizedShapeTestSuite

 Implementierung

  Anwendungen
   System.SysUtils,
   msTriangle,
   msRectangle,
   msCircle,
   msRoundedRectangle,
   msMover,
   Winapi.Windows,
   System.Rtti,
   System.TypInfo,
   FMX.Objects
   ;

 Funktion TestTmsSerializeControllerPrim.MakeFileName (const aTestName: String; aShapeClass: RmsShape): String;
 var
  l_Folder: String;
 beginnen
  l_Folder: = ExtractFilePath (ParamStr (0)) + 'Test- ergebnisse \';
  Force (l_Folder);
  Ergebnis: = l_Folder + Class + '_' + aTestName + '_' + aShapeClass.ClassName + '.json';
 Ende;

 Verfahren TestTmsSerializeControllerPrim.CheckFileWithEtalon (const AFileName: String);
 var
  l_FileSerialized, l_FileEtalon: TStringList;
  l_FileNameEtalon: String;
 beginnen
  l_FileNameEtalon: = AFileName + '.etalon' + ExtractFileExt (AFileName);
  wenn FileExists (l_FileNameEtalon), dann
  beginnen
   l_FileSerialized: = TStringList.Create;
   l_FileSerialized.LoadFromFile (AFileName);

   l_FileEtalon: = TStringList.Create;
   l_FileEtalon.LoadFromFile (l_FileNameEtalon);

   CheckTrue (l_FileEtalon.Equals (l_FileSerialized));

   FreeAndNil (l_FileSerialized);
   FreeAndNil (l_FileEtalon);
  Ende // FileExists (l_FileNameEtalon)
  sonst
  beginnen
   Copyfile (PWideChar (AFileName), PWideChar (l_FileNameEtalon), True);
  Ende; // FileExists (l_FileNameEtalon)
 Ende;

 Funktion TestTmsSerializeControllerPrim.TestResultsFileName (aShapeClass: RmsShape): String;
 beginnen
  Ergebnis: = MakeFileName (Name, aShapeClass);
 Ende;

 Verfahren TestTmsSerializeControllerPrim.SaveDiagrammAndCheck (aShapeClass: RmsShape; aDiagramm: TmsDiagramm);
 var
  l_FileNameTest: String;
 beginnen
  l_FileNameTest: = TestResultsFileName (aShapeClass);
  TmsSerializeController.Serialize (l_FileNameTest, aDiagramm);
  CheckFileWithEtalon (l_FileNameTest);
 Ende;

 Funktion TestTmsSerializeControllerPrim.ShapesCount: Integer;
 beginnen
  Ergebnis: = f_Context.rShapesCount;
 Ende;

 Konstruktor TmsShapeTestContext.Create (aMethodName: string; aSeed: Integer; aDiagrammName: String; aShapesCount: Integer; aShapeClass: RmsShape);
 beginnen
  rMethodName: = aMethodName;
  rSeed: = aSeed;
  rDiagrammName: = aDiagrammName;
  rShapesCount: = aShapesCount;
  rShapeClass: = aShapeClass
 Ende;

 Verfahren TestTmsSerializeControllerPrim.SetUp;
 var
  l_Index: Integer;
  L_X: Integer;
  l_Y: Integer;
 beginnen
  geerbt;
  RandSeed: = f_Context.rSeed;
  SetLength (f_Coords, ShapesCount);
  für l_Index: = 0 bis Pred (ShapesCount) tun
  beginnen
   L_X: = Random (100);
   l_Y: = Random (200);
   f_Coords [l_Index]: = TPoint.Create (L_X, l_Y);
  Ende; // für l_Index
 Ende;

 Verfahren TestTmsSerializeControllerPrim.CreateDiagrammAndCheck (aÜberprüfen und berichtigen: TmsDiagrammCheck; const aName: String);
 var
  l_Diagramm: TmsDiagramm;
  l_Image: TImage;
 beginnen
  l_Image: = nil;
  versuchen
   l_Diagramm: = TmsDiagramm.Create (l_Image, aName);
   versuchen
    aÜberprüfen und berichtigen (l_Diagramm);
   schließlich
    FreeAndNil (l_Diagramm);
   Ende; // try..finally
  schließlich
   FreeAndNil (l_Image);
  Ende; // try..finally
 Ende;

 Verfahren TestTmsSerializeControllerPrim.CreateDiagrammWithShapeAndSaveAndCheck (aShapeClass: RmsShape);
 beginnen
  CreateDiagrammAndCheck (
   Verfahren (aDiagramm: TmsDiagramm)
   var
    L_p: TPoint;
   beginnen
    für L_p in f_Coords tun
     aDiagramm.ShapeList.Add (aShapeClass.Create (TmsMakeShapeContext.Create (TPointF.Create (l_P.X, l_P.Y), nil)));
    SaveDiagrammAndCheck (aShapeClass, aDiagramm);
   Ende
   , f_Context.rDiagrammName
  );
 Ende;

 Verfahren TestTmsSerializeController.TestSerialize;
 beginnen
  CreateDiagrammWithShapeAndSaveAndCheck (ShapeClass);
 Ende;

 Funktion TestTmsSerializeControllerPrim.TestSerializeMethodName: String;
 beginnen
  Ergebnis: = 'TestSerialize';
 Ende;

 Verfahren TestTmsSerializeControllerPrim.DeserializeDiargammAndCheck (aÜberprüfen und berichtigen: TmsDiagrammCheck; aShapeClass: RmsShape);
 beginnen
  CreateDiagrammAndCheck (
   Verfahren (aDiagramm: TmsDiagramm)
   beginnen
    TmsSerializeController.DeSerialize (MakeFileName (TestSerializeMethodName, aShapeClass), aDiagramm);
    aÜberprüfen und berichtigen (aDiagramm);
   Ende
   ''
  );
 Ende;

 Verfahren TestTmsSerializeControllerPrim.TestDeSerializeForShapeClass (aShapeClass: RmsShape);
 beginnen
  DeserializeDiargammAndCheck (
   Verfahren (aDiagramm: TmsDiagramm)
   beginnen
    SaveDiagrammAndCheck (aShapeClass, aDiagramm);
   Ende
  , aShapeClass
  );
 Ende;

 Verfahren TestTmsSerializeController.TestDeSerialize;
 beginnen
  TestDeSerializeForShapeClass (ShapeClass);
 Ende;

 Konstruktor TestTmsSerializeControllerPrim.Create (const aContext: TmsShapeTestContext);
 beginnen
  Create (aContext.rMethodName) geerbt;
  f_Context: = aContext;
 Ende;

 Verfahren TestTmsSerializeControllerPrim.TestDeSerializeViaShapeCheckForShapeClass (aShapeClass: RmsShape);
 beginnen
  DeserializeDiargammAndCheck (
   Verfahren (aDiagramm: TmsDiagramm)
   var
    l_Shape: TmsShape;
    l_Index: Integer;
   beginnen
    Überprüfen Sie (aDiagramm.Name = f_Context.rDiagrammName);
    Check (aDiagramm.ShapeList <> nil);
    Überprüfen Sie (aDiagramm.ShapeList.Count = ShapesCount);
    Check (Länge (f_Coords) = aDiagramm.ShapeList.Count);
    für l_Index: = 0 bis Pred (aDiagramm.ShapeList.Count) tun
    beginnen
     l_Shape: = aDiagramm.ShapeList [l_Index] .HackInstance Als TmsShape;
     Überprüfen Sie (l_Shape.ClassType = aShapeClass);
     Überprüfen Sie (l_Shape.StartPoint.X = f_Coords [l_Index] .X);
     Überprüfen Sie (l_Shape.StartPoint.Y = f_Coords [l_Index] .Y);
    Ende; // für l_Shape
   Ende
  , aShapeClass
  );
 Ende;

 Verfahren TestTmsSerializeController.TestDeSerializeViaShapeCheck;
 beginnen
  TestDeSerializeViaShapeCheckForShapeClass (ShapeClass);
 Ende;

 Verfahren TestTmsSerializeControllerPrim.OutToFileAndCheck (aLambda: TmsFileLambda);
 var
  l_FileNameTest: String;
  l_FS: TFileStream;
 beginnen
  l_FileNameTest: = TestResultsFileName (ShapeClass);
  l_FS: = TFileStream.Create (l_FileNameTest, fmCreate);
  versuchen
   aLambda (l_FS);
  schließlich
   FreeAndNil (l_FS);
  Ende; // try..finally
  CheckFileWithEtalon (l_FileNameTest);
 Ende;

 Verfahren TestTmsSerializeController.TestShapeName;
 beginnen
  OutToFileAndCheck (
   Verfahren (aFile: TFileStream)
   beginnen
    aFile.Write (Ansistring (ShapeClass.ClassName) [1], Länge (ShapeClass.ClassName));
   Ende
  );
 Ende;

 Verfahren TestTmsSerializeController.TestDiagrammName;
 beginnen
  OutToFileAndCheck (
   Verfahren (aFile: TFileStream)
   beginnen
    aFile.Write (Ansistring (f_Context.rDiagrammName) [1], Länge (f_Context.rDiagrammName));
   Ende
  );
 Ende;

 Klasse Verfahren TmsShapeTestPrim.CheckShapes (aÜberprüfen und berichtigen: TmsShapeClassCheck);
 beginnen
  TmsRegisteredShapes.IterateShapes (
   Verfahren (aShapeClass: RmsShape)
   beginnen
    wenn nicht aShapeClass.InheritsFrom (TmsMover), dann
     aÜberprüfen und berichtigen (aShapeClass);
   Ende
  );
 Ende;

 Funktion TestTmsSerializeControllerPrim.ShapeClass: RmsShape;
 beginnen
  Ergebnis: = f_Context.rShapeClass;
 Ende;

 Funktion TmsParametrizedShapeTest.TestSerializeMethodName: String;
 beginnen
  Ergebnis: = f_TestSerializeMethodName + TestSerializeMethodName geerbt;
 Ende;

 Konstruktor TmsParametrizedShapeTest.Create (const aContext: TmsShapeTestContext);
 beginnen
  Create (aContext) geerbt;
  FTestName: = f_Context.rShapeClass.ClassName + '.'  + AContext.rMethodName;
  f_TestSerializeMethodName: = f_Context.rShapeClass.ClassName +; '.'
 Ende;

 // TmsParametrizedShapeTestSuite

 Konstruktor TmsParametrizedShapeTestSuite.CreatePrim;
 beginnen
  Create (TmsParametrizedShapeTest) geerbt;
 Ende;

 Klasse Funktion TmsParametrizedShapeTestSuite.Create: ITest;
 beginnen
  Ergebnis: = CreatePrim;
 Ende;

 Verfahren TmsParametrizedShapeTestSuite.AddTests (Testklasse: TTestCaseClass);
 beginnen
  Behaupten (testClass.InheritsFrom (TmsParametrizedShapeTest));

  RandSeed: = 10;
  TmsShapeTestPrim.CheckShapes (
   Verfahren (aShapeClass: RmsShape)
   var
    l_Method: TRttiMethod;
    l_DiagrammName: String;
    l_Seed: Integer;
    l_ShapesCount: Integer;
   beginnen
    l_Seed: = Random (High (l_Seed));
    l_DiagrammName: = 'Diagramm №' + IntToStr (Random (10));
    l_ShapesCount: = Random (1000) + 1;
    für l_Method in TRttiContext.Create.GetType (Testclass) .GetMethods tun
     if (l_Method.Visibility = mvPublished), dann
       AddTest (RmsParametrizedShapeTest (Testklasse) .Create (TmsShapeTestContext.Create (l_Method.Name, l_Seed, l_DiagrammName, l_ShapesCount, aShapeClass)));
   Ende
  );
 Ende;

 Initialisierung
   RegisterTest (TmsParametrizedShapeTestSuite.Create);
 Ende.

#1314. Ссылка. Так интереснее