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 Test8; |
30 |
{$IFDEF MSWINDOWS} |
31 |
{$DEFINE WINDOWS} |
32 |
{$ENDIF} |
33 |
|
34 |
{$IFDEF FPC} |
35 |
{$mode delphi} |
36 |
{$codepage utf8} |
37 |
{$ENDIF} |
38 |
|
39 |
{Test 8: Create and read back an Array with 2 dimensions} |
40 |
|
41 |
{ |
42 |
1. Create an empty database and populate with a single table including a two |
43 |
dimensional array of varchar(16) column. |
44 |
|
45 |
2. Select all and show metadata including array metadata. |
46 |
|
47 |
3. Insert a row but leave array null |
48 |
|
49 |
4. Show result. |
50 |
|
51 |
5. Update row with a populated array and show results. |
52 |
} |
53 |
|
54 |
interface |
55 |
|
56 |
uses |
57 |
Classes, SysUtils, TestApplication, FBTestApp, IB; |
58 |
|
59 |
type |
60 |
|
61 |
{ TTest8 } |
62 |
|
63 |
TTest8 = class(TFBTestBase) |
64 |
private |
65 |
procedure UpdateDatabase(Attachment: IAttachment); |
66 |
public |
67 |
function TestTitle: AnsiString; override; |
68 |
procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override; |
69 |
end; |
70 |
|
71 |
implementation |
72 |
|
73 |
const |
74 |
sqlCreateTable = |
75 |
'Create Table TestData ('+ |
76 |
'RowID Integer not null,'+ |
77 |
'Title VarChar(32) Character Set UTF8,'+ |
78 |
'MyArray VarChar(16) [0:16, -1:7] Character Set ISO8859_2,'+ |
79 |
'Primary Key(RowID)'+ |
80 |
')'; |
81 |
|
82 |
sqlInsert = 'Insert into TestData(RowID,Title) Values(:RowID,:Title)'; |
83 |
|
84 |
sqlUpdate = 'Update TestData Set MyArray = ? Where RowID = 1'; |
85 |
|
86 |
{ TTest8 } |
87 |
|
88 |
procedure TTest8.UpdateDatabase(Attachment: IAttachment); |
89 |
var Transaction: ITransaction; |
90 |
Statement: IStatement; |
91 |
i,j,k : integer; |
92 |
ar: IArray; |
93 |
begin |
94 |
Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit); |
95 |
Statement := Attachment.Prepare(Transaction,'Select * from TestData'); |
96 |
PrintMetaData(Statement.GetMetaData); |
97 |
Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert); |
98 |
ParamInfo(Statement.GetSQLParams); |
99 |
with Statement.GetSQLParams do |
100 |
begin |
101 |
ByName('rowid').AsInteger := 1; |
102 |
ByName('title').AsString := '2D Array'; |
103 |
end; |
104 |
Statement.Execute; |
105 |
Statement := Attachment.Prepare(Transaction,'Select * from TestData'); |
106 |
ReportResults(Statement); |
107 |
|
108 |
Statement := Attachment.Prepare(Transaction,sqlUpdate); |
109 |
ar := Attachment.CreateArray(Transaction,'TestData','MyArray'); |
110 |
if ar <> nil then |
111 |
begin |
112 |
k := 50; |
113 |
for i := 0 to 16 do |
114 |
for j := -1 to 7 do |
115 |
begin |
116 |
ar.SetAsString([i,j],'A' + IntToStr(k)); |
117 |
Inc(k); |
118 |
end; |
119 |
Statement.SQLParams[0].AsArray := ar; |
120 |
Statement.Execute; |
121 |
end; |
122 |
Statement := Attachment.Prepare(Transaction,'Select * from TestData'); |
123 |
ReportResults(Statement); |
124 |
end; |
125 |
|
126 |
function TTest8.TestTitle: AnsiString; |
127 |
begin |
128 |
Result := 'Test 8: Create and read back an Array with 2 dimensions'; |
129 |
end; |
130 |
|
131 |
procedure TTest8.RunTest(CharSet: AnsiString; SQLDialect: integer); |
132 |
var DPB: IDPB; |
133 |
Attachment: IAttachment; |
134 |
begin |
135 |
DPB := FirebirdAPI.AllocateDPB; |
136 |
DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName); |
137 |
DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword); |
138 |
DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet); |
139 |
DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect); |
140 |
Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB); |
141 |
Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable); |
142 |
UpdateDatabase(Attachment); |
143 |
|
144 |
Attachment.DropDatabase; |
145 |
end; |
146 |
|
147 |
initialization |
148 |
RegisterTest(TTest8); |
149 |
|
150 |
end. |
151 |
|