Starts adding lcl semi-auto tests

git-svn-id: trunk@27857 -

.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

test/runtestsgui.lpi

@@ -40,7 +40,7 @@
         <PackageName Value="CodeTools"/>
       </Item4>
     </RequiredPackages>
-    <Units Count="11">
+    <Units Count="12">
       <Unit0>
         <Filename Value="runtestsgui.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -96,6 +96,11 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="idesemiautotests"/>
       </Unit10>
+      <Unit11>
+        <Filename Value="semiauto\lclsemiautotests.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="lclsemiautotests"/>
+      </Unit11>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

test/runtestsgui.lpr

@@ -23,7 +23,7 @@ program runtestsgui;
 uses
   Interfaces, Forms,
   GuiTestRunner,
-  testunits, idesemiautotests, semiautotest;
+  testunits;
 
 begin
   Application.Title:='Run Lazarus tests';

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.
+

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.
 

test/testunits.pas

@@ -32,7 +32,7 @@ uses
   // lcltests
   testunicode, testpen,
   // semi-automatic tests
-  semiautotests, idesemiautotests;
+  semiautotests, idesemiautotests, lclsemiautotests;
 
 implementation