xpdunittestmodule.pas

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

const
  RootNode = nil;

  procedure AssignImages(const Node: TTreeNode; const ImageIndex: integer);
  begin
    Node.ImageIndex := ImageIndex;
    Node.SelectedIndex := ImageIndex;
  end;

begin
  FTestClassFilter.SetInput(FTestedModuleFilter);
  FTestClassFilter.Children.Start;
  TestClassesView.Items.BeginUpdate;

  try

    TestClassesView.Items.Clear;

    while FTestClassFilter.Children.Next(SectionNode) do
    begin
      CurrentSection := TestClassesView.Items.AddChildObject(RootNode,
        SectionNode.Name, pointer(SectionNode));
      AssignImages(CurrentSection, System.Ord(niSection));
      SectionNode.Children.Start;

      while SectionNode.Children.Next(ClassNode) do
      begin
        CurrentClass := TestClassesView.Items.AddChildObject(
          CurrentSection, FParameters.TestClassName(ClassNode.Name),
          pointer(ClassNode));
        AssignImages(CurrentClass, System.Ord(niClass));
        ClassNode.Children.Start;

        while ClassNode.Children.Next(VisibilityNode) do
        begin
          CurrentVisibility := TestClassesView.Items.AddChildObject(
            CurrentClass, VisibilityNode.Name, nil);
          AssignImages(CurrentVisibility, System.Ord(niVisibility));
          VisibilityNode.Children.Start;

          while VisibilityNode.Children.Next(MethodNode) do
            AssignImages(TestClassesView.Items.AddChildObject(
              CurrentVisibility, FParameters.TestMethodName(MethodNode.Name),
              pointer(MethodNode)), System.Ord(niMethod));

        end;

      end;

    end;

    SetSelectedTestNode;
  finally
    TestClassesView.Items.EndUpdate;
  end;

end;

procedure TXPDUnitTestModuleForm.ParseCurrentUnit;
begin
{$IFDEF GUI_DEMO}
  FTestedModuleParser.Parse(TestedUnitStream.CreateTestedUnitStream);
{$ELSE}
  // Parse current IDE unit
  FTestedModuleParser.Parse;
{$ENDIF}
end;

procedure TXPDUnitTestModuleForm.SelectPathClick(Sender: TObject);
const
  PathDelimiter  = '\';

var
{$IFDEF DELPHI7_UP}
  Directory: WideString;
{$ELSE}
  Directory: string;
{$ENDIF}

begin
  Directory := SysUtils.Trim(UnitPath.Text);

  if SelectDirectory('Choose TestModule directory...', '', Directory) then
    UnitPath.Text := Directory + PathDelimiter;

end;

procedure TXPDUnitTestModuleForm.CreateTestModuleClick(Sender: TObject);
begin
  // Persist our settings
  FPersistedValues.WriteBool(sBehaviours, iAddCurrentToTestModule,
    AddToTestModule.Checked);
  FPersistedValues.WriteBool(sBehaviours, iAddCurrentToProject,
    AddToProject.Checked);
  // Apply user values
  FParameters.Values[dpUnitName] := SysUtils.Trim(UnitName.Text);
  FParameters.Values[dpUnitPath] := SysUtils.Trim(UnitPath.Text);

  // Close form now
  // * parameters and tested classes handed on via public properties
  // * ModalResult is mrOK
end;

procedure TXPDUnitTestModuleForm.UnitNameChange(Sender: TObject);
begin
  UnitFileName.Text := SysUtils.Format('%s.pas',
    [SysUtils.Trim(UnitName.Text)]);
end;


function TXPDUnitTestModuleForm.GetTestClasses: IXPParserTree;
begin
  Result := FTestClassFilter;
end;

procedure TXPDUnitTestModuleForm.TestedClassesViewClick(Sender: TObject);
var
  Node: TTreeNode;

begin

  if ClickedOnStateIcon(Node) then
  begin
    SetNodeState(Node, not TreeToParser(Node).Enabled);
    UpdateTestClasses;
  end
  else
    SetSelectedTestNode;

end;

procedure TXPDUnitTestModuleForm.SetSelectedTestNode;
var
  TestedNode, TestNode: TTreeNode;
  MatchingNodeText: string;

const
  Recurse = true;

begin
  TestClassesView.Items.BeginUpdate;

  try
    // Expand to show class nodes only

    TestClassesView.FullCollapse;

    if TestClassesView.Items.GetFirstNode <> nil then
      TestClassesView.Items.GetFirstNode.Expand(not Recurse);

    // Now expand corresponding node to selected in TestedClassesView

    TestedNode := TestedClassesView.Selected;

    if Assigned(TestedNode) then
    begin

      // search for 'class' level node
      while System.Assigned(TestedNode.Parent)
        and System.Assigned(TestedNode.Parent.Parent) do
        TestedNode := TestedNode.Parent;

      if System.Assigned(TestedNode.Parent)
        and TreeToParser(TestedNode).Enabled then
      begin
        MatchingNodeText := FParameters.TestClassName(TestedNode.Text);
        TestNode := TestClassesView.Items.GetFirstNode.GetFirstChild;

        while Assigned(TestNode) and (TestNode.Text <> MatchingNodeText) do
          TestNode := TestClassesView.Items.GetFirstNode.GetNextChild(TestNode);

        if Assigned(TestNode) then
        begin
          TestNode.Focused := true;
          TestNode.Expand(Recurse);
        end;

      end;

    end;

  finally
    TestClassesView.Items.EndUpdate;
  end;


end;

function TXPDUnitTestModuleForm.ClickedOnStateIcon(
  out ANode: TTreeNode): boolean;
var
  HitInfo: THitTests;
  Pos: TPoint;

begin
  Windows.GetCursorPos(Pos);
  Pos := TestedClassesView.ScreenToClient(Pos);
  HitInfo := TestedClassesView.GetHitTestInfoAt(Pos.X, Pos.Y);
  ANode := TestedClassesView.GetNodeAt(Pos.X, Pos.Y);
  Result := System.Assigned(ANode) and (HtOnStateIcon in HitInfo);
end;


procedure TXPDUnitTestModuleForm.SetNodeState(const ANode: TTreeNode;
  const Enabled :boolean);
var
  MostSeniorChanged: TTreeNode;
  Node: TTreeNode;

begin
  System.Assert(System.Assigned(ANode));
  Node := ANode;
  TreeToParser(Node).Enabled := Enabled;
  MostSeniorChanged := Node;

  // update ancestors if enabling

  if Enabled then
  begin

    while System.Assigned(Node.Parent) do
    begin
      Node := Node.Parent;

      if not TreeToParser(Node).Enabled then
      begin // changed
        TreeToParser(Node).Enabled := true;
        MostSeniorChanged := Node;
      end;

    end;

  end;

  TestedClassesView.Items.BeginUpdate;

  try
    UpdateNodeState(MostSeniorChanged);
  finally
    TestedClassesView.Items.EndUpdate;
  end;

end;

function TXPDUnitTestModuleForm.TreeToParser(
  const ANode: TTreeNode): IXPParserNode;
begin
  System.Assert(System.Assigned(ANode)
    and SysUtils.Supports(IInterface(ANode.Data), IXPParserNode, Result));
end;

procedure TXPDUnitTestModuleForm.UpdateNodeImage(const ANode: TTreeNode);
var
  ParserNode: IXPParserNode;
  Node: TTreeNode;

begin
  Node := ANode;
  ParserNode := TreeToParser(Node);

  if not ParserNode.Enabled then
    Node.StateIndex := System.Ord(siDisabled)
  else if (Node.Parent <> nil)
    and (Node.Parent.StateIndex <= System.Ord(siParentDisabled)) then
    Node.StateIndex := System.Ord(siParentDisabled)
  else
    Node.StateIndex := System.Ord(siEnabled);

end;

procedure TXPDUnitTestModuleForm.UpdateNodeState(const ANode: TTreeNode);
var
  Node: TTreeNode;

begin
  System.Assert(System.Assigned(ANode));
  Node := ANode;
  UpdateNodeImage(Node);

  if Node.HasChildren then
  begin
    Node := Node.GetFirstChild;

    while System.Assigned(Node) do
    begin
      UpdateNodeState(Node);
      Node := Node.getNextSibling;
    end;

  end;

end;

initialization
finalization

  LForm.Free;

end.