xpobservertests.pas

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

  FObserver := nil;
  // temporary still present in rc after original ref released
  CheckEquals(3, FObserver2.RefCount, 'observer 2 rc after FObserver nil''d');
  Check(ASubject.Observers[0] = FObserver2,
    'observers[0] = first observer on subject after first observer');
  // temporary interface created in above comparison not released until
  // procedure scope exited
  CheckEquals(4, FObserver2.RefCount,
    'observer rc after observers[0] = FObserver2 comparison');
  CheckEquals(2, ASubject.RefCount,
    'subject rc count after observers[0] on subject after first observer');
  Check(ASubject.Observers[-1] = nil,
    'observers[-1] on subject after first observer');
  CheckEquals(2, ASubject.RefCount,
    'subject rc count after observers[-1] on subject after first observer');
  Check(ASubject.Observers[1] = nil,
    'observers[1] on subject after first observer');
  CheckEquals(2, ASubject.RefCount,
    'subject rc count after observers[1] on subject after first observer');

  // delete observer

  // still carrying 2 in rc for temporaries created above
  CheckEquals(4, FObserver2.RefCount, 'observer2 rc before discarding subject');
  CheckEquals(2, ASubject.RefCount,
    'subject rc count before sole observer detaches');
  Check(ASubject.DeleteObserver(FObserver2), 'deleting sole observer');
  CheckEquals(1, ASubject.RefCount, 'subject rc after sole observer deleted');
  CheckEquals(3, FObserver2.RefCount,
    'observer rc after detaching from subject');
  CheckEquals(0, ASubject.ObserverCount,
    'observer count after sole observer deleted');
  Check(ASubject.Observers[0] = nil, 'observers[0] on newly empty subject');
  CheckEquals(1, ASubject.RefCount,
    'subject rc count after observers[0] on newly empty subject');
  Check(ASubject.Observers[-1] = nil, 'observers[-1] on newly empty subject');
  CheckEquals(1, ASubject.RefCount,
    'subject rc count after observers[-1] on newly empty subject');
  Check(ASubject.Observers[1] = nil, 'observers[1] on newly empty subject');
  CheckEquals(1, ASubject.RefCount,
    'subject rc count after observers[1] on newly empty subject');

  // add observer again

  CheckEquals(1, FObserver3.RefCount,
    '2: observer rc before acquiring subject');
  FObserver3.Subject := ASubject;
  Check(ASubject.AddObserver(FObserver3, ASubject),
    '2: adding observer to subject');
  CheckEquals(2, ASubject.RefCount, '2: subject rc after observer');
  CheckEquals(2, FObserver3.RefCount, '2: observer rc after acquiring subject');
  CheckEquals(1, ASubject.ObserverCount, '2: observer count after observer');
  Check(ASubject.Observers[0] = FObserver3,
    'observers[0] = observer on subject after re-addition');
  // temporary interface created in above comparison not released until
  // procedure scope exited
  CheckEquals(3, FObserver3.RefCount,
    'observer rc after observers[0] = FObserver3 comparison');
  CheckEquals(2, ASubject.RefCount,
    'subject rc count after observers[0] on subject after re-addition');
  Check(ASubject.Observers[-1] = nil,
    'observers[-1] on subject after first observer');
  CheckEquals(2, ASubject.RefCount,
    'subject rc count after observers[-1] on subject after re-addition');
  Check(ASubject.Observers[1] = nil,
    'observers[1] on subject after first observer');
  CheckEquals(2, ASubject.RefCount,
    'subject rc count after observers[1] on subject after re-addition');

  // add a second observer

  CheckEquals(1, FObserver4.RefCount,
    '3: observer rc before acquiring subject');
  FObserver4.Subject := ASubject;
  Check(ASubject.AddObserver(FObserver4, ASubject),
    '3: adding observer to subject');
  CheckEquals(3, ASubject.RefCount, '3: subject rc after observer');
  CheckEquals(2, FObserver4.RefCount, '3: observer rc after acquiring subject');
  CheckEquals(2, ASubject.ObserverCount, '3: observer count after observer');
  Check(ASubject.Observers[1] = FObserver4,
    'observers[1] = second observer on subject');
  // temporary interface created in above comparison not released until
  // procedure scope exited
  CheckEquals(3, FObserver4.RefCount,
    'observer rc after observers[1] = FObserver4 comparison');
  Check(ASubject.Observers[0] = FObserver3,
    'observers[0] = FObserver3 on subject after second observer');
  // temporary interface created in above comparison not released until
  // procedure scope exited
  CheckEquals(4, FObserver3.RefCount,
    'observer rc after observers[0] = FObserver3 comparison');
  CheckEquals(3, ASubject.RefCount,
    'subject rc count after second observer');
  Check(ASubject.Observers[-1] = nil,
    'observers[-1] on subject after second observer');
  CheckEquals(3, ASubject.RefCount,
    'subject rc count after observers[-1] on subject after second observer');
  Check(ASubject.Observers[2] = nil,
    'observers[2] on subject after second observer');
  CheckEquals(3, ASubject.RefCount,
    'subject rc count after observers[2] on subject after second observer');

 // delete observers

  ASubject.DeleteObservers;
  CheckEquals(1, ASubject.RefCount, 'subject rc count after delete observers');
  CheckEquals(0, ASubject.ObserverCount,
    'empty observer count after delete observers');
  Check(ASubject.Observers[0] = nil, 'observers[0] after delete observers');
  CheckEquals(1, ASubject.RefCount,
    'subject rc count after observers[0] after delete observers');
  Check(ASubject.Observers[-1] = nil, 'observers[-1] after delete observers');
  CheckEquals(1, ASubject.RefCount,
    'subject rc count after observers[-1] after delete observers');
  Check(ASubject.Observers[1] = nil, 'observers[1] after delete observers');
  CheckEquals(1, ASubject.RefCount,
    'subject rc count after observers[1] after delete observers');
end;

{ TXPParentTests }

procedure TXPParentTests.SetUp;
begin
  inherited;
  FParent := TCrackedParent.Create;
end;

procedure TXPParentTests.TearDown;
begin
  FParent := nil;
  inherited;
end;

procedure TXPParentTests.TestCreate;
begin
  CheckEquals(1, FParent.RefCount, 'parent rc after construction');
  CheckEquals(0, FParent.Count, 'no children after parent construction');
  Check(FParent.Parent = nil,
    'parent.parent is unassigned after uninitialised contruction')
end;

procedure TXPParentTests.TestAccessParent;
var
  Child: IXPCrackedParent;
  Child2: IXPCrackedParent;

begin
  CheckEquals(1, FParent.RefCount, 'parent rc after construction');

  // Create parented child

  Child := TCrackedParent.Create(FParent);
  CheckEquals(2, FParent.RefCount, 'parent rc after child added');
  CheckEquals(2, Child.RefCount, 'child rc after child added to parent');
  Check(Child.Parent = FParent, 'failed to get parent on parented child');
  // temporary interface created above won't be released until we leave proc
  // scope (tested in D6) compiler optimization setting doesn't affect this
  // result
  CheckEquals(2, Child.RefCount, 'child rc before children[0] = child failed');
  Check(FParent.Children[0] = Child as IXPObserver,
    'children[0] = child failed');
  // new temporaries created by LHS *and* RHS
  CheckEquals(4, Child.RefCount, 'child rc after children[0] = child failed');

  // Create unparented child

  Child2 := TCrackedParent.Create;
  Check(Child2.Parent = nil, 'got parent on unparented child');
  CheckEquals(1, Child2.RefCount, 'child2 rc after construction');
  CheckEquals(3, FParent.RefCount, 'parent rc before child2 assigned');

  // Parent unparented child

  Child2.Parent := FParent;
  CheckEquals(4, FParent.RefCount, 'parent rc after child2 added to parent');
  Check(Child2.Parent <> nil, 'failed to get parent for child2');
  // persistent temporary interface created above (again)
  CheckEquals(5, FParent.RefCount, 'parent rc after child2 added to parent');
  CheckEquals(2, Child2.RefCount, 'child2 rc after child2 added to parent');

  // unparent first child

  // still carrying two temps in rc
  CheckEquals(4, Child.RefCount, 'child rc before unparenting');
  CheckEquals(5, FParent.RefCount, 'parent rc before unparenting child');
  CheckEquals(2, FParent.Count, 'observer count before unparenting child');
  Child.Parent := nil;
  // still carrying two temps in rc
  CheckEquals(3, Child.RefCount, 'child rc after unparenting');
  CheckEquals(4, FParent.RefCount, 'parent rc after unparenting child');
  CheckEquals(1, FParent.Count, 'observer count after unparenting child');
  CheckEquals(2, Child2.RefCount,
    'child2 rc before equality check on children[0]');
  Check(FParent.Children[0] = Child2 as IXPObserver,
    'child2 moved down to first slot in list');
  // new temporaries created by LHS *and* RHS
  CheckEquals(4, Child2.RefCount,
    'child2 rc after equality check on children[0]');
end;

procedure TXPParentTests.TestReleaseSubject;
var
  Child: IXPCrackedParent;
  Child2: IXPCrackedParent;
  Child3: IXPCrackedParent;
  Child4: IXPCrackedParent;
  Child21: IXPCrackedParent;
  Child22: IXPCrackedParent;
  Child211: IXPCrackedParent;
  Child212: IXPCrackedParent;

begin
  // Create first generation of children

  CheckEquals(1, FParent.RefCount, 'parent rc after construction');
  Child := TCrackedParent.Create(FParent);
  CheckEquals(2, FParent.RefCount, 'parent rc after child added');
  CheckEquals(2, Child.RefCount, 'child rc after child added to parent');
  Child2 := TCrackedParent.Create(FParent);
  CheckEquals(3, FParent.RefCount, 'parent rc after child2 added');
  CheckEquals(2, Child2.RefCount, 'child2 rc after child2 added to parent');
  Child3 := TCrackedParent.Create(FParent);
  CheckEquals(4, FParent.RefCount, 'parent rc after child3 added');
  CheckEquals(2, Child3.RefCount, 'child3 rc after child3 added to parent');
  Child4 := TCrackedParent.Create(FParent);
  CheckEquals(5, FParent.RefCount, 'parent rc after child4 added');
  CheckEquals(2, Child4.RefCount, 'child4 rc after child4 added to parent');

  // Create second generation of children

  Child21 := TCrackedParent.Create(Child2);
  CheckEquals(3, Child2.RefCount, 'child2 rc after child21 added');
  CheckEquals(2, Child21.RefCount, 'child21 rc after child21 added to parent');
  Child22 := TCrackedParent.Create(Child2);
  CheckEquals(4, Child2.RefCount, 'child2 rc after child22 added');
  CheckEquals(2, Child22.RefCount, 'child22 rc after child22 added to parent');

  // Create third generation of children

  Child211 := TCrackedParent.Create(Child21);
  CheckEquals(3, Child21.RefCount, 'child21 rc after child211 added');
  CheckEquals(2, Child211.RefCount,
    'child211 rc after child211 added to parent');
  Child212 := TCrackedParent.Create(Child21);
  CheckEquals(4, Child21.RefCount, 'child21 rc after child212 added');
  CheckEquals(2, Child212.RefCount,
    'child212 rc after child212 added to parent');

  // Release ancestor

  FParent := nil;
  CheckEquals(1, Child212.RefCount, 'child212 rc after ancestor released');
  CheckEquals(1, Child211.RefCount, 'child211 rc after ancestor released');
  CheckEquals(1, Child21.RefCount, 'child21 rc after ancestor released');
  CheckEquals(1, Child22.RefCount, 'child22 rc after ancestor released');
  CheckEquals(1, Child4.RefCount, 'child4 rc after ancestor released');
  CheckEquals(1, Child3.RefCount, 'child3 rc after ancestor released');
  CheckEquals(1, Child2.RefCount, 'child2 rc after ancestor released');
  CheckEquals(1, Child.RefCount, 'child rc after ancestor released');
end;


{ TCrackedObserver }

destructor TCrackedObserver.Destroy;
begin

  if FSubject <> nil then
    FSubject.DeleteObserver(self);

  inherited;
end;

function TCrackedObserver.GetSubject: IXPSubject;
begin
  Result := FSubject;
end;

function TCrackedObserver.RefCount: integer;
begin
  Result := FRefCount;
end;

procedure TCrackedObserver.ReleaseSubject(const Subject: IXPSubject;
  const Context: pointer);
begin

//  ff (FSubject <> nil)  and ((FSubject as IXPSubject) = Subject) then
  if Subject = FSubject then
    FSubject := nil;

end;

procedure TCrackedObserver.SetSubject(const Subject: IXPSubject);
begin
  FSubject := Subject;
end;

{ TCrackedSubject }

function TCrackedSubject.RefCount: integer;
begin
  Result := FRefCount;
end;

{ TCrackedSubjects }

destructor TCrackedSubjects.Destroy;
begin
  inherited;
end;

function TCrackedSubjects.RefCount: integer;
begin
  Result := FRefCount;
end;

{ TCrackedParent }

function TCrackedParent.RefCount: integer;
begin
  Result := FRefCount;
end;

initialization

  TestFramework.RegisterTest('XPObserverTests Suite',
    TXPSubjectsTests.Suite);
  TestFramework.RegisterTest('XPObserverTests Suite',
    TXPSubjectTests.Suite);
  TestFramework.RegisterTest('XPObserverTests Suite',
    TXPParentTests.Suite);

end.