source: tags/1.4.0/UTest.pas

unit UTest;

interface

uses
  Classes, SysUtils, Generics.Collections, UVCard;

type
  TTestResult = (trNone, trPassed, trFailed);

  { TTestCase }

  TTestCase = class
  public
    Name: string;
    Result: TTestResult;
    Log: string;
    procedure Run; virtual;
    procedure Evaluate(Passed: Boolean);
    procedure Pass;
    procedure Fail;
  end;

  TTestCaseClass = class of TTestCase;

  { TTestCases }

  TTestCases = class(TObjectList<TTestCase>)
    function AddNew(Name: string; TestClass: TTestCaseClass): TTestCase;
  end;

  TTestCaseActionKind = (akNone, akRemoveExactDuplicates);

  { TTestCaseLoadSave }

  TTestCaseLoadSave = class(TTestCase)
    Input: string;
    Output: string;
    Action: TTestCaseActionKind;
    procedure Run; override;
  end;

  { TTestCaseCheckProperty }

  TTestCaseCheckProperty = class(TTestCase)
    Input: string;
    ContactIndex: Integer;
    Index: TContactFieldIndex;
    Value: string;
    procedure Run; override;
  end;

resourcestring
  SNone = 'None';
  SPassed = 'Passed';
  SFailed = 'Failed';

const
  ResultText: array[TTestResult] of string = (SNone, SPassed, SFailed);

procedure Translate;


implementation

uses
  UVCardFile;

resourcestring
  SExpected = 'Expected:';
  SOutput = 'Output:';

procedure Translate;
begin
  ResultText[trNone] := SNone;
  ResultText[trPassed] := SPassed;
  ResultText[trFailed] := SFailed;
end;

{ TTestCaseCheckProperty }

procedure TTestCaseCheckProperty.Run;
var
  Lines: TStringList;
  PropertyValue: string;
begin
  Lines := TStringList.Create;
  try
    with TVCardFile.Create(nil) do
    try
      Lines.Text := Input;
      VCard.LoadFromStrings(Lines);
      if ContactIndex < VCard.Contacts.Count then begin
        PropertyValue := VCard.Contacts[ContactIndex].Fields[Index];
        Evaluate(PropertyValue = Value);
      end else Fail;
      Log := SExpected + LineEnding +
        '"' + Value + '"' + LineEnding + LineEnding +
        SOutput + LineEnding +
        '"' + PropertyValue + '"';
    finally
      Free;
    end;
  finally
    Lines.Free;
  end;
end;

{ TTestCaseLoadSave }

procedure TTestCaseLoadSave.Run;
var
  Lines: TStringList;
begin
  Lines := TStringList.Create;
  try
    with TVCardFile.Create(nil) do
    try
      Lines.Text := Input;
      VCard.LoadFromStrings(Lines);

      if Action = akRemoveExactDuplicates then
        VCard.Contacts.RemoveExactDuplicates;

      Lines.Text := '';
      VCard.SaveToStrings(Lines);
      Evaluate(Lines.Text = Output);
      Log := SExpected + LineEnding +
        '"' + Output + '"' + LineEnding + LineEnding +
        SOutput + LineEnding +
        '"' + Lines.Text + '"';
    finally
      Free;
    end;
  finally
    Lines.Free;
  end;
end;

{ TTestCase }

procedure TTestCase.Run;
begin
end;

procedure TTestCase.Evaluate(Passed: Boolean);
begin
  if Passed then Result := trPassed
    else Result := trFailed;
end;

procedure TTestCase.Pass;
begin
  Result := trPassed;
end;

procedure TTestCase.Fail;
begin
  Result := trFailed;
end;

{ TTestCases }

function TTestCases.AddNew(Name: string; TestClass: TTestCaseClass): TTestCase;
begin
  Result := TestClass.Create;
  Result.Name := Name;
  Add(Result);
end;

end.