trunk/testsuite/Test18.pas

(*
 *  IBX Test suite. This program is used to test the IBX non-visual
 *  components and provides a semi-automated pass/fail check for each test.
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2021 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)      
unit Test18;

{$mode objfpc}{$H+}

{Test 18: Cached Updates}

{ Description
}

interface

uses
  Classes, SysUtils,   TestApplication, IBXTestBase, Db, IB, IBCustomDataSet;

const
  aTestID    = '18';
  aTestTitle = 'Cached Updates';

type

{ TTest18 }

  TTest18 = class(TIBXTestBase)
  private
    FIBDataset: TIBDataSet;
    procedure HandleUpdateRecord(DataSet: TDataSet; UpdateKind: TUpdateKind;
                                   var UpdateAction: TIBUpdateAction);
    procedure HandleUpdateError(DataSet: TDataSet; E: EDatabaseError;
                                 UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction);
    procedure DoTest(aUnidirectional: boolean);
  protected
    procedure CreateObjects(Application: TTestApplication); override;
    function GetTestID: AnsiString; override;
    function GetTestTitle: AnsiString; override;
    procedure InitTest; override;
  public
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;


implementation

{ TTest18 }

procedure TTest18.HandleUpdateRecord(DataSet: TDataSet;
  UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction);
begin
  writeln(Outfile,'Update Record Called for ',UpdateKind);
  PrintDatasetRow(DataSet);
  UpdateAction := uaApply;
end;

procedure TTest18.HandleUpdateError(DataSet: TDataSet; E: EDatabaseError;
  UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction);
begin
  writeln(Outfile,'Update Error raised: ',E.Message);
  TheUpdateAction := uaFail;
end;

procedure TTest18.DoTest(aUnidirectional: boolean);
var lastkey: integer;
begin
  with FIBDataSet do
  begin
    Unidirectional := aUnidirectional;
    Active := true;
    writeln(Outfile,'Unidirectional caching = ',aUnidirectional);
    writeln(OutFile,'Simple Append i.e. caching of inserted records and cancel');
    if aUnidirectional then Insert else Append;
    FieldByName('PlainText').AsString := 'This is a test';
    Post;
    if aUnidirectional then Insert else Append;
    FieldByName('PlainText').AsString := 'This is another test';
    Post;
    PrintDataSet(FIBDataSet);
    writeln(Outfile,'Cancel Updates');
    CancelUpdates;
    PrintDataSet(FIBDataSet);
    writeln(Outfile,'Now reopen and show empty');
    Active := false;
    Active := true;
    PrintDataSet(FIBDataSet);

    writeln(Outfile);
    writeln(OutFile,'Simple Append i.e. caching of inserted records and apply updates');
    if aUnidirectional then Insert else Append;
    FieldByName('PlainText').AsString := 'This is a test';
    Post;
    if aUnidirectional then Insert else Append;
    FieldByName('PlainText').AsString := 'This is another test';
    Post;
    if aUnidirectional then Insert else Append;
    FieldByName('PlainText').AsString := 'And another';
    Post;
    PrintDataSet(FIBDataSet);
    writeln(Outfile,'Apply Updates');
    ApplyUpdates;
    PrintDataSet(FIBDataSet);
    writeln(Outfile,'Now reopen and show still there');
    Active := false;
    Active := true;
    PrintDataSet(FIBDataSet);

    writeln(OutFile);
    writeln(OutFile,'Update of First and Last records and cancel');
    First;
    Edit;
    FieldByName('PlainText').AsString := 'This is an updated test';
    Post;
    Last;
    Edit;
    FieldByName('PlainText').AsString := 'This is another updated test';
    Post;
    PrintDataSet(FIBDataSet);
    writeln(Outfile,'Cancel Updates');
    CancelUpdates;
    PrintDataSet(FIBDataSet);
    writeln(Outfile,'Now reopen and show no change');
    Active := false;
    Active := true;
    PrintDataSet(FIBDataSet);

    writeln(OutFile);
    writeln(OutFile,'Update of First and Last records and apply');
    First;
    Edit;
    FieldByName('PlainText').AsString := 'This is an updated test';
    Post;
    Last;
    Edit;
    FieldByName('PlainText').AsString := 'This is another updated test';
    Post;
    PrintDataSet(FIBDataSet);
    writeln(Outfile,'Apply Updates');
    ApplyUpdates;
    PrintDataSet(FIBDataSet);
    writeln(Outfile,'Now reopen and show still there');
    Active := false;
    Active := true;
    PrintDataSet(FIBDataSet);

    writeln(OutFile);
    writeln(OutFile,'Update of First and Last records and implicitly apply');
    DataSetCloseAction := dcSaveChanges;
    First;
    Edit;
    FieldByName('PlainText').AsString := 'This is an updated test (implicit apply updates)';
    Active := false;
    Active := true;
    PrintDataSet(FIBDataSet);

    writeln(OutFile);
    writeln(OutFile,'Delete First and Last records and Cancel');
    First;
    Delete;
    Last;
    Delete;
    PrintDataSet(FIBDataSet);
    writeln(Outfile,'Cancel Updates');
    CancelUpdates;
    PrintDataSet(FIBDataSet);
    writeln(Outfile,'Now reopen and show no change');
    Active := false;
    Active := true;
    PrintDataSet(FIBDataSet);

    writeln(OutFile);
    writeln(OutFile,'Delete First and Last records and Apply');
    First;
    Delete;
    Last;
    Delete;
    PrintDataSet(FIBDataSet);
    writeln(Outfile,'Apply Updates');
    ApplyUpdates;
    PrintDataSet(FIBDataSet);
    writeln(Outfile,'Now reopen and show no change');
    Active := false;
    Active := true;
    PrintDataSet(FIBDataSet);

    writeln(OutFile);
    writeln(OutFile, 'Test Error Handling');
    First;
    lastkey := FieldByName('KEYFIELD').AsInteger;
    Append;
    FieldByName('KEYFIELD').AsInteger := lastkey;
    Post;
    PrintDataSet(FIBDataSet);
    try
      ApplyUpdates;
    except on E: Exception do
      writeln(OutFile,'Exception caught: ',E.Message);
    end;
    CancelUpdates;
  end;
end;

procedure TTest18.CreateObjects(Application: TTestApplication);
begin
  inherited CreateObjects(Application);
  FIBDataSet := TIBDataSet.Create(Application);
  with FIBDataSet do
  begin
    Name := 'IBTestData';
    Database := IBDatabase;
    Transaction := IBTransaction;
    SelectSQL.Add('Select * From IBDataSetTest');
    InsertSQL.Add('Insert into IBDataSetTest(KeyField,PlainText) Values (:KeyField,:PlainText)');
    ModifySQL.Add('Update IBDataSetTest Set KeyField = :KeyField, PlainText = :PlainText Where KeyField = :Old_KeyField');
    DeleteSQL.Add('Delete from IBDataSetTest Where KeyField = :old_KeyField');
    RefreshSQL.Add('Select * from IBDataSetTest Where KeyField = :KeyField');
    GeneratorField.Field := 'KeyField';
    GeneratorField.Generator := 'AGENERATOR';
    GeneratorField.Increment := 1;
    CachedUpdates := true;
    OnUpdateRecord := @HandleUpdateRecord;
    OnUpdateError := @HandleUpdateError;
  end;
end;

function TTest18.GetTestID: AnsiString;
begin
  Result := aTestID;
end;

function TTest18.GetTestTitle: AnsiString;
begin
  Result := aTestTitle;
end;

procedure TTest18.InitTest;
begin
  IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
  IBDatabase.CreateIfNotExists := true;
  ReadWriteTransaction;
end;

procedure TTest18.RunTest(CharSet: AnsiString; SQLDialect: integer);
begin
  IBDatabase.CreateDatabase;
  try
    IBTransaction.Active := true;
    DoTest(false);
//    DoTest(true); {See https://bugs.freepascal.org/view.php?id=37900}
  finally
    IBDatabase.DropDatabase;
  end;
end;

initialization
  RegisterTest(TTest18);

end.

Revision:	323
Committed:	Thu Feb 25 12:14:35 2021 UTC (3 years, 8 months ago) by tony
Content type:	text/x-pascal
File size:	8086 byte(s)
Log Message:	Fixed Merged
#	User	Rev	Content
1	tony	323	(*
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	tony	315	unit Test18;
28
29			{$mode objfpc}{$H+}
30
31			{Test 18: Cached Updates}
32
33			{ Description
34			}
35
36			interface
37
38			uses
39			Classes, SysUtils, TestApplication, IBXTestBase, Db, IB, IBCustomDataSet;
40
41			const
42			aTestID = '18';
43			aTestTitle = 'Cached Updates';
44
45			type
46
47			{ TTest18 }
48
49			TTest18 = class(TIBXTestBase)
50			private
51			FIBDataset: TIBDataSet;
52			procedure HandleUpdateRecord(DataSet: TDataSet; UpdateKind: TUpdateKind;
53			var UpdateAction: TIBUpdateAction);
54			procedure HandleUpdateError(DataSet: TDataSet; E: EDatabaseError;
55			UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction);
56			procedure DoTest(aUnidirectional: boolean);
57			protected
58			procedure CreateObjects(Application: TTestApplication); override;
59			function GetTestID: AnsiString; override;
60			function GetTestTitle: AnsiString; override;
61			procedure InitTest; override;
62			public
63			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
64			end;
65
66
67			implementation
68
69			{ TTest18 }
70
71			procedure TTest18.HandleUpdateRecord(DataSet: TDataSet;
72			UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction);
73			begin
74			writeln(Outfile,'Update Record Called for ',UpdateKind);
75			PrintDatasetRow(DataSet);
76			UpdateAction := uaApply;
77			end;
78
79			procedure TTest18.HandleUpdateError(DataSet: TDataSet; E: EDatabaseError;
80			UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction);
81			begin
82			writeln(Outfile,'Update Error raised: ',E.Message);
83			TheUpdateAction := uaFail;
84			end;
85
86			procedure TTest18.DoTest(aUnidirectional: boolean);
87			var lastkey: integer;
88			begin
89			with FIBDataSet do
90			begin
91			Unidirectional := aUnidirectional;
92			Active := true;
93			writeln(Outfile,'Unidirectional caching = ',aUnidirectional);
94			writeln(OutFile,'Simple Append i.e. caching of inserted records and cancel');
95			if aUnidirectional then Insert else Append;
96			FieldByName('PlainText').AsString := 'This is a test';
97			Post;
98			if aUnidirectional then Insert else Append;
99			FieldByName('PlainText').AsString := 'This is another test';
100			Post;
101			PrintDataSet(FIBDataSet);
102			writeln(Outfile,'Cancel Updates');
103			CancelUpdates;
104			PrintDataSet(FIBDataSet);
105			writeln(Outfile,'Now reopen and show empty');
106			Active := false;
107			Active := true;
108			PrintDataSet(FIBDataSet);
109
110			writeln(Outfile);
111			writeln(OutFile,'Simple Append i.e. caching of inserted records and apply updates');
112			if aUnidirectional then Insert else Append;
113			FieldByName('PlainText').AsString := 'This is a test';
114			Post;
115			if aUnidirectional then Insert else Append;
116			FieldByName('PlainText').AsString := 'This is another test';
117			Post;
118			if aUnidirectional then Insert else Append;
119			FieldByName('PlainText').AsString := 'And another';
120			Post;
121			PrintDataSet(FIBDataSet);
122			writeln(Outfile,'Apply Updates');
123			ApplyUpdates;
124			PrintDataSet(FIBDataSet);
125			writeln(Outfile,'Now reopen and show still there');
126			Active := false;
127			Active := true;
128			PrintDataSet(FIBDataSet);
129
130			writeln(OutFile);
131			writeln(OutFile,'Update of First and Last records and cancel');
132			First;
133			Edit;
134			FieldByName('PlainText').AsString := 'This is an updated test';
135			Post;
136			Last;
137			Edit;
138			FieldByName('PlainText').AsString := 'This is another updated test';
139			Post;
140			PrintDataSet(FIBDataSet);
141			writeln(Outfile,'Cancel Updates');
142			CancelUpdates;
143			PrintDataSet(FIBDataSet);
144			writeln(Outfile,'Now reopen and show no change');
145			Active := false;
146			Active := true;
147			PrintDataSet(FIBDataSet);
148
149			writeln(OutFile);
150			writeln(OutFile,'Update of First and Last records and apply');
151			First;
152			Edit;
153			FieldByName('PlainText').AsString := 'This is an updated test';
154			Post;
155			Last;
156			Edit;
157			FieldByName('PlainText').AsString := 'This is another updated test';
158			Post;
159			PrintDataSet(FIBDataSet);
160			writeln(Outfile,'Apply Updates');
161			ApplyUpdates;
162			PrintDataSet(FIBDataSet);
163			writeln(Outfile,'Now reopen and show still there');
164			Active := false;
165			Active := true;
166			PrintDataSet(FIBDataSet);
167
168			writeln(OutFile);
169			writeln(OutFile,'Update of First and Last records and implicitly apply');
170			DataSetCloseAction := dcSaveChanges;
171			First;
172			Edit;
173			FieldByName('PlainText').AsString := 'This is an updated test (implicit apply updates)';
174			Active := false;
175			Active := true;
176			PrintDataSet(FIBDataSet);
177
178			writeln(OutFile);
179			writeln(OutFile,'Delete First and Last records and Cancel');
180			First;
181			Delete;
182			Last;
183			Delete;
184			PrintDataSet(FIBDataSet);
185			writeln(Outfile,'Cancel Updates');
186			CancelUpdates;
187			PrintDataSet(FIBDataSet);
188			writeln(Outfile,'Now reopen and show no change');
189			Active := false;
190			Active := true;
191			PrintDataSet(FIBDataSet);
192
193			writeln(OutFile);
194			writeln(OutFile,'Delete First and Last records and Apply');
195			First;
196			Delete;
197			Last;
198			Delete;
199			PrintDataSet(FIBDataSet);
200			writeln(Outfile,'Apply Updates');
201			ApplyUpdates;
202			PrintDataSet(FIBDataSet);
203			writeln(Outfile,'Now reopen and show no change');
204			Active := false;
205			Active := true;
206			PrintDataSet(FIBDataSet);
207
208			writeln(OutFile);
209			writeln(OutFile, 'Test Error Handling');
210			First;
211			lastkey := FieldByName('KEYFIELD').AsInteger;
212			Append;
213			FieldByName('KEYFIELD').AsInteger := lastkey;
214			Post;
215			PrintDataSet(FIBDataSet);
216			try
217			ApplyUpdates;
218			except on E: Exception do
219			writeln(OutFile,'Exception caught: ',E.Message);
220			end;
221			CancelUpdates;
222			end;
223			end;
224
225			procedure TTest18.CreateObjects(Application: TTestApplication);
226			begin
227			inherited CreateObjects(Application);
228			FIBDataSet := TIBDataSet.Create(Application);
229			with FIBDataSet do
230			begin
231			Name := 'IBTestData';
232			Database := IBDatabase;
233			Transaction := IBTransaction;
234			SelectSQL.Add('Select * From IBDataSetTest');
235			InsertSQL.Add('Insert into IBDataSetTest(KeyField,PlainText) Values (:KeyField,:PlainText)');
236			ModifySQL.Add('Update IBDataSetTest Set KeyField = :KeyField, PlainText = :PlainText Where KeyField = :Old_KeyField');
237			DeleteSQL.Add('Delete from IBDataSetTest Where KeyField = :old_KeyField');
238			RefreshSQL.Add('Select * from IBDataSetTest Where KeyField = :KeyField');
239			GeneratorField.Field := 'KeyField';
240			GeneratorField.Generator := 'AGENERATOR';
241			GeneratorField.Increment := 1;
242			CachedUpdates := true;
243			OnUpdateRecord := @HandleUpdateRecord;
244			OnUpdateError := @HandleUpdateError;
245			end;
246			end;
247
248			function TTest18.GetTestID: AnsiString;
249			begin
250			Result := aTestID;
251			end;
252
253			function TTest18.GetTestTitle: AnsiString;
254			begin
255			Result := aTestTitle;
256			end;
257
258			procedure TTest18.InitTest;
259			begin
260			IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
261			IBDatabase.CreateIfNotExists := true;
262			ReadWriteTransaction;
263			end;
264
265			procedure TTest18.RunTest(CharSet: AnsiString; SQLDialect: integer);
266			begin
267			IBDatabase.CreateDatabase;
268			try
269			IBTransaction.Active := true;
270			DoTest(false);
271			// DoTest(true); {See https://bugs.freepascal.org/view.php?id=37900}
272			finally
273			IBDatabase.DropDatabase;
274			end;
275			end;
276
277			initialization
278			RegisterTest(TTest18);
279
280			end.
281