trunk/testsuite/Test27.pas

(*
 *  IBX Test suite. This program is used to test the IBX non-visual
 *  components and provides a semi-automated pass/fail check for each test.
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2021 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)      
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:	323
Committed:	Thu Feb 25 12:14:35 2021 UTC (3 years, 9 months ago) by tony
Content type:	text/x-pascal
File size:	5181 byte(s)
Log Message:	Fixed Merged
#	Content
1	(*
2	* IBX Test suite. This program is used to test the IBX non-visual
3	* components and provides a semi-automated pass/fail check for each test.
4	*
5	* The contents of this file are subject to the Initial Developer's
6	* Public License Version 1.0 (the "License"); you may not use this
7	* file except in compliance with the License. You may obtain a copy
8	* of the License here:
9	*
10	* http://www.firebirdsql.org/index.php?op=doc&id=idpl
11	*
12	* Software distributed under the License is distributed on an "AS
13	* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
14	* implied. See the License for the specific language governing rights
15	* and limitations under the License.
16	*
17	* The Initial Developer of the Original Code is Tony Whyman.
18	*
19	* The Original Code is (C) 2021 Tony Whyman, MWA Software
20	* (http://www.mwasoftware.co.uk).
21	*
22	* All Rights Reserved.
23	*
24	* Contributor(s): ______________________________________.
25	*
26	*)
27	unit Test27;
28
29	{$mode objfpc}{$H+}
30
31	{Test 27: create, bring up-to-date and read from local database}
32
33	{
34	Requires Firebird Embedded Server - with FB 2.5 and lower this implies FBEmbedded
35
36	Creates a new local database from a backup archive.
37
38	Updates the schema
39
40	Prints out results of a query.
41	}
42
43	interface
44
45	uses
46	Classes, SysUtils, TestApplication, IBXTestBase, IB, IBCMLocalDBSupport, IBSQL,
47	IBQuery, IBDatabase;
48
49	const
50	aTestID = '27';
51	aTestTitle = 'create, bring up-to-date and read from local database';
52
53	type
54
55	{ TTest27 }
56
57	TTest27 = class(TIBXTestBase)
58	private
59	FLocalDB: TIBCMLocalDBSupport;
60	procedure HandleGetDBVersionNo(Sender: TObject; var VersionNo: integer);
61	procedure HandleLogMessage(Sender: TObject; Msg: string);
62	procedure GetSharedDirectory(Sender: TObject; var SharedDataDir: string);
63	protected
64	procedure CreateObjects(Application: TTestApplication); override;
65	function GetTestID: AnsiString; override;
66	function GetTestTitle: AnsiString; override;
67	procedure InitTest; override;
68	public
69	procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
70	end;
71
72
73	implementation
74
75	const
76	sqlExample =
77	'with recursive Depts As ( '+
78	'Select DEPT_NO, DEPARTMENT, HEAD_DEPT, cast(DEPARTMENT as VarChar(256)) as DEPT_PATH,'+
79	'cast(DEPT_NO as VarChar(64)) as DEPT_KEY_PATH '+
80	'From DEPARTMENT Where HEAD_DEPT is NULL '+
81	'UNION ALL '+
82	'Select D.DEPT_NO, D.DEPARTMENT, D.HEAD_DEPT, Depts.DEPT_PATH \|\| '' / '' \|\| D.DEPARTMENT as DEPT_PATH,'+
83	'Depts.DEPT_KEY_PATH \|\| '';'' \|\| D.DEPT_NO as DEPT_KEY_PATH '+
84	'From DEPARTMENT D '+
85	'JOIN Depts On D.HEAD_DEPT = Depts.DEPT_NO '+
86	')'+
87
88	'Select First 2 A.EMP_NO, A.FIRST_NAME, A.LAST_NAME, A.PHONE_EXT, A.HIRE_DATE, A.DEPT_NO, A.JOB_CODE,'+
89	'A.JOB_GRADE, A.JOB_COUNTRY, A.SALARY, A.FULL_NAME, A.PHOTO, D.DEPT_PATH, D.DEPT_KEY_PATH '+
90	'From EMPLOYEE A '+
91	'JOIN Depts D On D.DEPT_NO = A.DEPT_NO';
92
93	{ TTest27 }
94
95	procedure TTest27.HandleGetDBVersionNo(Sender: TObject; var VersionNo: integer);
96	begin
97	VersionNo := 0;
98	IBTransaction.Active := true;
99	try
100	with TIBSQL.Create(Owner) do
101	try
102	Database := IBDatabase;
103	Transaction := IBTransaction;
104	SQL.Text := 'Select * From RDB$RELATIONS Where RDB$RELATION_NAME = ''DBVERSIONINFO''';
105	ExecQuery;
106	try
107	if EOF then Exit;
108	finally
109	Close;
110	end;
111	finally
112	Free
113	end;
114
115	with TIBSQL.Create(Owner) do
116	try
117	Database := IBDatabase;
118	Transaction := IBTransaction;
119	SQL.Text := 'Select VersionNo From DBVersionInfo';
120	ExecQuery;
121	try
122	VersionNo := FieldByName('VersionNo').AsInteger;
123	finally
124	Close;
125	end;
126	finally
127	Free;
128	end;
129	finally
130	IBTransaction.Commit;
131	end;
132	end;
133
134	procedure TTest27.HandleLogMessage(Sender: TObject; Msg: string);
135	begin
136	writeln(OutFile,Msg);
137	end;
138
139	procedure TTest27.GetSharedDirectory(Sender: TObject; var SharedDataDir: string);
140	begin
141	SharedDataDir := 'resources/Test27';
142	end;
143
144	procedure TTest27.CreateObjects(Application: TTestApplication);
145	begin
146	inherited CreateObjects(Application);
147	FLocalDB := TIBCMLocalDBSupport.Create(Application);
148	FLocalDB.Database := IBDatabase;
149	FLocalDB.VendorName := 'MWA Software';
150	FLocalDB.OnGetDBVersionNo := @HandleGetDBVersionNo;
151	FLocalDB.OnLogMessage := @HandleLogMessage;
152	FLocalDB.OnGetSharedDataDir := @GetSharedDirectory;
153	end;
154
155	function TTest27.GetTestID: AnsiString;
156	begin
157	Result := aTestID;
158	end;
159
160	function TTest27.GetTestTitle: AnsiString;
161	begin
162	Result := aTestTitle;
163	end;
164
165	procedure TTest27.InitTest;
166	begin
167	IBDatabase.DatabaseName := 'nemo';
168	FLocalDB.DatabaseName := ExtractDBName(Owner.GetNewDatabaseName);
169	FLocalDB.EmptyDBArchive := 'employee.gbk';
170	FLocalDB.RequiredVersionNo := 2;
171	FLocalDB.UpgradeConfFile := 'upgrade.conf';
172	ReadOnlyTransaction;
173	end;
174
175	procedure TTest27.RunTest(CharSet: AnsiString; SQLDialect: integer);
176	begin
177	try
178	IBDatabase.Connected := true;
179	with IBQuery do
180	begin
181	AllowAutoActivateTransaction := true;
182	SQL.Text := sqlExample;
183	Active := true;
184	PrintDataSet(IBQuery);
185	end;
186	finally
187	IBDatabase.DropDatabase;
188	end;
189	end;
190
191	initialization
192	RegisterTest(TTest27);
193
194	end.
195