trunk/testsuite/Test28.pas

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