| 1 | unit TestCase;
|
|---|
| 2 |
|
|---|
| 3 | interface
|
|---|
| 4 |
|
|---|
| 5 | uses
|
|---|
| 6 | Classes, SysUtils, FileUtil, Generics.Collections;
|
|---|
| 7 |
|
|---|
| 8 | type
|
|---|
| 9 | TTestResult = (trNone, trPassed, trFailed);
|
|---|
| 10 |
|
|---|
| 11 | { TTestCase }
|
|---|
| 12 |
|
|---|
| 13 | TTestCase = class
|
|---|
| 14 | public
|
|---|
| 15 | Name: string;
|
|---|
| 16 | TestResult: TTestResult;
|
|---|
| 17 | Log: string;
|
|---|
| 18 | procedure Initialize; virtual;
|
|---|
| 19 | procedure Run; virtual;
|
|---|
| 20 | procedure Finalize; virtual;
|
|---|
| 21 | procedure Evaluate(Passed: Boolean);
|
|---|
| 22 | procedure Pass;
|
|---|
| 23 | procedure Fail;
|
|---|
| 24 | constructor Create; virtual;
|
|---|
| 25 | end;
|
|---|
| 26 |
|
|---|
| 27 | TTestCaseClass = class of TTestCase;
|
|---|
| 28 |
|
|---|
| 29 | { TTestCases }
|
|---|
| 30 |
|
|---|
| 31 | TTestCases = class(TObjectList<TTestCase>)
|
|---|
| 32 | function AddNew(Name: string; TestClass: TTestCaseClass): TTestCase;
|
|---|
| 33 | procedure Run;
|
|---|
| 34 | end;
|
|---|
| 35 |
|
|---|
| 36 |
|
|---|
| 37 | resourcestring
|
|---|
| 38 | SNone = 'None';
|
|---|
| 39 | SPassed = 'Passed';
|
|---|
| 40 | SFailed = 'Failed';
|
|---|
| 41 |
|
|---|
| 42 | const
|
|---|
| 43 | ResultText: array[TTestResult] of string = (SNone, SPassed, SFailed);
|
|---|
| 44 |
|
|---|
| 45 | procedure Translate;
|
|---|
| 46 |
|
|---|
| 47 |
|
|---|
| 48 | implementation
|
|---|
| 49 |
|
|---|
| 50 | procedure Translate;
|
|---|
| 51 | begin
|
|---|
| 52 | ResultText[trNone] := SNone;
|
|---|
| 53 | ResultText[trPassed] := SPassed;
|
|---|
| 54 | ResultText[trFailed] := SFailed;
|
|---|
| 55 | end;
|
|---|
| 56 |
|
|---|
| 57 | { TTestCase }
|
|---|
| 58 |
|
|---|
| 59 | procedure TTestCase.Initialize;
|
|---|
| 60 | begin
|
|---|
| 61 | TestResult := trNone;
|
|---|
| 62 | end;
|
|---|
| 63 |
|
|---|
| 64 | procedure TTestCase.Run;
|
|---|
| 65 | begin
|
|---|
| 66 | end;
|
|---|
| 67 |
|
|---|
| 68 | procedure TTestCase.Finalize;
|
|---|
| 69 | begin
|
|---|
| 70 | end;
|
|---|
| 71 |
|
|---|
| 72 | procedure TTestCase.Evaluate(Passed: Boolean);
|
|---|
| 73 | begin
|
|---|
| 74 | if Passed then TestResult := trPassed
|
|---|
| 75 | else TestResult := trFailed;
|
|---|
| 76 | end;
|
|---|
| 77 |
|
|---|
| 78 | procedure TTestCase.Pass;
|
|---|
| 79 | begin
|
|---|
| 80 | TestResult := trPassed;
|
|---|
| 81 | end;
|
|---|
| 82 |
|
|---|
| 83 | procedure TTestCase.Fail;
|
|---|
| 84 | begin
|
|---|
| 85 | TestResult := trFailed;
|
|---|
| 86 | end;
|
|---|
| 87 |
|
|---|
| 88 | constructor TTestCase.Create;
|
|---|
| 89 | begin
|
|---|
| 90 | end;
|
|---|
| 91 |
|
|---|
| 92 | { TTestCases }
|
|---|
| 93 |
|
|---|
| 94 | function TTestCases.AddNew(Name: string; TestClass: TTestCaseClass): TTestCase;
|
|---|
| 95 | begin
|
|---|
| 96 | Result := TestClass.Create;
|
|---|
| 97 | Result.Name := Name;
|
|---|
| 98 | Add(Result);
|
|---|
| 99 | end;
|
|---|
| 100 |
|
|---|
| 101 | procedure TTestCases.Run;
|
|---|
| 102 | var
|
|---|
| 103 | I: Integer;
|
|---|
| 104 | Passed: Integer;
|
|---|
| 105 | Failed: Integer;
|
|---|
| 106 | begin
|
|---|
| 107 | Passed := 0;
|
|---|
| 108 | Failed := 0;
|
|---|
| 109 | for I := 0 to Count - 1 do
|
|---|
| 110 | with Items[I] do begin
|
|---|
| 111 | WriteLn('== ' + Name + ' ======= ');
|
|---|
| 112 | Initialize;
|
|---|
| 113 | Run;
|
|---|
| 114 | Finalize;
|
|---|
| 115 | if TestResult = trPassed then Inc(Passed);
|
|---|
| 116 | if TestResult = trFailed then Inc(Failed);
|
|---|
| 117 | end;
|
|---|
| 118 |
|
|---|
| 119 | for I := 0 to Count - 1 do
|
|---|
| 120 | with Items[I] do begin
|
|---|
| 121 | WriteLn(Name + ': ' + ResultText[TestResult]);
|
|---|
| 122 | end;
|
|---|
| 123 | WriteLn('Total: ' + IntToStr(Count) + ', Passed: ' + IntToStr(Passed) +
|
|---|
| 124 | ', Failed: ' + IntToStr(Failed));
|
|---|
| 125 | end;
|
|---|
| 126 |
|
|---|
| 127 | end.
|
|---|