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, MD5;

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

type

{ TTest21 }

  TTest21 = class(TIBXTestBase)
  private
    FIBSQL: TIBSQL;
    function StuffDatabase: TMDDigest;
    function ReadDatabase: TMDDigest;
  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: TMDDigest;
var i: integer;
    HashString: AnsiString;
    MD5Context: TMDContext;
    Started: TDateTime;
begin
  Started := Now;
  writeln(Outfile,'Loading data into database table. Started at ',DateTimeToStr(Started));
  MDInit(MD5Context,MD_VERSION_5);
  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;
    MDUpdate(MD5Context,PAnsiChar(HashString)^,Length(HashString));
  end;
  IBTransaction.Commit;
  MDFinal(MD5Context,Result);
  writeln(OutFile, 'Data load completed at ',DateTimeToStr(Now), ' Elapsed Time = ',
    (MilliSecondsBetween(Now,Started)),' ms, ',RecordCount,' records loaded');
  writeln(Outfile,' MD5 checksum = ',MD5Print(Result));
end;

function TTest21.ReadDatabase: TMDDigest;
var MD5Context: TMDContext;
    Started: TDateTime;
    HashString: AnsiString;
    Count: integer;
begin
  MDInit(MD5Context,MD_VERSION_5);
  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);
      MDUpdate(MD5Context,PAnsiChar(HashString)^,Length(HashString));
      Next;
    end;
  end;
  writeln(OutFile, 'Read Dataset completed at ',DateTimeToStr(Now), ' Elapsed Time = ',
    (MilliSecondsBetween(Now,Started)), ' ms, ',Count,' records read');
  MDFinal(MD5Context,Result);
  writeln(Outfile,' MD5 checksum = ',MD5Print(Result));
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 Digest: TMD5Digest;
begin
  IBDatabase.CreateDatabase;
  try
    Digest := StuffDatabase;  {This creates a database holding a large 100,000 record table}
    if MD5Match(Digest,ReadDatabase) then
      writeln(Outfile,'Test Completed successfully')
    else
      writeln(Outfile,'Test failed. MD5 checksum error');
    writeln(Outfile,DateTimeToStr(Now),' Test ',aTestID,' passes as long as the MD5 sums are identical');
  finally
    IBDatabase.DropDatabase;
  end;
end;

initialization
  RegisterTest(TTest21);

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:	5061 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 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, MD5;
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: TMDDigest;
54	function ReadDatabase: TMDDigest;
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: TMDDigest;
76	var i: integer;
77	HashString: AnsiString;
78	MD5Context: TMDContext;
79	Started: TDateTime;
80	begin
81	Started := Now;
82	writeln(Outfile,'Loading data into database table. Started at ',DateTimeToStr(Started));
83	MDInit(MD5Context,MD_VERSION_5);
84	IBTransaction.Active := true;
85	for i := 1 to RecordCount do
86	with FIBSQL do
87	begin
88	Params[0].AsInteger := i;
89	Params[1].AsString := DateTimeToStr(Now) + testText + testText + testText + testText;
90	Params[2].AsDateTime := Now;
91	HashString := Params[0].Asstring + Params[1].AsString + DateTimeToStr(Params[2].AsDateTime);
92	ExecQuery;
93	MDUpdate(MD5Context,PAnsiChar(HashString)^,Length(HashString));
94	end;
95	IBTransaction.Commit;
96	MDFinal(MD5Context,Result);
97	writeln(OutFile, 'Data load completed at ',DateTimeToStr(Now), ' Elapsed Time = ',
98	(MilliSecondsBetween(Now,Started)),' ms, ',RecordCount,' records loaded');
99	writeln(Outfile,' MD5 checksum = ',MD5Print(Result));
100	end;
101
102	function TTest21.ReadDatabase: TMDDigest;
103	var MD5Context: TMDContext;
104	Started: TDateTime;
105	HashString: AnsiString;
106	Count: integer;
107	begin
108	MDInit(MD5Context,MD_VERSION_5);
109	IBTransaction.Active := true;
110	Started := Now;
111	Count := 0;
112	writeln(Outfile,'Database Read started at ',DateTimeToStr(Started));
113	with IBQuery do
114	begin
115	Active := true;
116	while not EOF do
117	begin
118	Inc(Count);
119	HashString := Fields[0].AsString + Fields[1].AsString + DateTimeToStr(Fields[2].AsDateTime);
120	MDUpdate(MD5Context,PAnsiChar(HashString)^,Length(HashString));
121	Next;
122	end;
123	end;
124	writeln(OutFile, 'Read Dataset completed at ',DateTimeToStr(Now), ' Elapsed Time = ',
125	(MilliSecondsBetween(Now,Started)), ' ms, ',Count,' records read');
126	MDFinal(MD5Context,Result);
127	writeln(Outfile,' MD5 checksum = ',MD5Print(Result));
128	end;
129
130	procedure TTest21.CreateObjects(Application: TTestApplication);
131	begin
132	inherited CreateObjects(Application);
133	FIBSQL := TIBSQL.Create(Application);
134	with FIBSQL do
135	begin
136	Database := IBDatabase;
137	Transaction := IBTransaction;
138	SQL.Text := 'Insert into LotsOfData(RowID,Mytext,theDate) Values(?,?,?)';
139	ParamCheck := false;
140	end;
141	IBQuery.SQL.Text := 'Select RowID,MyText,theDate from LotsOfData';
142	end;
143
144	function TTest21.GetTestID: AnsiString;
145	begin
146	Result := aTestID;
147	end;
148
149	function TTest21.GetTestTitle: AnsiString;
150	begin
151	Result := aTestTitle;
152	end;
153
154	procedure TTest21.InitTest;
155	begin
156	IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
157	IBDatabase.CreateIfNotExists := true;
158	ReadWriteTransaction;
159	end;
160
161	procedure TTest21.RunTest(CharSet: AnsiString; SQLDialect: integer);
162	var Digest: TMD5Digest;
163	begin
164	IBDatabase.CreateDatabase;
165	try
166	Digest := StuffDatabase; {This creates a database holding a large 100,000 record table}
167	if MD5Match(Digest,ReadDatabase) then
168	writeln(Outfile,'Test Completed successfully')
169	else
170	writeln(Outfile,'Test failed. MD5 checksum error');
171	writeln(Outfile,DateTimeToStr(Now),' Test ',aTestID,' passes as long as the MD5 sums are identical');
172	finally
173	IBDatabase.DropDatabase;
174	end;
175	end;
176
177	initialization
178	RegisterTest(TTest21);
179
180	end.
181