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, 6 months ago) by tony
Content type: text/x-pascal
File size: 3198 byte(s)
Log Message:
Fixed Merged

File Contents

# 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     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