From 993221704c8aafc4f51944420947f6aa8daff326 Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Mon, 25 Oct 2010 14:53:45 +0000 Subject: [PATCH] Starts adding lcl semi-auto tests git-svn-id: trunk@27857 - --- .gitattributes | 1 + test/runtestsgui.lpi | 7 +++- test/runtestsgui.lpr | 2 +- test/semiauto/lclsemiautotests.pas | 51 +++++++++++++++++++++++ test/semiauto/semiautotest.pas | 66 +++++++++++++++++++++++++++++- test/testunits.pas | 2 +- 6 files changed, 125 insertions(+), 4 deletions(-) create mode 100644 test/semiauto/lclsemiautotests.pas diff --git a/.gitattributes b/.gitattributes index 6c7b4fc52b..38a3392d35 100644 --- a/.gitattributes +++ b/.gitattributes @@ -5461,6 +5461,7 @@ test/runtests.lpr svneol=native#text/plain test/runtestsgui.lpi svneol=native#text/plain test/runtestsgui.lpr svneol=native#text/plain test/semiauto/idesemiautotests.pas svneol=native#text/pascal +test/semiauto/lclsemiautotests.pas svneol=native#text/pascal test/semiauto/semiautotest.pas svneol=native#text/pascal test/testglobals.pas svneol=native#text/plain test/testlpi.pas svneol=native#text/plain diff --git a/test/runtestsgui.lpi b/test/runtestsgui.lpi index 404be702d6..d06a10dc6c 100644 --- a/test/runtestsgui.lpi +++ b/test/runtestsgui.lpi @@ -40,7 +40,7 @@ - + @@ -96,6 +96,11 @@ + + + + + diff --git a/test/runtestsgui.lpr b/test/runtestsgui.lpr index c8fe46c3ea..5e1606d0fb 100644 --- a/test/runtestsgui.lpr +++ b/test/runtestsgui.lpr @@ -23,7 +23,7 @@ program runtestsgui; uses Interfaces, Forms, GuiTestRunner, - testunits, idesemiautotests, semiautotest; + testunits; begin Application.Title:='Run Lazarus tests'; diff --git a/test/semiauto/lclsemiautotests.pas b/test/semiauto/lclsemiautotests.pas new file mode 100644 index 0000000000..f613fd5a6a --- /dev/null +++ b/test/semiauto/lclsemiautotests.pas @@ -0,0 +1,51 @@ +unit lclsemiautotests; + +{$mode objfpc} + +interface + +uses + Classes, SysUtils, fpcunit, + Interfaces, LCLType, LCLIntf, Forms, Graphics, + testglobals, semiautotest; + +type + + { TTestLCLFormCanvas } + + TTestLCLFormCanvas = class(TSemiAutomaticTest) + private + APt: TPoint; + procedure TestOneHandlePaint(Sender: TObject); + published + procedure TestOne; + end; + +implementation + +{ TTestIdeNew } + +procedure TTestLCLFormCanvas.TestOneHandlePaint(Sender: TObject); +begin + FDialog.Canvas.Pen.Color := clRed; + FDialog.Canvas.Brush.Color := clBlue; + FDialog.Canvas.Rectangle(Bounds(APt.X, APt.Y, 100, 100)); +end; + +procedure TTestLCLFormCanvas.TestOne; +var + Str: string; + lDialog: TForm; +begin + Str := 'Please verify is a rectangle with a red frame and blue contents is drawn' + ; + lDialog := GetCanvasDialog(APt); + lDialog.OnPaint := @TestOneHandlePaint; + AssertTrue(ShowCanvasDialog('TTestLCLFormCanvas.TestOne', Str)); +end; + +initialization + AddToSemiAutoTestSuite(TTestLCLFormCanvas); + +end. + diff --git a/test/semiauto/semiautotest.pas b/test/semiauto/semiautotest.pas index 05d9c31fd5..246233d82f 100644 --- a/test/semiauto/semiautotest.pas +++ b/test/semiauto/semiautotest.pas @@ -5,8 +5,11 @@ unit semiautotest; interface uses + // RTL, FCL Classes, SysUtils, fpcunit, - Interfaces, Forms, LCLType, + // LCL + Interfaces, Forms, LCLType, StdCtrls, Controls, + // runtests testglobals; type @@ -14,19 +17,80 @@ type { TSemiAutomaticTest } TSemiAutomaticTest = class(TTestCase) + protected + FDialog: TForm; + FInstructions: TLabel; + FPass: TButton; + FFail: TButton; public + constructor Create; override; + // Simple Yes-No dialog function ShowResultDialog(const ATitle, AInstructions: string): Boolean; + // A dialog for testing the Canvas drawing + function GetCanvasDialog(var ADelta: TPoint): TForm; // ADelta is the position where the drawing should start + function ShowCanvasDialog(const ATitle, AInstructions: string): Boolean; end; implementation { TSemiAutomaticTest } +constructor TSemiAutomaticTest.Create; +begin + inherited Create; + + FDialog := TForm.Create(Application); + FDialog.Width := 240; + FDialog.Height := 240; + FDialog.Position := poScreenCenter; + + FInstructions := TLabel.Create(FDialog); + FInstructions.Parent := FDialog; + FInstructions.Top := 10; + FInstructions.Left := 10; + FInstructions.AutoSize := False; + FInstructions.Width := FDialog.Width - 10; + FInstructions.WordWrap := True; + FInstructions.Height := 200; + + FPass := TButton.Create(FDialog); + FPass.Parent := FDialog; + FPass.Caption := 'PASS'; + FPass.AutoSize := True; + FPass.Top := FDialog.Height - 35; + FPass.Left := 50; + FPass.ModalResult := mrYes; + + FFail := TButton.Create(FDialog); + FFail.Parent := FDialog; + FFail.Caption := 'FAIL'; + FFail.AutoSize := True; + FFail.Top := FDialog.Height - 35; + FFail.Left := 150; + FFail.ModalResult := mrNo; +end; + function TSemiAutomaticTest.ShowResultDialog(const ATitle, AInstructions: string ): Boolean; begin Result := Application.MessageBox(PChar(AInstructions), PChar(ATitle), MB_YESNO) = IDYES; end; +function TSemiAutomaticTest.GetCanvasDialog(var ADelta: TPoint): TForm; +begin + Result := FDialog; + ADelta.X := 50; + ADelta.Y := 50; +end; + +function TSemiAutomaticTest.ShowCanvasDialog(const ATitle, AInstructions: string + ): Boolean; +begin + FInstructions.Caption := AInstructions; + FDialog.Caption := ATitle; + + Result := FDialog.ShowModal() = mrYes; +end; + end. diff --git a/test/testunits.pas b/test/testunits.pas index e65d6a333d..a354fc8c72 100644 --- a/test/testunits.pas +++ b/test/testunits.pas @@ -32,7 +32,7 @@ uses // lcltests testunicode, testpen, // semi-automatic tests - semiautotests, idesemiautotests; + semiautotests, idesemiautotests, lclsemiautotests; implementation