xptestedunitutils.pas

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

begin
  Result := TFunctionNode.Create(AParent, AFunctionName, IsEnabled);
end;

type

  TClassNode = class(TXPParserNode, IXPClassNode)
  private

    FClassBegin: longint;
    FClassEnd: longint;

  protected

    function GetVisibility(const idx: TXPClassVisibility): IXPVisibilityNode;
    // stream positions
    function GetClassBegin: longint;
    procedure SetClassBegin(const APosition: longint);
    function GetClassEnd: longint;
    procedure SetClassEnd(const APosition: longint);


  public

    constructor Create(const AParent: IXPSectionNode;
      const AClassName: string; const IsEnabled: boolean = true;
      const ADelegator: IInterface = nil);
  end;

function CreateXPClassNode(const AParent: IXPSectionNode;
  const AClassName: string; const IsEnabled: boolean): IXPClassNode;
begin
  Result := TClassNode.Create(AParent, AClassName, IsEnabled);
end;

type

  TVisibilityNode = class (TXPParserNode, IXPVisibilityNode)
  private

    FVisibility: TXPClassVisibility;

  protected

    function GetVisibility: TXPClassVisibility;

  public

    constructor Create(const AParent: IXPClassNode;
      const AVisibility: TXPClassVisibility; const IsEnabled: boolean = true;
      const ADelegator: IInterface = nil);
  end;

function CreateXPVisibilityNode(const AParent: IXPClassNode;
  const AVisibility: TXPClassVisibility;
  const IsEnabled: boolean = true): IXPVisibilityNode;
begin
  Result := TVisibilityNode.Create(AParent, AVisibility, IsEnabled);
end;

type

  TMethodNode = class (TXPParserNode, IXPMethodNode)
  public

    constructor Create(const AParent: IXPVisibilityNode;
      const AMethodName: string; const IsEnabled: boolean = true;
      const ADelegator: IInterface = nil);
  end;

function CreateXPMethodNode(const AParent: IXPVisibilityNode;
  const AMethodName: string; const IsEnabled: boolean = true): IXPMethodNode;
begin
  Result := TMethodNode.Create(AParent, AMethodName, IsEnabled);
end;

type

  TPropertyNode = class (TXPParserNode, IXPPropertyNode)
  public

    constructor Create(const AParent: IXPVisibilityNode;
      const APropertyName: string; const IsEnabled: boolean = true;
      const ADelegator: IInterface = nil);
  end;

function CreateXPPropertyNode(const AParent: IXPVisibilityNode;
  const APropertyName: string; const IsEnabled: boolean = true): IXPPropertyNode;
begin
  Result := TPropertyNode.Create(AParent, APropertyName, IsEnabled);
end;

{ TMethodNode }

constructor TMethodNode.Create(const AParent: IXPVisibilityNode;
  const AMethodName: string; const IsEnabled: boolean;
  const ADelegator: IInterface);
begin
  inherited Create(AParent, AMethodName, IsEnabled, ADelegator);
end;

{ TXPParserNode }

constructor TXPParserNode.Create(const AParent: IXPParserNode;
  const AName: string; const IsEnabled: boolean; const ADelegator: IInterface);
begin
  inherited Create(AParent, ADelegator);
  FName := AName;
  FEnabled := IsEnabled;
  FIteratorIndex := -1;
end;

function TXPParserNode.AddChild(const ChildNode: IXPParserNode): boolean;
begin
  Result := AddObserver(ChildNode, self);
end;

function TXPParserNode.ChildCount: integer;
begin
  Result := ObserverCount;
end;

function TXPParserNode.Children: IXPForwardIterator;
begin
  Result := self;
end;

procedure TXPParserNode.Clear;
begin
  DeleteObservers;
end;


function TXPParserNode.DeleteChild(
  const ChildNode: IXPParserNode): boolean;
begin
  Result := DeleteObserver(ChildNode);
end;

function TXPParserNode.GetChild(const idx: integer;
  out ChildNode: IXPParserNode): boolean;
begin
  Result := SysUtils.Supports(GetObserver(idx), IXPParserNode, ChildNode);
end;

function TXPParserNode.GetEnabled: boolean;
begin
  Result := FEnabled;
end;

function TXPParserNode.GetName: string;
begin
  Result := FName;
end;

function TXPParserNode.InsertChild(const idx: integer;
  const ChildNode: IXPParserNode): boolean;
begin
  Result := InsertObserver(idx, ChildNode, self);
end;

function TXPParserNode.Next(out Element): boolean;
begin
  System.Inc(FIteratorIndex);
  Result := FIteratorIndex < ObserverCount;

  if Result then
    IXPParserNode(Element) := GetObserver(FIteratorIndex) as IXPParserNode;

end;

function TXPParserNode.Parent: IXPParserNode;
begin
  Result := FParent as IXPParserNode;
end;

procedure TXPParserNode.SetEnabled(const Value: boolean);
begin
  FEnabled := Value;
end;

procedure TXPParserNode.Start;
begin
  FIteratorIndex := -1;
end;

function TXPParserNode.SameContent(const ObserverA,
  ObserverB: IXPObserver): boolean;
begin
  Result := SysUtils.AnsiSameText((ObserverA as IXPParserNode).Name,
    (ObserverB as IXPParserNode).Name);
end;

function TXPParserNode.EnabledChildCount: integer;
var
  SavedIteratorIndex: integer;
  Node: IXPParserNode;

begin
  SavedIteratorIndex := FIteratorIndex;
  Result := 0;
  Start;

  while Next(Node) do
    if Node.Enabled then
      System.Inc(Result);

  FIteratorIndex := SavedIteratorIndex;
end;

{ TClassNode }

constructor TClassNode.Create(const AParent: IXPSectionNode;
  const AClassName: string; const IsEnabled: boolean;
  const ADelegator: IInterface);
begin
  inherited Create(AParent, AClassName, IsEnabled, ADelegator);
  CreateXPVisibilityNode(self, cvPrivate);
  CreateXPVisibilityNode(self, cvProtected);
  CreateXPVisibilityNode(self, cvPublic);
  CreateXPVisibilityNode(self, cvPublished);
end;

function TClassNode.GetClassBegin: longint;
begin
  Result := FClassBegin;
end;

function TClassNode.GetClassEnd: longint;
begin
  Result := FClassEnd;
end;

function TClassNode.GetVisibility(
  const idx: TXPClassVisibility): IXPVisibilityNode;
var
  Node: IXPParserNode;
  SavedIteratorIndex: integer;

begin
  SavedIteratorIndex := FIteratorIndex;
  Start;

  // Search till exhausted or we have a match
  while Next(Node) and ((Node as IXPVisibilityNode).GetVisibility <> idx) do ;

  if not (SysUtils.Supports(Node, IXPVisibilityNode, Result)
      and (Result.GetVisibility = idx)) then
    Result := nil;

  FIteratorIndex := SavedIteratorIndex;
end;

procedure TClassNode.SetClassBegin(const APosition: Integer);
begin
  FClassBegin := APosition;
end;

procedure TClassNode.SetClassEnd(const APosition: Integer);
begin
  FClassEnd := APosition;
end;

{ TVisibilityNode }

constructor TVisibilityNode.Create(const AParent: IXPClassNode;
  const AVisibility: TXPClassVisibility; const IsEnabled: boolean;
  const ADelegator: IInterface);
const
  VisStrs: array[cvPrivate..cvPublished] of string = ( 'private',
    'protected', 'public', 'published' );

begin
  Assert(AVisibility <> cvNone,
    'TVisibilityNode.Create(): AVisibility = cvNone');
  inherited Create(AParent, VisStrs[AVisibility], IsEnabled, ADelegator);
  FVisibility := AVisibility;
end;

function TVisibilityNode.GetVisibility: TXPClassVisibility;
begin
  Result := FVisibility;
end;

{ TSectionNode }

constructor TSectionNode.Create(const AParent: IXPParserTree;
  const AUnitSection: TXPUnitSection; const IsEnabled: boolean;
  const ADelegator: IInterface);
const
  SectionStrs: array[usInterface..usFinalization] of string = ( 'interface',
    'implementation', 'initialization', 'finalization' );

begin
  Assert(AUnitSection <> usNone,
    'TVisibilityNode.Create(): AUnitSection = usNone');
  inherited Create(AParent, SectionStrs[AUnitSection], IsEnabled, ADelegator);
  FUnitSection := AUnitSection;
end;

function TSectionNode.GetSection: TXPUnitSection;
begin
  Result := FUnitSection;
end;

{ TPropertyNode }

constructor TPropertyNode.Create(const AParent: IXPVisibilityNode;
  const APropertyName: string; const IsEnabled: boolean;
  const ADelegator: IInterface);
begin
  inherited Create(AParent, APropertyName, IsEnabled, ADelegator);
end;

end.