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

{$mode objfpc}{$H+}

{Test 20: TIBUpdateSQL Tests}

{ Description
}

interface

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

const
  aTestID    = '20';
  aTestTitle = 'TIBUpdateSQL Tests';

type

{ TTest20 }

  TTest20 = class(TIBXTestBase)
  private
    FUpdateSQL: TIBUpdateSQL;
    FUpdateSQL2: TIBUpdateSQL;
    FUpdateSQL3: TIBUpdateSQL;
    FIBQuery2: TIBQuery;
    FIBQuery3: TIBQuery;
    procedure HandleDeleteReturning(Sender: TObject; QryResults: IResults);
  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

{ TTest20 }

type

  { TIBQuery2 }

  TIBQuery3 = class(TIBQuery) {used to set field Provider Flag}
  protected
    procedure DoAfterBindFields; override;
  end;

{ TIBQuery2 }

procedure TIBQuery3.DoAfterBindFields;
var field: TField;
begin
  field := FindField('ServerSideText');
  if field <> nil then
    field.ProviderFlags := field.ProviderFlags + [pfRefreshOnInsert,pfRefreshOnUpdate];
end;


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

procedure TTest20.CreateObjects(Application: TTestApplication);
begin
  inherited CreateObjects(Application);
  FUpdateSQL := TIBUpdateSQL.Create(Application);
  with IBQuery do
  begin
    UpdateObject := FUpdateSQL;
    SQL.Add('Select * From IBDataSetTest');
    GeneratorField.Field := 'KeyField';
    GeneratorField.Generator := 'AGENERATOR';
    GeneratorField.Increment := 1;
  end;
  with FUpdateSQL do
  begin
    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');
  end;
  FIBQuery2 := TIBQuery.Create(Application);
  FUpdateSQL2 := TIBUpdateSQL.Create(Application);
  with FIBQuery2 do
  begin
    Database := IBDatabase;
    Transaction := IBTransaction;
    UpdateObject := FUpdateSQL2;
    SQL.Add('Select * From IBDataSetTest');
    OnDeleteReturning := @HandleDeleteReturning;
  end;
  with FUpdateSQL2 do
  begin
    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');
  end;
  FIBQuery3 := TIBQuery3.Create(Application);
  FUpdateSQL3 := TIBUpdateSQL.Create(Application);
  with FIBQuery3 do
  begin
    Database := IBDatabase;
    Transaction := IBTransaction;
    UpdateObject := FUpdateSQL3;
    SQL.Add('Select * From IBDataSetTest');
    OnDeleteReturning := @HandleDeleteReturning;
  end;
  with FUpdateSQL3 do
  begin
    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');
  end;
end;

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

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

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

procedure TTest20.RunTest(CharSet: AnsiString; SQLDialect: integer);
begin
  IBDatabase.CreateDatabase;
  try
    IBTransaction.Active := true;
    with IBQuery do
    begin
      Active := true;
      writeln(OutFile,'Simple Append');
      Append;
      FieldByName('PlainText').AsString := 'This is a test';
      Post;
      PrintDataSetRow(IBQuery);
      Refresh;
      writeln(OutFile,'After Refresh');
      PrintDataSetRow(IBQuery);
      writeln(OutFile,'Append and Update');
      Append;
      FieldByName('PlainText').AsString := 'This is another test';
      Post;
      PrintDataSetRow(IBQuery);
      Edit;
      FieldByName('PlainText').AsString := 'This is the update test';
      Post;
      PrintDataSetRow(IBQuery);
      writeln(OutFile,'Show the whole dataset');
      PrintDataSet(IBQuery);
      writeln(OutFile,'Now delete the first row');
      First;
      Delete;
      PrintDataSet(IBQuery);
      Active := false;
      Active := true;
      writeln(OutFile,'Show the whole dataset after close/reopen');
      PrintDataSet(IBQuery);
      writeln(Outfile,'On Post KeyField Assignment');
      GeneratorField.ApplyOnEvent := gaeOnPostRecord;
      Append;
      FieldByName('PlainText').AsString := 'On Post KeyField test';
      PrintDataSetRow(IBQuery);
      Post;
      writeln(Outfile,'Row data after post');
      PrintDataSetRow(IBQuery);
      GeneratorField.ApplyOnEvent := gaeOnNewRecord; {restore}
    end;
    IBTransaction.Rollback;

    writeln(Outfile);
    writeln(Outfile,'Repeat with cached updates');
    IBTransaction.Active := true;
    with IBQuery do
    begin
      CachedUpdates := true;
      Active := true;
      writeln(OutFile,'Simple Append');
      Append;
      FieldByName('PlainText').AsString := 'This is a test';
      Post;
      PrintDataSetRow(IBQuery);
      Refresh;
      writeln(OutFile,'After Refresh');
      PrintDataSetRow(IBQuery);
      writeln(OutFile,'Append and Update');
      Append;
      FieldByName('PlainText').AsString := 'This is another test';
      Post;
      PrintDataSetRow(IBQuery);
      Edit;
      FieldByName('PlainText').AsString := 'This is the update test';
      Post;
      PrintDataSetRow(IBQuery);
      writeln(OutFile,'Show the whole dataset');
      PrintDataSet(IBQuery);
      writeln(OutFile,'Now delete the first row');
      First;
      Delete;
      PrintDataSet(IBQuery);
      ApplyUpdates;
      Active := false;
      Active := true;
      writeln(Outfile,'close and re-open and print again');
      PrintDataSet(IBQuery);
    end;
    IBTransaction.Rollback;
    IBTransaction.Active := true;
    with FIBQuery2 do
    begin
      Active := true;
      writeln(OutFile,'FIBQuery2: Simple Append');
      Append;
      FieldByName('PlainText').AsString := 'This is a test';
      Post;
      PrintDataSetRow(FIBQuery2);
      Refresh;
      writeln(OutFile,'FIBQuery2 Refresh');
      PrintDataSetRow(FIBQuery2);
      writeln(OutFile,'Append and Update');
      Append;
      FieldByName('PlainText').AsString := 'This is another test';
      Post;
      PrintDataSetRow(FIBQuery2);
      Edit;
      FieldByName('PlainText').AsString := 'This is the update test';
      Post;
      PrintDataSetRow(FIBQuery2);
      writeln(OutFile,'Show the whole dataset');
      PrintDataSet(FIBQuery2);
      writeln(OutFile,'Now delete the first row');
      First;
      Delete;
      writeln(Outfile,'Dataset after delete');
      PrintDataSet(FIBQuery2);
      Active := false;
    end;
    IBTransaction.Rollback;
    IBTransaction.Active := true;
    with FIBQuery3 do
    begin
      Active := true;
      writeln(OutFile,'FIBQuery3: Simple Append - test refresh on insert');
      Append;
      FieldByName('PlainText').AsString := 'This is a test';
      Post;
      PrintDataSetRow(FIBQuery3);
      Edit;
      FieldByName('PlainText').AsString := 'This is the update test';
      Post;
      PrintDataSetRow(FIBQuery3);
      Active := false;
      Active := true;
      writeln(Outfile,'close and re-open and print again');
      PrintDataSet(FIBQuery3);
    end;
  finally
    IBDatabase.DropDatabase;
  end;
end;

initialization
  RegisterTest(TTest20);

end.

Revision:	410
Committed:	Thu Jun 22 13:52:39 2023 UTC (17 months ago) by tony
Content type:	text/x-pascal
File size:	9373 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 Test20;
28
29			{$mode objfpc}{$H+}
30
31			{Test 20: TIBUpdateSQL Tests}
32
33			{ Description
34			}
35
36			interface
37
38			uses
39			Classes, SysUtils, TestApplication, IBXTestBase, DB, IB,
40			IBCustomDataSet, IBUpdateSQL, IBQuery;
41
42			const
43			aTestID = '20';
44			aTestTitle = 'TIBUpdateSQL Tests';
45
46			type
47
48			{ TTest20 }
49
50			TTest20 = class(TIBXTestBase)
51			private
52			FUpdateSQL: TIBUpdateSQL;
53			FUpdateSQL2: TIBUpdateSQL;
54	tony	410	FUpdateSQL3: TIBUpdateSQL;
55	tony	315	FIBQuery2: TIBQuery;
56	tony	410	FIBQuery3: TIBQuery;
57	tony	315	procedure HandleDeleteReturning(Sender: TObject; QryResults: IResults);
58			protected
59			procedure CreateObjects(Application: TTestApplication); override;
60			function GetTestID: AnsiString; override;
61			function GetTestTitle: AnsiString; override;
62			procedure InitTest; override;
63			public
64			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
65			end;
66
67
68			implementation
69
70			{ TTest20 }
71
72	tony	410	type
73
74			{ TIBQuery2 }
75
76			TIBQuery3 = class(TIBQuery) {used to set field Provider Flag}
77			protected
78			procedure DoAfterBindFields; override;
79			end;
80
81			{ TIBQuery2 }
82
83			procedure TIBQuery3.DoAfterBindFields;
84			var field: TField;
85			begin
86			field := FindField('ServerSideText');
87			if field <> nil then
88			field.ProviderFlags := field.ProviderFlags + [pfRefreshOnInsert,pfRefreshOnUpdate];
89			end;
90
91
92	tony	315	procedure TTest20.HandleDeleteReturning(Sender: TObject; QryResults: IResults);
93			begin
94			writeln(OutFile,'Delete Returning');
95			ReportResult(QryResults);
96			writeln(OutFile);
97			end;
98
99			procedure TTest20.CreateObjects(Application: TTestApplication);
100			begin
101			inherited CreateObjects(Application);
102			FUpdateSQL := TIBUpdateSQL.Create(Application);
103			with IBQuery do
104			begin
105			UpdateObject := FUpdateSQL;
106			SQL.Add('Select * From IBDataSetTest');
107			GeneratorField.Field := 'KeyField';
108			GeneratorField.Generator := 'AGENERATOR';
109			GeneratorField.Increment := 1;
110			end;
111			with FUpdateSQL do
112			begin
113			InsertSQL.Add('Insert into IBDataSetTest(KeyField,PlainText) Values (:KeyField,:PlainText)');
114			ModifySQL.Add('Update IBDataSetTest Set KeyField = :KeyField, PlainText = :PlainText Where KeyField = :Old_KeyField');
115			DeleteSQL.Add('Delete from IBDataSetTest Where KeyField = :old_KeyField');
116			RefreshSQL.Add('Select * from IBDataSetTest Where KeyField = :KeyField');
117			end;
118			FIBQuery2 := TIBQuery.Create(Application);
119			FUpdateSQL2 := TIBUpdateSQL.Create(Application);
120			with FIBQuery2 do
121			begin
122			Database := IBDatabase;
123			Transaction := IBTransaction;
124			UpdateObject := FUpdateSQL2;
125			SQL.Add('Select * From IBDataSetTest');
126			OnDeleteReturning := @HandleDeleteReturning;
127			end;
128			with FUpdateSQL2 do
129			begin
130			InsertSQL.Add('Insert into IBDataSetTest(KeyField,PlainText) Values (Gen_ID(AGenerator,1),:PlainText) Returning KeyField, TextAndKey');
131			ModifySQL.Add('Update IBDataSetTest Set KeyField = :KeyField, PlainText = :PlainText Where KeyField = :Old_KeyField Returning TextAndKey,ServerSideText');
132			DeleteSQL.Add('Delete from IBDataSetTest Where KeyField = :old_KeyField Returning KeyField');
133			RefreshSQL.Add('Select * from IBDataSetTest Where KeyField = :KeyField');
134			end;
135	tony	410	FIBQuery3 := TIBQuery3.Create(Application);
136			FUpdateSQL3 := TIBUpdateSQL.Create(Application);
137			with FIBQuery3 do
138			begin
139			Database := IBDatabase;
140			Transaction := IBTransaction;
141			UpdateObject := FUpdateSQL3;
142			SQL.Add('Select * From IBDataSetTest');
143			OnDeleteReturning := @HandleDeleteReturning;
144			end;
145			with FUpdateSQL3 do
146			begin
147			InsertSQL.Add('Insert into IBDataSetTest(KeyField,PlainText) Values (Gen_ID(AGenerator,1),:PlainText) Returning KeyField, TextAndKey');
148			ModifySQL.Add('Update IBDataSetTest Set KeyField = :KeyField, PlainText = :PlainText Where KeyField = :Old_KeyField Returning TextAndKey,ServerSideText');
149			DeleteSQL.Add('Delete from IBDataSetTest Where KeyField = :old_KeyField Returning KeyField');
150			RefreshSQL.Add('Select * from IBDataSetTest Where KeyField = :KeyField');
151			end;
152	tony	315	end;
153
154			function TTest20.GetTestID: AnsiString;
155			begin
156			Result := aTestID;
157			end;
158
159			function TTest20.GetTestTitle: AnsiString;
160			begin
161			Result := aTestTitle;
162			end;
163
164			procedure TTest20.InitTest;
165			begin
166			IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
167			IBDatabase.CreateIfNotExists := true;
168			ReadWriteTransaction;
169			end;
170
171			procedure TTest20.RunTest(CharSet: AnsiString; SQLDialect: integer);
172			begin
173			IBDatabase.CreateDatabase;
174			try
175			IBTransaction.Active := true;
176			with IBQuery do
177			begin
178			Active := true;
179			writeln(OutFile,'Simple Append');
180			Append;
181			FieldByName('PlainText').AsString := 'This is a test';
182			Post;
183			PrintDataSetRow(IBQuery);
184			Refresh;
185			writeln(OutFile,'After Refresh');
186			PrintDataSetRow(IBQuery);
187			writeln(OutFile,'Append and Update');
188			Append;
189			FieldByName('PlainText').AsString := 'This is another test';
190			Post;
191			PrintDataSetRow(IBQuery);
192			Edit;
193			FieldByName('PlainText').AsString := 'This is the update test';
194			Post;
195			PrintDataSetRow(IBQuery);
196	tony	410	writeln(OutFile,'Show the whole dataset');
197			PrintDataSet(IBQuery);
198	tony	315	writeln(OutFile,'Now delete the first row');
199			First;
200			Delete;
201			PrintDataSet(IBQuery);
202	tony	410	Active := false;
203			Active := true;
204			writeln(OutFile,'Show the whole dataset after close/reopen');
205			PrintDataSet(IBQuery);
206	tony	315	writeln(Outfile,'On Post KeyField Assignment');
207			GeneratorField.ApplyOnEvent := gaeOnPostRecord;
208			Append;
209			FieldByName('PlainText').AsString := 'On Post KeyField test';
210			PrintDataSetRow(IBQuery);
211			Post;
212			writeln(Outfile,'Row data after post');
213			PrintDataSetRow(IBQuery);
214			GeneratorField.ApplyOnEvent := gaeOnNewRecord; {restore}
215			end;
216			IBTransaction.Rollback;
217
218			writeln(Outfile);
219			writeln(Outfile,'Repeat with cached updates');
220			IBTransaction.Active := true;
221			with IBQuery do
222			begin
223			CachedUpdates := true;
224			Active := true;
225			writeln(OutFile,'Simple Append');
226			Append;
227			FieldByName('PlainText').AsString := 'This is a test';
228			Post;
229			PrintDataSetRow(IBQuery);
230			Refresh;
231			writeln(OutFile,'After Refresh');
232			PrintDataSetRow(IBQuery);
233			writeln(OutFile,'Append and Update');
234			Append;
235			FieldByName('PlainText').AsString := 'This is another test';
236			Post;
237			PrintDataSetRow(IBQuery);
238			Edit;
239			FieldByName('PlainText').AsString := 'This is the update test';
240			Post;
241			PrintDataSetRow(IBQuery);
242	tony	410	writeln(OutFile,'Show the whole dataset');
243			PrintDataSet(IBQuery);
244	tony	315	writeln(OutFile,'Now delete the first row');
245			First;
246			Delete;
247			PrintDataSet(IBQuery);
248			ApplyUpdates;
249			Active := false;
250			Active := true;
251			writeln(Outfile,'close and re-open and print again');
252			PrintDataSet(IBQuery);
253			end;
254	tony	410	IBTransaction.Rollback;
255	tony	315	IBTransaction.Active := true;
256			with FIBQuery2 do
257			begin
258			Active := true;
259			writeln(OutFile,'FIBQuery2: Simple Append');
260			Append;
261			FieldByName('PlainText').AsString := 'This is a test';
262			Post;
263			PrintDataSetRow(FIBQuery2);
264			Refresh;
265			writeln(OutFile,'FIBQuery2 Refresh');
266			PrintDataSetRow(FIBQuery2);
267			writeln(OutFile,'Append and Update');
268			Append;
269			FieldByName('PlainText').AsString := 'This is another test';
270			Post;
271			PrintDataSetRow(FIBQuery2);
272			Edit;
273			FieldByName('PlainText').AsString := 'This is the update test';
274			Post;
275			PrintDataSetRow(FIBQuery2);
276	tony	410	writeln(OutFile,'Show the whole dataset');
277			PrintDataSet(FIBQuery2);
278	tony	315	writeln(OutFile,'Now delete the first row');
279			First;
280			Delete;
281			writeln(Outfile,'Dataset after delete');
282			PrintDataSet(FIBQuery2);
283	tony	410	Active := false;
284	tony	315	end;
285	tony	410	IBTransaction.Rollback;
286			IBTransaction.Active := true;
287			with FIBQuery3 do
288			begin
289			Active := true;
290			writeln(OutFile,'FIBQuery3: Simple Append - test refresh on insert');
291			Append;
292			FieldByName('PlainText').AsString := 'This is a test';
293			Post;
294			PrintDataSetRow(FIBQuery3);
295			Edit;
296			FieldByName('PlainText').AsString := 'This is the update test';
297			Post;
298			PrintDataSetRow(FIBQuery3);
299			Active := false;
300			Active := true;
301			writeln(Outfile,'close and re-open and print again');
302			PrintDataSet(FIBQuery3);
303			end;
304	tony	315	finally
305			IBDatabase.DropDatabase;
306			end;
307			end;
308
309			initialization
310			RegisterTest(TTest20);
311
312			end.
313