+ TargetHasDosStyleDirectories, TargetAmigaLike,

  TargetIsMacOS: New variables, used in new function IsAbsolute.
  SetTargetDirectoriesStyle;, IsMacFullPath, IsAbsolute: New functions.
  CopyFile: Changed from procedure to function returning the
  number of copied chars.
  RunCompiler: Add compilation type for benchmark -D option.
  RunExecutable: Add execution time for benchmark -D option.
  Also report Exitcode on failure if no output is written
  (i.e. CopyFile returns zero written chars).
  HelpScreen function: Order options alphabetically.
  Add new -D benchmark option.

git-svn-id: trunk@16757 -

tests/utils/dotest.pp

@@ -95,6 +95,72 @@ const
   UseTimeout : boolean = false;
   emulatorname : string = '';
 
+{ Constants used in IsAbsolute function }
+  TargetHasDosStyleDirectories : boolean = false;
+  TargetAmigaLike : boolean = false;
+  TargetIsMacOS : boolean = false;
+
+{ Set the three constants above according to
+  the current target }
+
+procedure SetTargetDirectoriesStyle;
+var
+  LTarget : string;
+begin
+  LTarget := lowercase(CompilerTarget);
+  TargetHasDosStyleDirectories :=
+    (LTarget='go32v2') or
+    (LTarget='win32') or
+    (LTarget='win64') or
+    (LTarget='watcom') or
+    (LTarget='os2');
+  TargetAmigaLike:=
+    (LTarget='amiga') or
+    (LTarget='morphos');
+  TargetIsMacOS:=
+    (LTarget='macos');
+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;
+
 Function FileExists (Const F : String) : Boolean;
 {
   Returns True if the file exists, False if not.
@@ -274,11 +340,12 @@ end;
       end;
 
 
-procedure Copyfile(const fn1,fn2:string;append:boolean);
+function Copyfile(const fn1,fn2:string;append:boolean) : longint;
 const
   bufsize = 16384;
 var
   f,g : file;
+  addsize,
   i   : longint;
   buf : pointer;
 begin
@@ -291,6 +358,7 @@ begin
   {$I-}
    reset(f,1);
   {$I+}
+  addsize:=0;
   if ioresult<>0 then
    Verbose(V_Error,'Can''t open '+fn1);
   if append then
@@ -315,10 +383,12 @@ begin
   repeat
     blockread(f,buf^,bufsize,i);
     blockwrite(g,buf^,i);
+    addsize:=addsize+i;
   until i<bufsize;
   freemem(buf,bufsize);
   close(f);
   close(g);
+  CopyFile:=addsize;
 end;
 
 
@@ -532,6 +602,8 @@ var
   passnr,
   passes  : longint;
   execres : boolean;
+  EndTicks,
+  StartTicks : int64;
 begin
   RunCompiler:=false;
   args:='-n -T'+CompilerTarget+' -Fu'+RTLUnitsDir;
@@ -570,6 +642,7 @@ begin
         end;
       Verbose(V_Debug,'Executing '+compilerbin+' '+args+wpoargs);
       { also get the output from as and ld that writes to stderr sometimes }
+      StartTicks:=GetMicroSTicks;
     {$ifndef macos}
       execres:=ExecuteRedir(CompilerBin,args+wpoargs,'',CompilerLogFile,'stdout');
     {$else macos}
@@ -578,7 +651,12 @@ begin
       if execres then
         execres:=ExecuteRedir(TestOutputDir + ':ppas','','',CompilerLogFile,'stdout');
     {$endif macos}
+      EndTicks:=GetMicroSTicks;
       Verbose(V_Debug,'Exitcode '+ToStr(ExecuteResult));
+      if BenchmarkInfo then
+        begin
+          Verbose(V_Normal,'Compilation took '+ToStr(EndTicks-StartTicks)+' us');
+        end;
 
       { Error during execution? }
       if (not execres) and (ExecuteResult=0) then
@@ -587,7 +665,8 @@ begin
           AddLog(ResLogFile,failed_to_compile+PPFileInfo[current]);
           AddLog(LongLogFile,line_separation);
           AddLog(LongLogFile,failed_to_compile+PPFileInfo[current]);
-          CopyFile(CompilerLogFile,LongLogFile,true);
+          if CopyFile(CompilerLogFile,LongLogFile,true)=0 then
+            AddLog(LongLogFile,'IOStatus'+ToStr(IOStatus));
           { avoid to try again }
           AddLog(ExeLogFile,failed_to_compile+PPFileInfo[current]);
           Verbose(V_Warning,'IOStatus: '+ToStr(IOStatus));
@@ -605,7 +684,8 @@ begin
          AddLog(LongLogFile,failed_to_compile+PPFileInfo[current]);
          if Config.Note<>'' then
           AddLog(LongLogFile,Config.Note);
-         CopyFile(CompilerLogFile,LongLogFile,true);
+         if CopyFile(CompilerLogFile,LongLogFile,true)=0 then
+           AddLog(LongLogFile,'Internal error in compiler');
          { avoid to try again }
          AddLog(ExeLogFile,'Failed to compile '+PPFileInfo[current]);
          Verbose(V_Warning,'Internal error in compiler');
@@ -649,7 +729,8 @@ begin
         AddLog(LongLogFile,line_separation);
         AddLog(LongLogFile,known_problem+Config.KnownCompileNote);
         AddLog(LongLogFile,failed_to_compile+PPFileInfo[current]+' ('+ToStr(ExecuteResult)+')');
-        Copyfile(CompilerLogFile,LongLogFile,true);
+        if Copyfile(CompilerLogFile,LongLogFile,true)=0 then
+          AddLog(LongLogFile,known_problem+'exitcode: '+ToStr(ExecuteResult));
         Verbose(V_Warning,known_problem+'exitcode: '+ToStr(ExecuteResult));
       end
      else if ExecuteResult<>0 then
@@ -662,7 +743,8 @@ begin
         AddLog(LongLogFile,failed_to_compile+PPFileInfo[current]);
         if Config.Note<>'' then
           AddLog(LongLogFile,Config.Note);
-        CopyFile(CompilerLogFile,LongLogFile,true);
+        if CopyFile(CompilerLogFile,LongLogFile,true)=0 then
+          AddLog(LongLogFile,'Exitcode: '+ToStr(ExecuteResult)+' (expected 0)');
         { avoid to try again }
         AddLog(ExeLogFile,failed_to_compile+PPFileInfo[current]);
         Verbose(V_Warning,'Exitcode: '+ToStr(ExecuteResult)+' (expected 0)');
@@ -709,6 +791,7 @@ end;
 
 function RunExecutable:boolean;
 const
+  MaxTrials = 5;
 {$ifdef unix}
   CurrDir = './';
 {$else}
@@ -722,16 +805,28 @@ var
   TestExe  : string;
   LocalFile, RemoteFile: string;
   LocalPath: string;
-  execcmd  : string;
+  execcmd,
+  pref     : string;
   execres  : boolean;
   index    : integer;
   EndTicks,
   StartTicks : int64;
   function ExecuteRemote(const prog,args:string):boolean;
+    var
+      Trials : longint;
     begin
       Verbose(V_Debug,'RemoteExecuting '+Prog+' '+args);
       StartTicks:=GetMicroSTicks;
-      ExecuteRemote:=ExecuteRedir(prog,args,'',EXELogFile,'stdout');
+      ExecuteRemote:=false;
+      Trials:=0;
+      While (Trials<MaxTrials) and not ExecuteRemote do
+        begin
+          inc(Trials);
+          ExecuteRemote:=ExecuteRedir(prog,args,'',EXELogFile,'stdout');
+        end;
+
+      if Trials>1 then
+        Verbose(V_Debug,'Done in '+tostr(trials)+' trials');
       EndTicks:=GetMicroSTicks;
     end;
 
@@ -749,7 +844,7 @@ begin
   RunExecutable:=false;
   execres:=true;
   { when remote testing, leave extension away }
-  if RemoteAddr='' then
+  if (RemoteAddr='') or (rcpprog='pscp') then
     TestExe:=OutputFileName(PPFile[current],ExeExt)
   else
     TestExe:=OutputFileName(PPFile[current],'');
@@ -778,7 +873,7 @@ begin
       execres:=ExecuteRemote(rcpprog,RemotePara+' '+TestExe+' '+RemoteAddr+':'+TestRemoteExe);
       if not execres then
       begin
-        Verbose(V_Abort, 'Could not copy executable '+TestExe);
+        Verbose(V_normal, 'Could not copy executable '+TestExe);
         goto done;
       end;
       s:=Config.Files;
@@ -795,10 +890,14 @@ begin
             LocalFile:=copy(s,1,index-1);
           RemoteFile:=RemotePath+'/'+SplitFileName(LocalFile);
           LocalFile:=LocalPath+LocalFile;
-          execres:=ExecuteRemote(rcpprog,RemotePara+' '+LocalFile+' '+RemoteAddr+':'+RemoteFile);
+          if DoVerbose and (rcpprog='pscp') then
+            pref:='-v '
+          else
+            pref:='';
+          execres:=ExecuteRemote(rcpprog,pref+RemotePara+' '+LocalFile+' '+RemoteAddr+':'+RemoteFile);
           if not execres then
           begin
-            Verbose(V_Abort, 'Could not copy required file '+LocalFile);
+            Verbose(V_normal, 'Could not copy required file '+LocalFile);
             goto done;
           end;
           if index=0 then
@@ -808,8 +907,14 @@ begin
       end;
       { rsh doesn't pass the exitcode, use a second command to print the exitcode
         on the remoteshell to stdout }
-      execcmd:=RemotePara+' '+RemoteAddr+' '+rquote+'chmod 755 '+TestRemoteExe+
-        ' ; cd '+RemotePath+' ;';
+      if DoVerbose and (rshprog='plink') then
+        execcmd:='-v '
+      else
+        execcmd:='';
+      execcmd:=execcmd+RemotePara+' '+RemoteAddr+' '+rquote+
+         'chmod 755 '+TestRemoteExe+' ; ';
+       //  ' ; cd '+RemotePath+' ;'; incompatible with directory
+       // present on TestRemoteExe
       if UseTimeout then
       begin
         execcmd:=execcmd+'timeout -9 ';
@@ -818,7 +923,11 @@ begin
         str(Config.Timeout,s);
         execcmd:=execcmd+s;
       end;
-      execcmd:=execcmd+' '+TestRemoteExe+' ; echo "TestExitCode: $?"';
+      if not isabsolute(TestRemoteExe) then
+        execcmd:=execcmd+' ./'+TestRemoteExe
+      else
+        execcmd:=execcmd+' '+TestRemoteExe;
+      execcmd:=execcmd+' ; echo "TestExitCode: $?"';
       if (deAfter in DelExecutable) and
          not Config.NeededAfter then
         execcmd:=execcmd+' ; rm -f '+TestRemoteExe;
@@ -864,7 +973,8 @@ done:
       AddLog(ResLogFile,failed_to_run+PPFileInfo[current]);
       AddLog(LongLogFile,line_separation);
       AddLog(LongLogFile,failed_to_run+PPFileInfo[current]);
-      CopyFile(EXELogFile,LongLogFile,true);
+      if CopyFile(EXELogFile,LongLogFile,true)=0 then
+        AddLog(LongLogFile,'IOStatus: '+ToStr(IOStatus));
       { avoid to try again }
       AddLog(ExeLogFile,failed_to_run+PPFileInfo[current]);
       Verbose(V_Warning,'IOStatus: '+ToStr(IOStatus));
@@ -881,7 +991,11 @@ done:
          AddLog(LongLogFile,line_separation);
          AddLog(LongLogFile,known_problem+Config.KnownRunNote);
          AddLog(LongLogFile,failed_to_run+PPFileInfo[current]+' ('+ToStr(ExecuteResult)+')');
-         Copyfile(EXELogFile,LongLogFile,true);
+         if Copyfile(EXELogFile,LongLogFile,true)=0 then
+           begin
+             AddLog(LongLogFile,known_problem+'exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
+             AddLog(ExeLogFile,known_problem+'exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
+           end;
          Verbose(V_Warning,known_problem+'exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
        end
      else
@@ -890,7 +1004,11 @@ done:
          AddLog(ResLogFile,failed_to_run+PPFileInfo[current]);
          AddLog(LongLogFile,line_separation);
          AddLog(LongLogFile,failed_to_run+PPFileInfo[current]+' ('+ToStr(ExecuteResult)+')');
-         Copyfile(EXELogFile,LongLogFile,true);
+         if Copyfile(EXELogFile,LongLogFile,true)=0 then
+           begin
+             AddLog(LongLogFile,'Exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
+             AddLog(ExeLogFile,'Exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
+           end;
          Verbose(V_Warning,'Exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
        end
    end
@@ -921,25 +1039,25 @@ var
     writeln('dotest [Options] <File>');
     writeln;
     writeln('Options can be:');
+    writeln('  -A            include ALL tests');
     writeln('  -B            delete executable before remote upload');
     writeln('  -C<compiler>  set compiler to use');
-    writeln('  -V            verbose');
+    writeln('  -D            display execution time');
     writeln('  -E            execute test also');
-    writeln('  -X            don''t use COMSPEC');
-    writeln('  -A            include ALL tests');
     writeln('  -G            include graph tests');
-    writeln('  -K            include known bug tests');
     writeln('  -I            include interactive tests');
-    writeln('  -O            use timeout wrapper for (remote) execution');
+    writeln('  -K            include known bug tests');
     writeln('  -M<emulator>  run the tests using the given emulator');
+    writeln('  -O            use timeout wrapper for (remote) execution');
+    writeln('  -P<path>      path to the tests tree on the remote machine');
     writeln('  -R<remote>    run the tests remotely with the given rsh/ssh address');
     writeln('  -S            use ssh instead of rsh');
     writeln('  -T[cpu-]<os>  run tests for target cpu and os');
-    writeln('  -P<path>      path to the tests tree on the remote machine');
     writeln('  -U<remotepara>');
     writeln('                pass additional parameter to remote program. Multiple -U can be used');
     writeln('  -V            be verbose');
     writeln('  -W            use putty compatible file names when testing (plink and pscp)');
+    writeln('  -X            don''t use COMSPEC');
     writeln('  -Y<opts>      extra options passed to the compiler. Several -Y<opt> can be given.');
     writeln('  -Z            remove temporary files (executable,ppu,o)');
     halt(1);
@@ -970,6 +1088,8 @@ begin
 
          'C' : CompilerBin:=Para;
 
+         'D' : BenchMarkInfo:=true;
+
          'E' : DoExecute:=true;
 
          'G' : begin
@@ -1025,7 +1145,7 @@ begin
            begin
              rshprog:='plink';
              rcpprog:='pscp';
-             rquote:=' ';
+             rquote:='"';
            end;
 
          'X' : UseComSpec:=false;
@@ -1308,6 +1428,7 @@ begin
   PPFileInfo:=TStringList.Create;
   PPFileInfo.Capacity:=10;
   GetArgs;
+  SetTargetDirectoriesStyle;
   Verbose(V_Debug,'Found '+ToStr(PPFile.Count)+' tests to run');
   if current>0 then
     for current:=0 to PPFile.Count-1 do