fpcunit: Fix bug where parent nodes did not indicate failure. Issue #27887, patch from Graeme Geldenhuys.

git-svn-id: trunk@48805 -
This commit is contained in:
juha 2015-04-21 17:30:02 +00:00
parent f0c6c67de5
commit d942a8006d

View File

@ -713,14 +713,14 @@ begin
end; end;
end; end;
if Assigned(aNode.Parent) then if Assigned(aNode.Parent) then
if aNode.Index = aNode.Parent.Count -1 then if aNode.Index = aNode.Parent.Count -1 then // is aNode the last child
begin begin
aNode := aNode.Parent; aNode := aNode.Parent;
noFailedSibling := true; noFailedSibling := true;
for i := 0 to aNode.Count -2 do for i := 0 to aNode.Count -2 do
begin begin
if aNode.Items[i].ImageIndex <> imgGreenBall then if aNode.Items[i].ImageIndex <> imgGreenBall then
noFailedSibling := false;; noFailedSibling := false;
end; end;
if (aNode.ImageIndex = imgBlueBall) and if (aNode.ImageIndex = imgBlueBall) and
noFailedSibling then noFailedSibling then
@ -748,10 +748,9 @@ begin
for i := 0 to aNode.Count -2 do for i := 0 to aNode.Count -2 do
begin begin
if aNode.Items[i].ImageIndex <> imgGreenBall then if aNode.Items[i].ImageIndex <> imgGreenBall then
BusySibling := false;; BusySibling := false;
end; end;
if (aNode.ImageIndex = imgBlueBall) and if (aNode.ImageIndex = imgBlueBall) and BusySibling then
BusySibling then
PaintNodeBusy(aNode); PaintNodeBusy(aNode);
end; end;
end; end;
@ -968,6 +967,8 @@ begin
end; end;
procedure TGUITestRunner.EndTestSuite(ATestSuite: TTestSuite); procedure TGUITestRunner.EndTestSuite(ATestSuite: TTestSuite);
var
n: TTreeNode;
begin begin
// scroll treeview to first failed test // scroll treeview to first failed test
if Assigned(FFirstFailure) then if Assigned(FFirstFailure) then
@ -975,6 +976,10 @@ begin
TestTree.Selected := FFirstFailure; TestTree.Selected := FFirstFailure;
TestTree.MakeSelectionVisible; TestTree.MakeSelectionVisible;
end; end;
n := FindNode(ATestSuite);
if Assigned(n) then
PaintNodeNonFailed(n);
end; end;
procedure TranslateResStrings; procedure TranslateResStrings;