trunk/testsuite/Test28.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 Test28;

{$mode objfpc}{$H+}

{Test 28: Create Local Database from Script}

{ Description
}

interface

uses
  Classes, SysUtils,   TestApplication, IBXTestBase, IB, IBCMLocalDBSupport,
  IBExtract, IBSQL;

const
  aTestID    = '28';
  aTestTitle = 'Create Local Database from Script';

type

{ TTest28 }

  TTest28 = class(TIBXTestBase)
  private
    FLocalDB: TIBCMLocalDBSupport;
    FExtract: TIBExtract;
    procedure HandleExtractLine(Sender: TObject; start, count: integer);
    procedure HandleGetDBVersionNo(Sender: TObject; var VersionNo: integer);
    procedure HandleLogMessage(Sender: TObject; Msg: string);
    procedure GetSharedDirectory(Sender: TObject; var SharedDataDir: string);
    procedure InsertRecord;
  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

{ TTest28 }

procedure TTest28.HandleExtractLine(Sender: TObject; start, count: integer);
var i: integer;
begin
  for i := 0 to count - 1 do
    writeln(OutFile,FExtract.Items[start + i]);
end;

procedure TTest28.HandleGetDBVersionNo(Sender: TObject; var VersionNo: integer);
begin
  VersionNo := 0;
  IBTransaction.Active := true;
  try
    with TIBSQL.Create(nil) 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(nil)  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 TTest28.HandleLogMessage(Sender: TObject; Msg: string);
begin
  writeln(OutFile,Msg);
end;

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

procedure TTest28.InsertRecord;
begin
  with TIBSQL.Create(nil) do
  try
    Database := IBDatabase;
    Transaction := IBTransaction;
    Transaction.Active := true;
    SQL.Text := 'INSERT INTO IBDATASETTEST (KeyField,PlainText) Values(Gen_ID(AGenerator,1),''Test'')';
    ExecQuery;
    Transaction.Commit;
  finally
    Free;
  end;
end;

procedure TTest28.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;
  FExtract := TIBExtract.Create(Application);
  FExtract.Database := IBDatabase;
  FExtract.Transaction := IBTransaction;
  FExtract.OnExtractLines := @HandleExtractLine;
end;

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

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

procedure TTest28.InitTest;
begin
  IBDatabase.DatabaseName := 'nemo';
  FLocalDB.DatabaseName := ExtractDBName(Owner.GetNewDatabaseName);
  FLocalDB.EmptyDBArchive := 'schema.sql';
  FLocalDB.RequiredVersionNo := 1;
  ReadWriteTransaction;
end;

procedure TTest28.RunTest(CharSet: AnsiString; SQLDialect: integer);
var BackupFileName: string;
begin
  IBDatabase.Connected := true;
  try
    writeln(Outfile,'Show schema for ',IBDatabase.DatabaseName);
    FExtract.ExtractObject(eoDatabase,'',[etGrantsToUser,etData]);

    InsertRecord;
    writeln(Outfile,'Now test out an upgrade failure');
    IBDatabase.connected := false;
    FLocalDB.RequiredVersionNo := 2;
    FLocalDB.UpgradeConfFile := 'upgrade.conf';
    try
      IBDatabase.connected := true;
    except on E:Exception do
      begin
        writeln(Outfile,'Upgrade failed (as expected): ',E.Message);
        FLocalDB.RequiredVersionNo := 1;
        IBDatabase.Connected := true;
      end;
    end;
    writeln(Outfile,'Schema after failed upgrade is');
    FExtract.ExtractObject(eoDatabase,'',[etGrantsToUser,etData]);
    writeln(Outfile,'Save and Restore Tests');
    InsertRecord;
    BackupFileName := Owner.GetBackupFileName;
    FLocalDB.SaveDatabase(BackupFileName);
    InsertRecord;
    FLocalDB.RestoreDatabase(BackupFileName);
    writeln(Outfile,'Database after restore');
    FExtract.ExtractObject(eoDatabase,'',[etGrantsToUser,etData]);
  finally
    IBDatabase.DropDatabase;
  end;
end;

initialization
  RegisterTest(TTest28);

end.

Revision:	323
Committed:	Thu Feb 25 12:14:35 2021 UTC (3 years, 2 months ago) by tony
Content type:	text/x-pascal
File size:	5867 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 Test28;
28
29	{$mode objfpc}{$H+}
30
31	{Test 28: Create Local Database from Script}
32
33	{ Description
34	}
35
36	interface
37
38	uses
39	Classes, SysUtils, TestApplication, IBXTestBase, IB, IBCMLocalDBSupport,
40	IBExtract, IBSQL;
41
42	const
43	aTestID = '28';
44	aTestTitle = 'Create Local Database from Script';
45
46	type
47
48	{ TTest28 }
49
50	TTest28 = class(TIBXTestBase)
51	private
52	FLocalDB: TIBCMLocalDBSupport;
53	FExtract: TIBExtract;
54	procedure HandleExtractLine(Sender: TObject; start, count: integer);
55	procedure HandleGetDBVersionNo(Sender: TObject; var VersionNo: integer);
56	procedure HandleLogMessage(Sender: TObject; Msg: string);
57	procedure GetSharedDirectory(Sender: TObject; var SharedDataDir: string);
58	procedure InsertRecord;
59	protected
60	procedure CreateObjects(Application: TTestApplication); override;
61	function GetTestID: AnsiString; override;
62	function GetTestTitle: AnsiString; override;
63	procedure InitTest; override;
64	public
65	procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
66	end;
67
68
69	implementation
70
71	{ TTest28 }
72
73	procedure TTest28.HandleExtractLine(Sender: TObject; start, count: integer);
74	var i: integer;
75	begin
76	for i := 0 to count - 1 do
77	writeln(OutFile,FExtract.Items[start + i]);
78	end;
79
80	procedure TTest28.HandleGetDBVersionNo(Sender: TObject; var VersionNo: integer);
81	begin
82	VersionNo := 0;
83	IBTransaction.Active := true;
84	try
85	with TIBSQL.Create(nil) do
86	try
87	Database := IBDatabase;
88	Transaction := IBTransaction;
89	SQL.Text := 'Select * From RDB$RELATIONS Where RDB$RELATION_NAME = ''DBVERSIONINFO''';
90	ExecQuery;
91	try
92	if EOF then Exit;
93	finally
94	Close;
95	end;
96	finally
97	Free
98	end;
99
100	with TIBSQL.Create(nil) do
101	try
102	Database := IBDatabase;
103	Transaction := IBTransaction;
104	SQL.Text := 'Select VersionNo From DBVersionInfo';
105	ExecQuery;
106	try
107	VersionNo := FieldByName('VersionNo').AsInteger;
108	finally
109	Close;
110	end;
111	finally
112	Free;
113	end;
114	finally
115	IBTransaction.Commit;
116	end;
117	end;
118
119	procedure TTest28.HandleLogMessage(Sender: TObject; Msg: string);
120	begin
121	writeln(OutFile,Msg);
122	end;
123
124	procedure TTest28.GetSharedDirectory(Sender: TObject; var SharedDataDir: string
125	);
126	begin
127	SharedDataDir := 'resources/Test28';
128	end;
129
130	procedure TTest28.InsertRecord;
131	begin
132	with TIBSQL.Create(nil) do
133	try
134	Database := IBDatabase;
135	Transaction := IBTransaction;
136	Transaction.Active := true;
137	SQL.Text := 'INSERT INTO IBDATASETTEST (KeyField,PlainText) Values(Gen_ID(AGenerator,1),''Test'')';
138	ExecQuery;
139	Transaction.Commit;
140	finally
141	Free;
142	end;
143	end;
144
145	procedure TTest28.CreateObjects(Application: TTestApplication);
146	begin
147	inherited CreateObjects(Application);
148	FLocalDB := TIBCMLocalDBSupport.Create(Application);
149	FLocalDB.Database := IBDatabase;
150	FLocalDB.VendorName := 'MWA Software';
151	FLocalDB.OnGetDBVersionNo := @HandleGetDBVersionNo;
152	FLocalDB.OnLogMessage := @HandleLogMessage;
153	FLocalDB.OnGetSharedDataDir := @GetSharedDirectory;
154	FExtract := TIBExtract.Create(Application);
155	FExtract.Database := IBDatabase;
156	FExtract.Transaction := IBTransaction;
157	FExtract.OnExtractLines := @HandleExtractLine;
158	end;
159
160	function TTest28.GetTestID: AnsiString;
161	begin
162	Result := aTestID;
163	end;
164
165	function TTest28.GetTestTitle: AnsiString;
166	begin
167	Result := aTestTitle;
168	end;
169
170	procedure TTest28.InitTest;
171	begin
172	IBDatabase.DatabaseName := 'nemo';
173	FLocalDB.DatabaseName := ExtractDBName(Owner.GetNewDatabaseName);
174	FLocalDB.EmptyDBArchive := 'schema.sql';
175	FLocalDB.RequiredVersionNo := 1;
176	ReadWriteTransaction;
177	end;
178
179	procedure TTest28.RunTest(CharSet: AnsiString; SQLDialect: integer);
180	var BackupFileName: string;
181	begin
182	IBDatabase.Connected := true;
183	try
184	writeln(Outfile,'Show schema for ',IBDatabase.DatabaseName);
185	FExtract.ExtractObject(eoDatabase,'',[etGrantsToUser,etData]);
186
187	InsertRecord;
188	writeln(Outfile,'Now test out an upgrade failure');
189	IBDatabase.connected := false;
190	FLocalDB.RequiredVersionNo := 2;
191	FLocalDB.UpgradeConfFile := 'upgrade.conf';
192	try
193	IBDatabase.connected := true;
194	except on E:Exception do
195	begin
196	writeln(Outfile,'Upgrade failed (as expected): ',E.Message);
197	FLocalDB.RequiredVersionNo := 1;
198	IBDatabase.Connected := true;
199	end;
200	end;
201	writeln(Outfile,'Schema after failed upgrade is');
202	FExtract.ExtractObject(eoDatabase,'',[etGrantsToUser,etData]);
203	writeln(Outfile,'Save and Restore Tests');
204	InsertRecord;
205	BackupFileName := Owner.GetBackupFileName;
206	FLocalDB.SaveDatabase(BackupFileName);
207	InsertRecord;
208	FLocalDB.RestoreDatabase(BackupFileName);
209	writeln(Outfile,'Database after restore');
210	FExtract.ExtractObject(eoDatabase,'',[etGrantsToUser,etData]);
211	finally
212	IBDatabase.DropDatabase;
213	end;
214	end;
215
216	initialization
217	RegisterTest(TTest28);
218
219	end.
220