Skip to content

Commit

Permalink
Add Firebird Object Pascal OO Api test cases
Browse files Browse the repository at this point in the history
  • Loading branch information
ccy committed Apr 16, 2023
1 parent 01b916b commit bd92415
Show file tree
Hide file tree
Showing 6 changed files with 217 additions and 11 deletions.
2 changes: 1 addition & 1 deletion delphi-firebird-api
3 changes: 2 additions & 1 deletion project/dbxfbTests.dpr
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,8 @@ uses
firebird.utils in '..\source\testcase\firebird.utils.pas',
vcl.dbx.cmdlines in '..\source\testcase\vcl.dbx.cmdlines.pas',
vcl.dbx.main in '..\source\testcase\vcl.dbx.main.pas',
vcl.dbx.testcase in '..\source\testcase\vcl.dbx.testcase.pas';
vcl.dbx.testcase in '..\source\testcase\vcl.dbx.testcase.pas',
firebird.api.testcase in '..\source\testcase\firebird.api.testcase.pas';

{$R *.RES}

Expand Down
1 change: 1 addition & 0 deletions project/dbxfbTests.dproj
Original file line number Diff line number Diff line change
Expand Up @@ -200,6 +200,7 @@
<DCCReference Include="..\source\testcase\vcl.dbx.cmdlines.pas"/>
<DCCReference Include="..\source\testcase\vcl.dbx.main.pas"/>
<DCCReference Include="..\source\testcase\vcl.dbx.testcase.pas"/>
<DCCReference Include="..\source\testcase\firebird.api.testcase.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
Expand Down
17 changes: 8 additions & 9 deletions source/testcase/build.xml
Original file line number Diff line number Diff line change
Expand Up @@ -29,13 +29,14 @@
</sequential>
</for>

<for param="i" begin="1" end="${p.server.count}" parallel="true" keepgoing="true">
<sequential>
<antcall target="dbx.test">
<param name="test" value="server_@{i}" />
</antcall>
</sequential>
</for>
<antcall target="dbx.test">
<param name="test" value="default" />
<param name="suite" value="3" />
</antcall>

<antcall target="dbx.test">
<param name="test" value="server_1" />
</antcall>
</target>

<target name="dbx.test">
Expand Down Expand Up @@ -79,8 +80,6 @@
<equals arg1="${p.platform}" arg2="Win32" casesensitive="false" />
</or>
</condition>

<property name="p.server.count" value="1" />
</target>

</project>
198 changes: 198 additions & 0 deletions source/testcase/firebird.api.testcase.pas
Original file line number Diff line number Diff line change
@@ -0,0 +1,198 @@
unit firebird.api.testcase;

interface

uses
TestExtensions, TestFramework,
Firebird, Firebird.helper, firebird.client;

type
TTestCase_FirebirdAPI = class(TTestCase)
strict private
fbstatus: IStatus;
FEngines: TFirebirdEngines;
FHandle: THandle;
master: IMaster;
prov: IProvider;
util: IUtil;
protected
class function GetEmbeddedSectionName: string;
public
procedure SetUp; override;
procedure TearDown; override;
published
procedure Test_attachDatabase;
procedure Test_attachServiceManager;
procedure Test_createDatabase;
end;

implementation

uses
Winapi.Windows, System.AnsiStrings, System.IniFiles, System.IOUtils,
System.SysUtils,
firebird.constants.h, firebird.consts_pub.h, firebird.inf_pub.h, firebird.ods.h,
firebird.sqlda_pub.h,
vcl.dbx.cmdlines;

type
TFirebirdDBVersionCallback = class(IVersionCallbackImpl)
FValues: TArray<string>;
procedure callback(status: IStatus; text: PAnsiChar); override;
property Values: TArray<string> read FValues;
end;

procedure TFirebirdDBVersionCallback.callback(status: IStatus; text: PAnsiChar);
begin
inherited;
FValues := FValues + [string(System.AnsiStrings.StrPas(text))];
end;

class function TTestCase_FirebirdAPI.GetEmbeddedSectionName: string;
begin
Result := 'embedded.' +
{$ifdef Win32}'x86'{$endif}
{$ifdef Win64}'x64'{$endif}
;
end;

procedure TTestCase_FirebirdAPI.SetUp;
begin
inherited;
var fbclient := '';

var F := TIniFile.Create(TCmdLineParams_App.ConfigFile);
try
fbclient := ExpandFileNameString(F.ReadString(GetEmbeddedSectionName, 'Default', ''));
finally
F.Free;
end;

master := fb_get_master_interface(fbclient, FHandle);
fbstatus := master.getStatus;
util := master.getUtilInterface;
prov := master.getDispatcher;

FEngines := TFirebirdEngines.Create(fbclient);
end;

procedure TTestCase_FirebirdAPI.TearDown;
begin
fbstatus := nil;
util := nil;
prov := nil;
master := nil;
FreeLibrary(FHandle);
FEngines.Free;
inherited;
end;

procedure TTestCase_FirebirdAPI.Test_attachDatabase;
begin
var p := util.getXpbBuilder(fbstatus, IXpbBuilder.DPB, nil, 0);
try
p.insertString(fbstatus, isc_dpb_config, FEngines.GetProviders);
var a := prov.attachDatabase(fbstatus, 'employee', p.getBufferLength(fbstatus), p.getBuffer(fbstatus));
try
var v := TFirebirdDBVersionCallback.Create;
try
util.getFbVersion(fbstatus, a, v);
for var s in v.Values do Status(s);
finally
v.Free;
end;
finally
a.detach(fbstatus);
end;
finally
p.dispose;
end;
end;

procedure TTestCase_FirebirdAPI.Test_attachServiceManager;
begin
var p := util.getXpbBuilder(fbstatus, IXpbBuilder.SPB_ATTACH, nil, 0);
try
p.insertString(fbstatus, isc_spb_user_name, DBA_USER_NAME);
p.insertString(fbstatus, isc_spb_password, TFirebird.DefaultDBAPassword);
var a := prov.attachServiceManager(fbstatus, TFirebird.service_mgr, p.getBufferLength(fbstatus), p.getBuffer(fbstatus));
try
var res: TBytes;
SetLength(res, High(Byte));

var b := TBytes.Create(isc_info_svc_version, isc_info_svc_server_version, isc_info_svc_implementation, isc_info_end);
a.query(fbstatus, 0, nil, Length(b), @b[0], Length(res), @res[0]);

var r := util.getXpbBuilder(fbstatus, IXpbBuilder.SPB_RESPONSE, @res[0], Length(res));
try
while r.getTag(fbstatus) <> isc_info_end do begin
case r.getTag(fbstatus) of
isc_info_svc_version: status(r.getInt(fbstatus).ToString);
isc_info_svc_server_version: status(string(System.AnsiStrings.StrPas(r.getString(fbstatus))));
isc_info_svc_implementation: status(string(System.AnsiStrings.StrPas(r.getString(fbstatus))));
end;
r.moveNext(fbstatus);
end;
finally
r.dispose;
end;
finally
a.detach(fbstatus);
end;
finally
p.dispose;
end;
end;

procedure TTestCase_FirebirdAPI.Test_createDatabase;
begin
for var Engine in FEngines do begin
for var PageSize in Engine.SupportedPageSizes do begin
var p := util.getXpbBuilder(fbstatus, IXpbBuilder.DPB, nil, 0);
try
p.insertString(fbstatus, isc_dpb_config, FEngines.GetProviders(Engine));
p.insertInt(fbstatus, isc_dpb_page_size, PageSize);

var fdb := TPath.ChangeExtension(TPath.GetTempPath + TPath.GetRandomFileName, 'fdb');
status(Format('Database: %s Engine: %s PageSize: %d', [fdb, Engine.Version, PageSize]));
var a := prov.createDatabase(fbstatus, fdb, p.getBufferLength(fbstatus), p.getBuffer(fbstatus));

var v := TFirebirdDBVersionCallback.Create;
try
util.getFbVersion(fbstatus, a, v);
for var s in v.Values do Status(s);
finally
v.Free;
end;

var q := TBytes.Create(isc_info_page_size, isc_info_ods_version, isc_info_ods_minor_version, isc_info_end);

var res: TBytes;
SetLength(res, High(Byte));
a.getInfo(fbstatus, Length(q), @q[0], Length(res), @res[0]);

var r := util.getXpbBuilder(fbstatus, IXpbBuilder.INFO_RESPONSE, @res[0], Length(res));
try
while r.getTag(fbstatus) <> isc_info_end do begin
case r.getTag(fbstatus) of
isc_info_page_size: CheckEquals(PageSize, r.getInt(fbstatus));
isc_info_ods_version: CheckEquals(DECODE_ODS_MAJOR(Engine.EncodedODS), r.getInt(fbstatus));
isc_info_ods_minor_version: CheckEquals(DECODE_ODS_MINOR(Engine.EncodedODS), r.getInt(fbstatus));
end;
r.moveNext(fbstatus);
end;
finally
r.dispose;
end;

a.dropDatabase(fbstatus)
finally
p.dispose;
end;
end;
end;
end;

initialization
if TCmdLineParams_App.TestSuite3 then RegisterTest(TTestCase_FirebirdAPI.Suite);
end.
7 changes: 7 additions & 0 deletions source/testcase/vcl.dbx.cmdlines.pas
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,7 @@ TCmdLineParams_App = class abstract
class function RunAsConsole: boolean;
class function TestSuite1: Boolean;
class function TestSuite2: Boolean;
class function TestSuite3: Boolean;
end;

implementation
Expand Down Expand Up @@ -90,4 +91,10 @@ class function TCmdLineParams_App.TestSuite2: Boolean;
Result := FindCmdLineSwitch('suite', s) and (s = '2');
end;

class function TCmdLineParams_App.TestSuite3: Boolean;
begin
var s := '';
Result := FindCmdLineSwitch('suite', s) and (s = '3');
end;

end.

0 comments on commit bd92415

Please sign in to comment.