trunk/testsuite/Test18.pas

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