|
@@ -1,7 +1,30 @@
|
|
{$MODE objfpc}{$H+}
|
|
{$MODE objfpc}{$H+}
|
|
|
|
|
|
uses
|
|
uses
|
|
- SysUtils, StrUtils, Process;
|
|
|
|
|
|
+ SysUtils, StrUtils,
|
|
|
|
+{$ifdef UseSignals}
|
|
|
|
+ signals,
|
|
|
|
+{$endif def UseSignals}
|
|
|
|
+ testu, classes,
|
|
|
|
+ Process;
|
|
|
|
+
|
|
|
|
+const
|
|
|
|
+ use_temp_dir : boolean = true;
|
|
|
|
+ need_cwsdpmi : boolean = false;
|
|
|
|
+ cwsdpmi_file : string = '';
|
|
|
|
+ hide_execution : boolean = true;
|
|
|
|
+ do_exit : boolean = true;
|
|
|
|
+ verbose : boolean = false;
|
|
|
|
+ DosBoxProcess: TProcess = nil;
|
|
|
|
+ dosbox_timeout : integer = 400; { default timeout in seconds }
|
|
|
|
+ DosBoxExitStatus : integer = -1;
|
|
|
|
+var
|
|
|
|
+ OutputFileName : String;
|
|
|
|
+ SourceFileName : String;
|
|
|
|
+ StartDir, DosBoxDir: string;
|
|
|
|
+ ExitCode: Integer = 255;
|
|
|
|
+ DosBoxBinaryPath: string;
|
|
|
|
+ TmpFileList : TStringList;
|
|
|
|
|
|
function GenerateTempDir: string;
|
|
function GenerateTempDir: string;
|
|
var
|
|
var
|
|
@@ -13,6 +36,8 @@ begin
|
|
repeat
|
|
repeat
|
|
try
|
|
try
|
|
FileName := TempDir + 'dosboxwrappertmp_' + IntToStr(Random(100000));
|
|
FileName := TempDir + 'dosboxwrappertmp_' + IntToStr(Random(100000));
|
|
|
|
+ if verbose then
|
|
|
|
+ writeln('Trying to create directory ',Filename);
|
|
MkDir(FileName);
|
|
MkDir(FileName);
|
|
Done := True;
|
|
Done := True;
|
|
except
|
|
except
|
|
@@ -20,7 +45,10 @@ begin
|
|
begin
|
|
begin
|
|
{ 5 = Access Denied, returned when a file is duplicated }
|
|
{ 5 = Access Denied, returned when a file is duplicated }
|
|
if E.ErrorCode <> 5 then
|
|
if E.ErrorCode <> 5 then
|
|
- raise;
|
|
|
|
|
|
+ begin
|
|
|
|
+ Writeln('Directory creation failed');
|
|
|
|
+ raise;
|
|
|
|
+ end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
until Done;
|
|
until Done;
|
|
@@ -31,10 +59,13 @@ procedure GenerateDosBoxConf(const ADosBoxDir: string);
|
|
var
|
|
var
|
|
SourceConfFileName, TargetConfFileName: string;
|
|
SourceConfFileName, TargetConfFileName: string;
|
|
SourceFile, TargetFile: TextFile;
|
|
SourceFile, TargetFile: TextFile;
|
|
- S: string;
|
|
|
|
|
|
+ OrigS, S: string;
|
|
begin
|
|
begin
|
|
SourceConfFileName := ExtractFilePath(ParamStr(0)) + 'dosbox.conf';
|
|
SourceConfFileName := ExtractFilePath(ParamStr(0)) + 'dosbox.conf';
|
|
TargetConfFileName := ADosBoxDir + 'dosbox.conf';
|
|
TargetConfFileName := ADosBoxDir + 'dosbox.conf';
|
|
|
|
+ OutputFileName := ADosBoxDir + 'dosbox.out';
|
|
|
|
+ if verbose then
|
|
|
|
+ Writeln('Using target dosbox.conf ',TargetConfFileName);
|
|
AssignFile(SourceFile, SourceConfFileName);
|
|
AssignFile(SourceFile, SourceConfFileName);
|
|
AssignFile(TargetFile, TargetConfFileName);
|
|
AssignFile(TargetFile, TargetConfFileName);
|
|
Reset(SourceFile);
|
|
Reset(SourceFile);
|
|
@@ -44,7 +75,15 @@ begin
|
|
while not EoF(SourceFile) do
|
|
while not EoF(SourceFile) do
|
|
begin
|
|
begin
|
|
Readln(SourceFile, S);
|
|
Readln(SourceFile, S);
|
|
|
|
+ OrigS:=S;
|
|
S := AnsiReplaceStr(S, '$DosBoxDir', ADosBoxDir);
|
|
S := AnsiReplaceStr(S, '$DosBoxDir', ADosBoxDir);
|
|
|
|
+ S := AnsiReplaceStr(S, '$wrapper_output', OutputFileName);
|
|
|
|
+ if do_exit then
|
|
|
|
+ S := AnsiReplaceStr(S, '$exit', 'exit')
|
|
|
|
+ else
|
|
|
|
+ S := AnsiReplaceStr(S, '$exit', '');
|
|
|
|
+ If verbose and (OrigS <> S) then
|
|
|
|
+ Writeln('"',OrigS,'" transformed into "',S,'"');
|
|
Writeln(TargetFile, S);
|
|
Writeln(TargetFile, S);
|
|
end;
|
|
end;
|
|
finally
|
|
finally
|
|
@@ -55,6 +94,17 @@ begin
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
+{ File names in Config entries assume that
|
|
|
|
+ executables have no suffix }
|
|
|
|
+function TargetFileExists(AName : string) : boolean;
|
|
|
|
+begin
|
|
|
|
+ result:=SysUtils.FileExists(AName);
|
|
|
|
+ if not result then
|
|
|
|
+ result:=SysUtils.FileExists(AName+'.exe');
|
|
|
|
+ if not result then
|
|
|
|
+ result:=SysUtils.FileExists(AName+'.EXE');
|
|
|
|
+end;
|
|
|
|
+
|
|
procedure CopyFile(ASrcFileName, ADestFileName: string);
|
|
procedure CopyFile(ASrcFileName, ADestFileName: string);
|
|
var
|
|
var
|
|
SrcF, DestF: File;
|
|
SrcF, DestF: File;
|
|
@@ -62,98 +112,450 @@ var
|
|
Buf: array [0..4095] of Byte;
|
|
Buf: array [0..4095] of Byte;
|
|
BytesRead: Integer;
|
|
BytesRead: Integer;
|
|
begin
|
|
begin
|
|
- Writeln('CopyFile ', ASrcFileName, '->', ADestFileName);
|
|
|
|
- if not AnsiEndsText('.exe', ASrcFileName) then
|
|
|
|
|
|
+ if not AnsiEndsText('.exe', ASrcFileName) and AnsiEndsText('.EXE',ADestFileName) then
|
|
ASrcFileName := ASrcFileName + '.exe';
|
|
ASrcFileName := ASrcFileName + '.exe';
|
|
|
|
+ if not FileExists(ASrcFileName) then
|
|
|
|
+ begin
|
|
|
|
+ ASrcFileName:=ASrcFileName+'.exe';
|
|
|
|
+ ADestFileName:=ADestFileName+'.exe';
|
|
|
|
+ end;
|
|
|
|
+ if verbose then
|
|
|
|
+ Writeln('CopyFile "', ASrcFileName, '" -> "', ADestFileName,'"');
|
|
OldFileMode := FileMode;
|
|
OldFileMode := FileMode;
|
|
try
|
|
try
|
|
- AssignFile(SrcF, ASrcFileName);
|
|
|
|
- AssignFile(DestF, ADestFileName);
|
|
|
|
- FileMode := fmOpenRead;
|
|
|
|
- Reset(SrcF, 1);
|
|
|
|
try
|
|
try
|
|
- FileMode := fmOpenWrite;
|
|
|
|
|
|
+ AssignFile(SrcF, ASrcFileName);
|
|
|
|
+ AssignFile(DestF, ADestFileName);
|
|
|
|
+ FileMode := fmOpenRead;
|
|
|
|
+ Reset(SrcF, 1);
|
|
try
|
|
try
|
|
- Rewrite(DestF, 1);
|
|
|
|
- repeat
|
|
|
|
- BlockRead(SrcF, Buf, SizeOf(Buf), BytesRead);
|
|
|
|
- BlockWrite(DestF, Buf, BytesRead);
|
|
|
|
- until BytesRead < SizeOf(Buf);
|
|
|
|
|
|
+ FileMode := fmOpenWrite;
|
|
|
|
+ try
|
|
|
|
+ Rewrite(DestF, 1);
|
|
|
|
+ repeat
|
|
|
|
+ BlockRead(SrcF, Buf, SizeOf(Buf), BytesRead);
|
|
|
|
+ BlockWrite(DestF, Buf, BytesRead);
|
|
|
|
+ until BytesRead < SizeOf(Buf);
|
|
|
|
+ finally
|
|
|
|
+ CloseFile(DestF);
|
|
|
|
+ end;
|
|
finally
|
|
finally
|
|
- CloseFile(DestF);
|
|
|
|
|
|
+ CloseFile(SrcF);
|
|
end;
|
|
end;
|
|
finally
|
|
finally
|
|
- CloseFile(SrcF);
|
|
|
|
|
|
+ FileMode := OldFileMode;
|
|
end;
|
|
end;
|
|
- finally
|
|
|
|
- FileMode := OldFileMode;
|
|
|
|
|
|
+ except
|
|
|
|
+ on E : Exception do
|
|
|
|
+ writeln('Error: '+ E.ClassName + #13#10 + E.Message );
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
+function ForceExtension(Const HStr,ext:String):String;
|
|
|
|
+{
|
|
|
|
+ Return a filename which certainly has the extension ext
|
|
|
|
+}
|
|
|
|
+var
|
|
|
|
+ j : longint;
|
|
|
|
+begin
|
|
|
|
+ j:=length(Hstr);
|
|
|
|
+ while (j>0) and (Hstr[j]<>'.') do
|
|
|
|
+ dec(j);
|
|
|
|
+ if j=0 then
|
|
|
|
+ j:=length(Hstr)+1;
|
|
|
|
+ if Ext<>'' then
|
|
|
|
+ begin
|
|
|
|
+ if Ext[1]='.' then
|
|
|
|
+ ForceExtension:=Copy(Hstr,1,j-1)+Ext
|
|
|
|
+ else
|
|
|
|
+ ForceExtension:=Copy(Hstr,1,j-1)+'.'+Ext
|
|
|
|
+ end
|
|
|
|
+ else
|
|
|
|
+ ForceExtension:=Copy(Hstr,1,j-1);
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+procedure CopyNeededFiles;
|
|
|
|
+var
|
|
|
|
+ Config : TConfig;
|
|
|
|
+ LocalFile, RemoteFile, s: string;
|
|
|
|
+ LocalPath: string;
|
|
|
|
+ i : integer;
|
|
|
|
+ FileList : TStringList;
|
|
|
|
+ RelativeToConfigMarker : TObject;
|
|
|
|
+
|
|
|
|
+ function SplitPath(const s:string):string;
|
|
|
|
+ var
|
|
|
|
+ i : longint;
|
|
|
|
+ begin
|
|
|
|
+ i:=Length(s);
|
|
|
|
+ while (i>0) and not(s[i] in ['/','\'{$IFDEF MACOS},':'{$ENDIF}]) do
|
|
|
|
+ dec(i);
|
|
|
|
+ SplitPath:=Copy(s,1,i);
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+ function BuildFileList: TStringList;
|
|
|
|
+ var
|
|
|
|
+ dfl, fl : string;
|
|
|
|
+ begin
|
|
|
|
+ fl:=Trim(Config.Files);
|
|
|
|
+ dfl:=Trim(Config.DelFiles);
|
|
|
|
+ if (fl='') and (dfl='') and (Config.ConfigFileSrc='') then
|
|
|
|
+ begin
|
|
|
|
+ Result:=nil;
|
|
|
|
+ exit;
|
|
|
|
+ end;
|
|
|
|
+ Result:=TStringList.Create;
|
|
|
|
+ while fl<>'' do
|
|
|
|
+ begin
|
|
|
|
+ LocalFile:=Trim(GetToken(fl, [' ',',',';']));
|
|
|
|
+ Result.Add(LocalFile);
|
|
|
|
+ if verbose then
|
|
|
|
+ writeln('Adding file ',LocalFile,' from Config.Files');
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+ if Config.ConfigFileSrc<>'' then
|
|
|
|
+ begin
|
|
|
|
+ if Config.ConfigFileSrc=Config.ConfigFileDst then
|
|
|
|
+ Result.AddObject(Config.ConfigFileSrc,RelativeToConfigMarker)
|
|
|
|
+ else
|
|
|
|
+ Result.AddObject(Config.ConfigFileSrc+'='+Config.ConfigFileDst,RelativeToConfigMarker);
|
|
|
|
+ if verbose then
|
|
|
|
+ writeln('Adding config file Src=',Config.ConfigFileSrc,' Dst=',Config.ConfigFileDst);
|
|
|
|
+ end;
|
|
|
|
+ while dfl <> '' do
|
|
|
|
+ begin
|
|
|
|
+ LocalFile:=Trim(GetToken(dfl, [' ',',',';']));
|
|
|
|
+ Result.Add(LocalFile);
|
|
|
|
+ if verbose then
|
|
|
|
+ writeln('Adding file ',LocalFile,' from Config.DelFiles');
|
|
|
|
+ end;
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+var
|
|
|
|
+ ddir : string;
|
|
|
|
+ param1_dir : string;
|
|
|
|
+begin
|
|
|
|
+ param1_dir:=ExtractFilePath(ParamStr(1));
|
|
|
|
+ if not IsAbsolute(SourceFileName) and not TargetFileExists(SourceFileName) then
|
|
|
|
+ begin
|
|
|
|
+ ddir:=GetEnvironmentVariable('BASEDIR');
|
|
|
|
+ if ddir='' then
|
|
|
|
+ GetDir(0,ddir);
|
|
|
|
+ // writeln('Start ddir=',ddir);
|
|
|
|
+ while (ddir<>'') do
|
|
|
|
+ begin
|
|
|
|
+ if TargetFileExists(ddir+DirectorySeparator+SourceFileName) then
|
|
|
|
+ begin
|
|
|
|
+ SourceFileName:=ddir+DirectorySeparator+SourceFileName;
|
|
|
|
+ break;
|
|
|
|
+ end
|
|
|
|
+ else
|
|
|
|
+ begin
|
|
|
|
+ if ddir=splitpath(ddir) then
|
|
|
|
+ break
|
|
|
|
+ else
|
|
|
|
+ ddir:=splitpath(ddir);
|
|
|
|
+ if ddir[length(ddir)]=DirectorySeparator then
|
|
|
|
+ ddir:=copy(ddir,1,length(ddir)-1);
|
|
|
|
+ // writeln('Next ddir=',ddir);
|
|
|
|
+ end;
|
|
|
|
+ end;
|
|
|
|
+ end;
|
|
|
|
+ if not TargetFileExists(SourceFileName) then
|
|
|
|
+ begin
|
|
|
|
+ writeln('File ',SourceFileName,' not found');
|
|
|
|
+ exit;
|
|
|
|
+ end
|
|
|
|
+ else if verbose then
|
|
|
|
+ writeln('Analyzing source file ',SourceFileName);
|
|
|
|
+ if not GetConfig(SourceFileName,config) then
|
|
|
|
+ exit;
|
|
|
|
+
|
|
|
|
+ RelativeToConfigMarker:=TObject.Create;
|
|
|
|
+ FileList:=BuildFileList;
|
|
|
|
+ TmpFileList:=TStringList.Create;
|
|
|
|
+ if assigned(FileList) then
|
|
|
|
+ begin
|
|
|
|
+ LocalPath:=SplitPath(SourceFileName);
|
|
|
|
+ if (Length(LocalPath) > 0) and (LocalPath[Length(LocalPath)]<>DirectorySeparator) then
|
|
|
|
+ LocalPath:=LocalPath+DirectorySeparator;
|
|
|
|
+ for i:=0 to FileList.count-1 do
|
|
|
|
+ begin
|
|
|
|
+ if FileList.Names[i]<>'' then
|
|
|
|
+ begin
|
|
|
|
+ LocalFile:=FileList.Names[i];
|
|
|
|
+ RemoteFile:=FileList.ValueFromIndex[i];
|
|
|
|
+ end
|
|
|
|
+ else
|
|
|
|
+ begin
|
|
|
|
+ LocalFile:=FileList[i];
|
|
|
|
+ RemoteFile:=LocalFile;
|
|
|
|
+ end;
|
|
|
|
+ if FileList.Objects[i]=RelativeToConfigMarker then
|
|
|
|
+ s:='config/'+LocalFile
|
|
|
|
+ else
|
|
|
|
+ s:=LocalPath+LocalFile;
|
|
|
|
+ if not TargetFileExists(s) then
|
|
|
|
+ if TargetFileExists(param1_dir+DirectorySeparator+LocalFile) then
|
|
|
|
+ s:=param1_dir+DirectorySeparator+LocalFile;
|
|
|
|
+ CopyFile(s,DosBoxDir+RemoteFile);
|
|
|
|
+ TmpFileList.Add(RemoteFile);
|
|
|
|
+ end;
|
|
|
|
+ FileList.Free;
|
|
|
|
+ end;
|
|
|
|
+ RelativeToConfigMarker.Free;
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+{ On modified dosbox executable it is possible to get
|
|
|
|
+ a copy of all output to CON into a file, simply write it
|
|
|
|
+ back to output, so it ends up into testname.elg file.
|
|
|
|
+ Skip all until line beginning with 'Drive C is mounted as' }
|
|
|
|
+procedure EchoOutput;
|
|
|
|
+const
|
|
|
|
+ SkipUntilText = 'Drive C is mounted as ';
|
|
|
|
+var
|
|
|
|
+ StdText : TextFile;
|
|
|
|
+ st : string;
|
|
|
|
+ line : longint;
|
|
|
|
+ SkipUntilSeen : boolean;
|
|
|
|
+begin
|
|
|
|
+ if FileExists(OutputFileName) then
|
|
|
|
+ begin
|
|
|
|
+ if verbose then
|
|
|
|
+ Writeln('Trying to open ',OutputFileName);
|
|
|
|
+ try
|
|
|
|
+ AssignFile(StdText, OutputFileName);
|
|
|
|
+ Reset(StdText);
|
|
|
|
+ if verbose then
|
|
|
|
+ Writeln('Successfully opened ',OutputFileName,', copying content to output');
|
|
|
|
+ try
|
|
|
|
+ line:=0;
|
|
|
|
+ SkipUntilSeen:=false;
|
|
|
|
+ while not eof(StdText) do
|
|
|
|
+ begin
|
|
|
|
+ Readln(StdText,st);
|
|
|
|
+ inc(line);
|
|
|
|
+ if not SkipUntilSeen then
|
|
|
|
+ SkipUntilSeen:=pos(SkipUntilText,st)>0;
|
|
|
|
+ if SkipUntilSeen then
|
|
|
|
+ Writeln(line,': ',st);
|
|
|
|
+ end;
|
|
|
|
+ finally
|
|
|
|
+ if not SkipUntilSeen then
|
|
|
|
+ Writeln('Could not find "',SkipUntilText,'" in file ',OutputFilename);
|
|
|
|
+ Flush(output);
|
|
|
|
+ CloseFile(StdText);
|
|
|
|
+ end;
|
|
|
|
+ finally
|
|
|
|
+ if use_temp_dir then
|
|
|
|
+ DeleteFile(OutputFileName);
|
|
|
|
+ end;
|
|
|
|
+ end;
|
|
|
|
+end;
|
|
|
|
+
|
|
function ReadExitCode(const ADosBoxDir: string): Integer;
|
|
function ReadExitCode(const ADosBoxDir: string): Integer;
|
|
var
|
|
var
|
|
F: TextFile;
|
|
F: TextFile;
|
|
begin
|
|
begin
|
|
AssignFile(F, ADosBoxDir + 'EXITCODE.TXT');
|
|
AssignFile(F, ADosBoxDir + 'EXITCODE.TXT');
|
|
- Reset(F);
|
|
|
|
try
|
|
try
|
|
|
|
+ Reset(F);
|
|
Readln(F, Result);
|
|
Readln(F, Result);
|
|
- finally
|
|
|
|
|
|
+ if Result <> 0 then
|
|
|
|
+ Writeln('ExitCode=',Result);
|
|
CloseFile(F);
|
|
CloseFile(F);
|
|
|
|
+ except
|
|
|
|
+ Writeln('Unable to read exitcode value');
|
|
|
|
+ if (DosBoxExitStatus <> 0) then
|
|
|
|
+ Writeln('DosBox exit status = ',DosBoxExitStatus);
|
|
|
|
+ ReadExitCode:=127*256;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
-procedure ExecuteDosBox(const ADosBoxBinaryPath, ADosBoxDir: string);
|
|
|
|
-const
|
|
|
|
- Timeout = 10*15; { 15 seconds }
|
|
|
|
|
|
+function ExecuteDosBox(const ADosBoxBinaryPath, ADosBoxDir: string) : Integer;
|
|
var
|
|
var
|
|
- Process: TProcess;
|
|
|
|
Time: Integer = 0;
|
|
Time: Integer = 0;
|
|
begin
|
|
begin
|
|
- Process := TProcess.Create(nil);
|
|
|
|
|
|
+ DosBoxProcess := TProcess.Create(nil);
|
|
|
|
+ result:=-1;
|
|
try
|
|
try
|
|
- Process.Executable := ADosBoxBinaryPath;
|
|
|
|
- Process.Parameters.Add('-conf');
|
|
|
|
- Process.Parameters.Add(ADosBoxDir + 'dosbox.conf');
|
|
|
|
- Process.Execute;
|
|
|
|
|
|
+ DosBoxProcess.Executable := ADosBoxBinaryPath;
|
|
|
|
+ DosBoxProcess.Parameters.Add('-conf');
|
|
|
|
+ DosBoxProcess.Parameters.Add(ADosBoxDir + 'dosbox.conf');
|
|
|
|
+ if hide_execution then
|
|
|
|
+ DosBoxProcess.ShowWindow := swoHIDE;
|
|
|
|
+ DosBoxProcess.Execute;
|
|
repeat
|
|
repeat
|
|
Inc(Time);
|
|
Inc(Time);
|
|
- if Time > Timeout then
|
|
|
|
|
|
+ if (Time > 10*dosbox_timeout) and do_exit then
|
|
break;
|
|
break;
|
|
Sleep(100);
|
|
Sleep(100);
|
|
- until not Process.Running;
|
|
|
|
- if Process.Running then
|
|
|
|
- Process.Terminate(254);
|
|
|
|
|
|
+ until not DosBoxProcess.Running;
|
|
|
|
+ if DosBoxProcess.Running then
|
|
|
|
+ begin
|
|
|
|
+ Writeln('Timeout exceeded. Killing dosbox...');
|
|
|
|
+ DosBoxProcess.Terminate(254);
|
|
|
|
+ Sleep(100);
|
|
|
|
+ end;
|
|
finally
|
|
finally
|
|
- Process.Free;
|
|
|
|
|
|
+ result:=DosBoxProcess.ExitStatus;
|
|
|
|
+ DosBoxProcess.Free;
|
|
|
|
+ DosBoxProcess:=nil;
|
|
|
|
+ EchoOutput;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
-procedure Cleanup(const ADosBoxDir: string);
|
|
|
|
|
|
|
|
- procedure DeleteIfExists(const AFileName: string);
|
|
|
|
- begin
|
|
|
|
- if FileExists(AFileName) then
|
|
|
|
- DeleteFile(AFileName);
|
|
|
|
- end;
|
|
|
|
|
|
+function DeleteIfExists(const AFileName: string) : boolean;
|
|
|
|
+begin
|
|
|
|
+ result:=false;
|
|
|
|
+ if FileExists(AFileName) then
|
|
|
|
+ result:=DeleteFile(AFileName);
|
|
|
|
+ if not result and FileExists(AFileName+'.exe') then
|
|
|
|
+ result:=DeleteFile(AFileName+'.exe');
|
|
|
|
+ if not result and FileExists(AFileName+'.EXE') then
|
|
|
|
+ result:=DeleteFile(AFileName+'.EXE');
|
|
|
|
+end;
|
|
|
|
|
|
|
|
+{ RemoveDir, with removal of files or subdirectories inside first.
|
|
|
|
+ ADirName is supposed to finish with DirectorySeparator }
|
|
|
|
+function RemoveDir(const ADirName: string) : boolean;
|
|
|
|
+var
|
|
|
|
+ Info : TSearchRec;
|
|
|
|
+begin
|
|
|
|
+ Result:=true;
|
|
|
|
+ If FindFirst (AdirName+'*',faAnyFile and faDirectory,Info)=0 then
|
|
|
|
+ begin
|
|
|
|
+ repeat
|
|
|
|
+ with Info do
|
|
|
|
+ begin
|
|
|
|
+ If (Attr and faDirectory) = faDirectory then
|
|
|
|
+ begin
|
|
|
|
+ { Skip present and parent directory }
|
|
|
|
+ if (Name<>'..') and (Name<>'.') then
|
|
|
|
+ if not RemoveDir(ADirName+Name+DirectorySeparator) then
|
|
|
|
+ begin
|
|
|
|
+ writeln('Failed to remove dir '+ADirName+Name+DirectorySeparator);
|
|
|
|
+ result:=false;
|
|
|
|
+ FindClose(Info);
|
|
|
|
+ exit;
|
|
|
|
+ end;
|
|
|
|
+ end
|
|
|
|
+ else
|
|
|
|
+ if not DeleteFile(ADirName+Name) then
|
|
|
|
+ begin
|
|
|
|
+ writeln('Failed to remove file '+ADirName+Name);
|
|
|
|
+ result:=false;
|
|
|
|
+ FindClose(Info);
|
|
|
|
+ exit;
|
|
|
|
+ end;
|
|
|
|
+ end;
|
|
|
|
+ Until FindNext(info)<>0;
|
|
|
|
+ end;
|
|
|
|
+ FindClose(Info);
|
|
|
|
+ RemoveDir:=SysUtils.RemoveDir(ADirName);
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+procedure Cleanup(const ADosBoxDir: string);
|
|
|
|
+var
|
|
|
|
+ i : longint;
|
|
begin
|
|
begin
|
|
DeleteIfExists(ADosBoxDir + 'dosbox.conf');
|
|
DeleteIfExists(ADosBoxDir + 'dosbox.conf');
|
|
DeleteIfExists(ADosBoxDir + 'EXITCODE.TXT');
|
|
DeleteIfExists(ADosBoxDir + 'EXITCODE.TXT');
|
|
DeleteIfExists(ADosBoxDir + 'EXITCODE.EXE');
|
|
DeleteIfExists(ADosBoxDir + 'EXITCODE.EXE');
|
|
|
|
+ DeleteIfExists(ADosBoxDir + 'CWSDPMI.EXE');
|
|
DeleteIfExists(ADosBoxDir + 'TEST.EXE');
|
|
DeleteIfExists(ADosBoxDir + 'TEST.EXE');
|
|
- RmDir(ADosBoxDir);
|
|
|
|
|
|
+ if Assigned(TmpFileList) then
|
|
|
|
+ begin
|
|
|
|
+ for i:=0 to TmpFileList.count-1 do
|
|
|
|
+ if TmpFileList[i]<>'' then
|
|
|
|
+ DeleteIfExists(ADosBoxDir + TmpFileList[i]);
|
|
|
|
+ end;
|
|
|
|
+ TmpFileList.Free;
|
|
|
|
+ ChDir(StartDir);
|
|
|
|
+ if not RemoveDir(ADosBoxDir) then
|
|
|
|
+ writeln('Failed to remove dir ',ADosBoxDir);
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+{$ifdef UseSignals}
|
|
|
|
+const
|
|
|
|
+ SignalCalled : boolean = false;
|
|
|
|
+ SignalNb : longint = 0;
|
|
|
|
+
|
|
|
|
+function DosBoxSignal(signal:longint):longint; cdecl;
|
|
|
|
+
|
|
|
|
+begin
|
|
|
|
+ SignalCalled:=true;
|
|
|
|
+ SignalNb:=signal;
|
|
end;
|
|
end;
|
|
|
|
+{$endif def UseSignals}
|
|
|
|
|
|
|
|
+procedure ExitProc;
|
|
var
|
|
var
|
|
- DosBoxDir: string;
|
|
|
|
- ExitCode: Integer = 255;
|
|
|
|
- DosBoxBinaryPath: string;
|
|
|
|
|
|
+ count : longint;
|
|
|
|
+begin
|
|
|
|
+ if assigned(DosBoxProcess) and (DosBoxProcess.Running) then
|
|
|
|
+ begin
|
|
|
|
+ Writeln('In ExitProc. Killing dosbox...');
|
|
|
|
+ DosBoxProcess.Terminate(254*1024);
|
|
|
|
+ Sleep(100);
|
|
|
|
+ count:=1;
|
|
|
|
+ while (DosBoxProcess.Running) do
|
|
|
|
+ begin
|
|
|
|
+ Sleep(100);
|
|
|
|
+ inc(count);
|
|
|
|
+ if (count mod 20=0) then
|
|
|
|
+ DosBoxProcess.Terminate(254*1024+count);
|
|
|
|
+ end;
|
|
|
|
+ if count>1 then
|
|
|
|
+ Writeln('In ExitProc. Wait for termination dosbox..., time=',count/10);
|
|
|
|
+ EchoOutput;
|
|
|
|
+ end;
|
|
|
|
+end;
|
|
|
|
+
|
|
begin
|
|
begin
|
|
Randomize;
|
|
Randomize;
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+ if GetEnvironmentVariable('DOSBOX_NO_TEMPDIR')<>'' then
|
|
|
|
+ begin
|
|
|
|
+ use_temp_dir:=false;
|
|
|
|
+ Writeln('use_temp_dir set to false');
|
|
|
|
+ end;
|
|
|
|
+ if GetEnvironmentVariable('DOSBOX_NO_HIDE')<>'' then
|
|
|
|
+ begin
|
|
|
|
+ hide_execution:=false;
|
|
|
|
+ Writeln('hide_execution set to false');
|
|
|
|
+ end;
|
|
|
|
+ if GetEnvironmentVariable('DOSBOX_NO_EXIT')<>'' then
|
|
|
|
+ begin
|
|
|
|
+ do_exit:=false;
|
|
|
|
+ Writeln('do_exit set to false');
|
|
|
|
+ end;
|
|
|
|
+ if GetEnvironmentVariable('DOSBOX_VERBOSE')<>'' then
|
|
|
|
+ begin
|
|
|
|
+ verbose:=true;
|
|
|
|
+ Writeln('verbose set to true');
|
|
|
|
+ end;
|
|
|
|
+ if (GetEnvironmentVariable('DOSBOX_NEEDS_CWSDPMI')<>'') or
|
|
|
|
+ (GetEnvironmentVariable('TEST_OS_TARGET')='go32v2') then
|
|
|
|
+ begin
|
|
|
|
+ need_cwsdpmi:=true;
|
|
|
|
+ Writeln('need_cwsdpmi set to true');
|
|
|
|
+ end;
|
|
|
|
+ if GetEnvironmentVariable('DOSBOX_TIMEOUT')<>'' then
|
|
|
|
+ begin
|
|
|
|
+ dosbox_timeout:=StrToInt(GetEnvironmentVariable('DOSBOX_TIMEOUT'));
|
|
|
|
+ Writeln('dosbox_timeout set to ', dosbox_timeout, ' seconds');
|
|
|
|
+ end;
|
|
if ParamCount = 0 then
|
|
if ParamCount = 0 then
|
|
begin
|
|
begin
|
|
- Writeln('Usage: ' + ParamStr(0) + ' <executable>');
|
|
|
|
|
|
+ Writeln('Usage: ' + ParamStr(0) + ' <executable> (-Ssourcename)');
|
|
|
|
+ Writeln('Set DOSBOX_NO_TEMPDIR env variable to 1 to avoid using a temporary directory');
|
|
|
|
+ Writeln('Set DOSBOX_NO_HIDE to avoid running dosbox in an hidden window');
|
|
|
|
+ Writeln('Set DOSBOX_NO_EXIT to avoid exiting dosbox after test has been run');
|
|
|
|
+ Writeln('Set DOSBOX_TIMEOUT to set the timeout in seconds before killing the dosbox process, assuming the test has hanged');
|
|
halt(1);
|
|
halt(1);
|
|
end;
|
|
end;
|
|
DosBoxBinaryPath := GetEnvironmentVariable('DOSBOX');
|
|
DosBoxBinaryPath := GetEnvironmentVariable('DOSBOX');
|
|
@@ -161,16 +563,64 @@ begin
|
|
begin
|
|
begin
|
|
Writeln('Please set the DOSBOX environment variable to the dosbox executable');
|
|
Writeln('Please set the DOSBOX environment variable to the dosbox executable');
|
|
halt(1);
|
|
halt(1);
|
|
|
|
+ end
|
|
|
|
+ else
|
|
|
|
+ begin
|
|
|
|
+ Writeln('Using DOSBOX executable: ',DosBoxBinaryPath);
|
|
end;
|
|
end;
|
|
- DosBoxDir := GenerateTempDir;
|
|
|
|
|
|
+
|
|
|
|
+ { DosBoxDir is used inside dosbox.conf as a MOUNT parameter }
|
|
|
|
+ if use_temp_dir then
|
|
|
|
+ begin
|
|
|
|
+ GetDir(0,StartDir);
|
|
|
|
+ DosBoxDir := GenerateTempDir;
|
|
|
|
+ { All executable test have t.*.pp pattern }
|
|
|
|
+ if (paramcount>1) and (copy(paramstr(2),1,2)='-S') then
|
|
|
|
+ SourceFileName:=copy(paramstr(2),3,length(paramstr(2)))
|
|
|
|
+ else
|
|
|
|
+ SourceFileName:=ForceExtension(Paramstr(1),'.pp');
|
|
|
|
+ CopyNeededFiles;
|
|
|
|
+ end
|
|
|
|
+ else
|
|
|
|
+ begin
|
|
|
|
+ Writeln('Using ',ParamStr(1));
|
|
|
|
+ DosBoxDir:=ExtractFilePath(ParamStr(1));
|
|
|
|
+ if DosBoxDir='' then
|
|
|
|
+ DosBoxDir:=GetCurrentDir+DirectorySeparator;
|
|
|
|
+ Writeln('Using DosBoxDir=',DosBoxDir);
|
|
|
|
+ { Get rid of previous exicode.txt file }
|
|
|
|
+ DeleteIfExists(DosBoxDir + 'EXITCODE.TXT');
|
|
|
|
+ end;
|
|
try
|
|
try
|
|
|
|
+{$ifdef UseSignals}
|
|
|
|
+ Signal(SIGINT,@DosBoxSignal);
|
|
|
|
+ Signal(SIGQUIT,@DosBoxSignal);
|
|
|
|
+ Signal(SIGTERM,@DosBoxSignal);
|
|
|
|
+{$endif def UseSignals}
|
|
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');
|
|
- ExecuteDosBox(DosBoxBinaryPath, DosBoxDir);
|
|
|
|
- ExitCode := ReadExitCode(DosBoxDir);
|
|
|
|
|
|
+ if need_cwsdpmi then
|
|
|
|
+ begin
|
|
|
|
+ cwsdpmi_file:=FileSearch('cwsdpmi.exe',GetEnvironmentVariable('PATH'));
|
|
|
|
+ if cwsdpmi_file<>'' then
|
|
|
|
+ CopyFile(cwsdpmi_file, DosBoxDir + 'CWSDPMI.EXE')
|
|
|
|
+ else if verbose then
|
|
|
|
+ writeln('cwsdpmi executable missing');
|
|
|
|
+ end;
|
|
|
|
+ DosBoxExitStatus:=ExecuteDosBox(DosBoxBinaryPath, DosBoxDir);
|
|
finally
|
|
finally
|
|
- Cleanup(DosBoxDir);
|
|
|
|
|
|
+ ExitProc;
|
|
end;
|
|
end;
|
|
|
|
+{$ifdef UseSignals}
|
|
|
|
+ if SignalCalled then
|
|
|
|
+ begin
|
|
|
|
+ Writeln('Signal ',SignalNb,' called');
|
|
|
|
+ end;
|
|
|
|
+{$endif def UseSignals}
|
|
|
|
+ ExitProc;
|
|
|
|
+ ExitCode:=ReadExitCode(DosBoxDir);
|
|
|
|
+ if use_temp_dir then
|
|
|
|
+ Cleanup(DosBoxDir);
|
|
halt(ExitCode);
|
|
halt(ExitCode);
|
|
end.
|
|
end.
|