DUnit: An XTreme testing framework for Delphi programs.
TTestFunc Function type used by the TDUnitDialog.ApplyToTests method
Author The DUnit Group.
HTML generated by Time2HELP
http://www.time2help.com
Unit GUITestRunner
Declaration TGUITestRunner = class (TForm, ITestListener )
Introduced Public Properties
Suite The test suite to be run in this runner TestResult The result of the last test run
HTML generated by Time2HELP
http://www.time2help.com
The test suite to be run in this runnerApplies to TGUITestRunner
Declaration Property Suite : ITest Read FSuite Write SetSuite ;
HTML generated by Time2HELP
http://www.time2help.com
The result of the last test runApplies to TGUITestRunner
Declaration Property TestResult : TTestResult Read FTestResult Write FTestResult;
HTML generated by Time2HELP
http://www.time2help.com
implement the ITestListener interfaceApplies to TGUITestRunner
Declaration Procedure AddError(failure: TTestFailure );Implementation
procedure TGUITestRunner.AddError(failure: TTestFailure );
var
ListItem: TListItem;
begin
UpdateStatus;
ListItem := AddFailureItem(failure);
ListItem.ImageIndex := imgERROR;
TProgressBarCrack(ScoreBar).Color := clERROR;
SetTreeNodeImage(TestToNode(failure.failedTest), imgERROR);
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure AddFailure(failure: TTestFailure );Implementation
procedure TGUITestRunner.AddFailure(failure: TTestFailure );
var
ListItem: TListItem;
begin
UpdateStatus;
ListItem := AddFailureItem(failure);
ListItem.ImageIndex := 0;
if testResult.errorCount = 0 then
begin
TProgressBarCrack(ScoreBar).Color := clFAILURE;
end ;
SetTreeNodeImage(TestToNode(failure.failedTest), imgFAILED);
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Function AddFailureItem(failure: TTestFailure ): TListItem;Implementation
function TGUITestRunner.AddFailureItem(failure: TTestFailure ): TListItem;
var
item : TListItem;
node : TTreeNode;
begin
assert(assigned(failure));
item := FailureListView.Items.Add;
item.data := Pointer(TestToNode(failure.failedTest));
item.Caption := failure.failedTest.Name ;
item.SubItems.Add(failure.thrownExceptionName);
item.SubItems.Add(failure.thrownExceptionMessage);
node := testToNode(failure.failedTest);
while node <> nil do
begin
node.Expand(false);
node := node.Parent;
end ;
Result := item;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure ApplyToTests(root :TTreeNode; const func :TTestFunc );Implementation
procedure TGUITestRunner.ApplyToTests(root :TTreeNode; const func :TTestFunc );
procedure DoApply(root :TTreeNode);
var
test: ITest ;
node: TTreeNode;
begin
if root <> nil then
begin
test := NodeToTest(root);
if func(test) then
begin
node := root.getFirstChild;
while node <> nil do
begin
DoApply(node);
node := node.getNextSibling;
end ;
end ;
end ;
end ;
begin
TestTree.Items.BeginUpdate;
try
DoApply(root)
finally
TestTree.Items.EndUpdate
end ;
UpdateTestTreeState;
End ;
HTML generated by Time2HELP
http://www.time2help.com
AutoFocusActionExecute method
Applies to TGUITestRunner
Declaration Procedure AutoFocusActionExecute(Sender: TObject);Implementation
procedure TGUITestRunner.AutoFocusActionExecute(Sender: TObject);
begin
with AutoFocusAction do
Checked := not Checked;
End ;
HTML generated by Time2HELP
http://www.time2help.com
AutoSaveActionExecute method
Applies to TGUITestRunner
Declaration Procedure AutoSaveActionExecute(Sender: TObject);Implementation
procedure TGUITestRunner.AutoSaveActionExecute(Sender: TObject);
begin
with AutoSaveAction do
begin
Checked := not Checked
end ;
AutoSaveConfiguration;
End ;
HTML generated by Time2HELP
http://www.time2help.com
AutoSaveConfiguration method
Applies to TGUITestRunner
Declaration Procedure AutoSaveConfiguration;Implementation
procedure TGUITestRunner.AutoSaveConfiguration;
begin
if AutoSaveAction.Checked then
SaveConfiguration;
End ;
HTML generated by Time2HELP
http://www.time2help.com
BreakOnFailuresActionExecute method
Applies to TGUITestRunner
Declaration Procedure BreakOnFailuresActionExecute(Sender: TObject);Implementation
procedure TGUITestRunner.BreakOnFailuresActionExecute(Sender: TObject);
begin
with BreakOnFailuresAction do
Checked := not Checked;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure ClearResult;Implementation
procedure TGUITestRunner.ClearResult;
begin
if FTestResult <> nil then
begin
FTestResult.Free;
FTestResult := nil ;
end ;
End ;
HTML generated by Time2HELP
http://www.time2help.com
CloseActionExecute method
Applies to TGUITestRunner
Declaration Procedure CloseActionExecute(Sender: TObject);Todo
autofocus logic should be refactored into its own set of routines Implementation procedure TGUITestRunner.CloseActionExecute(Sender: TObject);
begin
if FTestResult <> nil then
FTestResult.stop;
self.ModalResult := mrCancel;
Close;
End ;
HTML generated by Time2HELP
http://www.time2help.com
CollapseNonGrandparentNodes method
Applies to TGUITestRunner
Declaration Procedure CollapseNonGrandparentNodes(RootNode: TTreeNode);Implementation
procedure TGUITestRunner.CollapseNonGrandparentNodes(RootNode: TTreeNode);
var
AChildNode: TTreeNode;
begin
if not NodeIsGrandparent(RootNode) then
RootNode.Collapse(false);
AChildNode := RootNode.GetFirstChild;
while AChildNode <> nil do
begin
CollapseNonGrandparentNodes(AChildNode);
AChildNode := RootNode.GetNextChild(AChildNode);
end ;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Constructor Create(AOwner: TComponent); Implementation
constructor TGUITestRunner.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
LoadConfiguration;
FTests := TInterfaceList.Create;
End ;
HTML generated by Time2HELP
http://www.time2help.com
DeselectAllActionExecute method
Applies to TGUITestRunner
Declaration Procedure DeselectAllActionExecute(Sender: TObject);Implementation
procedure TGUITestRunner.DeselectAllActionExecute(Sender: TObject);
begin
inherited ;
ApplyToTests(TestTree.Selected, DisableTest);
UpdateStatus;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Destructor Destroy; Implementation
destructor TGUITestRunner.Destroy;
begin
AutoSaveConfiguration;
FTests.Free;
inherited Destroy;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Function DisableTest(test :ITest ): boolean;Implementation
function TGUITestRunner.DisableTest(test: ITest ): boolean;
begin
test.enabled := false;
result := true;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Function EnableTest(test :ITest ): boolean;Implementation
function TGUITestRunner.EnableTest(test: ITest ): boolean;
begin
test.enabled := true;
result := true;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure EnableUI(enable :Boolean);Implementation
procedure TGUITestRunner.EnableUI(enable: Boolean);
begin
SelectAllAction.Enabled := enable;
DeselectAllAction.Enabled := enable;
SelectFailedAction.Enabled := enable;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure EndTest(test: ITest );Implementation
procedure TGUITestRunner.EndTest(test: ITest );
begin
// do nothing
End ;
HTML generated by Time2HELP
http://www.time2help.com
ErrorBoxPanelResize method
Applies to TGUITestRunner
Declaration Procedure ErrorBoxPanelResize(Sender: TObject);Implementation
procedure TGUITestRunner.ErrorBoxPanelResize(Sender: TObject);
begin
// Solve bugs with Delphi4 resizing with constraints
ErrorBoxSplitter.Top := ErrorBoxPanel.Top-8;
End ;
HTML generated by Time2HELP
http://www.time2help.com
ErrorBoxSplitterMoved method
Applies to TGUITestRunner
Declaration Procedure ErrorBoxSplitterMoved(Sender: TObject);Implementation
procedure TGUITestRunner.ErrorBoxSplitterMoved(Sender: TObject);
begin
// Solve bugs with Delphi4 resizing with constraints
ErrorBoxSplitter.Top := ErrorBoxPanel.Top-8;
self.Update;
End ;
HTML generated by Time2HELP
http://www.time2help.com
ErrorBoxVisibleActionExecute method
Applies to TGUITestRunner
Declaration Procedure ErrorBoxVisibleActionExecute(Sender: TObject);Implementation
procedure TGUITestRunner.ErrorBoxVisibleActionExecute(Sender: TObject);
begin
with ErrorBoxVisibleAction do
begin
Checked := not Checked;
ErrorBoxSplitter.Visible := Checked;
ErrorBoxPanel.Visible := Checked;
if Checked then
begin
// Solve bugs with Delphi4 resizing with constraints
ErrorBoxSplitter.Top := ErrorBoxPanel.Top-8;
end
end ;
End ;
HTML generated by Time2HELP
http://www.time2help.com
ExpandAllNodesActionExecute method
Applies to TGUITestRunner
Declaration Procedure ExpandAllNodesActionExecute(Sender: TObject);Implementation
procedure TGUITestRunner.ExpandAllNodesActionExecute(Sender: TObject);
begin
TestTree.FullExpand;
if (TestTree.Selected <> nil ) then
TestTree.Selected.MakeVisible
else if (TestTree.Items.Count > 0) then
TestTree.Selected := TestTree.Items[0];
End ;
HTML generated by Time2HELP
http://www.time2help.com
FailureListViewClick method
Applies to TGUITestRunner
Declaration Procedure FailureListViewClick(Sender: TObject);Implementation
procedure TGUITestRunner.FailureListViewClick(Sender: TObject);
begin
if FailureListView.Selected <> nil then
begin
TestTree.Selected := TTreeNode(FailureListView.Selected.data);
end ;
End ;
HTML generated by Time2HELP
http://www.time2help.com
FailureListViewSelectItem method
Applies to TGUITestRunner
Declaration Procedure FailureListViewSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);Implementation
procedure TGUITestRunner.FailureListViewSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
var
hlColor :TColor;
begin
if Selected then
begin
TestTree.Selected := TTreeNode(Item.data);
hlColor := clFAILURE;
if Item.ImageIndex >= 1 then
hlColor := clERROR;
with ErrorMessageRTF do
begin
Clear;
SelAttributes.Style := [fsBold];
SelText := Item.Caption + ': ' ;
SelAttributes.Color := hlColor;
SelAttributes.Style := [fsBold];
SelText := Item.SubItems[0];
SelAttributes.Color := clWindowText;
Lines.Add('' );
SelAttributes.Style := [];
SelText := Item.SubItems[1];
end
end
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure FillTestTree(RootNode: TTreeNode; ATest: ITest );Implementation
procedure TGUITestRunner.FillTestTree(RootNode: TTreeNode; ATest: ITest );
var
Tests: IInterfaceList;
i: Integer;
index : Integer;
begin
if ATest = nil then
EXIT;
RootNode := TestTree.Items.AddChild(RootNode, ATest.Name );
index := FTests.Add(ATest);
RootNode.data := Pointer(index );
RootNode.StateIndex := imgENABLED;
Tests := ATest.Tests;
for i := 0 to Tests.count - 1 do
begin
FillTestTree(RootNode, Tests[i] as ITest );
end ;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure FormCreate(Sender: TObject);Implementation
procedure TGUITestRunner.FormCreate(Sender: TObject);
begin
inherited ;
TestTree.Items.Clear;
EnableUI(false);
FTestResult := TTestResult.Create;
Setup;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure FormDestroy(Sender: TObject);Implementation
procedure TGUITestRunner.FormDestroy(Sender: TObject);
begin
ClearResult;
inherited ;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure FormShow(Sender: TObject);Implementation
procedure TGUITestRunner.FormShow(Sender: TObject);
begin
if AutoFocusAction.Checked
and RunButton.CanFocus then
RunButton.SetFocus;
End ;
HTML generated by Time2HELP
http://www.time2help.com
HideTestNodesActionExecute method
Applies to TGUITestRunner
Declaration Procedure HideTestNodesActionExecute(Sender: TObject);Implementation
procedure TGUITestRunner.HideTestNodesActionExecute(Sender: TObject);
var
ANode: TTreeNode;
begin
inherited ;
TestTree.Items.BeginUpdate;
try
ANode := TestTree.Items[0];
if ANode <> nil then
begin
ANode.Expand(true);
CollapseNonGrandparentNodes(ANode);
ANode.Selected := true;
ANode.MakeVisible;
end ;
finally
TestTree.Items.EndUpdate;
end ;
End ;
HTML generated by Time2HELP
http://www.time2help.com
HideTestNodesOnOpenActionExecute method
Applies to TGUITestRunner
Declaration Procedure HideTestNodesOnOpenActionExecute(Sender: TObject);Implementation
procedure TGUITestRunner.HideTestNodesOnOpenActionExecute(Sender: TObject);
begin
HideTestNodesOnOpenAction.Checked := not HideTestNodesOnOpenAction.Checked;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Function IniFileName: string ;Implementation
function TGUITestRunner.IniFileName: string ;
const
TEST_INI_FILE = 'dunit.ini' ;
begin
result := ExtractFilePath(Application.ExeName) + TEST_INI_FILE
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure InitTree; Implementation
procedure TGUITestRunner.InitTree;
begin
FillTestTree(FSuite);
Setup;
if HideTestNodesOnOpenAction.Checked then
HideTestNodesAction.Execute
else
ExpandAllNodesAction.Execute;
TestTree.Selected := TestTree.Items.GetFirstNode;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure LoadConfiguration;Implementation
procedure TGUITestRunner.LoadConfiguration;
begin
if FSuite <> nil then
FSuite.LoadConfiguration(IniFileName);
with TIniFile.Create(IniFileName) do
try
with AutoSaveAction do
Checked := ReadBool(cnConfigIniSection, 'AutoSave' , Checked);
Left := ReadInteger(cnConfigIniSection, 'Left' , Left);
Top := ReadInteger(cnConfigIniSection, 'Top' , Top);
Width := ReadInteger(cnConfigIniSection, 'Width' , Width);
Height := ReadInteger(cnConfigIniSection, 'Height' , Height);
{ center splitter location }
with ResultsPanel do
Height := ReadInteger(cnConfigIniSection, 'ResultsPanel.Height' , Height);
{ error splitter location }
with ErrorBoxPanel do
Height := ReadInteger(cnConfigIniSection, 'ErrorMessage.Height' , Height);
with ErrorBoxVisibleAction do
Checked := ReadBool(cnConfigIniSection, 'ErrorMessage.Visible' , Checked);
ErrorBoxSplitter.Visible := ErrorBoxVisibleAction.Checked;
ErrorBoxPanel.Visible := ErrorBoxVisibleAction.Checked;
{ failure list configuration }
with FailureListView do begin
Columns[0].Width := ReadInteger(cnConfigIniSection, 'FailureList.ColumnWidth[0]' ,
Columns[0].Width);
Columns[1].Width := ReadInteger(cnConfigIniSection, 'FailureList.ColumnWidth[1]' ,
Columns[1].Width);
end ;
{ other options }
AutoFocusAction.Checked := ReadBool(cnConfigIniSection, 'AutoFocus' ,
AutoFocusAction.Checked);
HideTestNodesOnOpenAction.Checked := ReadBool(cnConfigIniSection,
'HideTestNodesOnOpen' , HideTestNodesOnOpenAction.Checked);
BreakOnFailuresAction.Checked := ReadBool(cnConfigIniSection,
'BreakOnFailures' , BreakOnFailuresAction.Checked);
finally
Free;
end ;
if FSuite <> nil then
UpdateTestTreeState;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Function NodeIsGrandparent(ANode: TTreeNode): boolean;Implementation
function TGUITestRunner.NodeIsGrandparent(ANode: TTreeNode): boolean;
var
AChildNode: TTreeNode;
begin
Result := false;
if ANode.HasChildren then
begin
AChildNode := ANode.GetFirstChild;
while AChildNode <> nil do
begin
Result := AChildNode.HasChildren or Result;
AChildNode := ANode.GetNextChild(AChildNode);
end ;
end ;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Function NodeToTest(node :TTreeNode): ITest ;Implementation
function TGUITestRunner.NodeToTest(Node: TTreeNode): ITest ;
var
index : Integer;
begin
assert(assigned(Node));
index := Integer(Node.data);
result := FTests[index ] as ITest ;
End ;
HTML generated by Time2HELP
http://www.time2help.com
RestoreSavedActionExecute method
Applies to TGUITestRunner
Declaration Procedure RestoreSavedActionExecute(Sender: TObject);Implementation
procedure TGUITestRunner.RestoreSavedActionExecute(Sender: TObject);
begin
LoadConfiguration
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure RunActionExecute(Sender: TObject);Implementation
procedure TGUITestRunner.RunActionExecute(Sender: TObject);
begin
if FSuite = nil then
EXIT;
if FRunning then begin
// warning: we're reentering this method if FRunning is true
assert(FTestResult <> nil );
FTestResult.Stop;
EXIT;
end ;
RunButton.Caption := '&Stop' ;
EnableUI(false);
FRunning := true;
try
Setup;
AutoSaveConfiguration;
ClearResult;
TestResult := TTestResult.create;
try
testResult.addListener(self);
TestFramework.SetBreakOnFailures(BreakOnFailuresAction.Checked);
TestTree.Items.BeginUpdate;
try
FSTartTime := now;
suite.run(testResult);
finally
TestTree.Items.EndUpdate;
end ;
{:@todo autofocus logic should be refactored into its own set of routines }
if AutoFocusAction.Checked
and testResult.WasSuccessful
then
begin
with CloseButton do
if CanFocus then SetFocus;
end
else
begin
with RunButton do
if CanFocus then SetFocus;
end
finally
testResult.Free;
testResult := nil ;
end ;
finally
FRunning := false;
RunButton.Caption := '&Run' ;
EnableUI(true);
end ;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure SaveConfiguration;Implementation
procedure TGUITestRunner.SaveConfiguration;
begin
if FSuite <> nil then
FSuite.SaveConfiguration(IniFileName);
with TIniFile.Create(IniFileName) do
try
WriteBool(cnConfigIniSection, 'AutoSave' , AutoSaveAction.Checked);
WriteInteger(cnConfigIniSection, 'Left' , Left);
WriteInteger(cnConfigIniSection, 'Top' , Top);
WriteInteger(cnConfigIniSection, 'Width' , Width);
WriteInteger(cnConfigIniSection, 'Height' , Height);
{ center splitter location }
WriteInteger(cnConfigIniSection, 'ResultsPanel.Height' ,
ResultsPanel.Height);
{ error box }
WriteInteger(cnConfigIniSection, 'ErrorMessage.Height' ,
ErrorBoxPanel.Height);
WriteBool(cnConfigIniSection, 'ErrorMessage.Visible' ,
ErrorBoxVisibleAction.Checked);
{ failure list configuration }
with FailureListView do begin
WriteInteger(cnConfigIniSection, 'FailureList.ColumnWidth[0]' ,
Columns[0].Width);
WriteInteger(cnConfigIniSection, 'FailureList.ColumnWidth[1]' ,
Columns[1].Width);
end ;
{ other options }
WriteBool(cnConfigIniSection, 'AutoFocus' , AutoFocusAction.Checked);
WriteBool(cnConfigIniSection, 'HideTestNodesOnOpen' , HideTestNodesOnOpenAction.Checked);
WriteBool(cnConfigIniSection, 'BreakOnFailures' , BreakOnFailuresAction.Checked);
finally
Free;
end ;
End ;
HTML generated by Time2HELP
http://www.time2help.com
SaveConfigurationActionExecute method
Applies to TGUITestRunner
Declaration Procedure SaveConfigurationActionExecute(Sender: TObject);Implementation
procedure TGUITestRunner.SaveConfigurationActionExecute(Sender: TObject);
begin
SaveConfiguration
End ;
HTML generated by Time2HELP
http://www.time2help.com
SelectAllActionExecute method
Applies to TGUITestRunner
Declaration Procedure SelectAllActionExecute(Sender: TObject);Implementation
procedure TGUITestRunner.SelectAllActionExecute(Sender: TObject);
begin
inherited ;
ApplyToTests(TestTree.Selected, EnableTest);
SetNodeState(TestTree.Selected, true);
UpdateStatus;
End ;
HTML generated by Time2HELP
http://www.time2help.com
SelectFailedActionExecute method
Applies to TGUITestRunner
Declaration Procedure SelectFailedActionExecute(Sender: TObject);Implementation
procedure TGUITestRunner.SelectFailedActionExecute(Sender: TObject);
var
i: integer;
ANode: TTreeNode;
begin
{ deselect all }
ApplyToTests(TestTree.Items[0], DisableTest);
{ select failed }
for i := 0 to FailureListView.Items.Count - 1 do
begin
ANode := TTreeNode(FailureListView.Items[i].Data);
SetNodeState(ANode, true);
end ;
UpdateStatus;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure SetNodeState(node: TTreeNode; enabled :boolean);Implementation
procedure TGUITestRunner.SetNodeState(node: TTreeNode; enabled :boolean);
var
MostSeniorChanged :TTReeNode;
begin
assert(node <> nil );
// update ancestors if enabling
NodeToTest(Node).Enabled := enabled;
MostSeniorChanged := Node;
if enabled then
begin
while Node.Parent <> nil do
begin
Node := Node.Parent;
if Node.StateIndex < imgENABLED then
begin // changed
NodeToTest(Node).Enabled := true;
Node.StateIndex := imgENABLED;
MostSeniorChanged := Node;
end
end ;
end ;
TestTree.Items.BeginUpdate;
try
UpdateNodeState(MostSeniorChanged);
finally
TestTree.Items.EndUpdate;
end
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure SetSuite(value: ITest );Implementation
procedure TGUITestRunner.SetSuite(value: ITest );
begin
FSuite := value;
if FSuite <> nil then
FSuite.LoadConfiguration(IniFileName);
EnableUI(FSuite <> nil );
InitTree;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure SetTreeNodeImage(Node :TTReeNode; imgIndex :Integer);Implementation
procedure TGUITestRunner.SetTreeNodeImage(Node :TTReeNode; imgIndex :Integer);
begin
while Node <> nil do
begin
if imgIndex > Node.ImageIndex then begin
Node.ImageIndex := imgIndex;
Node.SelectedIndex := imgIndex;
end ;
Node := Node.Parent;
end ;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure Setup;Implementation
procedure TGUITestRunner.Setup;
var
i: Integer;
node: TTreeNode;
begin
FailureListView.Items.Clear;
ProgressBar.Position := 0;
ScoreBar.Position := 0;
TProgressBarCrack(ScoreBar).ParentColor := true;
with ResultsView.Items[0] do
begin
if FSuite <> nil then
begin
SubItems[0] := IntToStr(FSuite.countEnabledTestCases);
end
else
begin
SubItems[0] := '' ;
end ;
SubItems[1] := '' ;
SubItems[2] := '' ;
SubItems[3] := '' ;
SubItems[4] := '' ;
end ;
if FSuite <> nil then
begin
ProgressBar.Max := FSuite.countEnabledTestCases;
end
else
begin
ProgressBar.Max:= 10000;
end ;
ScoreBar.Max := ProgressBar.Max;
for i := 0 to TestTree.Items.Count - 1 do
begin
node := TestTree.Items[i];
node.ImageIndex := imgNONE;
node.SelectedIndex := imgNONE;
end ;
UpdateTestTreeState;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure StartTest(test: ITest );Implementation
procedure TGUITestRunner.StartTest(test: ITest );
begin
assert(assigned(testResult));
assert(assigned(test));
Application.ProcessMessages;
SetTreeNodeImage(TestToNode(test), imgRUN);
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure SwitchNodeState(node: TTreeNode);Implementation
procedure TGUITestRunner.SwitchNodeState(node: TTreeNode);
begin
assert(node <> nil );
SetNodeState(node, not NodeToTest(node).enabled);
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure TestingEnds(testResult :TTestResult );Implementation
procedure TGUITestRunner.TestingEnds(testResult :TTestResult );
begin
if testResult.wasSuccessful then
begin
TProgressBarCrack(ScoreBar).Color := clOK;
ScoreBar.Position := 0;
end ;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure TestingStarts;Implementation
procedure TGUITestRunner.TestingStarts;
begin
UpdateStatus;
// sleep(100); // !!! for testing
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Function TestToNode(test :ITest ): TTreeNode;Implementation
function TGUITestRunner.TestToNode(test: ITest ): TTreeNode;
var
node: TTreeNode;
FoundNode : TTreeNode;
begin
assert(assigned(test));
FoundNode := nil ;
node := TestTree.Items.GetFirstNode;
while assigned(node) do
begin
if NodeToTest(node)= test then
begin
FoundNode := node;
break;
end ;
node := node.getNext;
end ;
assert(assigned(FoundNode));
Result := FoundNode;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure TestTreeClick(Sender: TObject);Implementation
procedure TGUITestRunner.TestTreeClick(Sender: TObject);
var
node: TTreeNode;
HitInfo: THitTests;
Pos: TPoint;
i : Integer;
begin
if FRunning then
EXIT;
GetCursorPos(Pos);
Pos := TestTree.ScreenToClient(Pos);
with Pos do
begin
HitInfo := TestTree.GetHitTestInfoAt(X, Y);
node := TestTree.GetNodeAt(X, Y);
end ;
if (node <> nil ) and (HtOnStateIcon in HitInfo) then
begin
SwitchNodeState(node);
end ;
FailureListView.Selected := nil ;
for i := 0 to FailureListView.Items.count - 1 do
begin
if TTreeNode(FailureListView.Items[i].Data) = TestTree.Selected then
begin
FailureListView.Selected := FailureListView.Items[i];
break;
end ;
end ;
UpdateStatus;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure TestTreeKeyPress(Sender: TObject; var Key: Char);Implementation
procedure TGUITestRunner.TestTreeKeyPress(Sender: TObject; var Key: Char);
begin
if (Key = ' ' ) and (TestTree.Selected <> nil ) then
begin
SwitchNodeState(TestTree.Selected);
UpdateStatus;
Key := #0
end ;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure UpdateNodeState(node: TTreeNode);Implementation
procedure TGUITestRunner.UpdateNodeState(node: TTreeNode);
var
test: ITest ;
begin
assert(assigned(node));
test := NodeToTest(node);
assert(assigned(test));
if not test.enabled then
begin
node.StateIndex := imgDISABLED;
end
else if (node.Parent <> nil )
and (node.Parent.StateIndex <= imgPARENT_DISABLED) then
begin
node.StateIndex := imgPARENT_DISABLED;
end
else
begin
node.StateIndex := imgENABLED;
end ;
if node.HasChildren then
begin
node := node.getFirstChild;
while node <> nil do
begin
UpdateNodeState(node);
node := node.getNextSibling;
end ;
end ;
End ;
HTML generated by Time2HELP
http://www.time2help.com
Applies to TGUITestRunner
Declaration Procedure UpdateStatus;Implementation
procedure TGUITestRunner.UpdateStatus;
var
i :Integer;
begin
if FSuite <> nil then
ResultsView.Items[0].SubItems[0] := IntToStr(FSuite.countEnabledTestCases)
else
ResultsView.Items[0].SubItems[0] := '' ;
if testResult <> nil then
begin
with ResultsView.Items[0] do
begin
SubItems[1] := IntToStr(testResult.runCount);
SubItems[2] := IntToStr(testResult.failureCount);
SubItems[3] := IntToStr(testResult.errorCount);
SubItems[4] := FormatDateTime('h:nn:ss' , FRunTime);
end ;
FRunTime := now - FSTartTime;
with testResult do begin
ScoreBar.Position := runCount - (failureCount + errorCount);
ProgressBar.Position := testResult.runCount;
end ;
end
else begin
with ResultsView.Items[0] do
begin
for i := 1 to 4 do
SubItems[i] := ''
end ;
ScoreBar.Position := 0;
ProgressBar.Position := 0;
end ;
End ;
HTML generated by Time2HELP
http://www.time2help.com
UpdateTestTreeState method
Applies to TGUITestRunner
Declaration Procedure UpdateTestTreeState;Implementation
procedure TGUITestRunner.UpdateTestTreeState;
var
node :TTreeNode;
begin
if TestTree.Items.Count > 0 then
begin
TestTree.Items.BeginUpdate;
try
node := TestTree.Items.GetFirstNode;
while node <> nil do
begin
UpdateNodeState(node);
node := node.getNextSibling;
end
finally
TestTree.Items.EndUpdate;
end ;
end ;
End ;
HTML generated by Time2HELP
http://www.time2help.com
RunRegisteredTests Routine
Unit GUITestRunner
Declaration Procedure RunRegisteredTests;Implementation
procedure RunRegisteredTests;
begin
RunTest(registeredTests)
End ;
HTML generated by Time2HELP
http://www.time2help.com
Unit GUITestRunner
Declaration Procedure RunTest(test: ITest );
HTML generated by Time2HELP
http://www.time2help.com
Function type used by the TDUnitDialog.ApplyToTests methodUnit GUITestRunner
Declaration
TTestFunc = function (item :ITest ):boolean of object ;
item The ITest instance on which to act
Returns true if processing should continue, false otherwise
HTML generated by Time2HELP
http://www.time2help.com
Unit GUITestRunner
Declaration clERROR = clRed;
HTML generated by Time2HELP
http://www.time2help.com
clFAILURE Global Constant
Unit GUITestRunner
Declaration clFAILURE = clFuchsia;
HTML generated by Time2HELP
http://www.time2help.com
Color constants for the progress bar and failure details panelUnit GUITestRunner
Declaration clOK = clGREEN;
HTML generated by Time2HELP
http://www.time2help.com
cnConfigIniSection Global Constant
Section of the dunit.ini file where GUI information will be storedUnit GUITestRunner
Declaration cnConfigIniSection = 'GUITestRunner Config' ;
HTML generated by Time2HELP
http://www.time2help.com
imgDISABLED Global Constant
Indexes of the images used for test tree checkboxesUnit GUITestRunner
Declaration imgDISABLED = 1;
HTML generated by Time2HELP
http://www.time2help.com
imgENABLED Global Constant
Unit GUITestRunner
Declaration imgENABLED = 3;
HTML generated by Time2HELP
http://www.time2help.com
Unit GUITestRunner
Declaration imgERROR = 3;
HTML generated by Time2HELP
http://www.time2help.com
imgFAILED Global Constant
Unit GUITestRunner
Declaration imgFAILED = 2;
HTML generated by Time2HELP
http://www.time2help.com
Indexes of the color images used in the test tree and failure listUnit GUITestRunner
Declaration imgNONE = 0;
HTML generated by Time2HELP
http://www.time2help.com
imgPARENT_DISABLED Global Constant
Unit GUITestRunner
Declaration imgPARENT_DISABLED = 2;
HTML generated by Time2HELP
http://www.time2help.com
Unit GUITestRunner
Declaration imgRUN = 1;
HTML generated by Time2HELP
http://www.time2help.com