fpc/packages/vcl-compat/tests/utcdevices.pas

{
    This file is part of the Free Pascal Run Time Library (rtl)
    Copyright (c) 1999-2019 by the Free Pascal development team

    This file provides the base for the pluggable sorting algorithm
    support. It also provides a default QuickSort implementation.

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}
unit utcdevices;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, fpcunit, testutils, testregistry, types, system.devices;

type
  TMyDeviceInfo = Class(TBaseDeviceInfo)
  //
  end;

  { TTestDevices }

  TTestDevices= class(TTestCase)
  private
    FDevice: TMyDeviceInfo;
    procedure AddSampleDevice1;
    procedure AddSampleDevice2;
    procedure AssertSampleDevice2(aDevice: TBaseDeviceInfo);
    procedure CreateEmpty;
    procedure AssertSampleDevice(aDevice: TBaseDeviceInfo);
    function CreateSampleDevice: TMyDeviceInfo;
    function CreateSampleDevice2: TMyDeviceInfo;
  protected
    procedure SetUp; override;
    procedure TearDown; override;
    Procedure AssertEquals(Msg : String; aExpected,aActual : TSize); overload;
    Procedure AssertEquals(Msg : String; aExpected,aActual : TDeviceInfo.TDeviceClass); overload;
    Procedure AssertEquals(Msg : String; aExpected,aActual : TOSVersion.TPlatform);overload;
    // Freed in teardown
    Property Device : TMyDeviceInfo Read FDevice Write FDevice;
  published
    procedure TestHookUp;
    Procedure TestCreate;
    Procedure TestCreateEmpty;
    Procedure TestDiagonal;
    Procedure TestAddDevice;
    Procedure TestAttribute;
    procedure TestSelect;
    procedure TestSelect2;
    procedure TestSelect3;
  end;

implementation

uses typinfo;

procedure TTestDevices.TestHookUp;
begin
  AssertNull('No this device',TDeviceInfo.ThisDevice);
  AssertEquals('No devices',0, TDeviceInfo.DeviceCount);
end;

function TTestDevices.CreateSampleDevice: TMyDeviceInfo;

begin
  Result:=TMyDeviceInfo.Create(TDeviceInfo.TDeviceClass.Desktop,'1',
                               TSize.Create(1200,900),
                               TSize.Create(2400,1800),
                               TSize.Create(1900,1200),
                               TSize.Create(3800,2400),TOSVersion.TPlatform.pfLinux,96,True);
end;

function TTestDevices.CreateSampleDevice2: TMyDeviceInfo;
begin
  Result:=TMyDeviceInfo.Create(TDeviceInfo.TDeviceClass.Tablet,'2',
                        TSize.Create(1600,1024),
                        TSize.Create(3200,2048),
                        TSize.Create(2048,1600),
                        TSize.Create(4096,3200),TOSVersion.TPlatform.pfLinux,128,False);

end;

procedure TTestDevices.TestCreate;

begin
  Device:=CreateSampleDevice;
  AssertSampleDevice(Device);
end;

procedure TTestDevices.AssertSampleDevice(aDevice : TBaseDeviceInfo);

begin
  AssertEquals('MinPhysicalScreenSize',TSize.Create(1200,900),aDevice.MinPhysicalScreenSize);
  AssertEquals('MinLogicalScreenSize',TSize.Create(2400,1800),aDevice.MinLogicalScreenSize);
  AssertEquals('MaxPhysicalScreenSize',TSize.Create(1900,1200),aDevice.MaxPhysicalScreenSize);
  AssertEquals('MaxLogicalScreenSize',TSize.Create(3800,2400),aDevice.MaxLogicalScreenSize);
  AssertEquals('Platform',TOSVersion.TPlatform.pfLinux,aDevice.Platform);
  AssertEquals('DeviceClass',TDeviceInfo.TDeviceClass.Desktop,aDevice.DeviceClass);
  AssertEquals('ID','1',aDevice.ID);
  AssertEquals('PixelsPerInch',96,aDevice.PixelsPerInch);
  AssertEquals('Exclusive',True,aDevice.Exclusive);
end;

procedure TTestDevices.AssertSampleDevice2(aDevice : TBaseDeviceInfo);

begin
  AssertEquals('MinPhysicalScreenSize',TSize.Create(1600,1024),aDevice.MinPhysicalScreenSize);
  AssertEquals('MinLogicalScreenSize',TSize.Create(3200,2048),aDevice.MinLogicalScreenSize);
  AssertEquals('MaxPhysicalScreenSize',TSize.Create(2048,1600),aDevice.MaxPhysicalScreenSize);
  AssertEquals('MaxLogicalScreenSize',TSize.Create(4096,3200),aDevice.MaxLogicalScreenSize);
  AssertEquals('Platform',TOSVersion.TPlatform.pfLinux,aDevice.Platform);
  AssertEquals('DeviceClass',TDeviceInfo.TDeviceClass.Tablet,aDevice.DeviceClass);
  AssertEquals('ID','2',aDevice.ID);
  AssertEquals('PixelsPerInch',128,aDevice.PixelsPerInch);
  AssertEquals('Exclusive',False,aDevice.Exclusive);
end;

procedure TTestDevices.CreateEmpty;

begin
  TDeviceInfo.create;
end;

procedure TTestDevices.TestCreateEmpty;
begin
  AssertException('Cannot create directly',ENoConstructException,@CreateEmpty);
end;

procedure TTestDevices.TestDiagonal;

Var
  D: Single;

begin
  Device:=CreateSampleDevice;
  D:=Sqrt(Sqr(1900)+Sqr(1200))/96;
  AssertEquals('MaxDiagonal',D,Device.MaxDiagonal);
  D:=Sqrt(Sqr(1200)+Sqr(900))/96;
  AssertEquals('MinDiagonal',D,Device.MinDiagonal);
end;

procedure TTestDevices.AddSampleDevice1;
begin
  TDeviceInfo.AddDevice(TDeviceInfo.TDeviceClass.Desktop,'1',
                        TSize.Create(1200,900),
                        TSize.Create(2400,1800),
                        TSize.Create(1900,1200),
                        TSize.Create(3800,2400),TOSVersion.TPlatform.pfLinux,96,True);
end;

procedure TTestDevices.AddSampleDevice2;
begin
  TDeviceInfo.AddDevice(TDeviceInfo.TDeviceClass.Tablet,'2',
                        TSize.Create(1600,1024),
                        TSize.Create(3200,2048),
                        TSize.Create(2048,1600),
                        TSize.Create(4096,3200),TOSVersion.TPlatform.pfLinux,128,False);
end;

procedure TTestDevices.TestAddDevice;
begin
  AddSampleDevice1;
  AssertEquals('Count correct',1,TDeviceInfo.DeviceCount);
  AssertSampleDevice(TDeviceInfo.Devices[0]);
  AddSampleDevice2;
  AssertEquals('Count correct',2,TDeviceInfo.DeviceCount);
  AssertSampleDevice2(TDeviceInfo.Devices[1]);
end;

procedure TTestDevices.TestAttribute;
begin
  Device:=CreateSampleDevice;
  Device.AddAttribute('tutu','toto');
  AssertEquals('Has existing attribute',True,Device.HasAttribute('tutu'));
  AssertEquals('Does not have non-existing attribute',False,Device.HasAttribute('titi'));
  AssertEquals('Value of existing attribute','toto',Device.Attributes['tutu']);
  AssertEquals('Value of non-existing attribute','',Device.Attributes['titi']);
end;

procedure TTestDevices.TestSelect;

Var
  Arr : TDeviceInfoArray;

begin
  AddSampleDevice1;
  AddSampleDevice2;
  Arr:=TDeviceInfo.SelectDevices(TDeviceInfo.TDeviceClass.Automotive,TSize.Create(100,100),TSize.Create(200,200),TOSVersion.TPlatform.pfAndroid,96,False);
  AssertEquals('Empty, platform does not match',0,Length(Arr));
end;

procedure TTestDevices.TestSelect2;

Var
  Arr : TDeviceInfoArray;

begin
  AddSampleDevice1;
  AddSampleDevice2;
  Arr:=TDeviceInfo.SelectDevices(TDeviceInfo.TDeviceClass.Desktop,TSize.Create(100,100),TSize.Create(200,200),TOSVersion.TPlatform.pfLinux,96,False);
  AssertEquals('platform matches',2,Length(Arr));
  AssertSame('El 1',TDeviceInfo.Devices[0],Arr[1]);
  AssertSame('El 2',TDeviceInfo.Devices[1],Arr[0]);
end;

procedure TTestDevices.TestSelect3;
Var
  Arr : TDeviceInfoArray;

begin
  AddSampleDevice1;
  AddSampleDevice2;
  Arr:=TDeviceInfo.SelectDevices(TDeviceInfo.TDeviceClass.Desktop,TSize.Create(1200,900),TSize.Create(2400,1800),TOSVersion.TPlatform.pfLinux,96,False);
  AssertEquals('platform matches',2,Length(Arr));
  AssertSame('El 1',TDeviceInfo.Devices[0],Arr[0]);
  AssertSame('El 2',TDeviceInfo.Devices[1],Arr[1]);
end;

procedure TTestDevices.SetUp;
begin
  TDeviceInfo.ClearDevices;
end;

procedure TTestDevices.TearDown;

begin
  TDeviceInfo.ClearDevices;
  FreeAndNil(FDevice);
end;

procedure TTestDevices.AssertEquals(Msg: String; aExpected, aActual: TSize);
begin
  AssertEquals(Msg+': cx',aExpected.cx,aActual.cx);
  AssertEquals(Msg+': cy',aExpected.cy,aActual.cy);
end;

procedure TTestDevices.AssertEquals(Msg: String; aExpected,
  aActual: TDeviceInfo.TDeviceClass);
begin
  AssertEquals(Msg,GetEnumName(TypeInfo(TDeviceInfo.TDeviceClass),Ord(aExpected)),
                   GetEnumName(TypeInfo(TDeviceInfo.TDeviceClass),Ord(aActual)));
end;

procedure TTestDevices.AssertEquals(Msg: String; aExpected,
  aActual: TOSVersion.TPlatform);
begin
  AssertEquals(Msg,GetEnumName(TypeInfo(TOSVersion.TPlatform),Ord(aExpected)),
                   GetEnumName(TypeInfo(TOSVersion.TPlatform),Ord(aActual)));
end;


initialization
  RegisterTest(TTestDevices);
end.