Browse Source

Merge most of trunk/tests/utils changes from trunk branch.

Merge of trunk revision 32622
------------------------------------------------------------------------
r32622 | nickysn | 2015-12-09 16:56:23 +0100 (Wed, 09 Dec 2015) | 2 lines
Changed paths:
   M /trunk/tests/utils/dosbox/dosbox_wrapper.pas

* on Windows, run dosbox with the swoHIDE option to prevent the annoying focus
  stealing dosbox consoles from appearing
------------------------------------------------------------------------
Merge of trunk revision 32623
------------------------------------------------------------------------
r32623 | pierre | 2015-12-10 02:48:18 +0100 (Thu, 10 Dec 2015) | 16 lines
Changed paths:
   M /trunk/tests/utils/dosbox/dosbox_wrapper.pas

  + (OutputFileName variable): Add possibility to use output duplicated to a file by a modified dosbox
  version, using an entry in [dos] section of dosbox.conf cinfig file.
  copy_con_to_file=/path/to/file/that/will/get/the/copy
  + (EchoOutput procedure) Write to ouput the content of this file so that it ends up into XXXX.elg file
  when checking test file XXXX.
  * Add use_temp_dir boolean variable, set to true by default, can be set to false by
  setting DOSBOX_NO_TEMPDIR env. variable.
  + Add hide_execution boolean variable (might only work on Windows),
  which sets SWOHide to Process.ShowWindow property if true.
  hide_execution defaults to true, but can be set to true by setting
  DOSBOX_NO_HIDE to set to false.
  + Add do_exit boolean variable (defaulting to true), which adds
  'exit' as last line into autoexec section in dosbox.conf.
  Use DOSBOX_NO_EXIT to avoid automatic closing of DosBox at the end of test
  execution (can bbe useful for debugging purposes).

------------------------------------------------------------------------
Merge of trunk revision 32624
------------------------------------------------------------------------
r32624 | pierre | 2015-12-10 02:49:37 +0100 (Thu, 10 Dec 2015) | 1 line
Changed paths:
   M /trunk/tests/utils/dosbox/dosbox.conf

 Change 'exit' to '' to allow to avoid exit at the end of test run
------------------------------------------------------------------------
Merge of trunk revision 32678
------------------------------------------------------------------------
r32678 | nickysn | 2015-12-18 02:40:22 +0100 (Fri, 18 Dec 2015) | 3 lines
Changed paths:
   M /trunk/tests/utils/dosbox/dosbox_wrapper.pas

* write a message to stdout if dosbox is killed due to a timeout


------------------------------------------------------------------------
Merge of trunk revision 32679
------------------------------------------------------------------------
r32679 | nickysn | 2015-12-18 02:43:24 +0100 (Fri, 18 Dec 2015) | 5 lines
Changed paths:
   M /trunk/tests/utils/dosbox/dosbox_wrapper.pas

* handle exceptions when opening the exitcode.txt file as well, so that we write
  a nicer message to stdout in case the file does not exist (which happens often
  when we kill dosbox, due to a timeout)


------------------------------------------------------------------------
Merge of trunk revision 32696
------------------------------------------------------------------------
r32696 | nickysn | 2015-12-22 01:05:39 +0100 (Tue, 22 Dec 2015) | 5 lines
Changed paths:
   M /trunk/tests/utils/dosbox/dosbox_wrapper.pas

+ support specifying the dosbox timeout (the maximal amount of time a test is
  allowed to run, before dosbox is killed) via the DOSBOX_TIMEOUT environment
  variable


------------------------------------------------------------------------
Merge of trunk revision 32697
------------------------------------------------------------------------
r32697 | nickysn | 2015-12-22 11:01:13 +0100 (Tue, 22 Dec 2015) | 3 lines
Changed paths:
   M /trunk/tests/utils/dosbox/dosbox_wrapper.pas

* increased the default dosbox timeout to 60 seconds


------------------------------------------------------------------------
Merge of trunk revision 32761
------------------------------------------------------------------------
r32761 | nickysn | 2015-12-27 13:43:01 +0100 (Sun, 27 Dec 2015) | 3 lines
Changed paths:
   M /trunk/tests/utils/dosbox/dosbox_wrapper.pas

* increased the default dosbox timeout to 90 seconds


------------------------------------------------------------------------
Merge of trunk revision 32834
------------------------------------------------------------------------
r32834 | nickysn | 2016-01-03 12:54:45 +0100 (Sun, 03 Jan 2016) | 3 lines
Changed paths:
   M /trunk/tests/utils/dosbox/dosbox_wrapper.pas

* dosbox timeout increased to 100 seconds


------------------------------------------------------------------------
Merge of trunk revision 33385
------------------------------------------------------------------------
r33385 | pierre | 2016-03-30 09:42:35 +0200 (Wed, 30 Mar 2016) | 9 lines
Changed paths:
   M /trunk/tests/utils/dosbox/dosbox_wrapper.pas

  + Add verbose boolean variable, set to false by default,
  set to true by setting environment variable DOSBOX_VERBOSE.
  Most output generated by the wrapper is now only given if 
  verbose is true.
  + New constant SkipUntilText, default value 'Drive C is mounted as ',
  allow to discard output generated by dosbox program up to the line
  containing this string.


------------------------------------------------------------------------
Merge of trunk revision 36230
------------------------------------------------------------------------
r36230 | pierre | 2017-05-16 22:51:36 +0200 (Tue, 16 May 2017) | 1 line
Changed paths:
   M /trunk/tests/utils/dosbox/dosbox.conf

 Add disablesplash=true
------------------------------------------------------------------------
Merge of trunk revision 36231
------------------------------------------------------------------------
r36231 | pierre | 2017-05-16 22:56:29 +0200 (Tue, 16 May 2017) | 9 lines
Changed paths:
   M /trunk/tests/utils/dosbox/dosbox_wrapper.pas

  + Add UseSignals macro, which conditionally adds
  code using signals unit to try to interrupt runaway executables
  + Global DosBoxProcess TProcess class variable.
  + Display modified lines  inside dosbox.conf if verbose
  * Try to use Terminate when program exceeds dosbox_timeout (in seconds)
  * Handle signals if UseSignals macro is set.



------------------------------------------------------------------------
Merge of trunk revision 36313
------------------------------------------------------------------------
r36313 | pierre | 2017-05-24 09:41:25 +0200 (Wed, 24 May 2017) | 1 line
Changed paths:
   M /trunk/tests/utils/dosbox/dosbox_wrapper.pas

 Fix ExitCode readout if temp directory is used by postponing temp directory cleanup
------------------------------------------------------------------------
Merge of trunk revision 36317
------------------------------------------------------------------------
r36317 | pierre | 2017-05-24 23:53:01 +0200 (Wed, 24 May 2017) | 1 line
Changed paths:
   M /trunk/tests/utils/dbdigest.pp
   M /trunk/tests/utils/testu.pp

 Limit log size to 50000, and add all testrun information at start
------------------------------------------------------------------------
Merge of trunk revision 36726
------------------------------------------------------------------------
r36726 | pierre | 2017-07-11 20:07:43 +0200 (Tue, 11 Jul 2017) | 1 line
Changed paths:
   M /trunk/tests/utils/dosbox/dosbox_wrapper.pas

 Search for cwsdpmi DOS exeutable in PATH if DOSBOX_NEEDS_CWSDPMI is set or TEST_OS_TARGET is go32v2 to allow testing go32v2 programs using DOSBOX
------------------------------------------------------------------------
Merge of trunk revision 36992
------------------------------------------------------------------------
r36992 | svenbarth | 2017-08-20 22:23:50 +0200 (Sun, 20 Aug 2017) | 1 line
Changed paths:
   M /trunk/tests/utils/dotest.pp
   M /trunk/tests/utils/testu.pp

* implement support for copying a central, pre-created configuration file for a test
------------------------------------------------------------------------
Merge of trunk revision 38648
------------------------------------------------------------------------
r38648 | pierre | 2018-03-30 09:59:14 +0200 (Fri, 30 Mar 2018) | 1 line
Changed paths:
   M /trunk/tests/utils/dotest.pp
   M /trunk/tests/utils/testu.pp

 Move several path related functions from dotest program to testu unit for use in dosbox_wrapper program
------------------------------------------------------------------------
Merge of trunk revision 38683
------------------------------------------------------------------------
r38683 | pierre | 2018-04-04 23:00:26 +0200 (Wed, 04 Apr 2018) | 7 lines
Changed paths:
   M /trunk/tests/utils/dosbox/dosbox_wrapper.pas

  * Improve support in temporary directory.
  + CopyNeededFiles to copy additional files to temp directory.
  + TempFileList: New variable.
  * Cleanup: Use TempFileList to delete more file.
  + Add optional -Ssource_file_name directory.


------------------------------------------------------------------------
Merge of trunk revision 38684
------------------------------------------------------------------------
r38684 | pierre | 2018-04-04 23:27:07 +0200 (Wed, 04 Apr 2018) | 1 line
Changed paths:
   M /trunk/tests/utils/dotest.pp
   M /trunk/tests/utils/testu.pp

 Move GetToken function to testu unit
------------------------------------------------------------------------
Merge of trunk revision 38685
------------------------------------------------------------------------
r38685 | pierre | 2018-04-04 23:27:36 +0200 (Wed, 04 Apr 2018) | 1 line
Changed paths:
   M /trunk/tests/utils/dosbox/dosbox_wrapper.pas

 Add handling of DelFiles
------------------------------------------------------------------------
Merge of trunk revision 38741
------------------------------------------------------------------------
r38741 | pierre | 2018-04-12 15:44:14 +0200 (Thu, 12 Apr 2018) | 1 line
Changed paths:
   M /trunk/tests/utils/dosbox/dosbox.conf

 Use auto instead of dynamic, as dynamic is not always possible
------------------------------------------------------------------------
Merge of trunk revision 38742
------------------------------------------------------------------------
r38742 | pierre | 2018-04-12 15:46:09 +0200 (Thu, 12 Apr 2018) | 1 line
Changed paths:
   M /trunk/tests/utils/dosbox/dosbox_wrapper.pas

 Add .exe suffix to ASrcFileName if ADestFileName ends with .exe or if file is not found
------------------------------------------------------------------------
Merge of trunk revision 38816
------------------------------------------------------------------------
r38816 | pierre | 2018-04-23 00:18:27 +0200 (Mon, 23 Apr 2018) | 1 line
Changed paths:
   M /trunk/tests/utils/dosbox/dosbox_wrapper.pas

 Avoid program RTE if failing to remove temporary directory
------------------------------------------------------------------------
Merge of trunk revision 38960
------------------------------------------------------------------------
r38960 | pierre | 2018-05-09 17:17:40 +0200 (Wed, 09 May 2018) | 1 line
Changed paths:
   M /trunk/tests/utils/dosbox/dosbox_wrapper.pas

 Correct copy of files to temp directory and removal of temp directory
------------------------------------------------------------------------
Merge of trunk revision 39197
------------------------------------------------------------------------
r39197 | pierre | 2018-06-08 10:35:45 +0200 (Fri, 08 Jun 2018) | 1 line
Changed paths:
   M /trunk/tests/utils/dosbox/dosbox_wrapper.pas

 Report if ExitStatus of DosBox process is non-zero
------------------------------------------------------------------------

git-svn-id: branches/fixes_3_0@39236 -
pierre 7 years ago
parent
commit
76315f9546

+ 9 - 3
tests/utils/dbdigest.pp

@@ -402,7 +402,8 @@ Var
   ConfigID : Integer;
   ConfigID : Integer;
 
 
 Procedure GetIDs;
 Procedure GetIDs;
-
+var
+  qry : string;
 begin
 begin
   TestCPUID := GetCPUId(TestCPU);
   TestCPUID := GetCPUId(TestCPU);
   If TestCPUID=-1 then
   If TestCPUID=-1 then
@@ -425,11 +426,15 @@ begin
   If (TestRunID=-1) then
   If (TestRunID=-1) then
     begin
     begin
     TestRunID:=AddRun(TestOSID,TestCPUID,TestVersionID,TestCategoryID,TestDate);
     TestRunID:=AddRun(TestOSID,TestCPUID,TestVersionID,TestCategoryID,TestDate);
-    If TestRUnID=-1 then
+    If TestRunID=-1 then
       Verbose(V_Error,'Could not insert new testrun record!');
       Verbose(V_Error,'Could not insert new testrun record!');
     end
     end
   else
   else
     CleanTestRun(TestRunID);
     CleanTestRun(TestRunID);
+  { Add known infomration at start }
+  qry:=format('UPDATE TESTRUN SET TU_SUBMITTER=''%s'', TU_MACHINE=''%s'', TU_COMMENT=''%s'', TU_DATE=''%s''',[Submitter,Machine,Comment,SqlDate(TestDate)]);
+  qry:=qry+' WHERE TU_ID='+format('%d',[TestRunID]);
+  ExecuteQuery(Qry,False);
 end;
 end;
 
 
 
 
@@ -467,7 +472,8 @@ begin
               { End of file marker }
               { End of file marker }
               if eof(LongLogFile) or (pos('>>>>>>>>>>>',S)=1) then
               if eof(LongLogFile) or (pos('>>>>>>>>>>>',S)=1) then
                 exit;
                 exit;
-              Result:=Result+S+LineEnding;
+              if length(Result)<MaxLogSize then
+                Result:=Result+S+LineEnding;
             end;
             end;
         end
         end
       else if IsFirst then
       else if IsFirst then

+ 5 - 3
tests/utils/dosbox/dosbox.conf

@@ -32,6 +32,7 @@ waitonerror=true
 priority=higher,normal
 priority=higher,normal
 mapperfile=mapper-0.74.map
 mapperfile=mapper-0.74.map
 usescancodes=true
 usescancodes=true
+disablesplash=true
 
 
 [dosbox]
 [dosbox]
 # language: Select another language file.
 # language: Select another language file.
@@ -77,8 +78,8 @@ scaler=normal2x
 #   cycleup: Amount of cycles to decrease/increase with keycombo.(CTRL-F11/CTRL-F12)
 #   cycleup: Amount of cycles to decrease/increase with keycombo.(CTRL-F11/CTRL-F12)
 # cycledown: Setting it lower than 100 will be a percentage.
 # cycledown: Setting it lower than 100 will be a percentage.
 
 
-#core=auto
-core=dynamic
+core=auto
+#core=dynamic
 cputype=auto
 cputype=auto
 #cycles=auto
 #cycles=auto
 cycles=max
 cycles=max
@@ -232,6 +233,7 @@ xms=true
 ems=true
 ems=true
 umb=true
 umb=true
 keyboardlayout=auto
 keyboardlayout=auto
+copy_con_to_file=$wrapper_output
 
 
 [ipx]
 [ipx]
 # ipx: Enable ipx over UDP/IP emulation.
 # ipx: Enable ipx over UDP/IP emulation.
@@ -247,4 +249,4 @@ ipx=false
 mount c $DosBoxDir
 mount c $DosBoxDir
 c:
 c:
 exitcode test.exe
 exitcode test.exe
-exit
+$exit

+ 500 - 50
tests/utils/dosbox/dosbox_wrapper.pas

@@ -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.

+ 70 - 160
tests/utils/dotest.pp

@@ -24,6 +24,7 @@ uses
 {$ifdef macos}
 {$ifdef macos}
   macutils,
   macutils,
 {$endif}
 {$endif}
+  strutils,
   teststr,
   teststr,
   testu,
   testu,
   redir,
   redir,
@@ -114,75 +115,20 @@ const
   TargetCanCompileLibraries : boolean = true;
   TargetCanCompileLibraries : boolean = true;
   UniqueSuffix: string = '';
   UniqueSuffix: string = '';
 
 
-{ Constants used in IsAbsolute function }
-  TargetHasDosStyleDirectories : boolean = false;
-  TargetAmigaLike : boolean = false;
-  TargetIsMacOS : boolean = false;
-  TargetIsUnix : boolean = false;
 
 
-{ extracted from rtl/macos/macutils.inc }
-
-function IsMacFullPath (const path: string): Boolean;
-  begin
-    if Pos(':', path) = 0 then    {its partial}
-      IsMacFullPath := false
-    else if path[1] = ':' then
-      IsMacFullPath := false
-    else
-      IsMacFullPath := true
-  end;
-
-
-Function IsAbsolute (Const F : String) : boolean;
-{
-  Returns True if the name F is a absolute file name
-}
-begin
-  IsAbsolute:=false;
-  if TargetHasDosStyleDirectories then
-    begin
-      if (F[1]='/') or (F[1]='\') then
-        IsAbsolute:=true;
-      if (Length(F)>2) and (F[2]=':') and ((F[3]='\') or (F[3]='/')) then
-        IsAbsolute:=true;
-    end
-  else if TargetAmigaLike then
-    begin
-      if (length(F)>0) and (Pos(':',F) <> 0) then
-        IsAbsolute:=true;
-    end
-  else if TargetIsMacOS then
-    begin
-      IsAbsolute:=IsMacFullPath(F);
-    end
-  { generic case }
-  else if (F[1]='/') then
-    IsAbsolute:=true;
-end;
-
-Function FileExists (Const F : String) : Boolean;
-{
-  Returns True if the file exists, False if not.
-}
-Var
-  info : searchrec;
-begin
-  FindFirst (F,anyfile,Info);
-  FileExists:=DosError=0;
-  FindClose (Info);
-end;
-
-
-Function PathExists (Const F : String) : Boolean;
-{
-  Returns True if the file exists, False if not.
-}
-Var
-  info : searchrec;
+const
+  NoSharedLibSupportPattern='$nosharedlib';
+  TargetHasNoSharedLibSupport = 'msdos,go32v2';
+  NoWorkingUnicodeSupport='$nounicode';
+  TargetHasNoWorkingUnicodeSupport = 'msdos';
+  NoWorkingThread='$nothread';
+  TargetHasNoWorkingThreadSupport = 'go32v2,msdos';
+
+procedure TranslateConfig(var AConfig: TConfig);
 begin
 begin
-  FindFirst (F,anyfile,Info);
-  PathExists:=(DosError=0) and (Info.Attr and Directory=Directory);
-  FindClose (Info);
+  AConfig.SkipTarget:=ReplaceText(AConfig.SkipTarget, NoSharedLibSupportPattern, TargetHasNoSharedLibSupport);
+  AConfig.SkipTarget:=ReplaceText(AConfig.SkipTarget, NoWorkingUnicodeSupport, TargetHasNoWorkingUnicodeSupport);
+  AConfig.SkipTarget:=ReplaceText(AConfig.SkipTarget, NoWorkingThread, TargetHasNoWorkingThreadSupport);
 end;
 end;
 
 
 
 
@@ -262,60 +208,6 @@ begin
 end;
 end;
 
 
 
 
-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 SplitBasePath(const s:string): string;
-var
-  i : longint;
-begin
-  i:=1;
-  while (i<length(s)) and not(s[i] in ['/','\'{$IFDEF MACOS},':'{$ENDIF}]) do
-   inc(i);
-  if s[i] in  ['/','\'{$IFDEF MACOS},':'{$ENDIF}] then
-    dec(i);
-  SplitBasePath:=Copy(s,1,i);
-end;
-
-Function SplitFileName(const s:string):string;
-var
-  p : dirstr;
-  n : namestr;
-  e : extstr;
-begin
-  FSplit(s,p,n,e);
-  SplitFileName:=n+e;
-end;
-
-Function SplitFileBase(const s:string):string;
-var
-  p : dirstr;
-  n : namestr;
-  e : extstr;
-begin
-  FSplit(s,p,n,e);
-  SplitFileBase:=n;
-end;
-
-Function SplitFileExt(const s:string):string;
-var
-  p : dirstr;
-  n : namestr;
-  e : extstr;
-begin
-  FSplit(s,p,n,e);
-  SplitFileExt:=e;
-end;
-
-
 function ForceExtension(Const HStr,ext:String):String;
 function ForceExtension(Const HStr,ext:String):String;
 {
 {
   Return a filename which certainly has the extension ext
   Return a filename which certainly has the extension ext
@@ -339,24 +231,6 @@ begin
    ForceExtension:=Copy(Hstr,1,j-1);
    ForceExtension:=Copy(Hstr,1,j-1);
 end;
 end;
 
 
-type
-  TCharSet = set of char;
-
-function GetToken(var s: string; Delims: TCharSet = [' ']):string;
-var
-  i : longint;
-  p: PChar;
-begin
-  p:=PChar(s);
-  i:=0;
-  while (p^ <> #0) and not (p^ in Delims) do begin
-    Inc(p);
-    Inc(i);
-  end;
-  GetToken:=Copy(s,1,i);
-  Delete(s,1,i+1);
-end;
-
 procedure mkdirtree(const s:string);
 procedure mkdirtree(const s:string);
 var
 var
   SErr, hs : string;
   SErr, hs : string;
@@ -1254,6 +1128,7 @@ var
   EndTicks,
   EndTicks,
   StartTicks : int64;
   StartTicks : int64;
   FileList   : TStringList;
   FileList   : TStringList;
+  RelativeToConfigMarker : TObject;
 
 
   function BuildFileList: TStringList;
   function BuildFileList: TStringList;
     var
     var
@@ -1261,44 +1136,61 @@ var
       index  : longint;
       index  : longint;
     begin
     begin
       s:=Config.Files;
       s:=Config.Files;
-      if length(s) = 0 then
+      if (length(s) = 0) and (Config.ConfigFileSrc='') then
         begin
         begin
           Result:=nil;
           Result:=nil;
           exit;
           exit;
         end;
         end;
       Result:=TStringList.Create;
       Result:=TStringList.Create;
-      repeat
-        index:=pos(' ',s);
-        if index=0 then
-          LocalFile:=s
-        else
-          LocalFile:=copy(s,1,index-1);
-        Result.Add(LocalFile);
-        if index=0 then
-          break;
-        s:=copy(s,index+1,length(s)-index);
-      until false;
+      if s<>'' then
+        repeat
+          index:=pos(' ',s);
+          if index=0 then
+            LocalFile:=s
+          else
+            LocalFile:=copy(s,1,index-1);
+          Result.Add(LocalFile);
+          if index=0 then
+            break;
+          s:=copy(s,index+1,length(s)-index);
+        until false;
+      if Config.ConfigFileSrc<>'' then
+        begin
+          if Config.ConfigFileSrc=Config.ConfigFileDst then
+            Result.AddObject(Config.ConfigFileSrc,RelativeToConfigMarker)
+          else
+            Result.AddObject(Config.ConfigFileSrc+'='+Config.ConfigFileDst,RelativeToConfigMarker);
+        end;
     end;
     end;
 
 
 begin
 begin
+  RelativeToConfigMarker:=TObject.Create;
   if RemoteAddr='' then
   if RemoteAddr='' then
     begin
     begin
       If UniqueSuffix<>'' then
       If UniqueSuffix<>'' then
         begin
         begin
           FileList:=BuildFileList;
           FileList:=BuildFileList;
           if assigned(FileList) then
           if assigned(FileList) then
+           for i:=0 to FileList.Count-1 do 
             begin
             begin
-              LocalPath:=SplitPath(PPFile[current]);
-              if Length(LocalPath) > 0 then
-                LocalPath:=LocalPath+'/';
-              for i:=0 to FileList.count-1 do
+              if FileList.Names[i]<>'' then
+                begin
+                  LocalFile:=FileList.Names[i];
+                  RemoteFile:=FileList.ValueFromIndex[i];
+                end
+              else
                 begin
                 begin
                   LocalFile:=FileList[i];
                   LocalFile:=FileList[i];
-                  CopyFile(LocalPath+LocalFile,TestOutputDir+'/'+LocalFile,false);
+                  RemoteFile:=LocalFile;
                 end;
                 end;
-              FileList.Free;
+              if FileList.Objects[i]=RelativeToConfigMarker then
+                s:='config/'+LocalFile
+              else
+                s:=LocalPath+LocalFile;
+              CopyFile(s,TestOutputDir+'/'+RemoteFile,false);
             end;
             end;
         end;
         end;
+      RelativeToConfigMarker.Free;
       exit(true);
       exit(true);
     end;
     end;
   execres:=true;
   execres:=true;
@@ -1321,6 +1213,7 @@ begin
   if not execres then
   if not execres then
   begin
   begin
     Verbose(V_normal, 'Could not copy executable '+FileToCopy);
     Verbose(V_normal, 'Could not copy executable '+FileToCopy);
+    RelativeToConfigMarker.Free;
     exit(execres);
     exit(execres);
   end;
   end;
   FileList:=BuildFileList;
   FileList:=BuildFileList;
@@ -1331,9 +1224,21 @@ begin
       LocalPath:=LocalPath+'/';
       LocalPath:=LocalPath+'/';
     for i:=0 to FileList.count-1 do
     for i:=0 to FileList.count-1 do
       begin
       begin
-        LocalFile:=FileList[i];
-        RemoteFile:=RemotePath+'/'+SplitFileName(LocalFile);
-        LocalFile:=LocalPath+LocalFile;
+        if FileList.Names[i]<>'' then
+          begin
+            LocalFile:=FileList.Names[i];
+            RemoteFile:=FileList.ValueFromIndex[i];
+          end
+        else
+          begin
+            LocalFile:=FileList[i];
+            RemoteFile:=LocalFile;
+          end;
+        RemoteFile:=RemotePath+'/'+SplitFileName(RemoteFile);
+        if FileList.Objects[i]=RelativeToConfigMarker then
+          LocalFile:='config/'+LocalFile
+        else
+          LocalFile:=LocalPath+LocalFile;
         if DoVerbose and (rcpprog='pscp') then
         if DoVerbose and (rcpprog='pscp') then
           pref:='-v '
           pref:='-v '
         else
         else
@@ -1344,12 +1249,14 @@ begin
         begin
         begin
           Verbose(V_normal, 'Could not copy required file '+LocalFile);
           Verbose(V_normal, 'Could not copy required file '+LocalFile);
           FileList.Free;
           FileList.Free;
+          RelativeToConfigMarker.Free;
           exit(false);
           exit(false);
         end;
         end;
       end;
       end;
   end;
   end;
   FileList.Free;
   FileList.Free;
   MaybeCopyFiles:=execres;
   MaybeCopyFiles:=execres;
+  RelativeToConfigMarker.Free;
 end;
 end;
 
 
 function RunExecutable:boolean;
 function RunExecutable:boolean;
@@ -1386,6 +1293,9 @@ begin
       {$I+}
       {$I+}
       ioresult;
       ioresult;
       s:=CurrDir+SplitFileName(TestExe);
       s:=CurrDir+SplitFileName(TestExe);
+      { Add -Ssource_file_name for dosbox_wrapper }
+      if pos('dosbox_wrapper',EmulatorName)>0 then
+        s:=s+' -S'+PPFile[current];
       execres:=ExecuteEmulated(EmulatorName,s,FullExeLogFile,StartTicks,EndTicks);
       execres:=ExecuteEmulated(EmulatorName,s,FullExeLogFile,StartTicks,EndTicks);
       {$I-}
       {$I-}
        ChDir(OldDir);
        ChDir(OldDir);

+ 181 - 1
tests/utils/testu.pp

@@ -5,11 +5,15 @@ unit testu;
 
 
 Interface
 Interface
 
 
+uses
+  dos;
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
     utility functions, shared by several programs of the test suite
     utility functions, shared by several programs of the test suite
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
 type
 type
+  TCharSet = set of char;
+
   TVerboseLevel=(V_Abort,V_Error,V_Warning,V_Normal,V_Debug,V_SQL);
   TVerboseLevel=(V_Abort,V_Error,V_Warning,V_Normal,V_Debug,V_SQL);
 
 
   TConfig = record
   TConfig = record
@@ -41,6 +45,8 @@ type
     Category      : string;
     Category      : string;
     Note          : string;
     Note          : string;
     Files         : string;
     Files         : string;
+    ConfigFileSrc : string;
+    ConfigFileDst : string;
     WpoParas      : string;
     WpoParas      : string;
     WpoPasses     : longint;
     WpoPasses     : longint;
     DelFiles      : string;
     DelFiles      : string;
@@ -49,6 +55,8 @@ type
 Const
 Const
   DoVerbose : boolean = false;
   DoVerbose : boolean = false;
   DoSQL     : boolean = false;
   DoSQL     : boolean = false;
+  MaxLogSize : LongInt = 50000;
+
 
 
 procedure TrimB(var s:string);
 procedure TrimB(var s:string);
 procedure TrimE(var s:string);
 procedure TrimE(var s:string);
@@ -57,8 +65,160 @@ procedure Verbose(lvl:TVerboseLevel;const s:string);
 function GetConfig(const fn:string;var r:TConfig):boolean;
 function GetConfig(const fn:string;var r:TConfig):boolean;
 Function GetFileContents (FN : String) : String;
 Function GetFileContents (FN : String) : String;
 
 
+const
+{ Constants used in IsAbsolute function }
+  TargetHasDosStyleDirectories : boolean = false;
+  TargetAmigaLike : boolean = false;
+  TargetIsMacOS : boolean = false;
+  TargetIsUnix : boolean = false;
+
+{ File path helper functions }
+function SplitPath(const s:string):string;
+function SplitBasePath(const s:string): string;
+Function SplitFileName(const s:string):string;
+Function SplitFileBase(const s:string):string;
+Function SplitFileExt(const s:string):string;
+Function FileExists (Const F : String) : Boolean;
+Function PathExists (Const F : String) : Boolean;
+Function IsAbsolute (Const F : String) : boolean;
+function GetToken(var s: string; Delims: TCharSet = [' ']):string;
+
 Implementation
 Implementation
 
 
+function GetToken(var s: string; Delims: TCharSet = [' ']):string;
+var
+  i : longint;
+  p: PChar;
+begin
+  p:=PChar(s);
+  i:=0;
+  while (p^ <> #0) and not (p^ in Delims) do begin
+    Inc(p);
+    Inc(i);
+  end;
+  GetToken:=Copy(s,1,i);
+  Delete(s,1,i+1);
+end;
+
+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 SplitBasePath(const s:string): string;
+var
+  i : longint;
+begin
+  i:=1;
+  while (i<length(s)) and not(s[i] in ['/','\'{$IFDEF MACOS},':'{$ENDIF}]) do
+   inc(i);
+  if s[i] in  ['/','\'{$IFDEF MACOS},':'{$ENDIF}] then
+    dec(i);
+  SplitBasePath:=Copy(s,1,i);
+end;
+
+Function SplitFileName(const s:string):string;
+var
+  p : dirstr;
+  n : namestr;
+  e : extstr;
+begin
+  FSplit(s,p,n,e);
+  SplitFileName:=n+e;
+end;
+
+Function SplitFileBase(const s:string):string;
+var
+  p : dirstr;
+  n : namestr;
+  e : extstr;
+begin
+  FSplit(s,p,n,e);
+  SplitFileBase:=n;
+end;
+
+Function SplitFileExt(const s:string):string;
+var
+  p : dirstr;
+  n : namestr;
+  e : extstr;
+begin
+  FSplit(s,p,n,e);
+  SplitFileExt:=e;
+end;
+
+
+Function FileExists (Const F : String) : Boolean;
+{
+  Returns True if the file exists, False if not.
+}
+Var
+  info : searchrec;
+begin
+  FindFirst (F,anyfile,Info);
+  FileExists:=DosError=0;
+  FindClose (Info);
+end;
+
+
+Function PathExists (Const F : String) : Boolean;
+{
+  Returns True if the file exists, False if not.
+}
+Var
+  info : searchrec;
+begin
+  FindFirst (F,anyfile,Info);
+  PathExists:=(DosError=0) and (Info.Attr and Directory=Directory);
+  FindClose (Info);
+end;
+
+{ extracted from rtl/macos/macutils.inc }
+
+function IsMacFullPath (const path: string): Boolean;
+  begin
+    if Pos(':', path) = 0 then    {its partial}
+      IsMacFullPath := false
+    else if path[1] = ':' then
+      IsMacFullPath := false
+    else
+      IsMacFullPath := true
+  end;
+
+
+Function IsAbsolute (Const F : String) : boolean;
+{
+  Returns True if the name F is a absolute file name
+}
+begin
+  IsAbsolute:=false;
+  if TargetHasDosStyleDirectories then
+    begin
+      if (F[1]='/') or (F[1]='\') then
+        IsAbsolute:=true;
+      if (Length(F)>2) and (F[2]=':') and ((F[3]='\') or (F[3]='/')) then
+        IsAbsolute:=true;
+    end
+  else if TargetAmigaLike then
+    begin
+      if (length(F)>0) and (Pos(':',F) <> 0) then
+        IsAbsolute:=true;
+    end
+  else if TargetIsMacOS then
+    begin
+      IsAbsolute:=IsMacFullPath(F);
+    end
+  { generic case }
+  else if (F[1]='/') then
+    IsAbsolute:=true;
+end;
+
 procedure Verbose(lvl:TVerboseLevel;const s:string);
 procedure Verbose(lvl:TVerboseLevel;const s:string);
 begin
 begin
   case lvl of
   case lvl of
@@ -282,6 +442,25 @@ begin
               else
               else
                if GetEntry('FILES') then
                if GetEntry('FILES') then
                 r.Files:=res
                 r.Files:=res
+              else
+                if GetEntry('CONFIGFILE') then
+                  begin
+                    l:=Pos(' ',res);
+                    if l>0 then
+                      begin
+                        r.ConfigFileSrc:=Copy(res,1,l-1);
+                        r.ConfigFileDst:=Copy(res,l+1,Length(res)-l+1);
+                        if r.ConfigFileSrc='' then
+                          Verbose(V_Error,'Config file source is empty');
+                        if r.ConfigFileDst='' then
+                          Verbose(V_Error,'Config file destination is empty');
+                      end
+                    else
+                      begin
+                        r.ConfigFileSrc:=res;
+                        r.ConfigFileDst:=res;
+                      end;
+                  end
               else
               else
                 if GetEntry('WPOPARAS') then
                 if GetEntry('WPOPARAS') then
                  r.wpoparas:=res
                  r.wpoparas:=res
@@ -320,7 +499,8 @@ begin
   While Not(EOF(F)) do
   While Not(EOF(F)) do
     begin
     begin
     ReadLn(F,S);
     ReadLn(F,S);
-    Result:=Result+S+LineEnding;
+    if length(Result)<MaxLogSize then
+      Result:=Result+S+LineEnding;
     end;
     end;
   Close(F);
   Close(F);
 end;
 end;