ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/testsuite/Test20.pas
Revision: 380
Committed: Mon Jan 10 10:13:17 2022 UTC (2 years, 10 months ago) by tony
Content type: text/x-pascal
File size: 7173 byte(s)
Log Message:
propset for eol-style

File Contents

# Content
1 (*
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 unit Test20;
28
29 {$mode objfpc}{$H+}
30
31 {Test 20: TIBUpdateSQL Tests}
32
33 { Description
34 }
35
36 interface
37
38 uses
39 Classes, SysUtils, TestApplication, IBXTestBase, DB, IB,
40 IBCustomDataSet, IBUpdateSQL, IBQuery;
41
42 const
43 aTestID = '20';
44 aTestTitle = 'TIBUpdateSQL Tests';
45
46 type
47
48 { TTest20 }
49
50 TTest20 = class(TIBXTestBase)
51 private
52 FUpdateSQL: TIBUpdateSQL;
53 FUpdateSQL2: TIBUpdateSQL;
54 FIBQuery2: TIBQuery;
55 procedure HandleDeleteReturning(Sender: TObject; QryResults: IResults);
56 protected
57 procedure CreateObjects(Application: TTestApplication); override;
58 function GetTestID: AnsiString; override;
59 function GetTestTitle: AnsiString; override;
60 procedure InitTest; override;
61 public
62 procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
63 end;
64
65
66 implementation
67
68 { TTest20 }
69
70 procedure TTest20.HandleDeleteReturning(Sender: TObject; QryResults: IResults);
71 begin
72 writeln(OutFile,'Delete Returning');
73 ReportResult(QryResults);
74 writeln(OutFile);
75 end;
76
77 procedure TTest20.CreateObjects(Application: TTestApplication);
78 begin
79 inherited CreateObjects(Application);
80 FUpdateSQL := TIBUpdateSQL.Create(Application);
81 with IBQuery do
82 begin
83 UpdateObject := FUpdateSQL;
84 SQL.Add('Select * From IBDataSetTest');
85 GeneratorField.Field := 'KeyField';
86 GeneratorField.Generator := 'AGENERATOR';
87 GeneratorField.Increment := 1;
88 end;
89 with FUpdateSQL do
90 begin
91 InsertSQL.Add('Insert into IBDataSetTest(KeyField,PlainText) Values (:KeyField,:PlainText)');
92 ModifySQL.Add('Update IBDataSetTest Set KeyField = :KeyField, PlainText = :PlainText Where KeyField = :Old_KeyField');
93 DeleteSQL.Add('Delete from IBDataSetTest Where KeyField = :old_KeyField');
94 RefreshSQL.Add('Select * from IBDataSetTest Where KeyField = :KeyField');
95 end;
96 FIBQuery2 := TIBQuery.Create(Application);
97 FUpdateSQL2 := TIBUpdateSQL.Create(Application);
98 with FIBQuery2 do
99 begin
100 Database := IBDatabase;
101 Transaction := IBTransaction;
102 UpdateObject := FUpdateSQL2;
103 SQL.Add('Select * From IBDataSetTest');
104 OnDeleteReturning := @HandleDeleteReturning;
105 end;
106 with FUpdateSQL2 do
107 begin
108 InsertSQL.Add('Insert into IBDataSetTest(KeyField,PlainText) Values (Gen_ID(AGenerator,1),:PlainText) Returning KeyField, TextAndKey');
109 ModifySQL.Add('Update IBDataSetTest Set KeyField = :KeyField, PlainText = :PlainText Where KeyField = :Old_KeyField Returning TextAndKey,ServerSideText');
110 DeleteSQL.Add('Delete from IBDataSetTest Where KeyField = :old_KeyField Returning KeyField');
111 RefreshSQL.Add('Select * from IBDataSetTest Where KeyField = :KeyField');
112 end;
113 end;
114
115 function TTest20.GetTestID: AnsiString;
116 begin
117 Result := aTestID;
118 end;
119
120 function TTest20.GetTestTitle: AnsiString;
121 begin
122 Result := aTestTitle;
123 end;
124
125 procedure TTest20.InitTest;
126 begin
127 IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
128 IBDatabase.CreateIfNotExists := true;
129 ReadWriteTransaction;
130 end;
131
132 procedure TTest20.RunTest(CharSet: AnsiString; SQLDialect: integer);
133 begin
134 IBDatabase.CreateDatabase;
135 try
136 IBTransaction.Active := true;
137 with IBQuery do
138 begin
139 Active := true;
140 writeln(OutFile,'Simple Append');
141 Append;
142 FieldByName('PlainText').AsString := 'This is a test';
143 Post;
144 PrintDataSetRow(IBQuery);
145 Refresh;
146 writeln(OutFile,'After Refresh');
147 PrintDataSetRow(IBQuery);
148 writeln(OutFile,'Append and Update');
149 Append;
150 FieldByName('PlainText').AsString := 'This is another test';
151 Post;
152 PrintDataSetRow(IBQuery);
153 Edit;
154 FieldByName('PlainText').AsString := 'This is the update test';
155 Post;
156 PrintDataSetRow(IBQuery);
157 writeln(OutFile,'Now delete the first row');
158 PrintDataSet(IBQuery);
159 First;
160 Delete;
161 PrintDataSet(IBQuery);
162 writeln(Outfile,'On Post KeyField Assignment');
163 GeneratorField.ApplyOnEvent := gaeOnPostRecord;
164 Append;
165 FieldByName('PlainText').AsString := 'On Post KeyField test';
166 PrintDataSetRow(IBQuery);
167 Post;
168 writeln(Outfile,'Row data after post');
169 PrintDataSetRow(IBQuery);
170 GeneratorField.ApplyOnEvent := gaeOnNewRecord; {restore}
171 end;
172 IBTransaction.Rollback;
173
174 writeln(Outfile);
175 writeln(Outfile,'Repeat with cached updates');
176 IBTransaction.Active := true;
177 with IBQuery do
178 begin
179 CachedUpdates := true;
180 Active := true;
181 writeln(OutFile,'Simple Append');
182 Append;
183 FieldByName('PlainText').AsString := 'This is a test';
184 Post;
185 PrintDataSetRow(IBQuery);
186 Refresh;
187 writeln(OutFile,'After Refresh');
188 PrintDataSetRow(IBQuery);
189 writeln(OutFile,'Append and Update');
190 Append;
191 FieldByName('PlainText').AsString := 'This is another test';
192 Post;
193 PrintDataSetRow(IBQuery);
194 Edit;
195 FieldByName('PlainText').AsString := 'This is the update test';
196 Post;
197 PrintDataSetRow(IBQuery);
198 writeln(OutFile,'Now delete the first row');
199 PrintDataSet(IBQuery);
200 First;
201 Delete;
202 PrintDataSet(IBQuery);
203 ApplyUpdates;
204 Active := false;
205 Active := true;
206 writeln(Outfile,'close and re-open and print again');
207 PrintDataSet(IBQuery);
208 end;
209 IBTransaction.Active := true;
210 with FIBQuery2 do
211 begin
212 Active := true;
213 writeln(OutFile,'FIBQuery2: Simple Append');
214 Append;
215 FieldByName('PlainText').AsString := 'This is a test';
216 Post;
217 PrintDataSetRow(FIBQuery2);
218 Refresh;
219 writeln(OutFile,'FIBQuery2 Refresh');
220 PrintDataSetRow(FIBQuery2);
221 writeln(OutFile,'Append and Update');
222 Append;
223 FieldByName('PlainText').AsString := 'This is another test';
224 Post;
225 PrintDataSetRow(FIBQuery2);
226 Edit;
227 FieldByName('PlainText').AsString := 'This is the update test';
228 Post;
229 PrintDataSetRow(FIBQuery2);
230 writeln(OutFile,'Now delete the first row');
231 PrintDataSet(FIBQuery2);
232 First;
233 Delete;
234 writeln(Outfile,'Dataset after delete');
235 PrintDataSet(FIBQuery2);
236
237 end;
238 finally
239 IBDatabase.DropDatabase;
240 end;
241 end;
242
243 initialization
244 RegisterTest(TTest20);
245
246 end.
247

Properties

Name Value
svn:eol-style native