xpobservertests.pas

For Delphi的单元测试工具DUnit的源代码

unit XPObserverTests;

interface

uses
  XPObserver,
  TestFrameWork;

type

  IXPCrackedObserver = interface(IXPObserver)
    ['{2523055E-E109-44E8-8A27-1663E0747493}']
    function RefCount: integer;
    procedure SetSubject(const Subject: IXPSubject);
    function GetSubject: IXPSubject;

    property Subject: IXPSubject
      read GetSubject write SetSubject;
  end;

  IXPCrackedSubject = interface(IXPSubject)
    ['{C469C949-3B53-4E5D-836F-5BE5A7F81718}']
    function RefCount: integer;
  end;

  IXPCrackedSubjects = interface(IXPSubjects)
    ['{26D4DFF5-2326-4AD0-9C9F-6D8251B1316D}']
    function RefCount: integer;
  end;

  IXPCrackedParent = interface(IXPFamily)
    ['{04FE35A5-8C4A-4230-9D01-3F480EB89454}']
    function RefCount: integer;
  end;

  TXPSubjectsTests = class(TTestCase)
  private

    FSubject: IXPCrackedSubject;
    FSubject2: IXPCrackedSubject;
    FSubject3: IXPCrackedSubject;
    FSubject4: IXPCrackedSubject;

  protected

    procedure SetUp; override;
    procedure TearDown; override;

  published

    // Test methods
    procedure TestAddSubject;
    procedure TestDeleteSubject;
    procedure TestClear;
    procedure TestCreate;

  end;

type
  TXPSubjectTests = class(TTestCase)
  private

    FObserver: IXPCrackedObserver;
    FObserver2: IXPCrackedObserver;
    FObserver3: IXPCrackedObserver;
    FObserver4: IXPCrackedObserver;

  protected

    procedure SetUp; override;
    procedure TearDown; override;

  published

    // Test methods
    procedure TestObserverCount;
    procedure TestAddObserver;
    procedure TestInsertObserver;
    procedure TestDeleteObserver;
    procedure TestDeleteObservers;
    procedure TestCreate;
    procedure TestGetObserver;

  end;

type
  TXPParentTests = class(TTestCase)
  private

    FParent: IXPCrackedParent;

  protected

    procedure SetUp; override;
    procedure TearDown; override;

  published

    // Test methods
    procedure TestReleaseSubject;
    procedure TestAccessParent;
    procedure TestCreate;

  end;

implementation

uses
  SysUtils;

type

  TCrackedObserver = class (TInterfacedObject, IXPObserver, IXPCrackedObserver)
  private

    FSubject: IXPSubject;

  protected

    function RefCount: integer;
    procedure SetSubject(const Subject: IXPSubject);
    function GetSubject: IXPSubject;
    procedure ReleaseSubject(const Subject: IXPSubject;
      const Context: pointer);

  public

     destructor Destroy; override;
  end;

  TCrackedSubject = class (TXPSubject, IXPCrackedSubject)
  protected

    function RefCount: integer;
  end;

  TCrackedSubjects = class (TXPSubjects, IXPCrackedSubjects)
  protected

    function RefCount: integer;
  public

    destructor Destroy; override;
  end;

  TCrackedParent = class (TXPFamily, IXPCrackedParent)
  protected

    function RefCount: integer;
  end;

{ TXPSubjectsTests }

procedure TXPSubjectsTests.SetUp;
begin
  inherited;
  FSubject := TCrackedSubject.Create;
  FSubject2 := TCrackedSubject.Create;
  FSubject3 := TCrackedSubject.Create;
  FSubject4 := TCrackedSubject.Create;
end;

procedure TXPSubjectsTests.TearDown;
begin
  FSubject := nil;
  FSubject2 := nil;
  FSubject3 := nil;
  FSubject4 := nil;
  inherited;
end;

procedure TXPSubjectsTests.TestAddSubject;
var
  Subjects: IXPCrackedSubjects;

begin
  Subjects := TCrackedSubjects.Create;
  CheckEquals(1, Subjects.RefCount,
    'subjects rc after clear after construction');
  Check(not Subjects.AddSubject(nil), 'addsubject with nil argument');

  CheckEquals(1, FSubject.RefCount, 'subject 1 rc before addition');
  CheckEquals(1, FSubject2.RefCount, 'subject 2 rc before addition');
  CheckEquals(1, FSubject3.RefCount, 'subject 3 rc before addition');
  CheckEquals(1, FSubject4.RefCount, 'subject 4 rc before addition');

  Check(Subjects.AddSubject(@FSubject), 'subject 1 addsubject');
  CheckEquals(1, FSubject.RefCount, 'subject 1 rc after addition');
  CheckEquals(2, Subjects.RefCount, 'subjects rc after subject 1 addition');

  Check(Subjects.AddSubject(@FSubject2), 'subject 2 addsubject');
  CheckEquals(1, FSubject2.RefCount, 'subject 2 rc after addition');
  CheckEquals(3, Subjects.RefCount, 'subjects rc after subject 2 addition');

  Check(Subjects.AddSubject(@FSubject3), 'subject 3 addsubject');
  CheckEquals(1, FSubject3.RefCount, 'subject 3 rc after addition');
  CheckEquals(4, Subjects.RefCount, 'subjects rc after subject 3 addition');

  Check(Subjects.AddSubject(@FSubject4), 'subject 4 addsubject');
  CheckEquals(1, FSubject4.RefCount, 'subject 4 rc after addition');
  CheckEquals(5, Subjects.RefCount, 'subjects rc after subject 4 addition');

  Subjects.Clear;
  CheckEquals(1, Subjects.RefCount, 'subjects rc after clear on 4 subjects');
  Check(FSubject = nil, 'subject 1 nil''d after clearing');
  Check(FSubject2 = nil, 'subject 2 nil''d after clearing');
  Check(FSubject3 = nil, 'subject 3 nil''d after clearing');
  Check(FSubject4 = nil, 'subject 4 nil''d after clearing');
end;

procedure TXPSubjectsTests.TestClear;
var
  Subjects: IXPCrackedSubjects;
  ACopy: IXPCrackedSubject;

begin
  Subjects := TCrackedSubjects.Create;
  Subjects.Clear;
  CheckEquals(1, Subjects.RefCount,
    'subjects rc after clear after construction');
  CheckEquals(1, FSubject.RefCount, 'subject 1 rc before addition');
  Check(Subjects.AddSubject(@FSubject), 'first addsubject');
  CheckEquals(1, FSubject.RefCount, 'subject 1 rc after addition');
  CheckEquals(2, Subjects.RefCount, 'subjects rc after first addition');

  ACopy := FSubject;
  CheckEquals(2, FSubject.RefCount, 'subject 1 rc after copy');
  CheckEquals(2, ACopy.RefCount, 'acopy rc after copy');

  Subjects.Clear;
  CheckEquals(1, Subjects.RefCount, 'subjects rc after clear on one subject');
  Check(FSubject = nil, 'subject 1 nil''d after clearing');
  CheckEquals(1, ACopy.RefCount, 'acopy rc after clearing');
end;

procedure TXPSubjectsTests.TestCreate;
var
  Subjects: IXPCrackedSubjects;

begin
  Subjects := TCrackedSubjects.Create;
  CheckEquals(1, Subjects.RefCount, 'subjects rc after construction');
end;

procedure TXPSubjectsTests.TestDeleteSubject;
var
  Subjects: IXPCrackedSubjects;
  ACopy: PInterface;

begin
  Subjects := TCrackedSubjects.Create;
  CheckEquals(1, Subjects.RefCount,
    'subjects rc after clear after construction');
  Check(not Subjects.DeleteSubject(nil),
    'deletesubject on empty subjects with nil argument');
  Check(not Subjects.DeleteSubject(@FSubject2),
    'deletesubject on empty subjects with non-nil but invalid argument');

  CheckEquals(1, FSubject.RefCount, 'subject 1 rc before addition');
  CheckEquals(1, FSubject2.RefCount, 'subject 2 rc before addition');
  CheckEquals(1, FSubject3.RefCount, 'subject 3 rc before addition');
  CheckEquals(1, FSubject4.RefCount, 'subject 4 rc before addition');

  Check(Subjects.AddSubject(@FSubject), 'subject 1 addsubject');
  CheckEquals(1, FSubject.RefCount, 'subject 1 rc after addition');
  CheckEquals(2, Subjects.RefCount, 'subjects rc after subject 1 addition');
  Check(not Subjects.DeleteSubject(nil),
    'deletesubject on non-empty subjects with nil argument');
  Check(not Subjects.DeleteSubject(@FSubject2),
    'deletesubject on non-empty subjects with non-nil but invalid argument');
  ACopy := @FSubject;
  Check(Subjects.DeleteSubject(@FSubject),
    'deletesubject 1 on non-empty subjects with valid argument');
  CheckEquals(1, Subjects.RefCount, 'subjects rc after subject 1 deletion');
  Check(not Subjects.DeleteSubject(ACopy),
    'deletesubject 1 (again) on now empty subjects with now invalid argument');
  CheckEquals(1, Subjects.RefCount,
    'subjects rc after attempted subject 1 re-deletion');

  Check(Subjects.AddSubject(@FSubject2), 'subject 2 addsubject');
  CheckEquals(1, FSubject2.RefCount, 'subject 2 rc after addition');
  CheckEquals(2, Subjects.RefCount, 'subjects rc after subject 2 addition');

  Check(Subjects.AddSubject(@FSubject3), 'subject 3 addsubject');
  CheckEquals(1, FSubject3.RefCount, 'subject 3 rc after addition');
  CheckEquals(3, Subjects.RefCount, 'subjects rc after subject 3 addition');

  Check(Subjects.AddSubject(@FSubject4), 'subject 4 addsubject');
  CheckEquals(1, FSubject4.RefCount, 'subject 4 rc after addition');
  CheckEquals(4, Subjects.RefCount, 'subjects rc after subject 4 addition');

  Check(Subjects.DeleteSubject(@FSubject3),
    'deletesubject 3 (middle element)');
  Check(FSubject3 = nil, 'subject 3 nil''d after clearing');
  CheckEquals(3, Subjects.RefCount, 'subjects rc after subject 3 deleted');
  Check(Subjects.DeleteSubject(@FSubject4), 'deletesubject 4 (end element)');
  Check(FSubject4 = nil, 'subject 4 nil''d after clearing');
  CheckEquals(2, Subjects.RefCount, 'subjects rc after subject 4 deleted');

  Check(Subjects.DeleteSubject(@FSubject2), 'deletesubject 2 (end element)');
  Check(FSubject2 = nil, 'subject 2 nil''d after clearing');
  CheckEquals(1, Subjects.RefCount, 'subjects rc after subject 2 deleted');
end;

{ TXPSubjectTests }

procedure TXPSubjectTests.TestAddObserver;
var
  ASubject: IXPCrackedSubject;

begin
  ASubject := TCrackedSubject.Create;
  CheckEquals(0, ASubject.ObserverCount,
    'empty observer count on construction');
  CheckEquals(0, ASubject.Count, 'empty count on construction');
  FObserver.Subject := ASubject;
  Check(ASubject.AddObserver(FObserver, ASubject), 'adding observer');
  CheckEquals(2, ASubject.RefCount, 'subject rc after first observer');
  CheckEquals(2, FObserver.RefCount, 'observer rc after acquiring subject');
  CheckEquals(1, ASubject.ObserverCount, 'observer count after first observer');
  ASubject := nil;
  CheckEquals(1, FObserver.RefCount, 'observer rc after subject is destroyed');

  // go round again - try to add observer a second time

  ASubject := TCrackedSubject.Create;
  CheckEquals(0, ASubject.ObserverCount,
    '2: empty observer count on construction');
  FObserver.Subject := ASubject;
  Check(ASubject.AddObserver(FObserver, ASubject), '2: adding observer');
  CheckEquals(2, ASubject.RefCount, '2: subject rc after first observer');
  CheckEquals(2, FObserver.RefCount, '2: observer rc after acquiring subject');
  CheckEquals(1, ASubject.ObserverCount,
    '2: observer count after first observer');
  Check(not ASubject.AddObserver(FObserver, ASubject),
    '2: adding observer again');
  CheckEquals(2, ASubject.RefCount,