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, 6 months ago) by tony
Content type:	text/x-pascal
File size:	7173 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 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