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 (16 months, 3 weeks ago) by tony
Content type:	text/x-pascal
File size:	8141 byte(s)
Log Message:	Release 2.6.0 beta
#	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	tony	410	PrintDataSet(FIBDataSet);
94	tony	315	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	tony	410	begin
221			writeln(OutFile,'Exception caught: ',E.Message);
222			end;
223	tony	315	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