ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/testsuite/Test26.pas
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: 3108 byte(s)
Log Message:
Updated for IBX 4 release

File Contents

# User Rev Content
1 tony 315 unit Test26;
2    
3     {$mode objfpc}{$H+}
4    
5     {Test 26: IBXScript data out and exceptional conditions}
6    
7     { Dumps data in CSV, Insert and Table formats + error conditions
8     }
9    
10     interface
11    
12     uses
13     Classes, SysUtils, TestApplication, IBXTestBase, IB,
14     IBXScript, IBDataOutput;
15    
16     const
17     aTestID = '26';
18     aTestTitle = 'IBXScript data out and exceptional conditions';
19    
20     type
21    
22     { TTest26 }
23    
24     TTest26 = class(TIBXTestBase)
25     private
26     FDataOutputCSVFormater: TIBCSVDataOut;
27     FDataOutputSQLFormater: TIBInsertStmtsOut;
28     FDataOutputBlockFormater: TIBBlockFormatOut;
29     procedure HandleOutputLog(Sender: TObject; Msg: string);
30     procedure HandleErrorLog(Sender: TObject; Msg: string);
31     protected
32     procedure CreateObjects(Application: TTestApplication); override;
33     function GetTestID: AnsiString; override;
34     function GetTestTitle: AnsiString; override;
35     procedure InitTest; override;
36     public
37     procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
38     end;
39    
40    
41     implementation
42    
43     const
44     sQuery = 'Select * From PROJECT;';
45     sTestSET = 'Set Blah;' + LINEENDING + 'Select First 2 * from JOB;';
46    
47     { TTest26 }
48    
49     procedure TTest26.HandleOutputLog(Sender: TObject; Msg: string);
50     begin
51     writeln(Outfile,Msg);
52     end;
53    
54     procedure TTest26.HandleErrorLog(Sender: TObject; Msg: string);
55     begin
56     writeln(Outfile,'Script Error: ',Msg);
57     end;
58    
59     procedure TTest26.CreateObjects(Application: TTestApplication);
60     begin
61     inherited CreateObjects(Application);
62     // IBXScriptObj.Echo := false;
63     IBXScriptObj.OnOutputLog := @HandleOutputLog;
64     IBXScriptObj.OnErrorLog := @HandleErrorLog;
65     FDataOutputCSVFormater := TIBCSVDataOut.Create(Application);
66     FDataOutputSQLFormater := TIBInsertStmtsOut.Create(Application);
67     FDataOutputBlockFormater := TIBBlockFormatOut.Create(Application);
68     end;
69    
70     function TTest26.GetTestID: AnsiString;
71     begin
72     Result := aTestID;
73     end;
74    
75     function TTest26.GetTestTitle: AnsiString;
76     begin
77     Result := aTestTitle;
78     end;
79    
80     procedure TTest26.InitTest;
81     begin
82     IBDatabase.DatabaseName := Owner.GetEmployeeDatabaseName;
83     ReadOnlyTransaction;
84     end;
85    
86     procedure TTest26.RunTest(CharSet: AnsiString; SQLDialect: integer);
87     begin
88     IBDatabase.Connected := true;
89     try
90     IBTransaction.Active := true;
91     IBXScriptObj.DataOutputFormatter := FDataOutputCSVFormater;
92     writeln(Outfile,'Dump project table to CSV');
93     IBXScriptObj.ExecSQLScript(sQuery);
94     IBXScriptObj.DataOutputFormatter := FDataOutputSQLFormater;
95     writeln(Outfile,'Dump project table to Insert Statements');
96     IBXScriptObj.ExecSQLScript(sQuery);
97     IBXScriptObj.DataOutputFormatter := FDataOutputBlockFormater;
98     writeln(Outfile,'Dump project table to Data Block Format');
99     IBXScriptObj.ExecSQLScript(sQuery);
100     writeln(Outfile,'Unknown SET statement - stop on first error');
101     IBXScriptObj.StopOnFirstError := true;
102     IBXScriptObj.ExecSQLScript(sTestSET);
103     writeln(Outfile,'Unknown SET statement - continue after error');
104     IBXScriptObj.StopOnFirstError := false;
105     IBXScriptObj.ExecSQLScript(sTestSET);
106     finally
107     IBDatabase.Connected := false;
108     end;
109     end;
110    
111     initialization
112     RegisterTest(TTest26);
113    
114     end.
115