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

File Contents

# User Rev Content
1 tony 315 unit Test17;
2    
3     {$mode objfpc}{$H+}
4    
5     {Test 17: TIBDataSet Tests}
6    
7     { Description
8    
9     TIBDataset Insert/Update/Delete tests.
10     }
11    
12     interface
13    
14     uses
15     Classes, SysUtils, TestApplication, IBXTestBase, DB, IB, IBCustomDataSet;
16    
17     const
18     aTestID = '17';
19     aTestTitle = 'TIBDataset Tests';
20    
21     type
22    
23     { TTest1 }
24    
25     { TTest17 }
26    
27     TTest17 = class(TIBXTestBase)
28     private
29     FIBDataSet1: TIBDataSet;
30     FIBDataSet2: TIBDataSet;
31     procedure HandleDeleteReturning(Sender: TObject; QryResults: IResults);
32     procedure HandleBeforeOpen(DataSet: TDataSet);
33     procedure HandleAfterOpen(DataSet: TDataSet);
34     procedure HandleBeforeClose(DataSet: TDataSet);
35     procedure HandleAfterClose(DataSet: TDataSet);
36     procedure HandleBeforeInsert(DataSet: TDataSet);
37     procedure HandleAfterInsert(DataSet: TDataSet);
38     procedure HandleBeforeEdit(DataSet: TDataSet);
39     procedure HandleAfterEdit(DataSet: TDataSet);
40     procedure HandleBeforePost(DataSet: TDataSet);
41     procedure HandleAfterPost(DataSet: TDataSet);
42     procedure HandleBeforeCancel(DataSet: TDataSet);
43     procedure HandleAfterCancel(DataSet: TDataSet);
44     procedure HandleBeforeDelete(DataSet: TDataSet);
45     procedure HandleAfterDelete(DataSet: TDataSet);
46     procedure HandleBeforeScroll(DataSet: TDataSet);
47     procedure HandleAfterScroll(DataSet: TDataSet);
48     procedure HandleBeforeRefresh(DataSet: TDataSet);
49     procedure HandleAfterRefresh(DataSet: TDataSet);
50     procedure ValidatePostOK(Sender: TObject; var CancelPost: boolean);
51     procedure ValidatePostCancel(Sender: TObject; var CancelPost: boolean);
52     procedure HandlePostError(DataSet: TDataSet; E: EDatabaseError;
53     var DataAction: TDataAction);
54     protected
55     procedure CreateObjects(Application: TTestApplication); override;
56     function GetTestID: AnsiString; override;
57     function GetTestTitle: AnsiString; override;
58     procedure InitTest; override;
59     public
60     procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
61     end;
62    
63    
64     implementation
65    
66     { TTest17 }
67    
68     procedure TTest17.HandleDeleteReturning(Sender: TObject; QryResults: IResults);
69     begin
70     writeln(OutFile,'Delete Returning');
71     ReportResult(QryResults);
72     writeln(OutFile);
73     end;
74    
75     procedure TTest17.HandleBeforeOpen(DataSet: TDataSet);
76     Begin
77     writeln(Outfile,'Dataset Event BeforeOpen: State = ',DataSet.State);
78     end;
79     procedure TTest17.HandleAfterOpen(DataSet: TDataSet);
80     Begin
81     writeln(Outfile,'Dataset Event AfterOpen: State = ',DataSet.State);
82     end;
83     procedure TTest17.HandleBeforeClose(DataSet: TDataSet);
84     Begin
85     writeln(Outfile,'Dataset Event BeforeClose: State = ',DataSet.State);
86     end;
87     procedure TTest17.HandleAfterClose(DataSet: TDataSet);
88     Begin
89     writeln(Outfile,'Dataset Event AfterClose: State = ',DataSet.State);
90     end;
91     procedure TTest17.HandleBeforeInsert(DataSet: TDataSet);
92     Begin
93     writeln(Outfile,'Dataset Event BeforeInsert: State = ',DataSet.State);
94     end;
95     procedure TTest17.HandleAfterInsert(DataSet: TDataSet);
96     Begin
97     writeln(Outfile,'Dataset Event AfterInsert: State = ',DataSet.State);
98     end;
99     procedure TTest17.HandleBeforeEdit(DataSet: TDataSet);
100     Begin
101     writeln(Outfile,'Dataset Event BeforeEdit: State = ',DataSet.State);
102     end;
103     procedure TTest17.HandleAfterEdit(DataSet: TDataSet);
104     Begin
105     writeln(Outfile,'Dataset Event AfterEdit: State = ',DataSet.State);
106     end;
107     procedure TTest17.HandleBeforePost(DataSet: TDataSet);
108     Begin
109     writeln(Outfile,'Dataset Event BeforePost: State = ',DataSet.State);
110     end;
111     procedure TTest17.HandleAfterPost(DataSet: TDataSet);
112     Begin
113     writeln(Outfile,'Dataset Event AfterPost: State = ',DataSet.State);
114     end;
115     procedure TTest17.HandleBeforeCancel(DataSet: TDataSet);
116     Begin
117     writeln(Outfile,'Dataset Event BeforeCancel: State = ',DataSet.State);
118     end;
119     procedure TTest17.HandleAfterCancel(DataSet: TDataSet);
120     Begin
121     writeln(Outfile,'Dataset Event AfterCancel: State = ',DataSet.State);
122     end;
123     procedure TTest17.HandleBeforeDelete(DataSet: TDataSet);
124     Begin
125     writeln(Outfile,'Dataset Event BeforeDelete: State = ',DataSet.State);
126     end;
127     procedure TTest17.HandleAfterDelete(DataSet: TDataSet);
128     Begin
129     writeln(Outfile,'Dataset Event AfterDelete: State = ',DataSet.State);
130     end;
131     procedure TTest17.HandleBeforeScroll(DataSet: TDataSet);
132     Begin
133     writeln(Outfile,'Dataset Event BeforeScroll: State = ',DataSet.State);
134     end;
135     procedure TTest17.HandleAfterScroll(DataSet: TDataSet);
136     Begin
137     writeln(Outfile,'Dataset Event AfterScroll: State = ',DataSet.State);
138     end;
139     procedure TTest17.HandleBeforeRefresh(DataSet: TDataSet);
140     Begin
141     writeln(Outfile,'Dataset Event BeforeRefresh: State = ',DataSet.State);
142     end;
143     procedure TTest17.HandleAfterRefresh(DataSet: TDataSet);
144     Begin
145     writeln(Outfile,'Dataset Event AfterRefresh: State = ',DataSet.State);
146     end;
147    
148     procedure TTest17.ValidatePostOK(Sender: TObject; var CancelPost: boolean);
149     begin
150     writeln(Outfile,'Validate Post OK called');
151     CancelPost := false;
152     end;
153    
154     procedure TTest17.ValidatePostCancel(Sender: TObject; var CancelPost: boolean);
155     begin
156     writeln(Outfile,'Validate Post Cancel called');
157     CancelPost := true;
158     end;
159    
160     procedure TTest17.HandlePostError(DataSet: TDataSet; E: EDatabaseError;
161     var DataAction: TDataAction);
162     begin
163     writeln(Outfile,'Post Error Called: ',E.Message);
164     DataAction := daFail;
165     end;
166    
167     procedure TTest17.CreateObjects(Application: TTestApplication);
168     begin
169     inherited CreateObjects(Application);
170     FIBDataSet1 := TIBDataSet.Create(Application);
171     with FIBDataSet1 do
172     begin
173     Database := IBDatabase;
174     Transaction := IBTransaction;
175     Unidirectional := false;
176     SelectSQL.Add('Select * From IBDataSetTest');
177     InsertSQL.Add('Insert into IBDataSetTest(KeyField,PlainText) Values (:KeyField,:PlainText)');
178     ModifySQL.Add('Update IBDataSetTest Set KeyField = :KeyField, PlainText = :PlainText Where KeyField = :Old_KeyField');
179     DeleteSQL.Add('Delete from IBDataSetTest Where KeyField = :old_KeyField');
180     RefreshSQL.Add('Select * from IBDataSetTest Where KeyField = :KeyField');
181     GeneratorField.Field := 'KeyField';
182     GeneratorField.Generator := 'AGENERATOR';
183     GeneratorField.Increment := 1;
184     OnPostError := @HandlePostError;
185     end;
186     FIBDataSet2 := TIBDataSet.Create(Application);
187     with FIBDataSet2 do
188     begin
189     Database := IBDatabase;
190     Transaction := IBTransaction;
191     Unidirectional := false;
192     SelectSQL.Add('Select * From IBDataSetTest');
193     InsertSQL.Add('Insert into IBDataSetTest(KeyField,PlainText) Values (Gen_ID(AGenerator,1),:PlainText) Returning KeyField, TextAndKey');
194     ModifySQL.Add('Update IBDataSetTest Set KeyField = :KeyField, PlainText = :PlainText Where KeyField = :Old_KeyField Returning TextAndKey,ServerSideText');
195     DeleteSQL.Add('Delete from IBDataSetTest Where KeyField = :old_KeyField Returning KeyField');
196     RefreshSQL.Add('Select * from IBDataSetTest Where KeyField = :KeyField');
197     OnDeleteReturning := @HandleDeleteReturning;
198     BeforeOpen := @HandleBeforeOpen;
199     AfterOpen := @HandleAfterOpen;
200     BeforeClose := @HandleBeforeClose;
201     AfterClose := @HandleAfterClose;
202     BeforeInsert := @HandleBeforeInsert;
203     AfterInsert := @HandleAfterInsert;
204     BeforeEdit := @HandleBeforeEdit;
205     AfterEdit := @HandleAfterEdit;
206     BeforePost := @HandleBeforePost;
207     AfterPost := @HandleAfterPost;
208     BeforeCancel := @HandleBeforeCancel;
209     AfterCancel := @HandleAfterCancel;
210     BeforeDelete := @HandleBeforeDelete;
211     AfterDelete := @HandleAfterDelete;
212     BeforeScroll := @HandleBeforeScroll;
213     AfterScroll := @HandleAfterScroll;
214     BeforeRefresh := @HandleBeforeRefresh;
215     AfterRefresh := @HandleAfterRefresh;
216     end;
217     end;
218    
219     function TTest17.GetTestID: AnsiString;
220     begin
221     Result := aTestID;
222     end;
223    
224     function TTest17.GetTestTitle: AnsiString;
225     begin
226     Result := aTestTitle;
227     end;
228    
229     procedure TTest17.InitTest;
230     begin
231     IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
232     IBDatabase.CreateIfNotExists := true;
233     ReadWriteTransaction;
234     end;
235    
236     procedure TTest17.RunTest(CharSet: AnsiString; SQLDialect: integer);
237     var lastKey: integer;
238     begin
239     IBDatabase.CreateDatabase;
240     try
241     IBTransaction.Active := true;
242     with FIBDataSet1 do
243     begin
244     Active := true;
245     writeln(OutFile,'FIBDataSet1: Simple Append');
246     Append;
247     // writeln(outfile,'BOF = ',BOF,', EOF = ',EOF);
248     FieldByName('PlainText').AsString := 'This is a test';
249     Post;
250     PrintDataSetRow(FIBDataSet1);
251     Refresh;
252     writeln(OutFile,'After Refresh');
253     PrintDataSetRow(FIBDataSet1);
254     writeln(OutFile,'Append and Update');
255     Append;
256     FieldByName('PlainText').AsString := 'This is another test';
257     Post;
258     PrintDataSetRow(FIBDataSet1);
259     Edit;
260     FieldByName('PlainText').AsString := 'This is the update test';
261     Post;
262     PrintDataSetRow(FIBDataSet1);
263     writeln(OutFile,'Now delete the first row');
264     PrintDataSet(FIBDataSet1);
265     First;
266     Delete;
267     PrintDataSet(FIBDataSet1);
268     writeln(Outfile,'On Post KeyField Assignment');
269     FIBDataSet1.GeneratorField.ApplyOnEvent := gaeOnPostRecord;
270     Append;
271     FieldByName('PlainText').AsString := 'On Post KeyField test';
272     PrintDataSetRow(FIBDataSet1);
273     Post;
274     writeln(Outfile,'Row data after post');
275     PrintDataSetRow(FIBDataSet1);
276     FIBDataSet1.GeneratorField.ApplyOnEvent := gaeOnNewRecord; {restore}
277    
278     writeln(Outfile,'Catch a Post Error - duplicate key');
279     lastkey := FieldByName('KeyField').AsInteger;
280     Append;
281     FieldByName('KeyField').AsInteger := lastkey;
282     FieldByName('PlainText').AsString := 'On Post Error test';
283     try
284     Post;
285     except on E: Exception do
286     writeln(Outfile,'Exception handled: ',E.Message);
287     end;
288    
289     IBTransaction.Rollback;
290     IBTransaction.Active := true;
291     DataSetCloseAction := dcSaveChanges;
292     Active := true;
293     writeln(OutFile,'FIBDataSet1: Simple Append with automatic posting on close');
294     Append;
295     FieldByName('PlainText').AsString := 'This is a test';
296     Active := false;
297     Active := true;
298     PrintDataSet(FIBDataSet1);
299    
300     IBTransaction.Rollback;
301     IBTransaction.Active := true;
302     DataSetCloseAction := dcDiscardChanges;
303     Active := true;
304     writeln(OutFile,'FIBDataSet1: Simple Append with discard on close');
305     Append;
306     FieldByName('PlainText').AsString := 'This is a test';
307     Active := false;
308     Active := true;
309     PrintDataSet(FIBDataSet1);
310    
311     {See https://bugs.freepascal.org/view.php?id=37900}
312    
313     (* IBTransaction.Rollback;
314     IBTransaction.Active := true;
315     writeln(Outfile);
316     writeln(Outfile,'Unidirectional editing');
317     Unidirectional := true;
318     Active := true;
319     writeln(OutFile,'FIBDataSet1: Simple Append - unidirectional');
320     Insert;
321     writeln(outfile,'BOF = ',BOF,', EOF = ',EOF);
322     FieldByName('PlainText').AsString := 'This is a test - unidirectional';
323     PrintDataSetRow(FIBDataSet1);
324     Post;
325     writeln(outfile,'BOF = ',BOF,', EOF = ',EOF);
326     PrintDataSetRow(FIBDataSet1);
327     Refresh;
328     writeln(OutFile,'After Refresh - unidirectional');
329     PrintDataSetRow(FIBDataSet1);
330     writeln(OutFile,'Append and Update');
331     Insert;
332     FieldByName('PlainText').AsString := 'This is another test - unidirectional';
333     Post;
334     PrintDataSetRow(FIBDataSet1);
335     Edit;
336     FieldByName('PlainText').AsString := 'This is the update test - unidirectional';
337     Post;
338     PrintDataSetRow(FIBDataSet1);
339     writeln(OutFile,'Now delete the first row - unidirectional');
340     PrintDataSet(FIBDataSet1);
341     First;
342     Delete;
343     PrintDataSet(FIBDataSet1);
344     writeln(Outfile,'Ensure dataset saved to database');
345     Active := false;
346     Active := true;
347     PrintDataSet(FIBDataSet1); *)
348    
349     end;
350     writeln(Outfile,'==================================');
351     IBTransaction.Rollback;
352     IBTransaction.Active := true;
353     with FIBDataSet2 do
354     begin
355     Active := true;
356     writeln(OutFile,'FIBDataSet2: Simple Append');
357     Append;
358     FieldByName('PlainText').AsString := 'This is a test';
359     Post;
360     PrintDataSetRow(FIBDataSet2);
361     Refresh;
362     writeln(OutFile,'After Refresh');
363     PrintDataSetRow(FIBDataSet2);
364     writeln(OutFile,'Append and Update');
365     Append;
366     FieldByName('PlainText').AsString := 'This is another test';
367     Post;
368     PrintDataSetRow(FIBDataSet2);
369     Edit;
370     FieldByName('PlainText').AsString := 'This is the update test';
371     Post;
372     PrintDataSetRow(FIBDataSet2);
373     writeln(OutFile,'Now delete the first row');
374     PrintDataSet(FIBDataSet2);
375     First;
376     Delete;
377     PrintDataSet(FIBDataSet2);
378     OnValidatePost := @ValidatePostOK;
379     writeln(Outfile,'Validate Post OK');
380     Append;
381     FieldByName('PlainText').AsString := 'This is a validated Post';
382     Post;
383     PrintDataSetRow(FIBDataSet2);
384     OnValidatePost := @ValidatePostCancel;
385     writeln(Outfile,'Validate Post Cancel');
386     Append;
387     FieldByName('PlainText').AsString := 'This is a validated Post which should have been cancelled';
388     Post;
389     PrintDataSetRow(FIBDataSet2);
390     OnValidatePost := nil;
391     writeln(OutFile,'FIBDataSet2: Simple Append with Forced Refresh');
392     ForcedRefresh := true;
393     Append;
394     FieldByName('PlainText').AsString := 'This is a test';
395     Post;
396     PrintDataSetRow(FIBDataSet2);
397    
398     end;
399     finally
400     IBDatabase.DropDatabase;
401     end;
402     end;
403    
404     initialization
405     RegisterTest(TTest17);
406    
407     end.
408