ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/Test7.pas
Revision: 315
Committed: Thu Feb 25 11:56:36 2021 UTC (3 years, 1 month ago) by tony
Content type: text/x-pascal
File size: 6364 byte(s)
Log Message:
Updated for IBX 4 release

File Contents

# Content
1 (*
2 * Firebird Interface (fbintf) Test suite. This program is used to
3 * test the Firebird Pascal Interface and provide a semi-automated
4 * pass/fail check for each test.
5 *
6 * The contents of this file are subject to the Initial Developer's
7 * Public License Version 1.0 (the "License"); you may not use this
8 * file except in compliance with the License. You may obtain a copy
9 * of the License here:
10 *
11 * http://www.firebirdsql.org/index.php?op=doc&id=idpl
12 *
13 * Software distributed under the License is distributed on an "AS
14 * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
15 * implied. See the License for the specific language governing rights
16 * and limitations under the License.
17 *
18 * The Initial Developer of the Original Code is Tony Whyman.
19 *
20 * The Original Code is (C) 2016 Tony Whyman, MWA Software
21 * (http://www.mwasoftware.co.uk).
22 *
23 * All Rights Reserved.
24 *
25 * Contributor(s): ______________________________________.
26 *
27 *)
28
29 unit Test7;
30 {$IFDEF MSWINDOWS}
31 {$DEFINE WINDOWS}
32 {$ENDIF}
33
34 {$IFDEF FPC}
35 {$mode delphi}
36 {$codepage utf8}
37 {$ENDIF}
38
39 {Test 7: Create and read back an Array}
40
41 {
42 1. Create an empty database and populate with a single table including an array of integer column.
43
44 2. Select all and show metadata including array metadata.
45
46 3. Insert a row but leave array null
47
48 4. Show result.
49
50 5. Update row with a populated array and show results.
51
52 7. Reopen cursor but before fetching array, shrink bounds
53
54 8. Fetch and print array with reduced bounds.
55
56 }
57
58 interface
59
60 uses
61 Classes, SysUtils, TestApplication, FBTestApp, IB;
62
63 type
64
65 { TTest7 }
66
67 TTest7 = class(TFBTestBase)
68 private
69 procedure UpdateDatabase(Attachment: IAttachment);
70 public
71 function TestTitle: AnsiString; override;
72 procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
73 end;
74
75 implementation
76
77 const
78 sqlCreateTable =
79 'Create Table TestData ('+
80 'RowID Integer not null,'+
81 'Title VarChar(32) Character Set UTF8,'+
82 'Dated TIMESTAMP, '+
83 'Notes VarChar(64) Character Set ISO8859_1,'+
84 'MyArray Integer [0:16],'+
85 'MyArray2 Timestamp [0:16],'+
86 'MyArray3 Numeric(10,2) [0:16],'+
87 'Primary Key(RowID)'+
88 ')';
89
90 sqlInsert = 'Insert into TestData(RowID,Title,Dated,Notes) Values(:RowID,:Title,:Dated,:Notes)';
91
92 sqlUpdate = 'Update TestData Set MyArray = :MyArray Where RowID = 1';
93 sqlUpdate2 = 'Update TestData Set MyArray2 = :MyArray2 Where RowID = 1';
94 sqlUpdate3 = 'Update TestData Set MyArray3 = :MyArray3 Where RowID = 1';
95
96 { TTest7 }
97
98 procedure TTest7.UpdateDatabase(Attachment: IAttachment);
99 var Transaction: ITransaction;
100 Statement: IStatement;
101 ResultSet: IResultSet;
102 i,j: integer;
103 ar: IArray;
104 aDateTime: TDateTime;
105 f: double;
106 begin
107 Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
108 Statement := Attachment.Prepare(Transaction,'Select * from TestData');
109 PrintMetaData(Statement.GetMetaData);
110 Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
111 ParamInfo(Statement.GetSQLParams);
112 with Statement.GetSQLParams do
113 begin
114 for i := 0 to GetCount - 1 do
115 writeln(OutFile,'Param Name = ',Params[i].getName);
116 ByName('rowid').AsInteger := 1;
117 {$IFDEF DCC}
118 ByName('title').AsString := UTF8Encode('Blob Test ©€');
119 {$ELSE}
120 ByName('title').AsString := 'Blob Test ©€';
121 {$ENDIF}
122 ByName('Notes').AsString := 'Écoute moi';
123 ByName('Dated').AsDateTime := EncodeDate(2016,4,1) + EncodeTime(9,30,0,100);
124 end;
125 Statement.Execute;
126 Statement := Attachment.Prepare(Transaction,'Select * from TestData');
127 ReportResults(Statement);
128
129 Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlUpdate);
130 ParamInfo(Statement.GetSQLParams);
131 Transaction.CommitRetaining;
132 ar := Attachment.CreateArray(Transaction,'TestData','MyArray');
133 j := 100;
134 for i := 0 to 16 do
135 begin
136 ar.SetAsInteger([i],j);
137 dec(j);
138 end;
139 Statement.SQLParams[0].AsArray := ar;
140 Statement.Execute;
141
142 Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlUpdate2);
143 ParamInfo(Statement.GetSQLParams);
144 ar := Attachment.CreateArray(Transaction,'TestData','MyArray2');
145 for i := 0 to 16 do
146 begin
147 aDateTime := EncodeDate(2020,5,1) + EncodeTime(12,i,0,0);
148 ar.SetAsDateTime(i,aDateTime);
149 end;
150 Statement.SQLParams[0].AsArray := ar;
151 Statement.Execute;
152
153 Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlUpdate3);
154 ParamInfo(Statement.GetSQLParams);
155 ar := Attachment.CreateArray(Transaction,'TestData','MyArray3');
156 f := 0;
157 for i := 0 to 16 do
158 begin
159 ar.SetAsFloat(i,f);
160 f := f + 1.05
161 end;
162 Statement.SQLParams[0].AsArray := ar;
163 Statement.Execute;
164
165 Statement := Attachment.Prepare(Transaction,'Select * from TestData');
166 PrintMetaData(Statement.GetMetaData);
167 ReportResults(Statement);
168
169 ResultSet := Statement.OpenCursor;
170 if Resultset.FetchNext then
171 begin
172 ar := ResultSet.ByName('MyArray').AsArray;
173 ar.SetBounds(0,10,2);
174 writeln(OutFile,'Shrink to 2:10');
175 WriteArray(ar);
176 end
177 else
178 writeln(OutFile,'Unable to reopen cursor');
179
180 {Now update the reduced slice}
181 writeln(OutFile,'Write updated reduced slice');
182 ar.SetAsInteger([2],1000);
183 Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlUpdate);
184 Statement.SQLParams[0].AsArray := ar;
185 Statement.Execute;
186 writeln(OutFile,'Show update array');
187 Statement := Attachment.Prepare(Transaction,'Select * from TestData');
188 ReportResults(Statement);
189
190 Transaction.Commit;
191 end;
192
193 function TTest7.TestTitle: AnsiString;
194 begin
195 Result := 'Test 7: Create and read back an Array';
196 end;
197
198 procedure TTest7.RunTest(CharSet: AnsiString; SQLDialect: integer);
199 var DPB: IDPB;
200 Attachment: IAttachment;
201 begin
202 DPB := FirebirdAPI.AllocateDPB;
203 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
204 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
205 DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
206 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
207 Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
208 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
209 UpdateDatabase(Attachment);
210
211 Attachment.DropDatabase;
212 end;
213
214 initialization
215 RegisterTest(TTest7);
216
217 end.
218