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, 8 months ago) by tony
Content type:	text/x-pascal
File size:	5867 byte(s)
Log Message:	Fixed Merged
#	User	Rev	Content
1	tony	323	(*
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	tony	315	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