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

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