trunk/testsuite/Test27.pas

unit Test27;

{$mode objfpc}{$H+}

{Test 27: create, bring up-to-date and read from local database}

{
  Requires Firebird Embedded Server - with FB 2.5 and lower this implies FBEmbedded

  Creates a new local database from a backup archive.

  Updates the schema

  Prints out results of a query.
}

interface

uses
  Classes, SysUtils,  TestApplication, IBXTestBase, IB, IBCMLocalDBSupport, IBSQL,
  IBQuery, IBDatabase;

const
  aTestID    = '27';
  aTestTitle = 'create, bring up-to-date and read from local database';

type

{ TTest27 }

  TTest27 = class(TIBXTestBase)
  private
    FLocalDB: TIBCMLocalDBSupport;
    procedure HandleGetDBVersionNo(Sender: TObject; var VersionNo: integer);
    procedure HandleLogMessage(Sender: TObject; Msg: string);
    procedure GetSharedDirectory(Sender: TObject; var SharedDataDir: string);
  protected
    procedure CreateObjects(Application: TTestApplication); override;
    function GetTestID: AnsiString; override;
    function GetTestTitle: AnsiString; override;
    procedure InitTest; override;
  public
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;


implementation

const
  sqlExample =
'with recursive Depts As (   '+
'Select DEPT_NO, DEPARTMENT, HEAD_DEPT, cast(DEPARTMENT  as VarChar(256)) as DEPT_PATH,'+
'cast(DEPT_NO as VarChar(64)) as DEPT_KEY_PATH '+
'From DEPARTMENT Where HEAD_DEPT is NULL '+
'UNION ALL '+
'Select D.DEPT_NO, D.DEPARTMENT, D.HEAD_DEPT, Depts.DEPT_PATH ||  '' / '' || D.DEPARTMENT as DEPT_PATH,'+
'Depts.DEPT_KEY_PATH || '';'' || D.DEPT_NO as DEPT_KEY_PATH '+
'From DEPARTMENT D '+
'JOIN Depts On D.HEAD_DEPT = Depts.DEPT_NO '+
')'+

'Select First 2 A.EMP_NO, A.FIRST_NAME, A.LAST_NAME, A.PHONE_EXT, A.HIRE_DATE, A.DEPT_NO, A.JOB_CODE,'+
'A.JOB_GRADE, A.JOB_COUNTRY, A.SALARY, A.FULL_NAME, A.PHOTO, D.DEPT_PATH, D.DEPT_KEY_PATH '+
'From EMPLOYEE A '+
'JOIN Depts D On D.DEPT_NO = A.DEPT_NO';

  { TTest27 }

procedure TTest27.HandleGetDBVersionNo(Sender: TObject; var VersionNo: integer);
begin
  VersionNo := 0;
  IBTransaction.Active := true;
  try
    with TIBSQL.Create(Owner) do
    try
      Database := IBDatabase;
      Transaction := IBTransaction;
      SQL.Text := 'Select * From RDB$RELATIONS Where RDB$RELATION_NAME = ''DBVERSIONINFO''';
      ExecQuery;
      try
        if EOF then Exit;
      finally
        Close;
      end;
    finally
      Free
    end;

    with TIBSQL.Create(Owner)  do
    try
      Database := IBDatabase;
      Transaction := IBTransaction;
      SQL.Text := 'Select VersionNo From DBVersionInfo';
      ExecQuery;
      try
        VersionNo := FieldByName('VersionNo').AsInteger;
      finally
        Close;
      end;
    finally
      Free;
    end;
  finally
    IBTransaction.Commit;
  end;
end;

procedure TTest27.HandleLogMessage(Sender: TObject; Msg: string);
begin
  writeln(OutFile,Msg);
end;

procedure TTest27.GetSharedDirectory(Sender: TObject; var SharedDataDir: string);
begin
  SharedDataDir := 'resources/Test27';
end;

procedure TTest27.CreateObjects(Application: TTestApplication);
begin
  inherited CreateObjects(Application);
  FLocalDB := TIBCMLocalDBSupport.Create(Application);
  FLocalDB.Database := IBDatabase;
  FLocalDB.VendorName := 'MWA Software';
  FLocalDB.OnGetDBVersionNo := @HandleGetDBVersionNo;
  FLocalDB.OnLogMessage := @HandleLogMessage;
  FLocalDB.OnGetSharedDataDir := @GetSharedDirectory;
end;

function TTest27.GetTestID: AnsiString;
begin
  Result := aTestID;
end;

function TTest27.GetTestTitle: AnsiString;
begin
  Result := aTestTitle;
end;

procedure TTest27.InitTest;
begin
  IBDatabase.DatabaseName := 'nemo';
  FLocalDB.DatabaseName := ExtractDBName(Owner.GetNewDatabaseName);
  FLocalDB.EmptyDBArchive := 'employee.gbk';
  FLocalDB.RequiredVersionNo := 2;
  FLocalDB.UpgradeConfFile := 'upgrade.conf';
  ReadOnlyTransaction;
end;

procedure TTest27.RunTest(CharSet: AnsiString; SQLDialect: integer);
begin
  try
    IBDatabase.Connected := true;
    with IBQuery do
    begin
      AllowAutoActivateTransaction := true;
      SQL.Text := sqlExample;
      Active := true;
      PrintDataSet(IBQuery);
    end;
 finally
    IBDatabase.DropDatabase;
  end;
end;

initialization
  RegisterTest(TTest27);

end.

Revision:	315
Committed:	Thu Feb 25 11:56:36 2021 UTC (3 years, 9 months ago) by tony
Content type:	text/x-pascal
File size:	4224 byte(s)
Log Message:	Updated for IBX 4 release
#	User	Rev	Content
1	tony	315	unit Test27;
2
3			{$mode objfpc}{$H+}
4
5			{Test 27: create, bring up-to-date and read from local database}
6
7			{
8			Requires Firebird Embedded Server - with FB 2.5 and lower this implies FBEmbedded
9
10			Creates a new local database from a backup archive.
11
12			Updates the schema
13
14			Prints out results of a query.
15			}
16
17			interface
18
19			uses
20			Classes, SysUtils, TestApplication, IBXTestBase, IB, IBCMLocalDBSupport, IBSQL,
21			IBQuery, IBDatabase;
22
23			const
24			aTestID = '27';
25			aTestTitle = 'create, bring up-to-date and read from local database';
26
27			type
28
29			{ TTest27 }
30
31			TTest27 = class(TIBXTestBase)
32			private
33			FLocalDB: TIBCMLocalDBSupport;
34			procedure HandleGetDBVersionNo(Sender: TObject; var VersionNo: integer);
35			procedure HandleLogMessage(Sender: TObject; Msg: string);
36			procedure GetSharedDirectory(Sender: TObject; var SharedDataDir: string);
37			protected
38			procedure CreateObjects(Application: TTestApplication); override;
39			function GetTestID: AnsiString; override;
40			function GetTestTitle: AnsiString; override;
41			procedure InitTest; override;
42			public
43			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
44			end;
45
46
47			implementation
48
49			const
50			sqlExample =
51			'with recursive Depts As ( '+
52			'Select DEPT_NO, DEPARTMENT, HEAD_DEPT, cast(DEPARTMENT as VarChar(256)) as DEPT_PATH,'+
53			'cast(DEPT_NO as VarChar(64)) as DEPT_KEY_PATH '+
54			'From DEPARTMENT Where HEAD_DEPT is NULL '+
55			'UNION ALL '+
56			'Select D.DEPT_NO, D.DEPARTMENT, D.HEAD_DEPT, Depts.DEPT_PATH \|\| '' / '' \|\| D.DEPARTMENT as DEPT_PATH,'+
57			'Depts.DEPT_KEY_PATH \|\| '';'' \|\| D.DEPT_NO as DEPT_KEY_PATH '+
58			'From DEPARTMENT D '+
59			'JOIN Depts On D.HEAD_DEPT = Depts.DEPT_NO '+
60			')'+
61
62			'Select First 2 A.EMP_NO, A.FIRST_NAME, A.LAST_NAME, A.PHONE_EXT, A.HIRE_DATE, A.DEPT_NO, A.JOB_CODE,'+
63			'A.JOB_GRADE, A.JOB_COUNTRY, A.SALARY, A.FULL_NAME, A.PHOTO, D.DEPT_PATH, D.DEPT_KEY_PATH '+
64			'From EMPLOYEE A '+
65			'JOIN Depts D On D.DEPT_NO = A.DEPT_NO';
66
67			{ TTest27 }
68
69			procedure TTest27.HandleGetDBVersionNo(Sender: TObject; var VersionNo: integer);
70			begin
71			VersionNo := 0;
72			IBTransaction.Active := true;
73			try
74			with TIBSQL.Create(Owner) do
75			try
76			Database := IBDatabase;
77			Transaction := IBTransaction;
78			SQL.Text := 'Select * From RDB$RELATIONS Where RDB$RELATION_NAME = ''DBVERSIONINFO''';
79			ExecQuery;
80			try
81			if EOF then Exit;
82			finally
83			Close;
84			end;
85			finally
86			Free
87			end;
88
89			with TIBSQL.Create(Owner) do
90			try
91			Database := IBDatabase;
92			Transaction := IBTransaction;
93			SQL.Text := 'Select VersionNo From DBVersionInfo';
94			ExecQuery;
95			try
96			VersionNo := FieldByName('VersionNo').AsInteger;
97			finally
98			Close;
99			end;
100			finally
101			Free;
102			end;
103			finally
104			IBTransaction.Commit;
105			end;
106			end;
107
108			procedure TTest27.HandleLogMessage(Sender: TObject; Msg: string);
109			begin
110			writeln(OutFile,Msg);
111			end;
112
113			procedure TTest27.GetSharedDirectory(Sender: TObject; var SharedDataDir: string);
114			begin
115			SharedDataDir := 'resources/Test27';
116			end;
117
118			procedure TTest27.CreateObjects(Application: TTestApplication);
119			begin
120			inherited CreateObjects(Application);
121			FLocalDB := TIBCMLocalDBSupport.Create(Application);
122			FLocalDB.Database := IBDatabase;
123			FLocalDB.VendorName := 'MWA Software';
124			FLocalDB.OnGetDBVersionNo := @HandleGetDBVersionNo;
125			FLocalDB.OnLogMessage := @HandleLogMessage;
126			FLocalDB.OnGetSharedDataDir := @GetSharedDirectory;
127			end;
128
129			function TTest27.GetTestID: AnsiString;
130			begin
131			Result := aTestID;
132			end;
133
134			function TTest27.GetTestTitle: AnsiString;
135			begin
136			Result := aTestTitle;
137			end;
138
139			procedure TTest27.InitTest;
140			begin
141			IBDatabase.DatabaseName := 'nemo';
142			FLocalDB.DatabaseName := ExtractDBName(Owner.GetNewDatabaseName);
143			FLocalDB.EmptyDBArchive := 'employee.gbk';
144			FLocalDB.RequiredVersionNo := 2;
145			FLocalDB.UpgradeConfFile := 'upgrade.conf';
146			ReadOnlyTransaction;
147			end;
148
149			procedure TTest27.RunTest(CharSet: AnsiString; SQLDialect: integer);
150			begin
151			try
152			IBDatabase.Connected := true;
153			with IBQuery do
154			begin
155			AllowAutoActivateTransaction := true;
156			SQL.Text := sqlExample;
157			Active := true;
158			PrintDataSet(IBQuery);
159			end;
160			finally
161			IBDatabase.DropDatabase;
162			end;
163			end;
164
165			initialization
166			RegisterTest(TTest27);
167
168			end.
169