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

{$mode objfpc}{$H+}

{Test 21: Big dataset test}

{ create a 100,000 record database.
  read it back and check for errors using an MD5 message digest.
}

interface

uses
  Classes, SysUtils,   TestApplication, IBXTestBase, IB, IBSQL;

const
  aTestID    = '21';
  aTestTitle = 'Big dataset test';

type

{ TTest21 }

  TTest21 = class(TIBXTestBase)
  private
    FIBSQL: TIBSQL;
    function StuffDatabase: TMsgHash;
    function ReadDatabase: TMsgHash;
  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;

const
  testText = 'The quick brown fox jumped over the lazy dog';
  RecordCount = 100000;

{ TTest21 }

function TTest21.StuffDatabase: TMsgHash;
var i: integer;
    HashString: AnsiString;
    Started: TDateTime;
begin
  Started := Now;
  Result := TMsgHash.CreateMsgHash;
  writeln(Outfile,'Loading data into database table. Started at ',DateTimeToStr(Started));
  IBTransaction.Active := true;
  for i := 1 to RecordCount do
  with FIBSQL do
  begin
    Params[0].AsInteger := i;
    Params[1].AsString := DateTimeToStr(Now) + testText + testText + testText + testText;
    Params[2].AsDateTime := Now;
    HashString := Params[0].Asstring + Params[1].AsString + DateTimeToStr(Params[2].AsDateTime);
    ExecQuery;
    Result.AddText(HashString);
  end;
  IBTransaction.Commit;
  Result.Finalise;
  writeln(OutFile, 'Data load completed at ',DateTimeToStr(Now), ' Elapsed Time = ',
    (MilliSecondsBetween(Now,Started)),' ms, ',RecordCount,' records loaded');
  writeln(Outfile,' Message Hash = ',Result.Digest);
end;

function TTest21.ReadDatabase: TMsgHash;
var Started: TDateTime;
    HashString: AnsiString;
    Count: integer;
begin
  Result := TMsgHash.CreateMsgHash;
  IBTransaction.Active := true;
  Started := Now;
  Count := 0;
  writeln(Outfile,'Database Read started at ',DateTimeToStr(Started));
  with IBQuery do
  begin
    Active := true;
    while not EOF do
    begin
      Inc(Count);
      HashString := Fields[0].AsString + Fields[1].AsString + DateTimeToStr(Fields[2].AsDateTime);
      Result.AddText(HashString);
      Next;
    end;
  end;
  writeln(OutFile, 'Read Dataset completed at ',DateTimeToStr(Now), ' Elapsed Time = ',
    (MilliSecondsBetween(Now,Started)), ' ms, ',Count,' records read');
  Result.Finalise;
  writeln(Outfile,' Message Hash = ',Result.Digest);
end;

procedure TTest21.CreateObjects(Application: TTestApplication);
begin
  inherited CreateObjects(Application);
  FIBSQL := TIBSQL.Create(Application);
  with FIBSQL do
  begin
    Database := IBDatabase;
    Transaction := IBTransaction;
    SQL.Text :=  'Insert into LotsOfData(RowID,Mytext,theDate) Values(?,?,?)';
    ParamCheck := false;
  end;
  IBQuery.SQL.Text := 'Select RowID,MyText,theDate from LotsOfData';
end;

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

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

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

procedure TTest21.RunTest(CharSet: AnsiString; SQLDialect: integer);
var InHash,OutHash: TMsgHash;
begin
  IBDatabase.CreateDatabase;
  try
    InHash := StuffDatabase;  {This creates a database holding a large 100,000 record table}
    try
      OutHash := ReadDatabase;
      try
        if InHash.SameHash(OutHash) then
          writeln(Outfile,'Test Completed successfully')
        else
          writeln(Outfile,'Test failed. Message checksum error');
        writeln(Outfile,DateTimeToStr(Now),' Test ',aTestID,' passes as long as the checksums are identical');
      finally
        OutHash.Free;
      end;
    finally
      Inhash.Free;
    end;
  finally
    IBDatabase.DropDatabase;
  end;
end;

initialization
  RegisterTest(TTest21);

end.

Revision:	345
Committed:	Mon Aug 23 14:22:29 2021 UTC (3 years, 3 months ago) by tony
Content type:	text/x-pascal
File size:	5060 byte(s)
Log Message:	Merged into public release
#	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 Test21;
28
29	{$mode objfpc}{$H+}
30
31	{Test 21: Big dataset test}
32
33	{ create a 100,000 record database.
34	read it back and check for errors using an MD5 message digest.
35	}
36
37	interface
38
39	uses
40	Classes, SysUtils, TestApplication, IBXTestBase, IB, IBSQL;
41
42	const
43	aTestID = '21';
44	aTestTitle = 'Big dataset test';
45
46	type
47
48	{ TTest21 }
49
50	TTest21 = class(TIBXTestBase)
51	private
52	FIBSQL: TIBSQL;
53	function StuffDatabase: TMsgHash;
54	function ReadDatabase: TMsgHash;
55	protected
56	procedure CreateObjects(Application: TTestApplication); override;
57	function GetTestID: AnsiString; override;
58	function GetTestTitle: AnsiString; override;
59	procedure InitTest; override;
60	public
61	procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
62	end;
63
64
65	implementation
66
67	uses DateUtils;
68
69	const
70	testText = 'The quick brown fox jumped over the lazy dog';
71	RecordCount = 100000;
72
73	{ TTest21 }
74
75	function TTest21.StuffDatabase: TMsgHash;
76	var i: integer;
77	HashString: AnsiString;
78	Started: TDateTime;
79	begin
80	Started := Now;
81	Result := TMsgHash.CreateMsgHash;
82	writeln(Outfile,'Loading data into database table. Started at ',DateTimeToStr(Started));
83	IBTransaction.Active := true;
84	for i := 1 to RecordCount do
85	with FIBSQL do
86	begin
87	Params[0].AsInteger := i;
88	Params[1].AsString := DateTimeToStr(Now) + testText + testText + testText + testText;
89	Params[2].AsDateTime := Now;
90	HashString := Params[0].Asstring + Params[1].AsString + DateTimeToStr(Params[2].AsDateTime);
91	ExecQuery;
92	Result.AddText(HashString);
93	end;
94	IBTransaction.Commit;
95	Result.Finalise;
96	writeln(OutFile, 'Data load completed at ',DateTimeToStr(Now), ' Elapsed Time = ',
97	(MilliSecondsBetween(Now,Started)),' ms, ',RecordCount,' records loaded');
98	writeln(Outfile,' Message Hash = ',Result.Digest);
99	end;
100
101	function TTest21.ReadDatabase: TMsgHash;
102	var Started: TDateTime;
103	HashString: AnsiString;
104	Count: integer;
105	begin
106	Result := TMsgHash.CreateMsgHash;
107	IBTransaction.Active := true;
108	Started := Now;
109	Count := 0;
110	writeln(Outfile,'Database Read started at ',DateTimeToStr(Started));
111	with IBQuery do
112	begin
113	Active := true;
114	while not EOF do
115	begin
116	Inc(Count);
117	HashString := Fields[0].AsString + Fields[1].AsString + DateTimeToStr(Fields[2].AsDateTime);
118	Result.AddText(HashString);
119	Next;
120	end;
121	end;
122	writeln(OutFile, 'Read Dataset completed at ',DateTimeToStr(Now), ' Elapsed Time = ',
123	(MilliSecondsBetween(Now,Started)), ' ms, ',Count,' records read');
124	Result.Finalise;
125	writeln(Outfile,' Message Hash = ',Result.Digest);
126	end;
127
128	procedure TTest21.CreateObjects(Application: TTestApplication);
129	begin
130	inherited CreateObjects(Application);
131	FIBSQL := TIBSQL.Create(Application);
132	with FIBSQL do
133	begin
134	Database := IBDatabase;
135	Transaction := IBTransaction;
136	SQL.Text := 'Insert into LotsOfData(RowID,Mytext,theDate) Values(?,?,?)';
137	ParamCheck := false;
138	end;
139	IBQuery.SQL.Text := 'Select RowID,MyText,theDate from LotsOfData';
140	end;
141
142	function TTest21.GetTestID: AnsiString;
143	begin
144	Result := aTestID;
145	end;
146
147	function TTest21.GetTestTitle: AnsiString;
148	begin
149	Result := aTestTitle;
150	end;
151
152	procedure TTest21.InitTest;
153	begin
154	IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
155	IBDatabase.CreateIfNotExists := true;
156	ReadWriteTransaction;
157	end;
158
159	procedure TTest21.RunTest(CharSet: AnsiString; SQLDialect: integer);
160	var InHash,OutHash: TMsgHash;
161	begin
162	IBDatabase.CreateDatabase;
163	try
164	InHash := StuffDatabase; {This creates a database holding a large 100,000 record table}
165	try
166	OutHash := ReadDatabase;
167	try
168	if InHash.SameHash(OutHash) then
169	writeln(Outfile,'Test Completed successfully')
170	else
171	writeln(Outfile,'Test failed. Message checksum error');
172	writeln(Outfile,DateTimeToStr(Now),' Test ',aTestID,' passes as long as the checksums are identical');
173	finally
174	OutHash.Free;
175	end;
176	finally
177	Inhash.Free;
178	end;
179	finally
180	IBDatabase.DropDatabase;
181	end;
182	end;
183
184	initialization
185	RegisterTest(TTest21);
186
187	end.
188