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;
    PrintDataSet(FIBDataSet);
    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
      begin
        writeln(OutFile,'Exception caught: ',E.Message);
      end;
    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:	410
Committed:	Thu Jun 22 13:52:39 2023 UTC (10 months, 1 week ago) by tony
Content type:	text/x-pascal
File size:	8141 byte(s)
Log Message:	Release 2.6.0 beta
#	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	PrintDataSet(FIBDataSet);
94	writeln(Outfile,'Unidirectional caching = ',aUnidirectional);
95	writeln(OutFile,'Simple Append i.e. caching of inserted records and cancel');
96	if aUnidirectional then Insert else Append;
97	FieldByName('PlainText').AsString := 'This is a test';
98	Post;
99	if aUnidirectional then Insert else Append;
100	FieldByName('PlainText').AsString := 'This is another test';
101	Post;
102	PrintDataSet(FIBDataSet);
103	writeln(Outfile,'Cancel Updates');
104	CancelUpdates;
105	PrintDataSet(FIBDataSet);
106	writeln(Outfile,'Now reopen and show empty');
107	Active := false;
108	Active := true;
109	PrintDataSet(FIBDataSet);
110
111	writeln(Outfile);
112	writeln(OutFile,'Simple Append i.e. caching of inserted records and apply updates');
113	if aUnidirectional then Insert else Append;
114	FieldByName('PlainText').AsString := 'This is a test';
115	Post;
116	if aUnidirectional then Insert else Append;
117	FieldByName('PlainText').AsString := 'This is another test';
118	Post;
119	if aUnidirectional then Insert else Append;
120	FieldByName('PlainText').AsString := 'And another';
121	Post;
122	PrintDataSet(FIBDataSet);
123	writeln(Outfile,'Apply Updates');
124	ApplyUpdates;
125	PrintDataSet(FIBDataSet);
126	writeln(Outfile,'Now reopen and show still there');
127	Active := false;
128	Active := true;
129	PrintDataSet(FIBDataSet);
130
131	writeln(OutFile);
132	writeln(OutFile,'Update of First and Last records and cancel');
133	First;
134	Edit;
135	FieldByName('PlainText').AsString := 'This is an updated test';
136	Post;
137	Last;
138	Edit;
139	FieldByName('PlainText').AsString := 'This is another updated test';
140	Post;
141	PrintDataSet(FIBDataSet);
142	writeln(Outfile,'Cancel Updates');
143	CancelUpdates;
144	PrintDataSet(FIBDataSet);
145	writeln(Outfile,'Now reopen and show no change');
146	Active := false;
147	Active := true;
148	PrintDataSet(FIBDataSet);
149
150	writeln(OutFile);
151	writeln(OutFile,'Update of First and Last records and apply');
152	First;
153	Edit;
154	FieldByName('PlainText').AsString := 'This is an updated test';
155	Post;
156	Last;
157	Edit;
158	FieldByName('PlainText').AsString := 'This is another updated test';
159	Post;
160	PrintDataSet(FIBDataSet);
161	writeln(Outfile,'Apply Updates');
162	ApplyUpdates;
163	PrintDataSet(FIBDataSet);
164	writeln(Outfile,'Now reopen and show still there');
165	Active := false;
166	Active := true;
167	PrintDataSet(FIBDataSet);
168
169	writeln(OutFile);
170	writeln(OutFile,'Update of First and Last records and implicitly apply');
171	DataSetCloseAction := dcSaveChanges;
172	First;
173	Edit;
174	FieldByName('PlainText').AsString := 'This is an updated test (implicit apply updates)';
175	Active := false;
176	Active := true;
177	PrintDataSet(FIBDataSet);
178
179	writeln(OutFile);
180	writeln(OutFile,'Delete First and Last records and Cancel');
181	First;
182	Delete;
183	Last;
184	Delete;
185	PrintDataSet(FIBDataSet);
186	writeln(Outfile,'Cancel Updates');
187	CancelUpdates;
188	PrintDataSet(FIBDataSet);
189	writeln(Outfile,'Now reopen and show no change');
190	Active := false;
191	Active := true;
192	PrintDataSet(FIBDataSet);
193
194	writeln(OutFile);
195	writeln(OutFile,'Delete First and Last records and Apply');
196	First;
197	Delete;
198	Last;
199	Delete;
200	PrintDataSet(FIBDataSet);
201	writeln(Outfile,'Apply Updates');
202	ApplyUpdates;
203	PrintDataSet(FIBDataSet);
204	writeln(Outfile,'Now reopen and show no change');
205	Active := false;
206	Active := true;
207	PrintDataSet(FIBDataSet);
208
209	writeln(OutFile);
210	writeln(OutFile, 'Test Error Handling');
211	First;
212	lastkey := FieldByName('KEYFIELD').AsInteger;
213	Append;
214	FieldByName('KEYFIELD').AsInteger := lastkey;
215	Post;
216	PrintDataSet(FIBDataSet);
217	try
218	ApplyUpdates;
219	except on E: Exception do
220	begin
221	writeln(OutFile,'Exception caught: ',E.Message);
222	end;
223	end;
224	CancelUpdates;
225	end;
226	end;
227
228	procedure TTest18.CreateObjects(Application: TTestApplication);
229	begin
230	inherited CreateObjects(Application);
231	FIBDataSet := TIBDataSet.Create(Application);
232	with FIBDataSet do
233	begin
234	Name := 'IBTestData';
235	Database := IBDatabase;
236	Transaction := IBTransaction;
237	SelectSQL.Add('Select * From IBDataSetTest');
238	InsertSQL.Add('Insert into IBDataSetTest(KeyField,PlainText) Values (:KeyField,:PlainText)');
239	ModifySQL.Add('Update IBDataSetTest Set KeyField = :KeyField, PlainText = :PlainText Where KeyField = :Old_KeyField');
240	DeleteSQL.Add('Delete from IBDataSetTest Where KeyField = :old_KeyField');
241	RefreshSQL.Add('Select * from IBDataSetTest Where KeyField = :KeyField');
242	GeneratorField.Field := 'KeyField';
243	GeneratorField.Generator := 'AGENERATOR';
244	GeneratorField.Increment := 1;
245	CachedUpdates := true;
246	OnUpdateRecord := @HandleUpdateRecord;
247	OnUpdateError := @HandleUpdateError;
248	end;
249	end;
250
251	function TTest18.GetTestID: AnsiString;
252	begin
253	Result := aTestID;
254	end;
255
256	function TTest18.GetTestTitle: AnsiString;
257	begin
258	Result := aTestTitle;
259	end;
260
261	procedure TTest18.InitTest;
262	begin
263	IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
264	IBDatabase.CreateIfNotExists := true;
265	ReadWriteTransaction;
266	end;
267
268	procedure TTest18.RunTest(CharSet: AnsiString; SQLDialect: integer);
269	begin
270	IBDatabase.CreateDatabase;
271	try
272	IBTransaction.Active := true;
273	DoTest(false);
274	// DoTest(true); {See https://bugs.freepascal.org/view.php?id=37900}
275	finally
276	IBDatabase.DropDatabase;
277	end;
278	end;
279
280	initialization
281	RegisterTest(TTest18);
282
283	end.
284