xpobserver.pas

类似于Java JUnit的单元测试

                                                                                                             
    // Release our local reference *before* AddObserver() call to avoid
    // Subject.DeleteObservers call as ASubject goes out of scope
    ASubject := nil;

    // Register self.ReleaseSubject with Subject, using supplied reference
    // as Context argument. We will use this for identification in
    // ReleaseSubject callback
    Result := IXPSubject(SubjectInfo^.AsSubject).AddObserver(self,
      IXPSubject(SubjectInfo^.AsSubject), LocalRef);

  end;

end;

function TXPSubjects.FindInterface(const LocalRef: PInterface;
  out idx: integer): boolean;
begin
  idx := FSubjects.Count - 1;

  while (idx >= 0)
    and (PXPSubjectInfo(FSubjects[idx])^.AsPassed <> LocalRef) do
    System.Dec(idx);

  Result := idx >= 0;
end;

function TXPSubjects.DeleteSubject(const LocalRef: PInterface): boolean;
var
  idx: integer;

begin
  Result := System.Assigned(LocalRef) and FindInterface(LocalRef, idx);

  if Result then
    // We have a match - detach from subject
    // ReleaseSubject will be called back consequently
    Result := IXPSubject(PXPSubjectInfo(
      FSubjects[idx])^.AsSubject).DeleteObserver(self, LocalRef);

end;

procedure TXPSubjects.ReleaseSubject(const ASubject: IXPSubject;
  const Context: pointer);
var
  idx: integer;
  SubjectInfo: TXPSubjectInfo;

begin
  // ASubject not used here. Subjects are keyed on Context, which is address of
  // subject reference held locally. See AddSubject()

  if FindInterface(PInterface(Context), idx) then
  begin
    SubjectInfo := PXPSubjectInfo(FSubjects[idx])^;
    // Clean up FSubjects entry
    System.Dispose(FSubjects[idx]);
    FSubjects.Delete(idx);

    if (@SubjectInfo.Releaser = nil)
      or (FDestroying and not(TMethod(SubjectInfo.Releaser).Data = self)) then
      // If we are in the context of our own destructor, and the supplied
      // Releaser is not a method of this object, then the supplied
      // Releaser may well be invalid at this point (as interface data members
      // are released after containing destructor body executes), so just drop
      // the reference.
      SubjectInfo.AsPassed^ := nil
    else
      // Fire the supplied Releaser with the argument passed to AddSubject(),
      // in turn passed by reference to Releaser
      SubjectInfo.Releaser(SubjectInfo.AsPassed);

  end;

end;

/////////////////////////////////////////////////////////////////////////////
//   TXPSubject implementation
/////////////////////////////////////////////////////////////////////////////

type

  PXPObserverInfo = ^TXPObserverInfo;

  TXPObserverInfo = record
    Observer: IXPObserver;
    Subject: pointer;
    Context: pointer;
  end;

constructor TXPSubject.Create(const ADelegator: IInterface);
begin
  inherited;
  // FDeletingObservers initialised to false by default
  FSync := TCriticalSection.Create;
  FObservers := TList.Create;
end;

destructor TXPSubject.Destroy;
begin
  FObservers.Free;
  FSync.Free;
  inherited;
end;


function TXPSubject.SameContent(
  const ObserverA, ObserverB: IXPObserver): boolean;
begin
  Result := ObserverA = ObserverB;
end;

function TXPSubject.FindObserver(const Observer: IXPObserver;
  const Context: pointer; out idx: integer): boolean;
begin
  idx := FObservers.Count - 1;

  while (idx >= 0)
    and not (SameContent(PXPObserverInfo(FObservers[idx])^.Observer, Observer)
      and (PXPObserverInfo(FObservers[idx])^.Context = Context)) do
    System.Dec(idx);

  Result := idx >= 0;
end;

function TXPSubject.AddObserver(const Observer: IXPObserver;
  const Subject: IXPSubject; const Context: pointer): boolean;
begin
  // InsertObserver is a synchronised method but we need to isolate call on
  // ObserverCount to same calling context, so synchronise both calls
  FSync.Enter;

  try
    Result := InsertObserver(ObserverCount, Observer, Subject, Context);
  finally
    FSync.Leave;
  end;

end;

function TXPSubject.ObserverCount: integer;
begin
  Result := FObservers.Count;
end;

function TXPSubject.InsertObserver(const idx: integer;
  const Observer: IXPObserver; const Subject: IXPSubject;
  const Context: pointer): boolean;
var
  jdx: integer;
  ObserverInfo: PXPObserverInfo;

begin
  FSync.Enter;

  try
    // No duplicates - check for prior entry
    // Check for range error

    Result := not FindObserver(Observer, Context, jdx)
      and (idx <= FObservers.Count) and (idx >= 0);

    if Result then
    begin
      System.New(ObserverInfo);
      ObserverInfo^.Observer := Observer;
      ObserverInfo^.Subject := pointer(Subject);
      ObserverInfo^.Context := Context;
      FObservers.Insert(idx, ObserverInfo);
    end;

  finally
    FSync.Leave;
  end;

end;

function TXPSubject.DeleteObserver(const Observer: IXPObserver;
  const Context: pointer): boolean;
var
  idx: integer;
  ObserverInfo: TXPObserverInfo;

begin
  FSync.Enter;

  try
    // Check for existence or prior removal
    Result := FindObserver(Observer, Context, idx);

    if Result then
    begin
      // Need local ref after deletion from list. Order of Delete() &
      // ReleaseSubject() is important here for correct functioning of _Release
      // ...***DON'T*** refactor this method!!
      ObserverInfo := PXPObserverInfo(FObservers[idx])^;
      // Release our (list) reference to observer
      PXPObserverInfo(FObservers[idx])^.Observer := nil;
      System.Dispose(FObservers[idx]);
      FObservers.Delete(idx);
    end;

    // Exit critical section here as we now have local vars only (thread-safe)
    // and call to ReleaseSubject below on last reference will leave FSync
    // invalid (destroyed).
  finally
    FSync.Leave;
  end;

  // Notify Observer to release reference to us. This will result in
  // a call to TXPSubject._Release.
  if Result then
    ObserverInfo.Observer.ReleaseSubject(IXPSubject(ObserverInfo.Subject),
      ObserverInfo.Context);

end;

function TXPSubject.GetObserver(const idx: integer): IXPObserver;
begin

  if (idx < 0) or (idx >= FObservers.Count) then
    Result := nil
  else
    Result := PXPObserverInfo(FObservers[idx])^.Observer;

end;

function TXPSubject._Release: Integer;
begin
  FSync.Enter;

  try

    // If this is the last reference excepting observers,
    // then drop the observers - save last reference so FSync is still valid
    if (FRefCount = FObservers.Count + 1) and (not FDeletingObservers) then
      DeleteObservers;

  finally
    FSync.Leave;
  end;

  Result := inherited _Release;
end;

procedure TXPSubject.DeleteObservers;
var
  idx: integer;
  ObserverInfo: PXPObserverInfo;

begin
  FDeletingObservers := true;
  // Count *down* to allow for side-effect of loop actions -
  // referenced item will be deleted from list, and remainder will move down
  // one slot.
  for idx := FObservers.Count - 1 downto 0 do
  begin
    ObserverInfo := FObservers[idx];
    // Notify Observer to release reference to Subject
    ObserverInfo^.Observer.ReleaseSubject(IXPSubject(ObserverInfo.Subject),
      ObserverInfo^.Context);
    // Release our (list) reference to Observer
    ObserverInfo^.Observer := nil;
    System.Dispose(ObserverInfo);
    FObservers.Delete(idx);
  end;

  FDeletingObservers := false;
end;

/////////////////////////////////////////////////////////////////////////////
//   TXPFamily implementation
/////////////////////////////////////////////////////////////////////////////

// Parent creates child, passing itself in to child's constructor.

constructor TXPFamily.Create(const AParent: IXPFamily;
  const ADelegator: IInterface);
begin
  inherited Create(ADelegator);
  SetParent(AParent);
end;

function TXPFamily.GetParent: IXPFamily;
begin
  Result := FParent;
end;

procedure TXPFamily.SetParent(const AParent: IXPFamily);
var
  ACopy: IXPFamily;

begin
  // We can re-parent a child with this method

  if AParent <> FParent then
  begin

    // Undo previous association
    if System.Assigned(FParent) then
    begin
      ACopy := FParent;
      // Release Parent (explicitly) first, since we don't want ReleaseSubject
      // side effects (DeleteObservers)
      FParent := nil;
      ACopy.DeleteObserver(self);
      // ACopy will be released after we exit procedure (ACopy scope boundary)
    end;

    // Now bind to new parent

    FParent := AParent;

    // Check for nil assignment
    if System.Assigned(FParent) then
      FParent.AddObserver(Self, FParent);

  end;

end;

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

  if (Subject = FParent) and System.Assigned(FParent) then
  begin
    // We don't need to detach from parent's observer list, as the *initiator*
    // of a detachment is responsible for this...
    // ( see Parent's DeleteObservers() implementation for an example )

    // Release reference to parent
    FParent := nil;
    // Parent-child relationship for lifetime - this parent releases all
    // *its* children (observers of parent)
    DeleteObservers;
  end
  else
    inherited ReleaseSubject(Subject, Context);

end;

end.