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

{$mode objfpc}{$H+}

{Test 4: handling of data types up to Firebird 3.

         Tests, Append, Edit and Delete operations

         Test both default createdatabase and createdatabasefromSQL
}

interface

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

const
  aTestID    = '04';
  aTestTitle = 'Handling of data types up to Firebird 3';

type

{ TTest04 }

  TTest04 = class(TIBXTestBase)
  private
    FDataSet: TIBDataSet;
    FCreateArrayOnInsert: boolean;
    procedure HandleAfterInsert(DataSet: TDataSet);
    procedure HandleTransactionEdit(Sender: TObject);
    procedure HandleTransactionDelete(Sender: TObject);
    procedure HandleTransactionInsert(Sender: TObject);
    procedure HandleTransactionPost(Sender: TObject);
    procedure HandleTransactionExecQuery(Sender: TObject);
  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

uses DateUtils, IBSQL;

{ TTest04 }

procedure TTest04.HandleAfterInsert(DataSet: TDataSet);
var S, F: TStream;
    Str: TStringList;
    i,j: integer;
    ar: IArray;
begin
  with DataSet do
  begin
    FieldByName('F1').AsInteger := 2;
    FieldByName('f2').AsFloat := 0.314;
    FieldByName('f3').AsFloat := 0.31412345678;
    FieldByName('F4').AsFloat := 101.314;
    FieldByName('F5').AsCurrency := 101.99;
    FieldByName('F6').AsDateTime := EncodeDateTime(2007,12,25,12,30,15,0);
    FieldByName('F7').AsDateTime := EncodeDateTime(2007,12,25,12,30,29,130);
    FieldByName('F8').AsString := 'XX';
    FieldByName('F9').AsString := 'The Quick Brown Fox jumps over the lazy dog';
    S := CreateBlobStream(FieldByName('F10'),bmWrite);
    F := TFileStream.Create('resources/Test04.jpg',fmOpenRead);
    try
      S.CopyFrom(F,0);
    finally
      S.Free;
      F.Free;
    end;
    FieldByName('F11').AsLargeInt := 9223372036854775807;
    FieldByName('F12').AsInteger := 65566;
    FieldByName('F13').AsDateTime := EncodeDateTime(2007,12,26,12,30,45,0);
    Str := TStringList.Create;
    try
      Str.LoadFromFile('resources/Test04.txt');
      FieldByName('F14').AsString := Str.Text;
    finally
      Str.Free;
    end;
    if FCreateArrayOnInsert then
      ar := TIBArrayField(FieldByName('MyArray')).CreateArray
    else
      ar := (DataSet as TIBCustomDataset).GetArray(TIBArrayField(FieldByName('MyArray')));
    j := 100;
    for i := 0 to 16 do
    begin
      ar.SetAsInteger([i],j);
      dec(j);
    end;
    TIBArrayField(FieldByName('MyArray')).ArrayIntf := ar;
  end;
end;

procedure TTest04.HandleTransactionEdit(Sender: TObject);
begin
  writeln(OutFile,'Transaction Edit');
end;

procedure TTest04.HandleTransactionDelete(Sender: TObject);
begin
  writeln(OutFile,'Transaction Delete');
end;

procedure TTest04.HandleTransactionInsert(Sender: TObject);
begin
  writeln(OutFile,'Transaction Insert');
end;

procedure TTest04.HandleTransactionPost(Sender: TObject);
begin
  writeln(OutFile,'Transaction Post');
end;

procedure TTest04.HandleTransactionExecQuery(Sender: TObject);
begin
  write(OutFile,'Transaction Exec Query ');
  if Sender is TIBSQL then
    writeln(OutFile,'"',(Sender as TIBSQL).SQL.Text,'"')
  else
    writeln(OutFile);
end;

procedure TTest04.CreateObjects(Application: TTestApplication);
begin
  inherited CreateObjects(Application);
  FDataSet := TIBDataSet.Create(Application);
  with FDataSet do
  begin
    Database := IBDatabase;
    with IBTransaction do
    begin
      AfterEdit := @HandleTransactionEdit;
      AfterDelete := @HandleTransactionDelete;
      AfterInsert := @HandleTransactionInsert;
      AfterPost := @HandleTransactionPost;
      AfterExecQuery := @HandleTransactionExecQuery;
    end;
    SelectSQL.Text := 'Select A.TABLEKEY, A.F1, A.F2, A.F3, A.F4, A.F5, A.F6,'+
      ' A.F7, A.F8, A.F9, A.F10, A.F11, A."f12", A.F13, A.F14, A.MyArray, A.'+
      'GRANTS, A."My Field" as MYFIELD1, A."MY Field" as MYFIELD2 From IBXTEST A';
    InsertSQL.Text :=
      'Insert Into IBXTEST(TABLEKEY, F1, F2, F3, F4, F5, F6, F7, F8, F9, F10, F11, "f12", F13, F14, MyArray, '+
      ' GRANTS) Values(:TABLEKEY, :F1, :F2, :F3, :F4, :F5, :F6, :F7,'+
      ':F8, :F9, :F10, :F11, :F12, :F13, :F14, :MyArray, :GRANTS)';
    RefreshSQL.Text :=
      'Select A.TABLEKEY, A.F1, A.F2, A.F3, A.F4, A.F5, A.F6,' +
      ' A.F7, A.F8, A.F9, A.F10, A.F11, A."f12", A.F13, A.F14, A.MyArray, A.'+
      'GRANTS, A."My Field" as MYFIELD1, A."MY Field"  as MYFIELD2 From IBXTEST A '+
      'Where A.TABLEKEY = :TABLEKEY';
    ModifySQL.Text :=
        'Update IBXTEST A Set ' +
        '  A.F1 = :F1,' +
        '  A.F2 = :F2,' +
        '  A.F3 = :F3,' +
        '  A.F4 = :F4,' +
        '  A.F5 = :F5,' +
        '  A.F6 = :F6,' +
        '  A.F7 = :F7,' +
        '  A.F8 = :F8,' +
        '  A.F9 = :F9,' +
        '  A.F10 = :F10,' +
        '  A.F11 = :F11,' +
        '  A."f12" = :F12,' +
        '  A.F13 = :F13,' +
        '  A.F14 = :F14,' +
        '  A.MyArray = :MyArray, ' +
        '  A."My Field"  = :MYFIELD1,'+
        '  A."MY Field" = :MYFIELD2,'+
        '  A.GRANTS = :GRANTS '+
        'Where A.TABLEKEY = :OLD_TABLEKEY';
    DeleteSQL.Text :=
      'Delete From IBXTEST A '+
      'Where A.TABLEKEY = :OLD_TABLEKEY';
    DataSetCloseAction := dcSaveChanges;
    AutoCommit := acDisabled;
    GeneratorField.Generator := 'IBXGEN';
    GeneratorField.Field := 'TABLEKEY';
    GeneratorField.ApplyOnEvent := gaeOnNewRecord;
    AfterInsert := @HandleAfterInsert;
  end;
end;

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

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

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

procedure TTest04.RunTest(CharSet: AnsiString; SQLDialect: integer);
var OldDefaultFormatSettings: TFormatSettings;
begin
  OldDefaultFormatSettings := DefaultFormatSettings;
  IBDatabase.CreateDatabase;
  try
    DefaultFormatSettings.LongTimeFormat := 'HH:MM:SS.zzzz';
    IBTransaction.Active := true;
    FDataSet.Active := true;
    writeln(OutFile,'Add a record');
    FDataSet.Append;
    FDataSet.Post;
    writeln(OutFile,'Add and edit a record');
    FCreateArrayOnInsert := true;
    FDataSet.Append;
    FDataSet.Post;
    FDataSet.Edit;
    FDataSet.FieldByName('MYField1').AsString := 'My Field';
    FDataSet.FieldByName('MYFIELD2').AsString := 'MY Field';
    FDataSet.Post;
    IBTransaction.Commit;

    IBTransaction.Active := true;
    FDataSet.Active := true;
    PrintDataSet(FDataSet);
    writeln(OutFile,'Delete a record');
    FDataSet.First;
    FDataSet.Delete;
    PrintDataSet(FDataSet);
    writeln(OutFile,'Rollback Retaining');
    IBTransaction.RollbackRetaining;
    FDataSet.Active := false;
    FDataSet.Active := true;
    PrintDataSet(FDataSet);
    writeln(OutFile,'Delete a record');
    FDataSet.First;
    FDataSet.Delete;
    PrintDataSet(FDataSet);
    writeln(OutFile,'Rollback');
    IBTransaction.Rollback;
    IBTransaction.Active := true;
    FDataSet.Active := true;
    PrintDataSet(FDataSet);
    writeln(OutFile,'Commit Retaining');
    FDataSet.Append;
    FDataSet.Post;
    IBTransaction.CommitRetaining;
    FDataSet.Active := false;
    FDataSet.Active := true;
    PrintDataSet(FDataSet);
    writeln(OutFile,'Commit');
    IBTransaction.Commit;
    IBTransaction.Active := true;
    FDataSet.Active := true;
    PrintDataSet(FDataSet);
  finally
    IBDatabase.DropDatabase;
  end;

  writeln(Outfile,'Creating Database from SQL');
  IBDatabase.CreateDatabase('CREATE DATABASE ''' + Owner.GetNewDatabaseName +
                            ''' USER ''' + Owner.GetUserName +
                            ''' PASSWORD ''' + Owner.GetPassword + '''' +
                            ' DEFAULT CHARACTER SET UTF8');
  if IBDatabase.Connected then
  begin
    writeln(Outfile,'Database Name = ',IBDatabase.DatabaseName);
    try
      IBTransaction.Active := true;
      FDataSet.Active := true;
      writeln(OutFile,'Add a record');
      FDataSet.Append;
      FDataSet.Post;
      FDataSet.First;
      PrintDataSet(FDataSet);
    finally
      IBDatabase.DropDatabase;
    end;

  end
  else
    writeln(OutFile,'Create Database failed');
end;

initialization
  RegisterTest(TTest04);

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:	9525 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 Test04;
28
29	{$mode objfpc}{$H+}
30
31	{Test 4: handling of data types up to Firebird 3.
32
33	Tests, Append, Edit and Delete operations
34
35	Test both default createdatabase and createdatabasefromSQL
36	}
37
38	interface
39
40	uses
41	Classes, SysUtils, TestApplication, IBXTestBase, DB, IB, IBCustomDataSet;
42
43	const
44	aTestID = '04';
45	aTestTitle = 'Handling of data types up to Firebird 3';
46
47	type
48
49	{ TTest04 }
50
51	TTest04 = class(TIBXTestBase)
52	private
53	FDataSet: TIBDataSet;
54	FCreateArrayOnInsert: boolean;
55	procedure HandleAfterInsert(DataSet: TDataSet);
56	procedure HandleTransactionEdit(Sender: TObject);
57	procedure HandleTransactionDelete(Sender: TObject);
58	procedure HandleTransactionInsert(Sender: TObject);
59	procedure HandleTransactionPost(Sender: TObject);
60	procedure HandleTransactionExecQuery(Sender: TObject);
61	protected
62	procedure CreateObjects(Application: TTestApplication); override;
63	function GetTestID: AnsiString; override;
64	function GetTestTitle: AnsiString; override;
65	procedure InitTest; override;
66	public
67	procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
68	end;
69
70
71	implementation
72
73	uses DateUtils, IBSQL;
74
75	{ TTest04 }
76
77	procedure TTest04.HandleAfterInsert(DataSet: TDataSet);
78	var S, F: TStream;
79	Str: TStringList;
80	i,j: integer;
81	ar: IArray;
82	begin
83	with DataSet do
84	begin
85	FieldByName('F1').AsInteger := 2;
86	FieldByName('f2').AsFloat := 0.314;
87	FieldByName('f3').AsFloat := 0.31412345678;
88	FieldByName('F4').AsFloat := 101.314;
89	FieldByName('F5').AsCurrency := 101.99;
90	FieldByName('F6').AsDateTime := EncodeDateTime(2007,12,25,12,30,15,0);
91	FieldByName('F7').AsDateTime := EncodeDateTime(2007,12,25,12,30,29,130);
92	FieldByName('F8').AsString := 'XX';
93	FieldByName('F9').AsString := 'The Quick Brown Fox jumps over the lazy dog';
94	S := CreateBlobStream(FieldByName('F10'),bmWrite);
95	F := TFileStream.Create('resources/Test04.jpg',fmOpenRead);
96	try
97	S.CopyFrom(F,0);
98	finally
99	S.Free;
100	F.Free;
101	end;
102	FieldByName('F11').AsLargeInt := 9223372036854775807;
103	FieldByName('F12').AsInteger := 65566;
104	FieldByName('F13').AsDateTime := EncodeDateTime(2007,12,26,12,30,45,0);
105	Str := TStringList.Create;
106	try
107	Str.LoadFromFile('resources/Test04.txt');
108	FieldByName('F14').AsString := Str.Text;
109	finally
110	Str.Free;
111	end;
112	if FCreateArrayOnInsert then
113	ar := TIBArrayField(FieldByName('MyArray')).CreateArray
114	else
115	ar := (DataSet as TIBCustomDataset).GetArray(TIBArrayField(FieldByName('MyArray')));
116	j := 100;
117	for i := 0 to 16 do
118	begin
119	ar.SetAsInteger([i],j);
120	dec(j);
121	end;
122	TIBArrayField(FieldByName('MyArray')).ArrayIntf := ar;
123	end;
124	end;
125
126	procedure TTest04.HandleTransactionEdit(Sender: TObject);
127	begin
128	writeln(OutFile,'Transaction Edit');
129	end;
130
131	procedure TTest04.HandleTransactionDelete(Sender: TObject);
132	begin
133	writeln(OutFile,'Transaction Delete');
134	end;
135
136	procedure TTest04.HandleTransactionInsert(Sender: TObject);
137	begin
138	writeln(OutFile,'Transaction Insert');
139	end;
140
141	procedure TTest04.HandleTransactionPost(Sender: TObject);
142	begin
143	writeln(OutFile,'Transaction Post');
144	end;
145
146	procedure TTest04.HandleTransactionExecQuery(Sender: TObject);
147	begin
148	write(OutFile,'Transaction Exec Query ');
149	if Sender is TIBSQL then
150	writeln(OutFile,'"',(Sender as TIBSQL).SQL.Text,'"')
151	else
152	writeln(OutFile);
153	end;
154
155	procedure TTest04.CreateObjects(Application: TTestApplication);
156	begin
157	inherited CreateObjects(Application);
158	FDataSet := TIBDataSet.Create(Application);
159	with FDataSet do
160	begin
161	Database := IBDatabase;
162	with IBTransaction do
163	begin
164	AfterEdit := @HandleTransactionEdit;
165	AfterDelete := @HandleTransactionDelete;
166	AfterInsert := @HandleTransactionInsert;
167	AfterPost := @HandleTransactionPost;
168	AfterExecQuery := @HandleTransactionExecQuery;
169	end;
170	SelectSQL.Text := 'Select A.TABLEKEY, A.F1, A.F2, A.F3, A.F4, A.F5, A.F6,'+
171	' A.F7, A.F8, A.F9, A.F10, A.F11, A."f12", A.F13, A.F14, A.MyArray, A.'+
172	'GRANTS, A."My Field" as MYFIELD1, A."MY Field" as MYFIELD2 From IBXTEST A';
173	InsertSQL.Text :=
174	'Insert Into IBXTEST(TABLEKEY, F1, F2, F3, F4, F5, F6, F7, F8, F9, F10, F11, "f12", F13, F14, MyArray, '+
175	' GRANTS) Values(:TABLEKEY, :F1, :F2, :F3, :F4, :F5, :F6, :F7,'+
176	':F8, :F9, :F10, :F11, :F12, :F13, :F14, :MyArray, :GRANTS)';
177	RefreshSQL.Text :=
178	'Select A.TABLEKEY, A.F1, A.F2, A.F3, A.F4, A.F5, A.F6,' +
179	' A.F7, A.F8, A.F9, A.F10, A.F11, A."f12", A.F13, A.F14, A.MyArray, A.'+
180	'GRANTS, A."My Field" as MYFIELD1, A."MY Field" as MYFIELD2 From IBXTEST A '+
181	'Where A.TABLEKEY = :TABLEKEY';
182	ModifySQL.Text :=
183	'Update IBXTEST A Set ' +
184	' A.F1 = :F1,' +
185	' A.F2 = :F2,' +
186	' A.F3 = :F3,' +
187	' A.F4 = :F4,' +
188	' A.F5 = :F5,' +
189	' A.F6 = :F6,' +
190	' A.F7 = :F7,' +
191	' A.F8 = :F8,' +
192	' A.F9 = :F9,' +
193	' A.F10 = :F10,' +
194	' A.F11 = :F11,' +
195	' A."f12" = :F12,' +
196	' A.F13 = :F13,' +
197	' A.F14 = :F14,' +
198	' A.MyArray = :MyArray, ' +
199	' A."My Field" = :MYFIELD1,'+
200	' A."MY Field" = :MYFIELD2,'+
201	' A.GRANTS = :GRANTS '+
202	'Where A.TABLEKEY = :OLD_TABLEKEY';
203	DeleteSQL.Text :=
204	'Delete From IBXTEST A '+
205	'Where A.TABLEKEY = :OLD_TABLEKEY';
206	DataSetCloseAction := dcSaveChanges;
207	AutoCommit := acDisabled;
208	GeneratorField.Generator := 'IBXGEN';
209	GeneratorField.Field := 'TABLEKEY';
210	GeneratorField.ApplyOnEvent := gaeOnNewRecord;
211	AfterInsert := @HandleAfterInsert;
212	end;
213	end;
214
215	function TTest04.GetTestID: AnsiString;
216	begin
217	Result := aTestID;
218	end;
219
220	function TTest04.GetTestTitle: AnsiString;
221	begin
222	Result := aTestTitle;
223	end;
224
225	procedure TTest04.InitTest;
226	begin
227	IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
228	IBDatabase.CreateIfNotExists := true;
229	ReadWriteTransaction;
230	end;
231
232	procedure TTest04.RunTest(CharSet: AnsiString; SQLDialect: integer);
233	var OldDefaultFormatSettings: TFormatSettings;
234	begin
235	OldDefaultFormatSettings := DefaultFormatSettings;
236	IBDatabase.CreateDatabase;
237	try
238	DefaultFormatSettings.LongTimeFormat := 'HH:MM:SS.zzzz';
239	IBTransaction.Active := true;
240	FDataSet.Active := true;
241	writeln(OutFile,'Add a record');
242	FDataSet.Append;
243	FDataSet.Post;
244	writeln(OutFile,'Add and edit a record');
245	FCreateArrayOnInsert := true;
246	FDataSet.Append;
247	FDataSet.Post;
248	FDataSet.Edit;
249	FDataSet.FieldByName('MYField1').AsString := 'My Field';
250	FDataSet.FieldByName('MYFIELD2').AsString := 'MY Field';
251	FDataSet.Post;
252	IBTransaction.Commit;
253
254	IBTransaction.Active := true;
255	FDataSet.Active := true;
256	PrintDataSet(FDataSet);
257	writeln(OutFile,'Delete a record');
258	FDataSet.First;
259	FDataSet.Delete;
260	PrintDataSet(FDataSet);
261	writeln(OutFile,'Rollback Retaining');
262	IBTransaction.RollbackRetaining;
263	FDataSet.Active := false;
264	FDataSet.Active := true;
265	PrintDataSet(FDataSet);
266	writeln(OutFile,'Delete a record');
267	FDataSet.First;
268	FDataSet.Delete;
269	PrintDataSet(FDataSet);
270	writeln(OutFile,'Rollback');
271	IBTransaction.Rollback;
272	IBTransaction.Active := true;
273	FDataSet.Active := true;
274	PrintDataSet(FDataSet);
275	writeln(OutFile,'Commit Retaining');
276	FDataSet.Append;
277	FDataSet.Post;
278	IBTransaction.CommitRetaining;
279	FDataSet.Active := false;
280	FDataSet.Active := true;
281	PrintDataSet(FDataSet);
282	writeln(OutFile,'Commit');
283	IBTransaction.Commit;
284	IBTransaction.Active := true;
285	FDataSet.Active := true;
286	PrintDataSet(FDataSet);
287	finally
288	IBDatabase.DropDatabase;
289	end;
290
291	writeln(Outfile,'Creating Database from SQL');
292	IBDatabase.CreateDatabase('CREATE DATABASE ''' + Owner.GetNewDatabaseName +
293	''' USER ''' + Owner.GetUserName +
294	''' PASSWORD ''' + Owner.GetPassword + '''' +
295	' DEFAULT CHARACTER SET UTF8');
296	if IBDatabase.Connected then
297	begin
298	writeln(Outfile,'Database Name = ',IBDatabase.DatabaseName);
299	try
300	IBTransaction.Active := true;
301	FDataSet.Active := true;
302	writeln(OutFile,'Add a record');
303	FDataSet.Append;
304	FDataSet.Post;
305	FDataSet.First;
306	PrintDataSet(FDataSet);
307	finally
308	IBDatabase.DropDatabase;
309	end;
310
311	end
312	else
313	writeln(OutFile,'Create Database failed');
314	end;
315
316	initialization
317	RegisterTest(TTest04);
318
319	end.
320