MonaTest.pas

   1 {$D-,Y-}
   2 {----------------------------------------------------------
   3         MonaTest
   4
   5         History
   6         2001.03.07 Check String\94Å\8dì\90¬
   7         2001.03.08 Check Integer\94Å\8dì\90¬
   8         2001.03.08 Check Int64\94Å\8dì\90¬
   9         2001.03.08 Check Single\8dì\90¬
  10         2001.03.08 Check Double\94Å\8dì\90¬
  11         2001.03.08 Check Extended\94Å\8dì\90¬
  12         2001.03.10 TestResult\8dì\90¬
  13         2001.03.10 Check Boolean\94Å\8dì\90¬
  14         2001.03.10 msg\82ð\96³\8e\8b\82µ\82Ä\82¢\82½\82Ì\82ð\8fC\90³
  15         2001.03.10 Error\8eè\91±\82«\8dì\90¬
  16         2001.03.11 Check Condition: Boolean\94Å\8dì\90¬
  17 ----------------------------------------------------------}
  18 unit MonaTest;
  19
  20 interface
  21 uses
  22         SysUtils, Classes;
  23
  24 type
  25         ETestFailure = class(Exception);
  26         ETestError = class(Exception);
  27
  28 procedure ClearTestResult;
  29
  30 var
  31         TestResult: record
  32                 Success: Integer;
  33                 Failure: Integer;
  34                 Error: Integer;
  35         end;
  36
  37 procedure Success;
  38 procedure Fail(msg: String); overload;
  39 procedure Fail(format: String; args: array of const); overload;
  40 procedure Error(msg: String); overload;
  41 procedure Error(format: String; args: array of const); overload;
  42 procedure Error(E: Exception); overload;
  43
  44 procedure Check(Condition: Boolean; msg: String = ''); overload;
  45 procedure Check(Actual, Required: String; msg: String = ''); overload;
  46 procedure Check(Actual, Required: Integer; msg: String = ''); overload;
  47 procedure Check(Actual, Required: Int64; msg: String = ''); overload;
  48 procedure Check(Actual, Required: Single; msg: String = ''); overload;
  49 procedure Check(Actual, Required: Double; msg: String = ''); overload;
  50 procedure Check(Actual, Required: Extended; msg: String = ''); overload;
  51 procedure Check(Actual, Required: Boolean; msg: String = ''); overload;
  52
  53 implementation
  54
  55 procedure ClearTestResult;
  56 begin
  57         with TestResult do
  58         begin
  59                 Success := 0;
  60                 Failure := 0;
  61                 Error := 0;
  62         end;
  63 end;
  64
  65 procedure Success;
  66 begin
  67         Inc(TestResult.Success);
  68 end;
  69
  70 procedure Fail(msg: String);
  71 begin
  72         Inc(TestResult.Failure);
  73         raise ETestFailure.CreateFmt('test failure: %s', [msg]);
  74 end;
  75
  76 procedure Fail(format: String; args: array of const);
  77 begin
  78         Fail(SysUtils.Format(format, args));
  79 end;
  80
  81 procedure Error(msg: String);
  82 begin
  83         Inc(TestResult.Error);
  84         raise ETestFailure.CreateFmt('test error: %s', [msg]);
  85 end;
  86
  87 procedure Error(format: String; args: array of const);
  88 begin
  89         Error(SysUtils.Format(format, args));
  90 end;
  91
  92 procedure Error(E: Exception);
  93 begin
  94         Error('test error: %s: %s', [E.Message, E.ClassName]);
  95 end;
  96
  97 procedure Check(Condition: Boolean; msg: String);
  98 begin
  99         if not Condition then
 100                 Fail('Condition = False, %s', [msg])
 101         else
 102                 Success;
 103 end;
 104
 105 procedure Check(Actual, Required: String; msg: String);
 106 begin
 107         if Actual <> Required then
 108                 Fail('''%s''=''%s'', String, %s', [Actual, Required, msg])
 109         else
 110                 Success;
 111 end;
 112
 113 procedure Check(Actual, Required: Integer; msg: String);
 114 begin
 115         if Actual <> Required then
 116                 Fail('''%d''=''%d'', Integer, %s', [Actual, Required, msg]);
 117 end;
 118
 119 procedure Check(Actual, Required: Int64; msg: String);
 120 begin
 121         if Actual <> Required then
 122                 Fail('''%d''=''%d'', Int64, %s', [Actual, Required, msg]);
 123 end;
 124
 125 procedure Check(Actual, Required: Single; msg: String);
 126 begin
 127         if Actual <> Required then
 128                 Fail('''%f''=''%f'', Single, %s', [Actual, Required, msg]);
 129 end;
 130
 131 procedure Check(Actual, Required: Double; msg: String);
 132 begin
 133         if Actual <> Required then
 134                 Fail('''%f''=''%f'', Double, %s', [Actual, Required, msg]);
 135 end;
 136
 137 procedure Check(Actual, Required: Extended; msg: String);
 138 begin
 139         if Actual <> Required then
 140                 Fail('''%f''=''%f'', Extended, %s', [Actual, Required, msg]);
 141 end;
 142
 143 procedure Check(Actual, Required: Boolean; msg: String);
 144 begin
 145         if Actual <> Required then
 146                 Fail('''%f''=''%f'', Boolean, %s', [Actual, Required, msg]);
 147 end;
 148
 149 end.