mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-17 19:49:22 +02:00
+ implemented a timeout in the dosbox wrapper, so that we don't wait forever if a test hangs
git-svn-id: branches/i8086@24222 -
This commit is contained in:
parent
3c6df5bedc
commit
f84fc17edc
@ -1,7 +1,7 @@
|
|||||||
{$MODE objfpc}{$H+}
|
{$MODE objfpc}{$H+}
|
||||||
|
|
||||||
uses
|
uses
|
||||||
SysUtils, StrUtils;
|
SysUtils, StrUtils, Process;
|
||||||
|
|
||||||
function GenerateTempDir: string;
|
function GenerateTempDir: string;
|
||||||
var
|
var
|
||||||
@ -103,6 +103,32 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure ExecuteDosBox(const ADosBoxBinaryPath, ADosBoxDir: string);
|
||||||
|
const
|
||||||
|
Timeout = 10*15; { 15 seconds }
|
||||||
|
var
|
||||||
|
Process: TProcess;
|
||||||
|
Time: Integer = 0;
|
||||||
|
begin
|
||||||
|
Process := TProcess.Create(nil);
|
||||||
|
try
|
||||||
|
Process.Executable := ADosBoxBinaryPath;
|
||||||
|
Process.Parameters.Add('-conf');
|
||||||
|
Process.Parameters.Add(ADosBoxDir + 'dosbox.conf');
|
||||||
|
Process.Execute;
|
||||||
|
repeat
|
||||||
|
Inc(Time);
|
||||||
|
if Time > Timeout then
|
||||||
|
break;
|
||||||
|
Sleep(100);
|
||||||
|
until not Process.Running;
|
||||||
|
if Process.Running then
|
||||||
|
Process.Terminate(254);
|
||||||
|
finally
|
||||||
|
Process.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure Cleanup(const ADosBoxDir: string);
|
procedure Cleanup(const ADosBoxDir: string);
|
||||||
|
|
||||||
procedure DeleteIfExists(const AFileName: string);
|
procedure DeleteIfExists(const AFileName: string);
|
||||||
@ -141,7 +167,7 @@ begin
|
|||||||
GenerateDosBoxConf(DosBoxDir);
|
GenerateDosBoxConf(DosBoxDir);
|
||||||
CopyFile(ExtractFilePath(ParamStr(0)) + 'exitcode.exe', DosBoxDir + 'EXITCODE.EXE');
|
CopyFile(ExtractFilePath(ParamStr(0)) + 'exitcode.exe', DosBoxDir + 'EXITCODE.EXE');
|
||||||
CopyFile(ParamStr(1), DosBoxDir + 'TEST.EXE');
|
CopyFile(ParamStr(1), DosBoxDir + 'TEST.EXE');
|
||||||
ExecuteProcess(DosBoxBinaryPath, '-conf ' + DosBoxDir + 'dosbox.conf');
|
ExecuteDosBox(DosBoxBinaryPath, DosBoxDir);
|
||||||
ExitCode := ReadExitCode(DosBoxDir);
|
ExitCode := ReadExitCode(DosBoxDir);
|
||||||
finally
|
finally
|
||||||
Cleanup(DosBoxDir);
|
Cleanup(DosBoxDir);
|
||||||
|
Loading…
Reference in New Issue
Block a user