trunk/testsuite/Test04.pas

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