ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/testsuite/Test10.pas
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: 3198 byte(s)
Log Message:
Fixed Merged

File Contents

# 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 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 Classes, SysUtils, TestApplication, IBXTestbase, IB, IBExtract, IBDatabase;
38
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