1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
{ Copyright (C) 2007 Vincent Snijders
This source is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free
Software Foundation; either version 2 of the License, or (at your option)
any later version.
This code is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
details.
A copy of the GNU General Public License is available on the World Wide Web
at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
to the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor,
Boston, MA 02110-1335, USA.
}
unit testglobals;
{$mode objfpc}{$H+}
interface
uses
fpcunit, testregistry,
classes, sysutils, process;
var
Compiler: string;
PrimaryConfigPath: string;
BugsTestSuite: TTestSuite;
LazUtilsTestSuite: TTestSuite;
LCLTestSuite: TTestSuite;
IDEIntfTestSuite: TTestSuite;
SemiAutoTestSuite: TTestSuite;
// reads the output from a process and puts it in a memory stream
function ReadOutput(AProcess:TProcess): TStringList;
procedure AddToBugsTestSuite(ATest: TTest);
procedure AddToLazUtilsTestSuite(ATestClass: TClass);
procedure AddToLCLTestSuite(ATestClass: TClass);
procedure AddToIDEIntfTestSuite(ATestClass: TClass);
procedure AddToSemiAutoTestSuite(ATestClass: TClass);
implementation
const
// Maximal number of bytes read from stream
READ_BYTES = 4096;
// Maximal run time for a test program
TIME_OUT = 120;
function ReadOutput(AProcess:TProcess): TStringList;
var
BytesRead: Integer;
n: Integer;
EndTime: TDateTime;
OutputStream: TMemoryStream;
begin
OutputStream := TMemoryStream.Create;
BytesRead := 0;
EndTime := Now + TIME_OUT / (24 * 60 * 60);
while AProcess.Running and (Now<EndTime) do
begin
// make sure we have room
OutputStream.SetSize(BytesRead + READ_BYTES);
// try reading it
if AProcess.Output.NumBytesAvailable>0 then begin
n := AProcess.Output.Read((OutputStream.Memory + BytesRead)^, READ_BYTES);
Inc(BytesRead, n)
end
else
// no data, wait 100 ms
Sleep(100);
end;
// read last part
repeat
// make sure we have room
OutputStream.SetSize(BytesRead + READ_BYTES);
// try reading it
if AProcess.Output.NumBytesAvailable>0 then begin
n := AProcess.Output.Read((OutputStream.Memory + BytesRead)^, READ_BYTES);
Inc(BytesRead, n);
end
else
n := 0;
until n <= 0;
OutputStream.SetSize(BytesRead);
OutputStream.Position:=0;
Result := TStringList.Create;
Result.LoadFromStream(OutputStream);
OutputStream.Free;
end;
procedure AddToBugsTestSuite(ATest: TTest);
begin
BugsTestSuite.AddTest(ATest);
end;
procedure AddToLazUtilsTestSuite(ATestClass: TClass);
begin
LazUtilsTestSuite.AddTestSuiteFromClass(ATestClass);
end;
procedure AddToLCLTestSuite(ATestClass: TClass);
begin
LCLTestSuite.AddTestSuiteFromClass(ATestClass);
end;
procedure AddToIDEIntfTestSuite(ATestClass: TClass);
begin
IDEIntfTestSuite.AddTestSuiteFromClass(ATestClass);
end;
procedure AddToSemiAutoTestSuite(ATestClass: TClass);
begin
SemiAutoTestSuite.AddTestSuiteFromClass(ATestClass);
end;
initialization
GetTestRegistry.TestName := 'All tests';
BugsTestSuite := TTestSuite.Create('Bugs');
GetTestRegistry.AddTest(BugsTestSuite);
LazUtilsTestSuite := TTestSuite.Create('LazUtils tests');
GetTestRegistry.AddTest(LazUtilsTestSuite);
LCLTestSuite := TTestSuite.Create('LCL tests');
GetTestRegistry.AddTest(LCLTestSuite);
IDEIntfTestSuite := TTestSuite.Create('IDEIntf tests');
GetTestRegistry.AddTest(IDEIntfTestSuite);
SemiAutoTestSuite := TTestSuite.Create('Semi Automatic tests');
GetTestRegistry.AddTest(SemiAutoTestSuite);
end.
|
