From 9b3c75ef0f5be9c6506e901d6bd8c8783846c2ac Mon Sep 17 00:00:00 2001
From: graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf>
Date: Wed, 9 Jul 2008 22:25:03 +0000
Subject: * More improvements to GUI Test Runner. It now sets the results as
 new nodes inside the treeview - all except for the last test case. The latter
 is still a bug.

---
 examples/apps/fpcunit/fpg_guitestrunner.pas | 68 +++++++++++++++++++++++++++--
 1 file changed, 65 insertions(+), 3 deletions(-)

(limited to 'examples/apps/fpcunit')

diff --git a/examples/apps/fpcunit/fpg_guitestrunner.pas b/examples/apps/fpcunit/fpg_guitestrunner.pas
index d304be98..9fc8fe79 100644
--- a/examples/apps/fpcunit/fpg_guitestrunner.pas
+++ b/examples/apps/fpcunit/fpg_guitestrunner.pas
@@ -25,6 +25,7 @@ type
     skipsCounter: Integer;
     testSuite: TTest;
     temptest: TTest;
+    barColor: TfpgColor;
     // ITestListener
     procedure AddFailure(ATest: TTest; AFailure: TTestFailure);
     procedure AddError(ATest: TTest; AError: TTestFailure);
@@ -73,13 +74,71 @@ implementation
 {@VFD_NEWFORM_IMPL}
 
 procedure TGUITestRunnerForm.AddFailure(ATest: TTest; AFailure: TTestFailure);
+var
+  FailureNode, node: TfpgTreeNode;
 begin
-  MemoLog('Failure in ' + ATest.TestName + ': ' + AFailure.ExceptionMessage);
+  MemoLog('failed - ' + ATest.TestName);
+  FailureNode := FindNode(ATest);
+  if not Assigned(FailureNode) then
+    memolog('  Failed to find node');
+  if Assigned(FailureNode) then
+  begin
+    node := FailureNode.AppendText('Message: ' + AFailure.ExceptionMessage);
+//    node.ImageIndex := 4;
+//    node.SelectedIndex := 4;
+    node.TextColor := clFuchsia;
+    node := FailureNode.AppendText('Exception: ' + AFailure.ExceptionClassName);
+//    node.ImageIndex := 4;
+//    node.SelectedIndex := 4;
+    node.TextColor := clFuchsia;
+//    PaintNodeFailure(FailureNode);
+  end;
+  Inc(failureCounter);
+  if errorCounter = 0 then
+    barColor := clFuchsia; // Error color takes preference
+
+  tvTests.Invalidate;
 end;
 
 procedure TGUITestRunnerForm.AddError(ATest: TTest; AError: TTestFailure);
+var
+  ErrorNode, node: TfpgTreeNode;
 begin
-  MemoLog('Error in ' + ATest.TestName + ': ' + AError.ExceptionMessage);
+  MemoLog('error - ' + ATest.TestName);
+  ErrorNode := FindNode(ATest);
+  if Assigned(ErrorNode) then
+  begin
+    node := ErrorNode.AppendText('Exception message: ' + AError.ExceptionMessage);
+    node.TextColor := clRed;
+//    node.ImageIndex := 4;
+//    node.SelectedIndex := 4;
+    node := ErrorNode.AppendText('Exception class: ' + AError.ExceptionClassName);
+    node.TextColor := clRed;
+//    node.ImageIndex := 4;
+//    node.SelectedIndex := 4;
+    if (AError.SourceUnitName <> '') and
+      (AError.FailedMethodName <> '')
+    then
+    begin
+      node := ErrorNode.AppendText('Unit name: ' + AError.SourceUnitName);
+      node.TextColor := clRed;
+//      node.ImageIndex := 11;
+//      node.SelectedIndex := 11;
+      node := ErrorNode.AppendText('Method name: ' + AError.FailedMethodName);
+      node.TextColor := clRed;
+//      node.ImageIndex := 11;
+//      node.SelectedIndex := 11;
+      node := ErrorNode.AppendText('Line number: ' + IntToStr(AError.LineNumber));
+      node.TextColor := clRed;
+//      node.ImageIndex := 11;
+//      node.SelectedIndex := 11;
+    end;
+//    PaintNodeError(ErrorNode);
+  end;
+  Inc(errorCounter);
+  barColor := clRed;
+
+  tvTests.Invalidate;
 end;
 
 procedure TGUITestRunnerForm.StartTest(ATest: TTest);
@@ -87,13 +146,16 @@ var
   Node: TfpgTreeNode;
 begin
 //  MemoLog('StartTest');
+
   Node := FindNode(ATest);
   if Assigned(Node) then
   begin
-    Node.TextColor := clBlue;
+    Node.Clear;
+//    Node.TextColor := clBlue;
     tvTests.Invalidate;
     fpgApplication.ProcessMessages;
   end;
+
 end;
 
 procedure TGUITestRunnerForm.EndTest(ATest: TTest);
-- 
cgit v1.2.3-70-g09d2