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, 9 months ago) by tony
Content type:	text/x-pascal
File size:	8086 byte(s)
Log Message:	Fixed Merged
#	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 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