From e3b56a1bcb30c7d89b0d59e587464458be63a0f4 Mon Sep 17 00:00:00 2001 From: pierre Date: Thu, 13 Jan 2011 14:06:24 +0000 Subject: [PATCH] + 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 | 169 ++++++++++++++++++++++++++++++++++++------ 1 file changed, 145 insertions(+), 24 deletions(-) diff --git a/tests/utils/dotest.pp b/tests/utils/dotest.pp index 2c8e4cc05b..f295c67c64 100644 --- a/tests/utils/dotest.pp +++ b/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'' 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 (Trials1 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] '); writeln; writeln('Options can be:'); + writeln(' -A include ALL tests'); writeln(' -B delete executable before remote upload'); writeln(' -C 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 run the tests using the given emulator'); + writeln(' -O use timeout wrapper for (remote) execution'); + writeln(' -P path to the tests tree on the remote machine'); writeln(' -R run the tests remotely with the given rsh/ssh address'); writeln(' -S use ssh instead of rsh'); writeln(' -T[cpu-] run tests for target cpu and os'); - writeln(' -P path to the tests tree on the remote machine'); writeln(' -U'); 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 extra options passed to the compiler. Several -Y 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