(*--▽---------------------------▼--
テスト関数とテストクラス
2006/07/08
・TXPtestクラス/UnitTestオブジェクトを作成
・Check関数の実装をすべてVariantCheckに委ねてみた。
//--▲---------------------------△--*)
unit XPtest;

interface

procedure Check(A, B: String;    MessageText: String = ''); overload;
procedure Check(A, B: Integer;   MessageText: String = ''); overload;
procedure Check(A, B: Boolean;   MessageText: String = ''); overload;
//procedure Check(A, B: WideString); overload;
procedure Check(A, B: TDateTime; MessageText: String = ''); overload;
procedure Check(A, B: Extended;  MessageText: String = ''); overload;
procedure Check(A, B: Variant;   MessageText: String = ''); overload;

type
  TXPtest = class
  private
    FErrorCount: Integer;
    FCheckCount: Integer;
    FPassCount: Integer;
    FLogText: String;
    FAssertSwitch: Boolean;
    procedure VariantCheck(A, B: Variant);
    procedure SetAssertSwitch(const Value: Boolean);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Initialize;
    function Finalize: String;
    procedure WriteLog(LineStr: String);
    procedure Check(A, B: String); overload;
    procedure Check(A, B: Integer); overload;
    procedure Check(A, B: Boolean); overload;
    procedure Check(A, B: WideString); overload;
    procedure Check(A, B: TDateTime); overload;
    procedure Check(A, B: Extended); overload;
    procedure Check(A, B: Variant); overload;
    property ErrorCount: Integer read FErrorCount;
    property CheckCount: Integer read FCheckCount;
    property PassCount: Integer read FPassCount;
    property LogText: String read FLogText;
    property AssertSwitch: Boolean read FAssertSwitch write SetAssertSwitch;
  end;

function UnitTest: TXPtest;

implementation

uses SysUtils;


{----------------------------------------
procedure VariantCheck(A, B: Variant);
begin
  if not(A = B) then
  begin
    Assert(False,
      Format('Error A!=B'#13#10'A=%s'#13#10'B=%s'#13#10,
        [String(A), String(B)]));
  end;
end;
//----------------------------------------}

procedure VariantCheck(A, B: Variant; MessageText: String = '');
begin
 if not(A = B) then
 begin
   Assert(False,
     TrimRight(
       'not equal' + #13#10 +
       'A=' + String(A) + #13#10 +
       'B=' + String(B) + #13#10 +
       MessageText) ) ;
 end;
end;

procedure Check(A, B: String; MessageText: String = ''); overload;
begin
  VariantCheck(A, B, MessageText);
end;

procedure Check(A, B: Integer; MessageText: string = ''); overload;
begin
  VariantCheck(A, B, MessageText);
end;

procedure Check(A, B: Boolean; MessageText: string = ''); overload;
begin
  VariantCheck(A, B, MessageText);
end;

//procedure Check(A, B: WideString); overload
//begin
//  VariantCheck(A, B);
//end;

procedure Check(A, B: TDateTime; MessageText: string = ''); overload;
begin
  VariantCheck(A, B, MessageText);
end;

procedure Check(A, B: Extended; MessageText: string = ''); overload;
begin
  VariantCheck(A, B, MessageText);
end;

procedure Check(A, B: Variant; MessageText: string = ''); overload;
begin
  VariantCheck(A, B, MessageText);
end;


////////////////////////////////////////////////////////////
  { TXPtest }
////////////////////////////////////////////////////////////
(*--▽---------------------------▼--
◆TXPtestクラス/UnitTestオブジェクトの使い方
・UnitTestオブジェクトはシングルトンなので
  いきなり、UnitTest.InitializeとかUnitTest.Checkと呼び出すことができる
  破棄はアプリケーション終了時に行われる
・UnitTest.Initializeではログ消去、カウントクリアが行われる
・UnitTest.Finalizeではログのまとめがログに記録される
・UnitTest.WriteLogではログにメッセージを追加することができる。
・使い方
    procedure TForm1.Button1Click(Sender: TObject);
    begin
      UnitTest.Initialize;
      UnitTest.WriteLog('いまからテストAを行います');
      UnitTest.Check(5, 5);
      UnitTest.Check(10, 10);
      UnitTest.Check(20, 10);
      UnitTest.Finalize;
      ShowMessage(UnitTest.LogText);
      UnitTest.Initialize;
      UnitTest.WriteLog('いまからテストBを行います');
      UnitTest.Check(105, 105);
      UnitTest.Check(100, 100);
      UnitTest.Finalize;
      ShowMessage(UnitTest.LogText);
    end;
  このようなソースから次のメッセージが出力される
      ---------------------------
      Meminifiletest
      ---------------------------
      いまからテストAを行います
      1:PASS :A=5:B=5
      2:PASS :A=10:B=10
      3:ERROR:A=20:B=10
        テスト数:3  不合格数:1  合格数:2    エラー率:33.3%
      ---------------------------
      OK
      ---------------------------
      ---------------------------
      Project1
      ---------------------------
      いまからテストBを行います
      1:PASS :A=105:B=105
      2:PASS :A=100:B=100
        テスト数:2  不合格数:0  合格数:2    エラー率:0.0%
      ---------------------------
      OK
      ---------------------------

//--▲---------------------------△--*)

procedure AddLine(var S: String; const Line: String);
begin
  S := S + Line + #13#10;
end;

procedure TXPtest.Initialize;
begin
  FCheckCount := 0;
  FErrorCount := 0;
  FPassCount  := 0;
  FLogText := '';
end;

procedure TXPtest.SetAssertSwitch(const Value: Boolean);
begin
  FAssertSwitch := Value;
end;

function TXPtest.Finalize: String;
begin
  Result :=
    '  テスト数:'+IntToStr(FCheckCount)+
    '  不合格数:'+IntToStr(FErrorCount)+
    '  合格数:'  +IntToStr(FPassCount)+
    '    エラー率:'+ FormatFloat('#,##0.0', FErrorCount/FCheckCount*100)+'%';
  AddLine(FLogText, Result);
end;

procedure TXPtest.WriteLog(LineStr: String);
begin
  AddLine(FLogText, LineStr);
end;

constructor TXPtest.Create;
begin
  FAssertSwitch := False;
  Self.Initialize;
end;

destructor TXPtest.Destroy;
begin

  inherited;
end;

procedure TXPtest.VariantCheck(A, B: Variant);
var
  ResultText: String;
begin
  Inc(FCheckCount);
  if A=B then
  begin
    ResultText := 'PASS ';
    Inc(FPassCount);
  end else
  begin
    ResultText := 'ERROR';
    Inc(FErrorCount);
    if FAssertSwitch then
    begin
      Assert(False,
        'エラーです:A=' + String(A) + '|B=' + String(B));
    end;
  end;
  AddLine(FLogText,
    IntToStr(FCheckCount)+':'+ResultText+'|A='+String(A)+'|B='+String(B));
end;

procedure TXPtest.Check(A, B: WideString);
begin
  VariantCheck(A, B);
end;

procedure TXPtest.Check(A, B: TDateTime);
begin
  VariantCheck(A, B);
end;

procedure TXPtest.Check(A, B: Boolean);
begin
  VariantCheck(A, B);
end;

procedure TXPtest.Check(A, B: Integer);
begin
  VariantCheck(A, B);
end;

procedure TXPtest.Check(A, B: Extended);
begin
  VariantCheck(A, B);
end;

procedure TXPtest.Check(A, B: Variant);
begin
  VariantCheck(A, B);
end;

procedure TXPtest.Check(A, B: String);
begin
  VariantCheck(A, B);
end;

var
  XPtestInstance: TXPtest;

function UnitTest: TXPtest;
begin
  if Assigned(XPtestInstance)=False then
  begin
    XPtestInstance := TXPtest.Create;
  end;
  Result := XPtestInstance;
end;

initialization


finalization

  if Assigned(XPtestInstance) then
  begin
    XPtestInstance.Free;
  end;

end.