From c6d2b8ec732465b7dc82bc15994d7cb24c82bf50 Mon Sep 17 00:00:00 2001 From: graemeg Date: Tue, 8 Jul 2008 17:05:09 +0000 Subject: * Got the basics working in the GUI Test Runner. --- examples/apps/fpcunit/guitestrunner.pas | 203 ++++++++++++++++++++++++-------- 1 file changed, 157 insertions(+), 46 deletions(-) (limited to 'examples/apps') 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 @@ interface gui_radiobutton, gui_tab, gui_menu, gui_panel, gui_popupcalendar, gui_gauge, // FPCUnit support - fpcunit, testregistry; + fpcunit, testregistry, testdecorator; type @@ -23,6 +23,7 @@ TGUITestRunnerForm = class(TfpgForm, ITestListener) 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 @@ TGUITestRunnerForm = class(TfpgForm, ITestListener) 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 @@ procedure TGUITestRunnerForm.EndTestSuite(ATestSuite: TTestSuite); 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 @@ procedure TGUITestRunnerForm.AfterCreate; FontDesc := '#Label1'; ImageName := ''; TabOrder := 2; + OnClick := @btnRunClicked; end; lblName1 := TfpgLabel.Create(self); @@ -138,40 +237,6 @@ procedure TGUITestRunnerForm.AfterCreate; 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 @@ procedure TGUITestRunnerForm.AfterCreate; with lblRuns do begin Name := 'lblRuns'; - SetPosition(52, 96, 56, 16); + SetPosition(48, 96, 55, 16); FontDesc := '#Label1'; Text := '---'; end; @@ -194,7 +259,7 @@ procedure TGUITestRunnerForm.AfterCreate; 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 @@ procedure TGUITestRunnerForm.AfterCreate; with lblErrors do begin Name := 'lblErrors'; - SetPosition(172, 96, 36, 16); + SetPosition(166, 96, 55, 16); FontDesc := '#Label1'; Text := '---'; end; @@ -212,7 +277,7 @@ procedure TGUITestRunnerForm.AfterCreate; 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 @@ procedure TGUITestRunnerForm.AfterCreate; 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; -- cgit v1.2.3-54-g00ecf