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, 9 months ago) by tony
Content type:	text/x-pascal
File size:	7129 byte(s)
Log Message:	Updated for IBX 4 release
#	User	Rev	Content
1	tony	315	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