Заметки о тестировании, программировании и прочий "поток сознания", который жалко писать "в стол"
понедельник, 28 ноября 2016 г.
четверг, 24 ноября 2016 г.
вторник, 22 ноября 2016 г.
понедельник, 21 ноября 2016 г.
воскресенье, 20 ноября 2016 г.
среда, 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.