View Issue Details

IDProjectCategoryView StatusLast Update
0025921PatchesPackagespublic2014-03-28 16:49
ReporterReinier OlislagersAssigned ToJuha Manninen  
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
Platformx64 (with x86 compiler)OSWindows 
Product Version1.3 (SVN) 
Summary0025921: [Patch] fpcunit gui test runner: show green balls for ignored tests
DescriptionWhen using fpcunit tests, sometimes you specify that tests should be ignored (e.g. for a certain platform, database etc).

Currently, the GUI test runner treats test results coming from this as failures instead of success. While understandable given the underlying fpcunit setup, it misrepresents statistics and gives the wrong idea: ignored test results should not be investigated but treated the same was as successful tests. Additionally, the fpc console test writer (e.g. plain text) also separate out the ignored tests from the failures.


Attached patch:
- uses green balls instead of purple balls/warning messages, but keeps the "ignored test" exception text etc for info
- cosmetic: replaces hard coded imagelist numbers with descriptive constants so code maintenance is easier
- cosmetic: updates copyright year, contributors
- cosmetic/automatic: update project to laz 1.3 layout

See screenshots: failure count decreases and colours are different

Patch to be applied in components\fpcunit
TagsNo tags attached.
Fixed in Revisionr44530
LazTarget-
WidgetsetWin32/Win64
Attached Files

Activities

Reinier Olislagers

2014-03-26 13:26

developer  

guitest.diff (14,313 bytes)   
Index: guitestrunner.lfm
===================================================================
--- guitestrunner.lfm	(revision 44525)
+++ guitestrunner.lfm	(working copy)
@@ -46,7 +46,7 @@
   OnShow = GUITestRunnerShow
   Position = poScreenCenter
   ShowHint = True
-  LCLVersion = '1.1'
+  LCLVersion = '1.3'
   object Panel1: TPanel
     Left = 0
     Height = 88
@@ -83,7 +83,7 @@
       Left = 7
       Height = 34
       Top = 7
-      Width = 80
+      Width = 79
       Action = RunAction
       AutoSize = True
       BorderSpacing.Around = 6
@@ -172,10 +172,10 @@
       AnchorSideTop.Control = Panel1
       AnchorSideRight.Control = Panel1
       AnchorSideRight.Side = asrBottom
-      Left = 486
+      Left = 488
       Height = 34
       Top = 7
-      Width = 82
+      Width = 80
       Action = ActCloseForm
       Anchors = [akTop, akRight]
       AutoSize = True
@@ -266,10 +266,10 @@
       AnchorSideLeft.Control = BtnRun
       AnchorSideLeft.Side = asrBottom
       AnchorSideTop.Control = Panel1
-      Left = 93
+      Left = 92
       Height = 32
       Top = 7
-      Width = 158
+      Width = 148
       Action = ActRunHighlightedTest
       AutoSize = True
       BorderSpacing.Around = 6
@@ -367,13 +367,13 @@
       TabOrder = 0
       object tsTestTree: TTabSheet
         Caption = 'Testcase tree'
-        ClientHeight = 472
+        ClientHeight = 474
         ClientWidth = 565
         object Splitter1: TSplitter
           Cursor = crVSplit
           Left = 0
           Height = 5
-          Top = 334
+          Top = 336
           Width = 565
           Align = alBottom
           ResizeAnchor = akBottom
@@ -380,7 +380,7 @@
         end
         object TestTree: TTreeView
           Left = 6
-          Height = 322
+          Height = 324
           Top = 6
           Width = 553
           Align = alClient
@@ -387,7 +387,7 @@
           BorderSpacing.Around = 6
           BackgroundColor = clBtnFace
           Color = clBtnFace
-          DefaultItemHeight = 18
+          DefaultItemHeight = 16
           Images = TestTreeImageList
           PopupMenu = PopupMenu3
           ReadOnly = True
@@ -403,7 +403,7 @@
         object Memo1: TMemo
           Left = 6
           Height = 121
-          Top = 345
+          Top = 347
           Width = 553
           Align = alBottom
           BorderSpacing.Around = 6
@@ -843,6 +843,7 @@
               ShiftMask = [ssShift, ssAlt, ssCtrl]
               Command = emcMouseLink
             end>
+          MouseTextActions = <>
           MouseSelActions = <          
             item
               ClickDir = cdDown
@@ -850,6 +851,7 @@
             end>
           VisibleSpecialChars = [vscSpace, vscTabAtLast]
           ReadOnly = True
+          SelectedColor.FrameEdges = sfeAround
           SelectedColor.BackPriority = 50
           SelectedColor.ForePriority = 50
           SelectedColor.FramePriority = 50
@@ -856,17 +858,24 @@
           SelectedColor.BoldPriority = 50
           SelectedColor.ItalicPriority = 50
           SelectedColor.UnderlinePriority = 50
+          SelectedColor.StrikeOutPriority = 50
+          IncrementColor.FrameEdges = sfeAround
+          HighlightAllColor.FrameEdges = sfeAround
           BracketHighlightStyle = sbhsBoth
           BracketMatchColor.Background = clNone
           BracketMatchColor.Foreground = clNone
+          BracketMatchColor.FrameEdges = sfeAround
           BracketMatchColor.Style = [fsBold]
           FoldedCodeColor.Background = clNone
           FoldedCodeColor.Foreground = clGray
           FoldedCodeColor.FrameColor = clGray
+          FoldedCodeColor.FrameEdges = sfeAround
           MouseLinkColor.Background = clNone
           MouseLinkColor.Foreground = clBlue
+          MouseLinkColor.FrameEdges = sfeAround
           LineHighlightColor.Background = clNone
           LineHighlightColor.Foreground = clNone
+          LineHighlightColor.FrameEdges = sfeAround
           inline TSynGutterPartList
             object TSynGutterMarks
               Width = 24
@@ -877,6 +886,7 @@
               MouseActions = <>
               MarkupInfo.Background = clBtnFace
               MarkupInfo.Foreground = clNone
+              MarkupInfo.FrameEdges = sfeAround
               DigitCount = 2
               ShowOnlyLineNumbersMultiplesOf = 1
               ZeroStart = False
@@ -893,6 +903,7 @@
               MouseActions = <>
               MarkupInfo.Background = clWhite
               MarkupInfo.Foreground = clGray
+              MarkupInfo.FrameEdges = sfeAround
             end
             object TSynGutterCodeFolding
               MouseActions = <              
@@ -923,6 +934,7 @@
                 end>
               MarkupInfo.Background = clNone
               MarkupInfo.Foreground = clGray
+              MarkupInfo.FrameEdges = sfeAround
               MouseActionsExpanded = <              
                 item
                   ClickCount = ccAny
Index: guitestrunner.pas
===================================================================
--- guitestrunner.pas	(revision 44525)
+++ guitestrunner.pas	(working copy)
@@ -1,5 +1,5 @@
 {
-  Copyright (C) 2004 Dean Zobec
+  Copyright (C) 2004-2014 Dean Zobec, contributors
 
   This library is free software; you can redistribute it and/or modify it
   under the terms of the GNU Library General Public License as published by
@@ -19,6 +19,7 @@
   Modified:
     Graeme Geldenhuys <graemeg@gmail.com>
     Darius Blaszijk <dhkblaszyk@zeelandnet.nl>
+    Reinier Olislagers <reinierolislagers@gmail.com>
 }
 
 unit GuiTestRunner;
@@ -119,6 +120,7 @@
     procedure ResetNodeColors;
     procedure PaintNodeError(aNode: TTreeNode);
     procedure PaintNodeFailure(aNode: TTreeNode);
+    procedure PaintNodeIgnore(aNode: TTreeNode);
     procedure PaintNodeNonFailed(aNode: TTreeNode);
     procedure PaintNodeBusy(aNode: TTreeNode);
     procedure MemoLog(LogEntry: string);
@@ -180,6 +182,15 @@
 uses
   xmlwrite
   ;
+const
+  // TestTreeImageList indexes:
+  imgGreenBall = 0; //success result
+  imgRedBall = 2;
+  imgPurpleBall = 3;
+  imgWarningSign = 4; //failure result
+  imgInfoSign = 11; //error result
+  imgGrayBall = 12; //default
+  imgBlueBall = 13; //busy
 
 type
 
@@ -307,7 +318,7 @@
 end;
 
 
-procedure TGUITestRunner.ActRunHighlightedTestUpdate(Sender: TObject);
+procedure TGUITestRunner.ActRunHighLightedTestUpdate(Sender: TObject);
 begin
   (Sender as TAction).Enabled := ((TestTree.Selected <> nil)
     and (TestTree.Selected.Data <> nil));
@@ -463,8 +474,8 @@
     else
       if TObject(ASuite.Test[i]).InheritsFrom(TTestDecorator) then
         BuildTree(Node, TTestSuite(TTestDecorator(ASuite.Test[i]).Test));
-    node.ImageIndex := 12;
-    node.SelectedIndex := 12;
+    node.ImageIndex := imgGrayBall;
+    node.SelectedIndex := imgGrayBall;
     node.StateIndex := ord(tsChecked);
   end;
   rootNode.Expand(False);
@@ -492,8 +503,8 @@
 begin
   for i := 0 to TestTree.Items.Count - 1 do
   begin
-    TestTree.Items[i].ImageIndex := 12;
-    TestTree.Items[i].SelectedIndex := 12;
+    TestTree.Items[i].ImageIndex := imgGrayBall;
+    TestTree.Items[i].SelectedIndex := imgGrayBall;
   end;
 end;
 
@@ -502,11 +513,13 @@
 begin
   while Assigned(aNode) do
   begin
-    aNode.ImageIndex := 2;
-    aNode.SelectedIndex := 2;
+    aNode.ImageIndex := imgRedBall;
+    aNode.SelectedIndex := imgRedBall;
     aNode.Expand(True);
     aNode := aNode.Parent;
-    if Assigned(aNode) and ((aNode.ImageIndex in [0, 3, 12, 13]) or (ANode.ImageIndex = -1)) then
+    if Assigned(aNode) and
+      ((aNode.ImageIndex in [imgGreenBall, imgPurpleBall, imgGrayBall, imgBlueBall]) or
+      (ANode.ImageIndex = -1)) then
       PaintNodeError(aNode);
   end;
 end;
@@ -516,19 +529,52 @@
 begin
   while Assigned(aNode) do
   begin
-    if ((aNode.ImageIndex in [0, 12, 13]) or (ANode.ImageIndex = -1)) then
+    if ((aNode.ImageIndex in [imgGreenBall, imgGrayBall, imgBlueBall]) or
+      (ANode.ImageIndex = -1)) then
     begin
-      aNode.ImageIndex := 3;
-      aNode.SelectedIndex := 3;
+      aNode.ImageIndex := imgPurpleBall;
+      aNode.SelectedIndex := imgPurpleBall;
       aNode.Expand(true);
     end;
     aNode := aNode.Parent;
-    if Assigned(aNode) and ((aNode.ImageIndex in [0, 12, 13]) or (ANode.ImageIndex = -1)) then
+    if Assigned(aNode) and ((aNode.ImageIndex in [imgGreenBall, imgGrayBall, imgBlueBall]) or
+      (ANode.ImageIndex = -1)) then
       PaintNodeFailure(aNode);
   end;
 end;
 
+procedure TGUITestRunner.PaintNodeIgnore(aNode: TTreeNode);
+// Test results with Ignore
+var
+  noFailedSibling: boolean;
+  i: integer;
+begin
+  if Assigned(aNode) then
+  begin
+    if ((aNode.ImageIndex in [imgGrayBall, imgBlueBall]) or
+      (ANode.ImageIndex = -1)) then
+    begin
+      aNode.ImageIndex := imgGreenBall;
+      aNode.SelectedIndex := imgGreenBall;
+    end;
+  end;
+  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 <> imgGreenBall then
+        noFailedSibling := false;;
+    end;
+    if (aNode.ImageIndex = imgBlueBall) and
+      noFailedSibling then
+      PaintNodeIgnore(aNode);
+    end;
+end;
 
+
 procedure TGUITestRunner.PaintNodeNonFailed(aNode: TTreeNode);
 var
   noFailedSibling: boolean;
@@ -536,10 +582,11 @@
 begin
   if Assigned(aNode) then
   begin
-    if ((aNode.ImageIndex in [12, 13]) or (ANode.ImageIndex = -1)) then
+    if ((aNode.ImageIndex in [imgGrayBall, imgBlueBall]) or
+      (ANode.ImageIndex = -1)) then
     begin
-      aNode.ImageIndex := 0;
-      aNode.SelectedIndex := 0;
+      aNode.ImageIndex := imgGreenBall;
+      aNode.SelectedIndex := imgGreenBall;
     end;
   end;
   if Assigned(aNode.Parent) then
@@ -549,10 +596,11 @@
     noFailedSibling := true;
     for i := 0 to aNode.Count -2 do
     begin
-      if aNode.Items[i].ImageIndex <> 0 then
+      if aNode.Items[i].ImageIndex <> imgGreenBall then
         noFailedSibling := false;;
     end;
-    if (aNode.ImageIndex = 13) and noFailedSibling then
+    if (aNode.ImageIndex = imgBlueBall) and
+      noFailedSibling then
       PaintNodeNonFailed(aNode);
     end;
 end;
@@ -565,8 +613,8 @@
 begin
   if Assigned(aNode) then
   begin
-    aNode.ImageIndex := 13;
-    aNode.SelectedIndex := 13;
+    aNode.ImageIndex := imgBlueBall;
+    aNode.SelectedIndex := imgBlueBall;
   end;
   if Assigned(aNode.Parent) then
   begin
@@ -576,10 +624,11 @@
       BusySibling := true;
       for i := 0 to aNode.Count -2 do
       begin
-        if aNode.Items[i].ImageIndex <> 0 then
+        if aNode.Items[i].ImageIndex <> imgGreenBall then
           BusySibling := false;;
       end;
-      if (aNode.ImageIndex = 12) and BusySibling then
+      if (aNode.ImageIndex = imgBlueBall) and
+        BusySibling then
         PaintNodeBusy(aNode);
     end;
   end;
@@ -609,18 +658,39 @@
     node := TestTree.Items.AddChild(FailureNode,
       Format(rsMessage, [FirstLine(AFailure.ExceptionMessage)]))
       as TMessageTreeNode;
-    node.Message := AFailure.ExceptionMessage;
-    node.ImageIndex := 4;
-    node.SelectedIndex := 4;
-    node := TestTree.Items.AddChild(FailureNode,
-      Format(rsException, [AFailure.ExceptionClassName])) as TMessageTreeNode;
-    node.ImageIndex := 4;
-    node.SelectedIndex := 4;
-    PaintNodeFailure(FailureNode);
+    if not(AFailure.IsIgnoredTest) then
+    begin
+      // Genuine failure
+      node.Message := AFailure.ExceptionMessage;
+      node.ImageIndex := imgWarningSign;
+      node.SelectedIndex := imgWarningSign;
+      node := TestTree.Items.AddChild(FailureNode,
+        Format(rsException, [AFailure.ExceptionClassName])) as TMessageTreeNode;
+      node.ImageIndex := imgWarningSign;
+      node.SelectedIndex := imgWarningSign;
+      PaintNodeFailure(FailureNode);
+    end
+    else
+    begin
+      // Although reported as a failure, the test was set up
+      // to be ignored so it is actually a success of sorts
+      node.Message := AFailure.ExceptionMessage;
+      node.ImageIndex := imgGreenBall;
+      node.SelectedIndex := imgGreenBall;
+      node := TestTree.Items.AddChild(FailureNode,
+        Format(rsException, [AFailure.ExceptionClassName])) as TMessageTreeNode;
+      node.ImageIndex := imgGreenBall;
+      node.SelectedIndex := imgGreenBall;
+      PaintNodeIgnore(FailureNode);
+    end;
   end;
-  Inc(failureCounter);
-  if errorCounter = 0 then
-    barColor := clFuchsia;
+
+  if not(AFailure.IsIgnoredTest) then
+  begin
+    Inc(failureCounter);
+    if errorCounter = 0 then
+      barColor := clFuchsia;
+  end;
 end;
 
 
@@ -636,12 +706,12 @@
       Format(rsExceptionMes, [FirstLine(AError.ExceptionMessage)]))
       as TMessageTreeNode;
     MessageNode.Message := AError.ExceptionMessage;
-    MessageNode.ImageIndex := 4;
-    MessageNode.SelectedIndex := 4;
+    MessageNode.ImageIndex := imgWarningSign;
+    MessageNode.SelectedIndex := imgWarningSign;
     node := TestTree.Items.AddChild(ErrorNode, Format(rsExceptionCla, [
       AError.ExceptionClassName]));
-    node.ImageIndex := 4;
-    node.SelectedIndex := 4;
+    node.ImageIndex := imgWarningSign;
+    node.SelectedIndex := imgWarningSign;
     if (AError.SourceUnitName <> '') and
       (AError.FailedMethodName <> '')
     then
@@ -648,16 +718,16 @@
     begin
       node := TestTree.Items.AddChild(ErrorNode, Format(rsUnitName, [
         AError.SourceUnitName]));
-      node.ImageIndex := 11;
-      node.SelectedIndex := 11;
+      node.ImageIndex := imgInfoSign;
+      node.SelectedIndex := imgInfoSign;
       node := TestTree.Items.AddChild(ErrorNode, Format(rsMethodName, [
         AError.FailedMethodName]));
-      node.ImageIndex := 11;
-      node.SelectedIndex := 11;
+      node.ImageIndex := imgInfoSign;
+      node.SelectedIndex := imgInfoSign;
       node := TestTree.Items.AddChild(ErrorNode, Format(rsLineNumber, [IntToStr(
         AError.LineNumber)]));
-      node.ImageIndex := 11;
-      node.SelectedIndex := 11;
+      node.ImageIndex := imgInfoSign;
+      node.SelectedIndex := imgInfoSign;
     end;
     PaintNodeError(ErrorNode);
   end;
guitest.diff (14,313 bytes)   

Reinier Olislagers

2014-03-26 13:26

developer  

ignoredtestsbefore.png (33,634 bytes)   
ignoredtestsbefore.png (33,634 bytes)   

Reinier Olislagers

2014-03-26 13:26

developer  

ignoredtestsafter.png (27,013 bytes)   
ignoredtestsafter.png (27,013 bytes)   

Juha Manninen

2014-03-27 23:46

developer   ~0074033

Applied, thanks.

Issue History

Date Modified Username Field Change
2014-03-26 13:26 Reinier Olislagers New Issue
2014-03-26 13:26 Reinier Olislagers File Added: guitest.diff
2014-03-26 13:26 Reinier Olislagers File Added: ignoredtestsbefore.png
2014-03-26 13:26 Reinier Olislagers File Added: ignoredtestsafter.png
2014-03-26 13:56 Reinier Olislagers Description Updated View Revisions
2014-03-27 23:46 Juha Manninen Fixed in Revision => r44530
2014-03-27 23:46 Juha Manninen Note Added: 0074033
2014-03-27 23:46 Juha Manninen Status new => resolved
2014-03-27 23:46 Juha Manninen Resolution open => fixed
2014-03-27 23:46 Juha Manninen Assigned To => Juha Manninen
2014-03-28 16:49 Reinier Olislagers Status resolved => closed