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

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

Browse Source 
git-svn-id: trunk@48805 -
This commit is contained in:
juha 2015-04-21 17:30:02 +00:00
parent f0c6c67de5
commit d942a8006d
1 changed files with 10 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
components/fpcunit/guitestrunner.pas
View File

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