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, 9 months ago) by tony
Content type:	text/x-pascal
File size:	14395 byte(s)
Log Message:	Fixed Merged
#	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 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