* Got the basics working in the GUI Test Runner.

1 files changed, 157 insertions, 46 deletions

diff --git a/examples/apps/fpcunit/guitestrunner.pas b/examples/apps/fpcunit/guitestrunner.pas
index 78227b5f..d67c145a 100644
--- a/examples/apps/fpcunit/guitestrunner.pas
+++ b/examples/apps/fpcunit/guitestrunner.pas
@@ -13,7 +13,7 @@ uses
   gui_radiobutton, gui_tab, gui_menu, gui_panel, gui_popupcalendar,
   gui_gauge,
   // FPCUnit support
-  fpcunit, testregistry;
+  fpcunit, testregistry, testdecorator;
 
 type
 
@@ -23,6 +23,7 @@ type
     errorCounter: Integer;
     testsCounter: Integer;
     skipsCounter: Integer;
+    testSuite: TTest;
     // ITestListener
     procedure AddFailure(ATest: TTest; AFailure: TTestFailure);
     procedure AddError(ATest: TTest; AError: TTestFailure);
@@ -31,23 +32,31 @@ type
     procedure StartTestSuite(ATestSuite: TTestSuite);
     procedure EndTestSuite(ATestSuite: TTestSuite);
     //
+    procedure RunTest(ATest: TTest);
     procedure MemoLog(LogEntry: string);
+    procedure BuildTree(ARootNode: TfpgTreeNode; ASuite: TTestSuite);
+    procedure FormCreate(Sender: TObject);
+    procedure btnQuitClicked(Sender: TObject);
+    procedure btnClearClicked(Sender: TObject);
+    procedure btnRunClicked(Sender: TObject);
   public
     {@VFD_HEAD_BEGIN: GUITestRunnerForm}
     pbName1: TfpgProgressBar;
     cbName1: TfpgComboBox;
     btnRun: TfpgButton;
     lblName1: TfpgLabel;
-    memName1: TfpgMemo;
-    btnClear: TfpgButton;
-    btnQuit: TfpgButton;
     lblName2: TfpgLabel;
     lblRuns: TfpgLabel;
     lblName4: TfpgLabel;
     lblErrors: TfpgLabel;
     lblName6: TfpgLabel;
     lblFailures: TfpgLabel;
+    tvTests: TfpgTreeView;
+    memName1: TfpgMemo;
+    btnClear: TfpgButton;
+    btnQuit: TfpgButton;
     {@VFD_HEAD_END: GUITestRunnerForm}
+    constructor Create(AOwner: TComponent); override;
     procedure AfterCreate; override;
   end;
 
@@ -59,12 +68,12 @@ implementation
 
 procedure TGUITestRunnerForm.AddFailure(ATest: TTest; AFailure: TTestFailure);
 begin
-
+  MemoLog(AFailure.ExceptionMessage);
 end;
 
 procedure TGUITestRunnerForm.AddError(ATest: TTest; AError: TTestFailure);
 begin
-
+  MemoLog(AError.ExceptionMessage);
 end;
 
 procedure TGUITestRunnerForm.StartTest(ATest: TTest);
@@ -87,16 +96,105 @@ begin
 
 end;
 
+procedure TGUITestRunnerForm.RunTest(ATest: TTest);
+var
+  lTestResult: TTestResult;
+  FStopCrono: TDateTime;
+  FStartCrono: TDateTime;
+begin
+  // Reset counters
+  failureCounter  := 0;
+  errorCounter    := 0;
+  testsCounter    := 0;
+  skipsCounter    := 0;
+
+  lTestResult := TTestResult.Create;
+  try
+    lTestResult.AddListener(self);
+    MemoLog('Running ' + tvTests.Selection.Text);
+    FStartCrono := Now;
+    ATest.Run(lTestResult);
+    FStopCrono  := Now;
+
+    MemoLog('Number of executed tests: '
+      + IntToStr(lTestResult.RunTests)
+      + '  Time elapsed: '
+      + FormatDateTime('hh:nn:ss.zzz', FStopCrono - FStartCrono));
+
+  finally
+    lTestResult.Free;
+  end;
+end;
+
 procedure TGUITestRunnerForm.MemoLog(LogEntry: string);
 begin
   memName1.Lines.Add(TimeToStr(Now) + ' - ' + LogEntry);
 end;
 
+procedure TGUITestRunnerForm.BuildTree(ARootNode: TfpgTreeNode; ASuite: TTestSuite);
+var
+  node: TfpgTreeNode;
+  i: integer;
+begin
+//  ARootNode.StateIndex := Ord(tsChecked);
+
+  for i := 0 to ASuite.Tests.Count-1 do
+  begin
+    node := ARootNode.AppendText(ASuite.Test[i].TestName);
+    node.Data := ASuite.Test[i];
+    if ASuite.Test[i] is TTestSuite then
+      BuildTree(node, TTestSuite(ASuite.Test[i]))
+    else
+      if TObject(ASuite.Test[i]).InheritsFrom(TTestDecorator) then
+        BuildTree(node, TTestSuite(TTestDecorator(ASuite.Test[i]).Test));
+//    node.ImageIndex := 12;
+//    node.SelectedIndex := 12;
+//    node.StateIndex := ord(tsChecked);
+  end;
+//  rootNode.Expand(False);
+//  ResetNodeColors;
+
+end;
+
+procedure TGUITestRunnerForm.FormCreate(Sender: TObject);
+var
+  n: TfpgTreeNode;
+begin
+  n := tvTests.RootNode.AppendText('All Tests');
+  BuildTree(n, GetTestRegistry);
+end;
+
+procedure TGUITestRunnerForm.btnQuitClicked(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TGUITestRunnerForm.btnClearClicked(Sender: TObject);
+begin
+  memName1.Lines.Clear;
+end;
+
+procedure TGUITestRunnerForm.btnRunClicked(Sender: TObject);
+begin
+  if (tvTests.Selection <> nil) and (tvTests.Selection.Data <> nil) then
+  begin
+    testSuite := TTest(tvTests.Selection.Data);
+//    tvTests.Selection.Collapse;
+  end;
+  RunTest(testSuite);
+end;
+
+constructor TGUITestRunnerForm.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  OnCreate := @FormCreate;
+end;
+
 procedure TGUITestRunnerForm.AfterCreate;
 begin
   {@VFD_BODY_BEGIN: GUITestRunnerForm}
   Name := 'GUITestRunnerForm';
-  SetPosition(304, 190, 359, 310);
+  SetPosition(372, 260, 359, 547);
   WindowTitle := 'GUI Test Runner';
 
   pbName1 := TfpgProgressBar.Create(self);
@@ -127,6 +225,7 @@ begin
     FontDesc := '#Label1';
     ImageName := '';
     TabOrder := 2;
+    OnClick := @btnRunClicked;
   end;
 
   lblName1 := TfpgLabel.Create(self);
@@ -138,40 +237,6 @@ begin
     Text := 'TestCase';
   end;
 
-  memName1 := TfpgMemo.Create(self);
-  with memName1 do
-  begin
-    Name := 'memName1';
-    SetPosition(8, 120, 340, 156);
-    Anchors := [anLeft,anRight,anTop,anBottom];
-    FontDesc := '#Edit1';
-    TabOrder := 4;
-  end;
-
-  btnClear := TfpgButton.Create(self);
-  with btnClear do
-  begin
-    Name := 'btnClear';
-    SetPosition(8, 280, 80, 24);
-    Anchors := [anLeft,anBottom];
-    Text := 'Clear';
-    FontDesc := '#Label1';
-    ImageName := '';
-    TabOrder := 5;
-  end;
-
-  btnQuit := TfpgButton.Create(self);
-  with btnQuit do
-  begin
-    Name := 'btnQuit';
-    SetPosition(268, 280, 80, 24);
-    Anchors := [anRight,anBottom];
-    Text := 'Quit';
-    FontDesc := '#Label1';
-    ImageName := '';
-    TabOrder := 6;
-  end;
-
   lblName2 := TfpgLabel.Create(self);
   with lblName2 do
   begin
@@ -185,7 +250,7 @@ begin
   with lblRuns do
   begin
     Name := 'lblRuns';
-    SetPosition(52, 96, 56, 16);
+    SetPosition(48, 96, 55, 16);
     FontDesc := '#Label1';
     Text := '---';
   end;
@@ -194,7 +259,7 @@ begin
   with lblName4 do
   begin
     Name := 'lblName4';
-    SetPosition(124, 96, 52, 16);
+    SetPosition(120, 96, 44, 16);
     FontDesc := '#Label2';
     Text := 'Errors:';
   end;
@@ -203,7 +268,7 @@ begin
   with lblErrors do
   begin
     Name := 'lblErrors';
-    SetPosition(172, 96, 36, 16);
+    SetPosition(166, 96, 55, 16);
     FontDesc := '#Label1';
     Text := '---';
   end;
@@ -212,7 +277,7 @@ begin
   with lblName6 do
   begin
     Name := 'lblName6';
-    SetPosition(220, 96, 60, 16);
+    SetPosition(232, 96, 60, 16);
     FontDesc := '#Label2';
     Text := 'Failures:';
   end;
@@ -221,11 +286,57 @@ begin
   with lblFailures do
   begin
     Name := 'lblFailures';
-    SetPosition(284, 96, 48, 16);
+    SetPosition(292, 96, 55, 16);
     FontDesc := '#Label1';
     Text := '---';
   end;
 
+  tvTests := TfpgTreeView.Create(self);
+  with tvTests do
+  begin
+    Name := 'tvTests';
+    SetPosition(8, 120, 340, 268);
+    Anchors := [anLeft,anRight,anTop,anBottom];
+    FontDesc := '#Label1';
+    TabOrder := 3;
+  end;
+
+  memName1 := TfpgMemo.Create(self);
+  with memName1 do
+  begin
+    Name := 'memName1';
+    SetPosition(8, 400, 340, 113);
+    Anchors := [anLeft,anRight,anBottom];
+    FontDesc := '#Edit1';
+    TabOrder := 4;
+  end;
+
+  btnClear := TfpgButton.Create(self);
+  with btnClear do
+  begin
+    Name := 'btnClear';
+    SetPosition(8, 517, 80, 24);
+    Anchors := [anLeft,anBottom];
+    Text := 'Clear';
+    FontDesc := '#Label1';
+    ImageName := '';
+    TabOrder := 5;
+    OnClick := @btnClearClicked;
+  end;
+
+  btnQuit := TfpgButton.Create(self);
+  with btnQuit do
+  begin
+    Name := 'btnQuit';
+    SetPosition(268, 517, 80, 24);
+    Anchors := [anRight,anBottom];
+    Text := 'Quit';
+    FontDesc := '#Label1';
+    ImageName := '';
+    TabOrder := 6;
+    OnClick := @btnQuitClicked;
+  end;
+
   {@VFD_BODY_END: GUITestRunnerForm}
 end;