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, 2 months ago) by tony
Content type:	text/x-pascal
File size:	5060 byte(s)
Log Message:	Merged into public release
#	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	tony	345	Classes, SysUtils, TestApplication, IBXTestBase, IB, IBSQL;
41	tony	315
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	tony	345	function StuffDatabase: TMsgHash;
54			function ReadDatabase: TMsgHash;
55	tony	315	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	tony	345	function TTest21.StuffDatabase: TMsgHash;
76	tony	315	var i: integer;
77			HashString: AnsiString;
78			Started: TDateTime;
79			begin
80			Started := Now;
81	tony	345	Result := TMsgHash.CreateMsgHash;
82	tony	315	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	tony	345	Result.AddText(HashString);
93	tony	315	end;
94			IBTransaction.Commit;
95	tony	345	Result.Finalise;
96	tony	315	writeln(OutFile, 'Data load completed at ',DateTimeToStr(Now), ' Elapsed Time = ',
97			(MilliSecondsBetween(Now,Started)),' ms, ',RecordCount,' records loaded');
98	tony	345	writeln(Outfile,' Message Hash = ',Result.Digest);
99	tony	315	end;
100
101	tony	345	function TTest21.ReadDatabase: TMsgHash;
102			var Started: TDateTime;
103	tony	315	HashString: AnsiString;
104			Count: integer;
105			begin
106	tony	345	Result := TMsgHash.CreateMsgHash;
107	tony	315	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	tony	345	Result.AddText(HashString);
119	tony	315	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	tony	345	Result.Finalise;
125			writeln(Outfile,' Message Hash = ',Result.Digest);
126	tony	315	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	tony	345	var InHash,OutHash: TMsgHash;
161	tony	315	begin
162			IBDatabase.CreateDatabase;
163			try
164	tony	345	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	tony	315	finally
180			IBDatabase.DropDatabase;
181			end;
182			end;
183
184			initialization
185			RegisterTest(TTest21);
186
187			end.
188