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