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;
    FIBQuery2: 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 }

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;
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,'Now delete the first row');
      PrintDataSet(IBQuery);
      First;
      Delete;
      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,'Now delete the first row');
      PrintDataSet(IBQuery);
      First;
      Delete;
      PrintDataSet(IBQuery);
      ApplyUpdates;
      Active := false;
      Active := true;
      writeln(Outfile,'close and re-open and print again');
      PrintDataSet(IBQuery);
    end;
    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,'Now delete the first row');
      PrintDataSet(FIBQuery2);
      First;
      Delete;
      writeln(Outfile,'Dataset after delete');
      PrintDataSet(FIBQuery2);

    end;
  finally
    IBDatabase.DropDatabase;
  end;
end;

initialization
  RegisterTest(TTest20);

end.

Revision:	323
Committed:	Thu Feb 25 12:14:35 2021 UTC (3 years, 2 months ago) by tony
Content type:	text/x-pascal
File size:	7173 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 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	FIBQuery2: TIBQuery;
55	procedure HandleDeleteReturning(Sender: TObject; QryResults: IResults);
56	protected
57	procedure CreateObjects(Application: TTestApplication); override;
58	function GetTestID: AnsiString; override;
59	function GetTestTitle: AnsiString; override;
60	procedure InitTest; override;
61	public
62	procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
63	end;
64
65
66	implementation
67
68	{ TTest20 }
69
70	procedure TTest20.HandleDeleteReturning(Sender: TObject; QryResults: IResults);
71	begin
72	writeln(OutFile,'Delete Returning');
73	ReportResult(QryResults);
74	writeln(OutFile);
75	end;
76
77	procedure TTest20.CreateObjects(Application: TTestApplication);
78	begin
79	inherited CreateObjects(Application);
80	FUpdateSQL := TIBUpdateSQL.Create(Application);
81	with IBQuery do
82	begin
83	UpdateObject := FUpdateSQL;
84	SQL.Add('Select * From IBDataSetTest');
85	GeneratorField.Field := 'KeyField';
86	GeneratorField.Generator := 'AGENERATOR';
87	GeneratorField.Increment := 1;
88	end;
89	with FUpdateSQL do
90	begin
91	InsertSQL.Add('Insert into IBDataSetTest(KeyField,PlainText) Values (:KeyField,:PlainText)');
92	ModifySQL.Add('Update IBDataSetTest Set KeyField = :KeyField, PlainText = :PlainText Where KeyField = :Old_KeyField');
93	DeleteSQL.Add('Delete from IBDataSetTest Where KeyField = :old_KeyField');
94	RefreshSQL.Add('Select * from IBDataSetTest Where KeyField = :KeyField');
95	end;
96	FIBQuery2 := TIBQuery.Create(Application);
97	FUpdateSQL2 := TIBUpdateSQL.Create(Application);
98	with FIBQuery2 do
99	begin
100	Database := IBDatabase;
101	Transaction := IBTransaction;
102	UpdateObject := FUpdateSQL2;
103	SQL.Add('Select * From IBDataSetTest');
104	OnDeleteReturning := @HandleDeleteReturning;
105	end;
106	with FUpdateSQL2 do
107	begin
108	InsertSQL.Add('Insert into IBDataSetTest(KeyField,PlainText) Values (Gen_ID(AGenerator,1),:PlainText) Returning KeyField, TextAndKey');
109	ModifySQL.Add('Update IBDataSetTest Set KeyField = :KeyField, PlainText = :PlainText Where KeyField = :Old_KeyField Returning TextAndKey,ServerSideText');
110	DeleteSQL.Add('Delete from IBDataSetTest Where KeyField = :old_KeyField Returning KeyField');
111	RefreshSQL.Add('Select * from IBDataSetTest Where KeyField = :KeyField');
112	end;
113	end;
114
115	function TTest20.GetTestID: AnsiString;
116	begin
117	Result := aTestID;
118	end;
119
120	function TTest20.GetTestTitle: AnsiString;
121	begin
122	Result := aTestTitle;
123	end;
124
125	procedure TTest20.InitTest;
126	begin
127	IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
128	IBDatabase.CreateIfNotExists := true;
129	ReadWriteTransaction;
130	end;
131
132	procedure TTest20.RunTest(CharSet: AnsiString; SQLDialect: integer);
133	begin
134	IBDatabase.CreateDatabase;
135	try
136	IBTransaction.Active := true;
137	with IBQuery do
138	begin
139	Active := true;
140	writeln(OutFile,'Simple Append');
141	Append;
142	FieldByName('PlainText').AsString := 'This is a test';
143	Post;
144	PrintDataSetRow(IBQuery);
145	Refresh;
146	writeln(OutFile,'After Refresh');
147	PrintDataSetRow(IBQuery);
148	writeln(OutFile,'Append and Update');
149	Append;
150	FieldByName('PlainText').AsString := 'This is another test';
151	Post;
152	PrintDataSetRow(IBQuery);
153	Edit;
154	FieldByName('PlainText').AsString := 'This is the update test';
155	Post;
156	PrintDataSetRow(IBQuery);
157	writeln(OutFile,'Now delete the first row');
158	PrintDataSet(IBQuery);
159	First;
160	Delete;
161	PrintDataSet(IBQuery);
162	writeln(Outfile,'On Post KeyField Assignment');
163	GeneratorField.ApplyOnEvent := gaeOnPostRecord;
164	Append;
165	FieldByName('PlainText').AsString := 'On Post KeyField test';
166	PrintDataSetRow(IBQuery);
167	Post;
168	writeln(Outfile,'Row data after post');
169	PrintDataSetRow(IBQuery);
170	GeneratorField.ApplyOnEvent := gaeOnNewRecord; {restore}
171	end;
172	IBTransaction.Rollback;
173
174	writeln(Outfile);
175	writeln(Outfile,'Repeat with cached updates');
176	IBTransaction.Active := true;
177	with IBQuery do
178	begin
179	CachedUpdates := true;
180	Active := true;
181	writeln(OutFile,'Simple Append');
182	Append;
183	FieldByName('PlainText').AsString := 'This is a test';
184	Post;
185	PrintDataSetRow(IBQuery);
186	Refresh;
187	writeln(OutFile,'After Refresh');
188	PrintDataSetRow(IBQuery);
189	writeln(OutFile,'Append and Update');
190	Append;
191	FieldByName('PlainText').AsString := 'This is another test';
192	Post;
193	PrintDataSetRow(IBQuery);
194	Edit;
195	FieldByName('PlainText').AsString := 'This is the update test';
196	Post;
197	PrintDataSetRow(IBQuery);
198	writeln(OutFile,'Now delete the first row');
199	PrintDataSet(IBQuery);
200	First;
201	Delete;
202	PrintDataSet(IBQuery);
203	ApplyUpdates;
204	Active := false;
205	Active := true;
206	writeln(Outfile,'close and re-open and print again');
207	PrintDataSet(IBQuery);
208	end;
209	IBTransaction.Active := true;
210	with FIBQuery2 do
211	begin
212	Active := true;
213	writeln(OutFile,'FIBQuery2: Simple Append');
214	Append;
215	FieldByName('PlainText').AsString := 'This is a test';
216	Post;
217	PrintDataSetRow(FIBQuery2);
218	Refresh;
219	writeln(OutFile,'FIBQuery2 Refresh');
220	PrintDataSetRow(FIBQuery2);
221	writeln(OutFile,'Append and Update');
222	Append;
223	FieldByName('PlainText').AsString := 'This is another test';
224	Post;
225	PrintDataSetRow(FIBQuery2);
226	Edit;
227	FieldByName('PlainText').AsString := 'This is the update test';
228	Post;
229	PrintDataSetRow(FIBQuery2);
230	writeln(OutFile,'Now delete the first row');
231	PrintDataSet(FIBQuery2);
232	First;
233	Delete;
234	writeln(Outfile,'Dataset after delete');
235	PrintDataSet(FIBQuery2);
236
237	end;
238	finally
239	IBDatabase.DropDatabase;
240	end;
241	end;
242
243	initialization
244	RegisterTest(TTest20);
245
246	end.
247