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

{$mode objfpc}{$H+}

{Test 10: Create Database from SQL Script and Extract SQL}


interface

uses
  Classes, SysUtils,  TestApplication, IBXTestBase, IB, IBExtract, IBDatabase;

const
  aTestID    = '10';
  aTestTitle = 'Create Database from SQL Script and Extract SQL';

type

{ TTest10 }

  TTest10 = class(TIBXTestBase)
  private
    FExtract: TIBExtract;
    procedure HandleExtractLine(Sender: TObject; start, count: integer);
  protected
    procedure CreateObjects(Application: TTestApplication); override;
    function GetTestID: AnsiString; override;
    function GetTestTitle: AnsiString; override;
    procedure InitTest; override;
    procedure InitialiseDatabase(aDatabase: TIBDatabase); override;
  public
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;


implementation

{ TTest10 }

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

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

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

procedure TTest10.InitTest;
begin
  ReadWriteTransaction;
  IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
  IBDatabase.CreateIfNotExists := true;
end;

procedure TTest10.InitialiseDatabase(aDatabase: TIBDatabase);
begin
  IBXScriptObj.StopOnFirstError := false;
  inherited InitialiseDatabase(aDatabase);
end;

procedure TTest10.RunTest(CharSet: AnsiString; SQLDialect: integer);
begin
  IBDatabase.Connected := true;
  writeln(OutFile);
  writeln(OutFile,'Extracting Database Schema and Data');
  FExtract.ExtractObject(eoDatabase,'',[etData,etGrantsToUser]);
  WriteStrings(FExtract.Items);
  FExtract.Items.SaveToFile(GetOutFile);
  writeln(OutFile,'Schema written to ',GetOutFile);
  IBDatabase.DropDatabase;
end;

initialization
  RegisterTest(TTest10);

end.

Revision:	349
Committed:	Mon Oct 18 08:39:40 2021 UTC (3 years, 1 month ago) by tony
Content type:	text/x-pascal
File size:	3198 byte(s)
Log Message:	FIxes 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 Test10;
28
29			{$mode objfpc}{$H+}
30
31			{Test 10: Create Database from SQL Script and Extract SQL}
32
33
34			interface
35
36			uses
37	tony	349	Classes, SysUtils, TestApplication, IBXTestBase, IB, IBExtract, IBDatabase;
38	tony	315
39			const
40			aTestID = '10';
41			aTestTitle = 'Create Database from SQL Script and Extract SQL';
42
43			type
44
45			{ TTest10 }
46
47			TTest10 = class(TIBXTestBase)
48			private
49			FExtract: TIBExtract;
50			procedure HandleExtractLine(Sender: TObject; start, count: integer);
51			protected
52			procedure CreateObjects(Application: TTestApplication); override;
53			function GetTestID: AnsiString; override;
54			function GetTestTitle: AnsiString; override;
55			procedure InitTest; override;
56			procedure InitialiseDatabase(aDatabase: TIBDatabase); override;
57			public
58			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
59			end;
60
61
62			implementation
63
64			{ TTest10 }
65
66			procedure TTest10.HandleExtractLine(Sender: TObject; start, count: integer);
67			var i: integer;
68			begin
69			for i := 0 to count - 1 do
70			writeln(OutFile,FExtract.Items[start + i]);
71			end;
72
73			procedure TTest10.CreateObjects(Application: TTestApplication);
74			begin
75			inherited CreateObjects(Application);
76			FExtract := TIBExtract.Create(Application);
77			FExtract.Database := IBDatabase;
78			FExtract.Transaction := IBTransaction;
79			FExtract.OnExtractLines := @HandleExtractLine;
80			end;
81
82			function TTest10.GetTestID: AnsiString;
83			begin
84			Result := aTestID;
85			end;
86
87			function TTest10.GetTestTitle: AnsiString;
88			begin
89			Result := aTestTitle;
90			end;
91
92			procedure TTest10.InitTest;
93			begin
94			ReadWriteTransaction;
95			IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
96			IBDatabase.CreateIfNotExists := true;
97			end;
98
99			procedure TTest10.InitialiseDatabase(aDatabase: TIBDatabase);
100			begin
101			IBXScriptObj.StopOnFirstError := false;
102			inherited InitialiseDatabase(aDatabase);
103			end;
104
105			procedure TTest10.RunTest(CharSet: AnsiString; SQLDialect: integer);
106			begin
107			IBDatabase.Connected := true;
108			writeln(OutFile);
109			writeln(OutFile,'Extracting Database Schema and Data');
110			FExtract.ExtractObject(eoDatabase,'',[etData,etGrantsToUser]);
111			WriteStrings(FExtract.Items);
112			FExtract.Items.SaveToFile(GetOutFile);
113			writeln(OutFile,'Schema written to ',GetOutFile);
114			IBDatabase.DropDatabase;
115			end;
116
117			initialization
118			RegisterTest(TTest10);
119
120			end.
121