paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-13 21:19:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL, Test: Add buildmode to use real WidgetSet (and open form on screen)

Browse Source
This commit is contained in:
Martin 2025-07-06 12:32:41 +02:00
parent 816bfaad13
commit 684b0d543e
3 changed files with 67 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
lcl/testcase/test_childsizing.pas
View File

@ -5,7 +5,7 @@ unit Test_ChildSizing;
interface
uses
Classes, SysUtils, Math, fpcunit, testutils, testregistry, Controls;
Classes, SysUtils, Math, fpcunit, testutils, testregistry, Controls, Forms;
type
TIntegerArray = array of integer;
@ -52,6 +52,7 @@ type
TTestChildSizing = class(TTestCase)
private
FContainer: TTestContainer;
FTestForm: TForm;
protected
class procedure AssertApprox(Expected, Actual: integer; AnAllowance: Integer = 1);
class procedure AssertApprox(AName: String; Expected, Actual: integer);
@ -101,12 +102,19 @@ implementation
procedure TTestWinControl.CreateHandle;
begin
{$IFDEF LCLNOGUI}
Handle := 1;
{$ELSE}
inherited;
{$ENDIF}
end;
procedure TTestWinControl.DestroyHandle;
begin
//
{$IFDEF LCLNOGUI}
{$ELSE}
inherited;
{$ENDIF}
end;
function TTestWinControl.IsVisible: Boolean;
@ -208,7 +216,16 @@ procedure TTestChildSizing.Init1(out P: TTestContainer; AContainerWidth: integer
var
i: Integer;
begin
P := TTestContainer.Create(nil);
{$IFnDEF LCLNOGUI}
if FTestForm = nil then begin
FTestForm := TForm.CreateNew(nil);
FTestForm.SetBounds(10,10,100,100);
FTestForm.Show;
end;
{$ENDIF}
P := TTestContainer.Create(FTestForm);
p.Parent := FTestForm;
if AInitContainerHeight then begin
P.SetBounds(0,0, 150, AContainerWidth);
p.ChildSizing.ControlsPerLine := APerLine;
@ -299,6 +316,7 @@ procedure TTestChildSizing.TearDown;
begin
inherited TearDown;
FreeAndNil(FContainer);
FreeAndNil(FTestForm);
end;
procedure TTestChildSizing.TestAnchorAlign;

36
lcl/testcase/test_lcl.lpi
View File

@ -18,9 +18,41 @@
<Macro1 Name="LCLWidgetType" Value="nogui"/>
</MacroValues>
<BuildModes>
<Item Name="Default" Default="True"/>
<Item Name="NO GUI" Default="True"/>
<Item Name="Real WS">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="test_lcl"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
<VerifyObjMethodCallValidity Value="True"/>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
</Debugging>
</Linking>
</CompilerOptions>
</Item>
<SharedMatrixOptions Count="1">
<Item1 ID="887419357598" Modes="Default" Type="IDEMacro" MacroName="LCLWidgetType" Value="nogui"/>
<Item1 ID="887419357598" Targets="#project,LCL" Modes="NO GUI" Type="IDEMacro" MacroName="LCLWidgetType" Value="nogui"/>
</SharedMatrixOptions>
</BuildModes>
<PublishOptions>

19
lcl/testcase/test_lcl.lpr
View File

@ -4,7 +4,7 @@ program test_lcl;
uses
Interfaces,
Classes, consoletestrunner, Test_ChildSizing;
Classes, consoletestrunner, Test_ChildSizing, Forms;
type
@ -16,14 +16,19 @@ type
end;
var
Application: TMyTestRunner;
TestApplication: TMyTestRunner;
begin
{$IFnDEF LCLNOGUI}
Application.Scaled:=True;
Application.Initialize;
{$ENDIF}
DefaultRunAllTests:=True;
DefaultFormat:=fXML;
Application := TMyTestRunner.Create(nil);
Application.Initialize;
Application.Title := 'FPCUnit Console test runner';
Application.Run;
Application.Free;
TestApplication := TMyTestRunner.Create(nil);
TestApplication.Initialize;
TestApplication.Title := 'FPCUnit Console test runner';
TestApplication.Run;
TestApplication.Free;
end.