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, 9 months ago) by tony
Content type:	text/x-pascal
File size:	5061 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 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	tony	323	writeln(Outfile,DateTimeToStr(Now),' Test ',aTestID,' passes as long as the MD5 sums are identical');
172	tony	315	finally
173			IBDatabase.DropDatabase;
174			end;
175			end;
176
177			initialization
178			RegisterTest(TTest21);
179
180			end.
181