mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-09 20:28:19 +02:00
tests: log compiler output is compilation of a test project fails.
git-svn-id: trunk@16166 -
This commit is contained in:
vincents
parent
a4c53780ce
commit
caea24aa16
@ -46,68 +46,10 @@ type
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
// Maximal number of bytes read from stream
|
||||
READ_BYTES = 2048;
|
||||
// Maximal run time for a test program
|
||||
TIME_OUT = 30;
|
||||
|
||||
var
|
||||
BufferedOutput: TMemoryStream; // a global variable is not nice, but it works.
|
||||
// a global variable to pass information between tests is not nice, but it works
|
||||
RunOutput: TStringList;
|
||||
|
||||
procedure ReadOutput(AProcess:TProcess);
|
||||
var
|
||||
BytesRead: Integer;
|
||||
n: Integer;
|
||||
EndTime: TDateTime;
|
||||
begin
|
||||
BytesRead := 0;
|
||||
BufferedOutput.Clear;
|
||||
EndTime := Now + TIME_OUT / (24 * 60 * 60);
|
||||
while AProcess.Running and (Now<EndTime) do
|
||||
begin
|
||||
// make sure we have room
|
||||
BufferedOutput.SetSize(BytesRead + READ_BYTES);
|
||||
|
||||
// try reading it
|
||||
{$IFNDEF VER2_0}
|
||||
if AProcess.Output.NumBytesAvailable>0 then begin
|
||||
n := AProcess.Output.Read((BufferedOutput.Memory + BytesRead)^, READ_BYTES);
|
||||
Inc(BytesRead, n)
|
||||
end
|
||||
else
|
||||
// no data, wait 100 ms
|
||||
Sleep(100);
|
||||
{$ELSE}
|
||||
n := AProcess.Output.Read((BufferedOutput.Memory + BytesRead)^, READ_BYTES);
|
||||
if n>0 then
|
||||
Inc(BytesRead, n)
|
||||
else
|
||||
// no data, wait 100 ms
|
||||
Sleep(100);
|
||||
{$ENDIF}
|
||||
end;
|
||||
// read last part
|
||||
repeat
|
||||
// make sure we have room
|
||||
BufferedOutput.SetSize(BytesRead + READ_BYTES);
|
||||
// try reading it
|
||||
{$IFNDEF VER2_0}
|
||||
if AProcess.Output.NumBytesAvailable>0 then begin
|
||||
n := AProcess.Output.Read((BufferedOutput.Memory + BytesRead)^, READ_BYTES);
|
||||
Inc(BytesRead, n);
|
||||
end
|
||||
else
|
||||
n := 0;
|
||||
{$ELSE}
|
||||
n := AProcess.Output.Read((BufferedOutput.Memory + BytesRead)^, READ_BYTES);
|
||||
if n>0 then
|
||||
Inc(BytesRead, n);
|
||||
{$ENDIF}
|
||||
until n <= 0;
|
||||
BufferedOutput.SetSize(BytesRead);
|
||||
end;
|
||||
|
||||
function FindProjectFile(APath: string):string;
|
||||
var
|
||||
SearchRec: TSearchRec;
|
||||
@ -159,6 +101,7 @@ procedure TBugTestCase.RunTestApp;
|
||||
var
|
||||
TestProcess : TProcess;
|
||||
ExeName: string;
|
||||
OutputLines: TStringList;
|
||||
begin
|
||||
ExeName := ChangeFileExt(FProjectFile, GetExeExt);
|
||||
AssertTrue(ExeName + 'does not exist.', FileExists(ExeName));
|
||||
@ -168,7 +111,12 @@ begin
|
||||
TestProcess.Options := [poUsePipes];
|
||||
TestProcess.Execute;
|
||||
try
|
||||
ReadOutput(TestProcess);
|
||||
OutputLines := ReadOutput(TestProcess);
|
||||
try
|
||||
RunOutput.Assign(OutputLines);
|
||||
finally
|
||||
OutputLines.Free;
|
||||
end;
|
||||
AssertFalse('TestProcess did not auto-terminate', TestProcess.Running);
|
||||
finally
|
||||
TestProcess.Terminate(0);
|
||||
@ -193,9 +141,8 @@ begin
|
||||
try
|
||||
ExpectedLines := TStringList.Create;
|
||||
ExpectedLines.LoadFromFile(ExpectedFileName);
|
||||
BufferedOutput.Position := 0;
|
||||
ActualLines := TStringList.Create;
|
||||
ActualLines.LoadFromStream(BufferedOutput);
|
||||
ActualLines.Assign(RunOutput);
|
||||
MinLineCount := min(ExpectedLines.Count, ActualLines.Count);
|
||||
for i := 0 to MinLineCount - 1 do begin
|
||||
AssertEquals('Output difference on line '+IntToStr(i+1),
|
||||
@ -253,9 +200,9 @@ end;
|
||||
|
||||
initialization
|
||||
GatherTests;
|
||||
BufferedOutput := TMemoryStream.Create;
|
||||
RunOutput := TStringList.Create;
|
||||
|
||||
finalization
|
||||
FreeAndNil(BufferedOutput);
|
||||
FreeAndNil(RunOutput);
|
||||
end.
|
||||
|
||||
|
||||
@ -35,7 +35,7 @@
|
||||
<PackageName Value="CodeTools"/>
|
||||
</Item4>
|
||||
</RequiredPackages>
|
||||
<Units Count="7">
|
||||
<Units Count="8">
|
||||
<Unit0>
|
||||
<Filename Value="runtestsgui.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
@ -71,17 +71,19 @@
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="testfileproc"/>
|
||||
</Unit6>
|
||||
<Unit7>
|
||||
<Filename Value="bugtestcase.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="BugTestCase"/>
|
||||
</Unit7>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="5"/>
|
||||
<Version Value="8"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<OtherUnitFiles Value="bugs\"/>
|
||||
</SearchPaths>
|
||||
<CodeGeneration>
|
||||
<Generate Value="Faster"/>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<UseHeaptrc Value="True"/>
|
||||
|
||||
@ -23,16 +23,68 @@ unit testglobals;
|
||||
interface
|
||||
|
||||
uses
|
||||
fpcunit, testregistry;
|
||||
fpcunit, testregistry,
|
||||
classes, sysutils, process;
|
||||
|
||||
var
|
||||
Compiler: string;
|
||||
BugsTestSuite: TTestSuite;
|
||||
|
||||
|
||||
// reads the output from a process and puts it in a memory stream
|
||||
function ReadOutput(AProcess:TProcess): TStringList;
|
||||
procedure AddToBugsTestSuite(ATest: TTest);
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
// Maximal number of bytes read from stream
|
||||
READ_BYTES = 4096;
|
||||
// Maximal run time for a test program
|
||||
TIME_OUT = 30;
|
||||
|
||||
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);
|
||||
|
||||
@ -132,15 +132,17 @@ procedure TLpkTest.TestCompile;
|
||||
var
|
||||
LazBuildPath: string;
|
||||
LazBuild: TProcess;
|
||||
OutputLines: TStrings;
|
||||
begin
|
||||
LazBuildPath := LazarusDir + 'lazbuild' + GetExeExt;
|
||||
AssertTrue(LazBuildPath + ' does not exist', FileExists(LazBuildPath));
|
||||
LazBuild := TProcess.Create(nil);
|
||||
OutputLines := nil;
|
||||
try
|
||||
{$IFDEF windows}
|
||||
LazBuild.Options := [poNewConsole];
|
||||
LazBuild.Options := [poNewConsole, poUsePipes];
|
||||
{$ELSE}
|
||||
LazBuild.Options := [poNoConsole];
|
||||
LazBuild.Options := [poNoConsole, poUsePipes];
|
||||
{$ENDIF}
|
||||
LazBuild.ShowWindow := swoHIDE;
|
||||
LazBuild.CommandLine := LazBuildPath;
|
||||
@ -149,10 +151,14 @@ begin
|
||||
LazBuild.CommandLine := LazBuild.CommandLine + ' -B ' + FPath;
|
||||
LazBuild.CurrentDirectory := ExtractFileDir(FPath);
|
||||
LazBuild.Execute;
|
||||
OutputLines := ReadOutput(LazBuild);
|
||||
LazBuild.WaitOnExit;
|
||||
AssertEquals('Compilation failed: ExitCode', 0, LazBuild.ExitStatus);
|
||||
if LazBuild.ExitStatus<>0 then
|
||||
Fail(format('Compilation failed: ExitCode=%d%s%s',
|
||||
[LazBuild.ExitStatus, LineEnding, OutputLines.Text]));
|
||||
finally
|
||||
LazBuild.Free;
|
||||
OutputLines.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user