paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-20 14:19:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

fixed painting test icon green before run from Dean

Browse Source 
git-svn-id: trunk@7211 -
This commit is contained in:
vincents 2005-05-28 20:49:18 +00:00
parent 07a5e02a5c
commit e4204011e9
1 changed files with 33 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
components/fpcunit/guitestrunner.pas
View File

@ -96,8 +96,7 @@ type
procedure ResetNodeColors; procedure ResetNodeColors;
procedure PaintNodeError(aNode: TTreeNode); procedure PaintNodeError(aNode: TTreeNode);
procedure PaintNodeFailure(aNode: TTreeNode); procedure PaintNodeFailure(aNode: TTreeNode);
procedure PaintNodeSuccess(aNode: TTreeNode); procedure PaintNodeNonFailed(aNode: TTreeNode);
procedure PaintRunnableSubnodes(aNode: TTreeNode);
procedure MemoLog(LogEntry: string); procedure MemoLog(LogEntry: string);
public public
procedure AddFailure(ATest: TTest; AFailure: TTestFailure); procedure AddFailure(ATest: TTest; AFailure: TTestFailure);
@ -139,18 +138,16 @@ var
begin begin
barcolor := clGreen; barcolor := clGreen;
ResetNodeColors; ResetNodeColors;
if (TestTree.Selected <> nil) and (TestTree.Selected.Data <> nil) then if (TestTree.Selected <> nil) and (TestTree.Selected.Data <> nil) then
begin begin
testSuite := TTest(TestTree.Selected.Data); testSuite := TTest(TestTree.Selected.Data);
PaintNodeSuccess(TestTree.Selected); TestTree.Selected.Expand(false);
PaintRunnableSubnodes(TestTree.Selected);
end end
else else
begin begin
testSuite := GetTestRegistry; testSuite := GetTestRegistry;
TestTree.Selected := TestTree.Items[0]; TestTree.Selected := TestTree.Items[0];
ResetNodeColors;
PaintRunnableSubnodes(TestTree.Selected);
end; end;
failureCounter := 0; failureCounter := 0;
errorCounter := 0; errorCounter := 0;
@ -263,7 +260,8 @@ begin
node.ImageIndex := 12; node.ImageIndex := 12;
node.SelectedIndex := 12; node.SelectedIndex := 12;
end; end;
rootNode.Expand(True); rootNode.Expand(False);
ResetNodeColors;
end; end;
function TGUITestRunner.FindNode(aTest: TTest): TTreeNode; function TGUITestRunner.FindNode(aTest: TTest): TTreeNode;
@ -296,6 +294,7 @@ begin
begin begin
aNode.ImageIndex := 2; aNode.ImageIndex := 2;
aNode.SelectedIndex := 2; aNode.SelectedIndex := 2;
aNode.Expand(True);
aNode := aNode.Parent; aNode := aNode.Parent;
if Assigned(aNode) and (aNode.ImageIndex in [0, 3, 12, -1]) then if Assigned(aNode) and (aNode.ImageIndex in [0, 3, 12, -1]) then
PaintNodeError(aNode); PaintNodeError(aNode);
@ -310,6 +309,7 @@ begin
begin begin
aNode.ImageIndex := 3; aNode.ImageIndex := 3;
aNode.SelectedIndex := 3; aNode.SelectedIndex := 3;
aNode.Expand(true);
end; end;
aNode := aNode.Parent; aNode := aNode.Parent;
if Assigned(aNode) and (aNode.ImageIndex in [0, -1, 12]) then if Assigned(aNode) and (aNode.ImageIndex in [0, -1, 12]) then
@ -317,26 +317,31 @@ begin
end; end;
end; end;
procedure TGUITestRunner.PaintNodeSuccess(aNode: TTreeNode); procedure TGUITestRunner.PaintNodeNonFailed(aNode: TTreeNode);
begin
if Assigned(aNode) then
begin
aNode.ImageIndex := 0;
aNode.SelectedIndex := 0;
end;
end;
procedure TGUITestRunner.PaintRunnableSubnodes(aNode: TTreeNode);
var var
noFailedSibling: boolean;
i: integer; i: integer;
begin begin
if Assigned(aNode) then if Assigned(aNode) then
begin
if aNode.ImageIndex in [12, -1] then
begin begin
aNode.ImageIndex := 0; aNode.ImageIndex := 0;
aNode.SelectedIndex := 0; aNode.SelectedIndex := 0;
for i := 0 to aNode.Count - 1 do end;
if aNode.Items[i].Count > 0 then end;
PaintRunnableSubnodes(aNode.Items[i]); if Assigned(aNode.Parent) then
if aNode.Index = aNode.Parent.Count -1 then
begin
aNode := aNode.Parent;
noFailedSibling := true;
for i := 0 to aNode.Count -2 do
begin
if aNode.Items[i].ImageIndex <> 0 then
noFailedSibling := false;;
end;
if (aNode.ImageIndex = 12) and noFailedSibling then
PaintNodeNonFailed(aNode);
end; end;
end; end;
@ -411,22 +416,18 @@ begin
end; end;
procedure TGUITestRunner.StartTest(ATest: TTest); procedure TGUITestRunner.StartTest(ATest: TTest);
var
Node: TTreeNode;
begin begin
Node := FindNode(ATest);
if Assigned(Node) then
begin
Node.ImageIndex := 0;
Node.SelectedIndex := 0;
end;
end; end;
procedure TGUITestRunner.EndTest(ATest: TTest); procedure TGUITestRunner.EndTest(ATest: TTest);
var
Node: TTreeNode;
begin begin
Inc(testsCounter); Inc(testsCounter);
pbBar.Refresh; Node := FindNode(ATest);
pbBar1.Refresh; PaintNodeNonFailed(Node);
pbbar.Refresh;
pbbar1.Refresh;
end; end;
initialization initialization