trunk/testsuite/Test17.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 Test17;

{$mode objfpc}{$H+}

{Test 17: TIBDataSet Tests}

{ Description

  TIBDataset Insert/Update/Delete tests.
}

interface

uses
  Classes, SysUtils,   TestApplication, IBXTestBase, DB, IB, IBCustomDataSet;

const
  aTestID    = '17';
  aTestTitle = 'TIBDataset Tests';

type

{ TTest1 }

  { TTest17 }

  TTest17 = class(TIBXTestBase)
  private
    FIBDataSet1: TIBDataSet;
    FIBDataSet2: TIBDataSet;
    procedure HandleDeleteReturning(Sender: TObject; QryResults: IResults);
    procedure HandleBeforeOpen(DataSet: TDataSet);
    procedure HandleAfterOpen(DataSet: TDataSet);
    procedure HandleBeforeClose(DataSet: TDataSet);
    procedure HandleAfterClose(DataSet: TDataSet);
    procedure HandleBeforeInsert(DataSet: TDataSet);
    procedure HandleAfterInsert(DataSet: TDataSet);
    procedure HandleBeforeEdit(DataSet: TDataSet);
    procedure HandleAfterEdit(DataSet: TDataSet);
    procedure HandleBeforePost(DataSet: TDataSet);
    procedure HandleAfterPost(DataSet: TDataSet);
    procedure HandleBeforeCancel(DataSet: TDataSet);
    procedure HandleAfterCancel(DataSet: TDataSet);
    procedure HandleBeforeDelete(DataSet: TDataSet);
    procedure HandleAfterDelete(DataSet: TDataSet);
    procedure HandleBeforeScroll(DataSet: TDataSet);
    procedure HandleAfterScroll(DataSet: TDataSet);
    procedure HandleBeforeRefresh(DataSet: TDataSet);
    procedure HandleAfterRefresh(DataSet: TDataSet);
    procedure ValidatePostOK(Sender: TObject; var CancelPost: boolean);
    procedure ValidatePostCancel(Sender: TObject; var CancelPost: boolean);
    procedure HandlePostError(DataSet: TDataSet; E: EDatabaseError;
                     var DataAction: TDataAction);
  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

{ TTest17 }

procedure TTest17.HandleDeleteReturning(Sender: TObject; QryResults: IResults);
begin
  writeln(OutFile,'Delete Returning');
  ReportResult(QryResults);
  writeln(OutFile);
end;

procedure TTest17.HandleBeforeOpen(DataSet: TDataSet);
Begin
  writeln(Outfile,'Dataset Event BeforeOpen: State = ',DataSet.State);
end;
procedure TTest17.HandleAfterOpen(DataSet: TDataSet);
Begin
  writeln(Outfile,'Dataset Event AfterOpen: State = ',DataSet.State);
end;
procedure TTest17.HandleBeforeClose(DataSet: TDataSet);
Begin
  writeln(Outfile,'Dataset Event BeforeClose: State = ',DataSet.State);
end;
procedure TTest17.HandleAfterClose(DataSet: TDataSet);
Begin
  writeln(Outfile,'Dataset Event AfterClose: State = ',DataSet.State);
end;
procedure TTest17.HandleBeforeInsert(DataSet: TDataSet);
Begin
  writeln(Outfile,'Dataset Event BeforeInsert: State = ',DataSet.State);
end;
procedure TTest17.HandleAfterInsert(DataSet: TDataSet);
Begin
  writeln(Outfile,'Dataset Event AfterInsert: State = ',DataSet.State);
end;
procedure TTest17.HandleBeforeEdit(DataSet: TDataSet);
Begin
  writeln(Outfile,'Dataset Event BeforeEdit: State = ',DataSet.State);
end;
procedure TTest17.HandleAfterEdit(DataSet: TDataSet);
Begin
  writeln(Outfile,'Dataset Event AfterEdit: State = ',DataSet.State);
end;
procedure TTest17.HandleBeforePost(DataSet: TDataSet);
Begin
  writeln(Outfile,'Dataset Event BeforePost: State = ',DataSet.State);
end;
procedure TTest17.HandleAfterPost(DataSet: TDataSet);
Begin
  writeln(Outfile,'Dataset Event AfterPost: State = ',DataSet.State);
end;
procedure TTest17.HandleBeforeCancel(DataSet: TDataSet);
Begin
  writeln(Outfile,'Dataset Event BeforeCancel: State = ',DataSet.State);
end;
procedure TTest17.HandleAfterCancel(DataSet: TDataSet);
Begin
  writeln(Outfile,'Dataset Event AfterCancel: State = ',DataSet.State);
end;
procedure TTest17.HandleBeforeDelete(DataSet: TDataSet);
Begin
  writeln(Outfile,'Dataset Event BeforeDelete: State = ',DataSet.State);
end;
procedure TTest17.HandleAfterDelete(DataSet: TDataSet);
Begin
  writeln(Outfile,'Dataset Event AfterDelete: State = ',DataSet.State);
end;
procedure TTest17.HandleBeforeScroll(DataSet: TDataSet);
Begin
  writeln(Outfile,'Dataset Event BeforeScroll: State = ',DataSet.State);
end;
procedure TTest17.HandleAfterScroll(DataSet: TDataSet);
Begin
  writeln(Outfile,'Dataset Event AfterScroll: State = ',DataSet.State);
end;
procedure TTest17.HandleBeforeRefresh(DataSet: TDataSet);
Begin
  writeln(Outfile,'Dataset Event BeforeRefresh: State = ',DataSet.State);
end;
procedure TTest17.HandleAfterRefresh(DataSet: TDataSet);
Begin
  writeln(Outfile,'Dataset Event AfterRefresh: State = ',DataSet.State);
end;

procedure TTest17.ValidatePostOK(Sender: TObject; var CancelPost: boolean);
begin
  writeln(Outfile,'Validate Post OK called');
  CancelPost := false;
end;

procedure TTest17.ValidatePostCancel(Sender: TObject; var CancelPost: boolean);
begin
  writeln(Outfile,'Validate Post Cancel called');
  CancelPost := true;
end;

procedure TTest17.HandlePostError(DataSet: TDataSet; E: EDatabaseError;
  var DataAction: TDataAction);
begin
  writeln(Outfile,'Post Error Called: ',E.Message);
  DataAction := daFail;
end;

procedure TTest17.CreateObjects(Application: TTestApplication);
begin
  inherited CreateObjects(Application);
  FIBDataSet1 := TIBDataSet.Create(Application);
  with FIBDataSet1 do
  begin
    Database := IBDatabase;
    Transaction := IBTransaction;
    Unidirectional := false;
    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;
    OnPostError := @HandlePostError;
  end;
  FIBDataSet2 := TIBDataSet.Create(Application);
  with FIBDataSet2 do
  begin
    Database := IBDatabase;
    Transaction := IBTransaction;
    Unidirectional := false;
    SelectSQL.Add('Select * From IBDataSetTest');
    InsertSQL.Add('Insert into IBDataSetTest(KeyField,PlainText) Values (Gen_ID(AGenerator,1),:PlainText) Returning KeyField, TextAndKey');
    ModifySQL.Add('Update IBDataSetTest Set KeyField = :KeyField, PlainText = :PlainText Where KeyField = :Old_KeyField Returning TextAndKey,ServerSideText');
    DeleteSQL.Add('Delete from IBDataSetTest Where KeyField = :old_KeyField Returning KeyField');
    RefreshSQL.Add('Select * from IBDataSetTest Where KeyField = :KeyField');
    OnDeleteReturning := @HandleDeleteReturning;
    BeforeOpen := @HandleBeforeOpen;
    AfterOpen := @HandleAfterOpen;
    BeforeClose := @HandleBeforeClose;
    AfterClose := @HandleAfterClose;
    BeforeInsert := @HandleBeforeInsert;
    AfterInsert := @HandleAfterInsert;
    BeforeEdit := @HandleBeforeEdit;
    AfterEdit := @HandleAfterEdit;
    BeforePost := @HandleBeforePost;
    AfterPost := @HandleAfterPost;
    BeforeCancel := @HandleBeforeCancel;
    AfterCancel := @HandleAfterCancel;
    BeforeDelete := @HandleBeforeDelete;
    AfterDelete := @HandleAfterDelete;
    BeforeScroll := @HandleBeforeScroll;
    AfterScroll := @HandleAfterScroll;
    BeforeRefresh := @HandleBeforeRefresh;
    AfterRefresh := @HandleAfterRefresh;
  end;
end;

function TTest17.GetTestID: AnsiString;
begin
  Result := aTestID;
end;

function TTest17.GetTestTitle: AnsiString;
begin
  Result := aTestTitle;
end;

procedure TTest17.InitTest;
begin
  IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
  IBDatabase.CreateIfNotExists := true;
  ReadWriteTransaction;
end;

procedure TTest17.RunTest(CharSet: AnsiString; SQLDialect: integer);
var lastKey: integer;
begin
  IBDatabase.CreateDatabase;
  try
    IBTransaction.Active := true;
    with FIBDataSet1 do
    begin
      Active := true;
      writeln(OutFile,'FIBDataSet1: Simple Append');
      Append;
//      writeln(outfile,'BOF = ',BOF,', EOF = ',EOF);
      FieldByName('PlainText').AsString := 'This is a test';
      Post;
      PrintDataSetRow(FIBDataSet1);
      Refresh;
      writeln(OutFile,'After Refresh');
      PrintDataSetRow(FIBDataSet1);
      writeln(OutFile,'Append and Update');
      Append;
      FieldByName('PlainText').AsString := 'This is another test';
      Post;
      PrintDataSetRow(FIBDataSet1);
      Edit;
      FieldByName('PlainText').AsString := 'This is the update test';
      Post;
      PrintDataSetRow(FIBDataSet1);
      writeln(OutFile,'Now delete the first row');
      PrintDataSet(FIBDataSet1);
      First;
      Delete;
      PrintDataSet(FIBDataSet1);
      writeln(Outfile,'On Post KeyField Assignment');
      FIBDataSet1.GeneratorField.ApplyOnEvent := gaeOnPostRecord;
      Append;
      FieldByName('PlainText').AsString := 'On Post KeyField test';
      PrintDataSetRow(FIBDataSet1);
      Post;
      writeln(Outfile,'Row data after post');
      PrintDataSetRow(FIBDataSet1);
      FIBDataSet1.GeneratorField.ApplyOnEvent := gaeOnNewRecord; {restore}

      writeln(Outfile,'Catch a Post Error - duplicate key');
      lastkey := FieldByName('KeyField').AsInteger;
      Append;
      FieldByName('KeyField').AsInteger := lastkey;
      FieldByName('PlainText').AsString := 'On Post Error test';
      try
        Post;
      except on E: Exception do
        writeln(Outfile,'Exception handled: ',E.Message);
      end;

      IBTransaction.Rollback;
      IBTransaction.Active := true;
      DataSetCloseAction := dcSaveChanges;
      Active := true;
      writeln(OutFile,'FIBDataSet1: Simple Append with automatic posting on close');
      Append;
      FieldByName('PlainText').AsString := 'This is a test';
      Active := false;
      Active := true;
      PrintDataSet(FIBDataSet1);

      IBTransaction.Rollback;
      IBTransaction.Active := true;
      DataSetCloseAction := dcDiscardChanges;
      Active := true;
      writeln(OutFile,'FIBDataSet1: Simple Append with discard on close');
      Append;
      FieldByName('PlainText').AsString := 'This is a test';
      Active := false;
      Active := true;
      PrintDataSet(FIBDataSet1);

      {See https://bugs.freepascal.org/view.php?id=37900}

(*      IBTransaction.Rollback;
      IBTransaction.Active := true;
      writeln(Outfile);
      writeln(Outfile,'Unidirectional editing');
      Unidirectional := true;
      Active := true;
      writeln(OutFile,'FIBDataSet1: Simple Append - unidirectional');
      Insert;
      writeln(outfile,'BOF = ',BOF,', EOF = ',EOF);
      FieldByName('PlainText').AsString := 'This is a test - unidirectional';
      PrintDataSetRow(FIBDataSet1);
      Post;
      writeln(outfile,'BOF = ',BOF,', EOF = ',EOF);
      PrintDataSetRow(FIBDataSet1);
      Refresh;
      writeln(OutFile,'After Refresh - unidirectional');
      PrintDataSetRow(FIBDataSet1);
      writeln(OutFile,'Append and Update');
      Insert;
      FieldByName('PlainText').AsString := 'This is another test - unidirectional';
      Post;
      PrintDataSetRow(FIBDataSet1);
      Edit;
      FieldByName('PlainText').AsString := 'This is the update test - unidirectional';
      Post;
      PrintDataSetRow(FIBDataSet1);
      writeln(OutFile,'Now delete the first row - unidirectional');
      PrintDataSet(FIBDataSet1);
      First;
      Delete;
      PrintDataSet(FIBDataSet1);
      writeln(Outfile,'Ensure dataset saved to database');
      Active := false;
      Active := true;
      PrintDataSet(FIBDataSet1);  *)

    end;
    writeln(Outfile,'==================================');
    IBTransaction.Rollback;
    IBTransaction.Active := true;
    with FIBDataSet2 do
    begin
      Active := true;
      writeln(OutFile,'FIBDataSet2: Simple Append');
      Append;
      FieldByName('PlainText').AsString := 'This is a test';
      Post;
      PrintDataSetRow(FIBDataSet2);
      Refresh;
      writeln(OutFile,'After Refresh');
      PrintDataSetRow(FIBDataSet2);
      writeln(OutFile,'Append and Update');
      Append;
      FieldByName('PlainText').AsString := 'This is another test';
      Post;
      PrintDataSetRow(FIBDataSet2);
      Edit;
      FieldByName('PlainText').AsString := 'This is the update test';
      Post;
      PrintDataSetRow(FIBDataSet2);
      writeln(OutFile,'Now delete the first row');
      PrintDataSet(FIBDataSet2);
      First;
      Delete;
      PrintDataSet(FIBDataSet2);
      OnValidatePost := @ValidatePostOK;
      writeln(Outfile,'Validate Post OK');
      Append;
      FieldByName('PlainText').AsString := 'This is a validated Post';
      Post;
      PrintDataSetRow(FIBDataSet2);
      OnValidatePost := @ValidatePostCancel;
      writeln(Outfile,'Validate Post Cancel');
      Append;
      FieldByName('PlainText').AsString := 'This is a validated Post which should have been cancelled';
      Post;
      PrintDataSetRow(FIBDataSet2);
      OnValidatePost := nil;
      writeln(OutFile,'FIBDataSet2: Simple Append with Forced Refresh');
      ForcedRefresh := true;
      Append;
      FieldByName('PlainText').AsString := 'This is a test';
      Post;
      PrintDataSetRow(FIBDataSet2);

    end;
  finally
    IBDatabase.DropDatabase;
  end;
end;

initialization
  RegisterTest(TTest17);

end.

Revision:	323
Committed:	Thu Feb 25 12:14:35 2021 UTC (3 years, 8 months ago) by tony
Content type:	text/x-pascal
File size:	14395 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 Test17;
28
29	{$mode objfpc}{$H+}
30
31	{Test 17: TIBDataSet Tests}
32
33	{ Description
34
35	TIBDataset Insert/Update/Delete tests.
36	}
37
38	interface
39
40	uses
41	Classes, SysUtils, TestApplication, IBXTestBase, DB, IB, IBCustomDataSet;
42
43	const
44	aTestID = '17';
45	aTestTitle = 'TIBDataset Tests';
46
47	type
48
49	{ TTest1 }
50
51	{ TTest17 }
52
53	TTest17 = class(TIBXTestBase)
54	private
55	FIBDataSet1: TIBDataSet;
56	FIBDataSet2: TIBDataSet;
57	procedure HandleDeleteReturning(Sender: TObject; QryResults: IResults);
58	procedure HandleBeforeOpen(DataSet: TDataSet);
59	procedure HandleAfterOpen(DataSet: TDataSet);
60	procedure HandleBeforeClose(DataSet: TDataSet);
61	procedure HandleAfterClose(DataSet: TDataSet);
62	procedure HandleBeforeInsert(DataSet: TDataSet);
63	procedure HandleAfterInsert(DataSet: TDataSet);
64	procedure HandleBeforeEdit(DataSet: TDataSet);
65	procedure HandleAfterEdit(DataSet: TDataSet);
66	procedure HandleBeforePost(DataSet: TDataSet);
67	procedure HandleAfterPost(DataSet: TDataSet);
68	procedure HandleBeforeCancel(DataSet: TDataSet);
69	procedure HandleAfterCancel(DataSet: TDataSet);
70	procedure HandleBeforeDelete(DataSet: TDataSet);
71	procedure HandleAfterDelete(DataSet: TDataSet);
72	procedure HandleBeforeScroll(DataSet: TDataSet);
73	procedure HandleAfterScroll(DataSet: TDataSet);
74	procedure HandleBeforeRefresh(DataSet: TDataSet);
75	procedure HandleAfterRefresh(DataSet: TDataSet);
76	procedure ValidatePostOK(Sender: TObject; var CancelPost: boolean);
77	procedure ValidatePostCancel(Sender: TObject; var CancelPost: boolean);
78	procedure HandlePostError(DataSet: TDataSet; E: EDatabaseError;
79	var DataAction: TDataAction);
80	protected
81	procedure CreateObjects(Application: TTestApplication); override;
82	function GetTestID: AnsiString; override;
83	function GetTestTitle: AnsiString; override;
84	procedure InitTest; override;
85	public
86	procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
87	end;
88
89
90	implementation
91
92	{ TTest17 }
93
94	procedure TTest17.HandleDeleteReturning(Sender: TObject; QryResults: IResults);
95	begin
96	writeln(OutFile,'Delete Returning');
97	ReportResult(QryResults);
98	writeln(OutFile);
99	end;
100
101	procedure TTest17.HandleBeforeOpen(DataSet: TDataSet);
102	Begin
103	writeln(Outfile,'Dataset Event BeforeOpen: State = ',DataSet.State);
104	end;
105	procedure TTest17.HandleAfterOpen(DataSet: TDataSet);
106	Begin
107	writeln(Outfile,'Dataset Event AfterOpen: State = ',DataSet.State);
108	end;
109	procedure TTest17.HandleBeforeClose(DataSet: TDataSet);
110	Begin
111	writeln(Outfile,'Dataset Event BeforeClose: State = ',DataSet.State);
112	end;
113	procedure TTest17.HandleAfterClose(DataSet: TDataSet);
114	Begin
115	writeln(Outfile,'Dataset Event AfterClose: State = ',DataSet.State);
116	end;
117	procedure TTest17.HandleBeforeInsert(DataSet: TDataSet);
118	Begin
119	writeln(Outfile,'Dataset Event BeforeInsert: State = ',DataSet.State);
120	end;
121	procedure TTest17.HandleAfterInsert(DataSet: TDataSet);
122	Begin
123	writeln(Outfile,'Dataset Event AfterInsert: State = ',DataSet.State);
124	end;
125	procedure TTest17.HandleBeforeEdit(DataSet: TDataSet);
126	Begin
127	writeln(Outfile,'Dataset Event BeforeEdit: State = ',DataSet.State);
128	end;
129	procedure TTest17.HandleAfterEdit(DataSet: TDataSet);
130	Begin
131	writeln(Outfile,'Dataset Event AfterEdit: State = ',DataSet.State);
132	end;
133	procedure TTest17.HandleBeforePost(DataSet: TDataSet);
134	Begin
135	writeln(Outfile,'Dataset Event BeforePost: State = ',DataSet.State);
136	end;
137	procedure TTest17.HandleAfterPost(DataSet: TDataSet);
138	Begin
139	writeln(Outfile,'Dataset Event AfterPost: State = ',DataSet.State);
140	end;
141	procedure TTest17.HandleBeforeCancel(DataSet: TDataSet);
142	Begin
143	writeln(Outfile,'Dataset Event BeforeCancel: State = ',DataSet.State);
144	end;
145	procedure TTest17.HandleAfterCancel(DataSet: TDataSet);
146	Begin
147	writeln(Outfile,'Dataset Event AfterCancel: State = ',DataSet.State);
148	end;
149	procedure TTest17.HandleBeforeDelete(DataSet: TDataSet);
150	Begin
151	writeln(Outfile,'Dataset Event BeforeDelete: State = ',DataSet.State);
152	end;
153	procedure TTest17.HandleAfterDelete(DataSet: TDataSet);
154	Begin
155	writeln(Outfile,'Dataset Event AfterDelete: State = ',DataSet.State);
156	end;
157	procedure TTest17.HandleBeforeScroll(DataSet: TDataSet);
158	Begin
159	writeln(Outfile,'Dataset Event BeforeScroll: State = ',DataSet.State);
160	end;
161	procedure TTest17.HandleAfterScroll(DataSet: TDataSet);
162	Begin
163	writeln(Outfile,'Dataset Event AfterScroll: State = ',DataSet.State);
164	end;
165	procedure TTest17.HandleBeforeRefresh(DataSet: TDataSet);
166	Begin
167	writeln(Outfile,'Dataset Event BeforeRefresh: State = ',DataSet.State);
168	end;
169	procedure TTest17.HandleAfterRefresh(DataSet: TDataSet);
170	Begin
171	writeln(Outfile,'Dataset Event AfterRefresh: State = ',DataSet.State);
172	end;
173
174	procedure TTest17.ValidatePostOK(Sender: TObject; var CancelPost: boolean);
175	begin
176	writeln(Outfile,'Validate Post OK called');
177	CancelPost := false;
178	end;
179
180	procedure TTest17.ValidatePostCancel(Sender: TObject; var CancelPost: boolean);
181	begin
182	writeln(Outfile,'Validate Post Cancel called');
183	CancelPost := true;
184	end;
185
186	procedure TTest17.HandlePostError(DataSet: TDataSet; E: EDatabaseError;
187	var DataAction: TDataAction);
188	begin
189	writeln(Outfile,'Post Error Called: ',E.Message);
190	DataAction := daFail;
191	end;
192
193	procedure TTest17.CreateObjects(Application: TTestApplication);
194	begin
195	inherited CreateObjects(Application);
196	FIBDataSet1 := TIBDataSet.Create(Application);
197	with FIBDataSet1 do
198	begin
199	Database := IBDatabase;
200	Transaction := IBTransaction;
201	Unidirectional := false;
202	SelectSQL.Add('Select * From IBDataSetTest');
203	InsertSQL.Add('Insert into IBDataSetTest(KeyField,PlainText) Values (:KeyField,:PlainText)');
204	ModifySQL.Add('Update IBDataSetTest Set KeyField = :KeyField, PlainText = :PlainText Where KeyField = :Old_KeyField');
205	DeleteSQL.Add('Delete from IBDataSetTest Where KeyField = :old_KeyField');
206	RefreshSQL.Add('Select * from IBDataSetTest Where KeyField = :KeyField');
207	GeneratorField.Field := 'KeyField';
208	GeneratorField.Generator := 'AGENERATOR';
209	GeneratorField.Increment := 1;
210	OnPostError := @HandlePostError;
211	end;
212	FIBDataSet2 := TIBDataSet.Create(Application);
213	with FIBDataSet2 do
214	begin
215	Database := IBDatabase;
216	Transaction := IBTransaction;
217	Unidirectional := false;
218	SelectSQL.Add('Select * From IBDataSetTest');
219	InsertSQL.Add('Insert into IBDataSetTest(KeyField,PlainText) Values (Gen_ID(AGenerator,1),:PlainText) Returning KeyField, TextAndKey');
220	ModifySQL.Add('Update IBDataSetTest Set KeyField = :KeyField, PlainText = :PlainText Where KeyField = :Old_KeyField Returning TextAndKey,ServerSideText');
221	DeleteSQL.Add('Delete from IBDataSetTest Where KeyField = :old_KeyField Returning KeyField');
222	RefreshSQL.Add('Select * from IBDataSetTest Where KeyField = :KeyField');
223	OnDeleteReturning := @HandleDeleteReturning;
224	BeforeOpen := @HandleBeforeOpen;
225	AfterOpen := @HandleAfterOpen;
226	BeforeClose := @HandleBeforeClose;
227	AfterClose := @HandleAfterClose;
228	BeforeInsert := @HandleBeforeInsert;
229	AfterInsert := @HandleAfterInsert;
230	BeforeEdit := @HandleBeforeEdit;
231	AfterEdit := @HandleAfterEdit;
232	BeforePost := @HandleBeforePost;
233	AfterPost := @HandleAfterPost;
234	BeforeCancel := @HandleBeforeCancel;
235	AfterCancel := @HandleAfterCancel;
236	BeforeDelete := @HandleBeforeDelete;
237	AfterDelete := @HandleAfterDelete;
238	BeforeScroll := @HandleBeforeScroll;
239	AfterScroll := @HandleAfterScroll;
240	BeforeRefresh := @HandleBeforeRefresh;
241	AfterRefresh := @HandleAfterRefresh;
242	end;
243	end;
244
245	function TTest17.GetTestID: AnsiString;
246	begin
247	Result := aTestID;
248	end;
249
250	function TTest17.GetTestTitle: AnsiString;
251	begin
252	Result := aTestTitle;
253	end;
254
255	procedure TTest17.InitTest;
256	begin
257	IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
258	IBDatabase.CreateIfNotExists := true;
259	ReadWriteTransaction;
260	end;
261
262	procedure TTest17.RunTest(CharSet: AnsiString; SQLDialect: integer);
263	var lastKey: integer;
264	begin
265	IBDatabase.CreateDatabase;
266	try
267	IBTransaction.Active := true;
268	with FIBDataSet1 do
269	begin
270	Active := true;
271	writeln(OutFile,'FIBDataSet1: Simple Append');
272	Append;
273	// writeln(outfile,'BOF = ',BOF,', EOF = ',EOF);
274	FieldByName('PlainText').AsString := 'This is a test';
275	Post;
276	PrintDataSetRow(FIBDataSet1);
277	Refresh;
278	writeln(OutFile,'After Refresh');
279	PrintDataSetRow(FIBDataSet1);
280	writeln(OutFile,'Append and Update');
281	Append;
282	FieldByName('PlainText').AsString := 'This is another test';
283	Post;
284	PrintDataSetRow(FIBDataSet1);
285	Edit;
286	FieldByName('PlainText').AsString := 'This is the update test';
287	Post;
288	PrintDataSetRow(FIBDataSet1);
289	writeln(OutFile,'Now delete the first row');
290	PrintDataSet(FIBDataSet1);
291	First;
292	Delete;
293	PrintDataSet(FIBDataSet1);
294	writeln(Outfile,'On Post KeyField Assignment');
295	FIBDataSet1.GeneratorField.ApplyOnEvent := gaeOnPostRecord;
296	Append;
297	FieldByName('PlainText').AsString := 'On Post KeyField test';
298	PrintDataSetRow(FIBDataSet1);
299	Post;
300	writeln(Outfile,'Row data after post');
301	PrintDataSetRow(FIBDataSet1);
302	FIBDataSet1.GeneratorField.ApplyOnEvent := gaeOnNewRecord; {restore}
303
304	writeln(Outfile,'Catch a Post Error - duplicate key');
305	lastkey := FieldByName('KeyField').AsInteger;
306	Append;
307	FieldByName('KeyField').AsInteger := lastkey;
308	FieldByName('PlainText').AsString := 'On Post Error test';
309	try
310	Post;
311	except on E: Exception do
312	writeln(Outfile,'Exception handled: ',E.Message);
313	end;
314
315	IBTransaction.Rollback;
316	IBTransaction.Active := true;
317	DataSetCloseAction := dcSaveChanges;
318	Active := true;
319	writeln(OutFile,'FIBDataSet1: Simple Append with automatic posting on close');
320	Append;
321	FieldByName('PlainText').AsString := 'This is a test';
322	Active := false;
323	Active := true;
324	PrintDataSet(FIBDataSet1);
325
326	IBTransaction.Rollback;
327	IBTransaction.Active := true;
328	DataSetCloseAction := dcDiscardChanges;
329	Active := true;
330	writeln(OutFile,'FIBDataSet1: Simple Append with discard on close');
331	Append;
332	FieldByName('PlainText').AsString := 'This is a test';
333	Active := false;
334	Active := true;
335	PrintDataSet(FIBDataSet1);
336
337	{See https://bugs.freepascal.org/view.php?id=37900}
338
339	(* IBTransaction.Rollback;
340	IBTransaction.Active := true;
341	writeln(Outfile);
342	writeln(Outfile,'Unidirectional editing');
343	Unidirectional := true;
344	Active := true;
345	writeln(OutFile,'FIBDataSet1: Simple Append - unidirectional');
346	Insert;
347	writeln(outfile,'BOF = ',BOF,', EOF = ',EOF);
348	FieldByName('PlainText').AsString := 'This is a test - unidirectional';
349	PrintDataSetRow(FIBDataSet1);
350	Post;
351	writeln(outfile,'BOF = ',BOF,', EOF = ',EOF);
352	PrintDataSetRow(FIBDataSet1);
353	Refresh;
354	writeln(OutFile,'After Refresh - unidirectional');
355	PrintDataSetRow(FIBDataSet1);
356	writeln(OutFile,'Append and Update');
357	Insert;
358	FieldByName('PlainText').AsString := 'This is another test - unidirectional';
359	Post;
360	PrintDataSetRow(FIBDataSet1);
361	Edit;
362	FieldByName('PlainText').AsString := 'This is the update test - unidirectional';
363	Post;
364	PrintDataSetRow(FIBDataSet1);
365	writeln(OutFile,'Now delete the first row - unidirectional');
366	PrintDataSet(FIBDataSet1);
367	First;
368	Delete;
369	PrintDataSet(FIBDataSet1);
370	writeln(Outfile,'Ensure dataset saved to database');
371	Active := false;
372	Active := true;
373	PrintDataSet(FIBDataSet1); *)
374
375	end;
376	writeln(Outfile,'==================================');
377	IBTransaction.Rollback;
378	IBTransaction.Active := true;
379	with FIBDataSet2 do
380	begin
381	Active := true;
382	writeln(OutFile,'FIBDataSet2: Simple Append');
383	Append;
384	FieldByName('PlainText').AsString := 'This is a test';
385	Post;
386	PrintDataSetRow(FIBDataSet2);
387	Refresh;
388	writeln(OutFile,'After Refresh');
389	PrintDataSetRow(FIBDataSet2);
390	writeln(OutFile,'Append and Update');
391	Append;
392	FieldByName('PlainText').AsString := 'This is another test';
393	Post;
394	PrintDataSetRow(FIBDataSet2);
395	Edit;
396	FieldByName('PlainText').AsString := 'This is the update test';
397	Post;
398	PrintDataSetRow(FIBDataSet2);
399	writeln(OutFile,'Now delete the first row');
400	PrintDataSet(FIBDataSet2);
401	First;
402	Delete;
403	PrintDataSet(FIBDataSet2);
404	OnValidatePost := @ValidatePostOK;
405	writeln(Outfile,'Validate Post OK');
406	Append;
407	FieldByName('PlainText').AsString := 'This is a validated Post';
408	Post;
409	PrintDataSetRow(FIBDataSet2);
410	OnValidatePost := @ValidatePostCancel;
411	writeln(Outfile,'Validate Post Cancel');
412	Append;
413	FieldByName('PlainText').AsString := 'This is a validated Post which should have been cancelled';
414	Post;
415	PrintDataSetRow(FIBDataSet2);
416	OnValidatePost := nil;
417	writeln(OutFile,'FIBDataSet2: Simple Append with Forced Refresh');
418	ForcedRefresh := true;
419	Append;
420	FieldByName('PlainText').AsString := 'This is a test';
421	Post;
422	PrintDataSetRow(FIBDataSet2);
423
424	end;
425	finally
426	IBDatabase.DropDatabase;
427	end;
428	end;
429
430	initialization
431	RegisterTest(TTest17);
432
433	end.
434