{ This file is part of the Free Pascal test suite. Copyright (c) 1999-2002 by the Free Pascal development team. This program makes the compilation and execution of individual test sources. See the file COPYING.FPC, included in this distribution, for details about the copyright. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} {$H+} program dotest; uses dos, {$ifdef macos} macutils, {$endif} teststr, testu, redir; {$ifdef go32v2} {$define LIMIT83FS} {$endif} {$ifdef os2} {$define LIMIT83FS} {$endif} type tcompinfo = (compver,comptarget,compcpu); const ObjExt='o'; PPUExt='ppu'; {$ifdef UNIX} ExeExt=''; {$else UNIX} {$ifdef MACOS} ExeExt=''; {$else MACOS} ExeExt='exe'; {$endif MACOS} {$endif UNIX} var Config : TConfig; CompilerLogFile, ExeLogFile, LongLogfile, FailLogfile, RTLUnitsDir, TestOutputDir, OutputDir : string; CompilerBin : string; CompilerCPU : string; CompilerTarget : string; CompilerVersion : string; PPFile : string; PPFileInfo : string; TestName : string; const DoGraph : boolean = false; DoInteractive : boolean = false; DoExecute : boolean = false; DoKnown : boolean = false; DoAll : boolean = false; DoUsual : boolean = true; TargetDir : string = ''; ExtraCompilerOpts : string = ''; DelExecutable : boolean = false; RemoteAddr : string = ''; RemotePath : string = '/tmp'; RemotePara : string = ''; rshprog : string = 'rsh'; rcpprog : string = 'rcp'; rquote : char = ''''; emulatorname : string = ''; 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; function ToStr(l:longint):string; var s : string; begin Str(l,s); ToStr:=s; end; function ToStrZero(l:longint;nbzero : byte):string; var s : string; begin Str(l,s); while length(s)0) and (s[i] in [#9,' ']) do dec(i); j:=1; while (j',') do inc(i); if Upcase(entry)=Upcase(TrimSpace(Copy(list,istart,i-istart+1))) then begin IsInList:=true; exit; end; { skip , } inc(i); end; end; procedure SetPPFileInfo; Var info : searchrec; dt : DateTime; begin FindFirst (PPFile,anyfile,Info); If DosError=0 then begin UnpackTime(info.time,dt); PPFileInfo:=PPFile+' '+ToStr(dt.year)+'/'+ToStrZero(dt.month,2)+'/'+ ToStrZero(dt.day,2)+' '+ToStrZero(dt.Hour,2)+':'+ToStrZero(dt.min,2)+':'+ToStrZero(dt.sec,2); end else PPFileInfo:=PPfile; FindClose (Info); 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 SplitFileName(const s:string):string; var p : dirstr; n : namestr; e : extstr; begin FSplit(s,p,n,e); SplitFileName:=n+e; 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:=255; if Ext<>'' then ForceExtension:=Copy(Hstr,1,j-1)+'.'+Ext else ForceExtension:=Copy(Hstr,1,j-1); end; procedure mkdirtree(const s:string); var hs : string; begin if s='' then exit; if s[length(s)] in ['\','/'{$IFDEF MACOS},':'{$ENDIF}] then hs:=Copy(s,1,length(s)-1) else hs:=s; if not PathExists(hs) then begin { Try parent first } mkdirtree(SplitPath(hs)); { make this dir } Verbose(V_Debug,'Making Directory '+s); {$I-} mkdir(s); {$I+} ioresult; end; end; Function RemoveFile(const f:string):boolean; var g : file; begin assign(g,f); {$I-} erase(g); {$I+} RemoveFile:=(ioresult=0); end; procedure Copyfile(const fn1,fn2:string;append:boolean); const bufsize = 16384; var f,g : file; i : longint; buf : pointer; begin if Append then Verbose(V_Debug,'Appending '+fn1+' to '+fn2) else Verbose(V_Debug,'Copying '+fn1+' to '+fn2); assign(f,fn1); assign(g,fn2); {$I-} reset(f,1); {$I+} if ioresult<>0 then Verbose(V_Error,'Can''t open '+fn1); if append then begin {$I-} reset(g,1); {$I+} if ioresult<>0 then append:=false else seek(g,filesize(g)); end; if not append then begin {$I-} rewrite(g,1); {$I+} if ioresult<>0 then Verbose(V_Error,'Can''t open '+fn2+' for output'); end; getmem(buf,bufsize); repeat blockread(f,buf^,bufsize,i); blockwrite(g,buf^,i); until i0 then begin {$I-} rewrite(t); {$I+} if ioresult<>0 then Verbose(V_Abort,'Can''t append to '+logfile); end; writeln(t,s); close(t); end; function GetCompilerInfo(c:tcompinfo):boolean; function GetToken(var s:string):string; var i : longint; begin i:=pos(' ',s); if i=0 then i:=length(s)+1; GetToken:=Copy(s,1,i-1); Delete(s,1,i); end; var t : text; hs : string; begin GetCompilerInfo:=false; { Try to get all information in one call, this is supported in 1.1. Older compilers 1.0.x will only return the first info } case c of compver : hs:='-iVTPTO'; compcpu : hs:='-iTPTOV'; comptarget : hs:='-iTOTPV'; end; ExecuteRedir(CompilerBin,hs,'','out',''); assign(t,'out'); {$I-} reset(t); readln(t,hs); close(t); erase(t); {$I+} if ioresult<>0 then Verbose(V_Error,'Can''t get Compiler Info') else begin Verbose(V_Debug,'Retrieved Compiler Info: "'+hs+'"'); case c of compver : begin CompilerVersion:=GetToken(hs); CompilerCPU:=GetToken(hs); CompilerTarget:=GetToken(hs); end; compcpu : begin CompilerCPU:=GetToken(hs); CompilerTarget:=GetToken(hs); CompilerVersion:=GetToken(hs); end; comptarget : begin CompilerTarget:=GetToken(hs); CompilerCPU:=GetToken(hs); CompilerVersion:=GetToken(hs); end; end; GetCompilerInfo:=true; end; end; function GetCompilerVersion:boolean; begin if CompilerVersion='' then GetCompilerVersion:=GetCompilerInfo(compver) else GetCompilerVersion:=true; if GetCompilerVersion then Verbose(V_Debug,'Compiler Version: "'+CompilerVersion+'"'); end; function GetCompilerCPU:boolean; begin if CompilerCPU='' then GetCompilerCPU:=GetCompilerInfo(compcpu) else GetCompilerCPU:=true; if GetCompilerCPU then Verbose(V_Debug,'Compiler CPU: "'+CompilerCPU+'"'); end; function GetCompilerTarget:boolean; begin if CompilerTarget='' then GetCompilerTarget:=GetCompilerInfo(comptarget) else GetCompilerTarget:=true; if GetCompilerTarget then Verbose(V_Debug,'Compiler Target: "'+CompilerTarget+'"'); end; function CompilerFullTarget:string; begin CompilerFullTarget:=CompilerCPU+'-'+CompilerTarget; end; function OutputFileName(Const s,ext:String):String; begin {$ifndef macos} OutputFileName:=OutputDir+'/'+ForceExtension(s,ext); {$else macos} OutputFileName:=ConcatMacPath(OutputDir,ForceExtension(s,ext)); {$endif macos} end; function TestOutputFileName(Const s,ext:String):String; begin {$ifndef macos} TestOutputFileName:=TestOutputDir+'/'+ForceExtension(SplitFileName(s),ext); {$else macos} TestOutputFileName:=ConcatMacPath(TestOutputDir,ForceExtension(SplitFileName(s),ext)); {$endif macos} end; function ExitWithInternalError(const OutName:string):boolean; var t : text; s : string; begin ExitWithInternalError:=false; { open logfile } assign(t,Outname); {$I-} reset(t); {$I+} if ioresult<>0 then exit; while not eof(t) do begin readln(t,s); if pos('Fatal: Internal error ',s)>0 then begin ExitWithInternalError:=true; break; end; end; close(t); end; function RunCompiler:boolean; var args : string; execres : boolean; begin RunCompiler:=false; args:='-n -Fu'+RTLUnitsDir; args:=args+' -FE'+TestOutputDir; {$ifdef macos} args:=args+' -WT '; {tests should be compiled as MPWTool} {$endif macos} if ExtraCompilerOpts<>'' then args:=args+ExtraCompilerOpts; {$ifdef unix} { Add runtime library path to current dir to find .so files } if Config.NeedLibrary then {$ifndef darwin} args:=args+' -Fl'+TestOutputDir+' ''-k-rpath .'''; {$else darwin} args:=args+' -Fl'+TestOutputDir; {$endif darwin} {$endif unix} if Config.NeedOptions<>'' then args:=args+' '+Config.NeedOptions; args:=args+' '+ppfile; Verbose(V_Debug,'Executing '+compilerbin+' '+args); { also get the output from as and ld that writes to stderr sometimes } {$ifndef macos} execres:=ExecuteRedir(CompilerBin,args,'',CompilerLogFile,'stdout'); {$else macos} {Due to that Toolserver is not reentrant, we have to asm and link via script.} execres:=ExecuteRedir(CompilerBin,'-s '+args,'',CompilerLogFile,'stdout'); if execres then execres:=ExecuteRedir(TestOutputDir + ':ppas','','',CompilerLogFile,'stdout'); {$endif macos} Verbose(V_Debug,'Exitcode '+ToStr(ExecuteResult)); { Error during execution? } if (not execres) and (ExecuteResult=0) then begin AddLog(FailLogFile,TestName); AddLog(ResLogFile,failed_to_compile+PPFileInfo); AddLog(LongLogFile,line_separation); AddLog(LongLogFile,failed_to_compile+PPFileInfo); CopyFile(CompilerLogFile,LongLogFile,true); { avoid to try again } AddLog(ExeLogFile,failed_to_compile+PPFileInfo); Verbose(V_Abort,'IOStatus: '+ToStr(IOStatus)); exit; end; { Check for internal error } if ExitWithInternalError(CompilerLogFile) then begin AddLog(FailLogFile,TestName); if Config.Note<>'' then AddLog(FailLogFile,Config.Note); AddLog(ResLogFile,failed_to_compile+PPFileInfo+' internalerror generated'); AddLog(LongLogFile,line_separation); AddLog(LongLogFile,failed_to_compile+PPFileInfo); if Config.Note<>'' then AddLog(LongLogFile,Config.Note); CopyFile(CompilerLogFile,LongLogFile,true); { avoid to try again } AddLog(ExeLogFile,'Failed to compile '+PPFileInfo); Verbose(V_Abort,'Internal error in compiler'); exit; end; { Should the compile fail ? } if Config.ShouldFail then begin if ExecuteResult<>0 then begin AddLog(ResLogFile,success_compilation_failed+PPFileInfo); { avoid to try again } AddLog(ExeLogFile,success_compilation_failed+PPFileInfo); RunCompiler:=true; end else begin AddLog(FailLogFile,TestName); if Config.Note<>'' then AddLog(FailLogFile,Config.Note); AddLog(ResLogFile,failed_compilation_successful+PPFileInfo); AddLog(LongLogFile,line_separation); AddLog(LongLogFile,failed_compilation_successful+PPFileInfo); { avoid to try again } AddLog(ExeLogFile,failed_compilation_successful+PPFileInfo); if Config.Note<>'' then AddLog(LongLogFile,Config.Note); CopyFile(CompilerLogFile,LongLogFile,true); end; end else begin if (ExecuteResult<>0) and (((Config.KnownCompileNote<>'') and (Config.KnownCompileError=0)) or ((Config.KnownCompileError<>0) and (ExecuteResult=Config.KnownCompileError))) then begin AddLog(FailLogFile,TestName+known_problem+Config.KnownCompileNote); AddLog(ResLogFile,failed_to_run+PPFileInfo+known_problem+Config.KnownCompileNote); AddLog(LongLogFile,line_separation); AddLog(LongLogFile,known_problem+Config.KnownCompileNote); AddLog(LongLogFile,failed_to_compile+PPFileInfo+' ('+ToStr(ExecuteResult)+')'); Copyfile(CompilerLogFile,LongLogFile,true); Verbose(V_Abort,known_problem+'exitcode: '+ToStr(ExecuteResult)); end else if ExecuteResult<>0 then begin AddLog(FailLogFile,TestName); if Config.Note<>'' then AddLog(FailLogFile,Config.Note); AddLog(ResLogFile,failed_to_compile+PPFileInfo); AddLog(LongLogFile,line_separation); AddLog(LongLogFile,failed_to_compile+PPFileInfo); if Config.Note<>'' then AddLog(LongLogFile,Config.Note); CopyFile(CompilerLogFile,LongLogFile,true); { avoid to try again } AddLog(ExeLogFile,failed_to_compile+PPFileInfo); Verbose(V_Abort,'Exitcode: '+ToStr(ExecuteResult)+' (expected 0)'); end else begin AddLog(ResLogFile,successfully_compiled+PPFileInfo); RunCompiler:=true; end; end; end; function CheckTestExitCode(const OutName:string):boolean; var t : text; s : string; i,code : integer; begin CheckTestExitCode:=false; { open logfile } assign(t,Outname); {$I-} reset(t); {$I+} if ioresult<>0 then exit; while not eof(t) do begin readln(t,s); i:=pos('TestExitCode: ',s); if i>0 then begin delete(s,1,i+14-1); val(s,ExecuteResult,code); if code=0 then; CheckTestExitCode:=true; break; end; end; close(t); end; function RunExecutable:boolean; const {$ifdef unix} CurrDir = './'; {$else} CurrDir = ''; {$endif} var OldDir, FullExeLogFile, TestRemoteExe, TestExe : string; execres : boolean; function ExecuteRemote(const prog,args:string):boolean; begin Verbose(V_Debug,'RemoteExecuting '+Prog+' '+args); ExecuteRemote:=ExecuteRedir(prog,args,'',EXELogFile,'stdout'); end; function ExecuteEmulated(const prog,args:string):boolean; begin Verbose(V_Debug,'EmulatorExecuting '+Prog+' '+args); ExecuteEmulated:=ExecuteRedir(prog,args,'',FullExeLogFile,'stdout'); end; begin RunExecutable:=false; execres:=true; { when remote testing, leave extension away } if RemoteAddr='' then TestExe:=OutputFileName(PPFile,ExeExt) else TestExe:=OutputFileName(PPFile,''); if EmulatorName<>'' then begin { Get full name out log file, because we change the directory during execution } FullExeLogFile:=FExpand(EXELogFile); {$I-} GetDir(0,OldDir); ChDir(TestOutputDir); {$I+} ioresult; execres:=ExecuteEmulated(EmulatorName,CurrDir+SplitFileName(TestExe)); {$I-} ChDir(OldDir); {$I+} end else if RemoteAddr<>'' then begin { We don't want to create subdirs, remove paths from the test } TestRemoteExe:=RemotePath+'/'+SplitFileName(TestExe); ExecuteRemote(rshprog,RemotePara+' '+RemoteAddr+' rm -f '+TestRemoteExe); ExecuteRemote(rcpprog,RemotePara+' '+TestExe+' '+RemoteAddr+':'+TestRemoteExe); { rsh doesn't pass the exitcode, use a second command to print the exitcode on the remoteshell to stdout } execres:=ExecuteRemote(rshprog,RemotePara+' '+RemoteAddr+' '+rquote+'chmod 755 '+TestRemoteExe+ ' ; cd '+RemotePath+' ; '+TestRemoteExe+' ; echo "TestExitCode: $?"'+rquote); { Check for TestExitCode error in output, sets ExecuteResult } CheckTestExitCode(EXELogFile); end else begin { Get full name out log file, because we change the directory during execution } FullExeLogFile:=FExpand(EXELogFile); Verbose(V_Debug,'Executing '+TestExe); {$I-} GetDir(0,OldDir); ChDir(TestOutputDir); {$I+} ioresult; { don't redirect interactive and graph programs } if Config.IsInteractive or Config.UsesGraph then execres:=ExecuteRedir(CurrDir+SplitFileName(TestExe),'','','','') else execres:=ExecuteRedir(CurrDir+SplitFileName(TestExe),'','',FullExeLogFile,'stdout'); {$I-} ChDir(OldDir); {$I+} ioresult; end; { Error during execution? } Verbose(V_Debug,'Exitcode '+ToStr(ExecuteResult)); if (not execres) and (ExecuteResult=0) then begin AddLog(FailLogFile,TestName); AddLog(ResLogFile,failed_to_run+PPFileInfo); AddLog(LongLogFile,line_separation); AddLog(LongLogFile,failed_to_run+PPFileInfo); CopyFile(EXELogFile,LongLogFile,true); { avoid to try again } AddLog(ExeLogFile,failed_to_run+PPFileInfo); Verbose(V_Abort,'IOStatus: '+ToStr(IOStatus)); exit; end; if ExecuteResult<>Config.ResultCode then begin if (ExecuteResult<>0) and (ExecuteResult=Config.KnownRunError) then begin AddLog(FailLogFile,TestName+known_problem+Config.KnownRunNote); AddLog(ResLogFile,failed_to_run+PPFileInfo+known_problem+Config.KnownRunNote); AddLog(LongLogFile,line_separation); AddLog(LongLogFile,known_problem+Config.KnownRunNote); AddLog(LongLogFile,failed_to_run+PPFileInfo+' ('+ToStr(ExecuteResult)+')'); Copyfile(EXELogFile,LongLogFile,true); Verbose(V_Abort,known_problem+'exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')'); end else begin AddLog(FailLogFile,TestName); AddLog(ResLogFile,failed_to_run+PPFileInfo); AddLog(LongLogFile,line_separation); AddLog(LongLogFile,failed_to_run+PPFileInfo+' ('+ToStr(ExecuteResult)+')'); Copyfile(EXELogFile,LongLogFile,true); Verbose(V_Abort,'Exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')'); end end else begin AddLog(ResLogFile,successfully_run+PPFileInfo); RunExecutable:=true; end; if DelExecutable then begin Verbose(V_Debug,'Deleting executable '+TestExe); if RemoteAddr<>'' then ExecuteRemote(rshprog,RemotePara+' '+RemoteAddr+' rm -f '+TestRemoteExe); RemoveFile(TestExe); RemoveFile(ForceExtension(TestExe,ObjExt)); RemoveFile(ForceExtension(TestExe,PPUExt)); end; end; procedure getargs; var ch : char; para : string; i : longint; procedure helpscreen; begin writeln('dotest [Options] '); writeln; writeln('Options can be:'); writeln(' -C set compiler to use'); writeln(' -V verbose'); 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(' -M run the tests using the given emulator'); writeln(' -R run the tests remotely with the given rsh/ssh address'); writeln(' -S use ssh instead of rsh'); writeln(' -T remove temporary files (executable,ppu,o)'); 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(' -Y extra options passed to the compiler. Several -Y can be given.'); halt(1); end; begin PPFile:=''; if exeext<>'' then CompilerBin:='ppc386.'+exeext else CompilerBin:='ppc386'; for i:=1 to paramcount do begin para:=Paramstr(i); if (para[1]='-') then begin ch:=Upcase(para[2]); delete(para,1,2); case ch of 'A' : begin DoGraph:=true; DoInteractive:=true; DoKnown:=true; DoAll:=true; end; 'C' : CompilerBin:=Para; 'E' : DoExecute:=true; 'G' : begin DoGraph:=true; if para='-' then DoUsual:=false; end; 'I' : begin DoInteractive:=true; if para='-' then DoUsual:=false; end; 'K' : begin DoKnown:=true; if para='-' then DoUsual:=false; end; 'M' : EmulatorName:=Para; 'P' : RemotePath:=Para; 'R' : RemoteAddr:=Para; 'S' : begin rshprog:='ssh'; rcpprog:='scp'; end; 'T' : DelExecutable:=true; 'U' : RemotePara:=RemotePara+' '+Para; 'V' : DoVerbose:=true; 'W' : begin rshprog:='plink'; rcpprog:='pscp'; rquote:=' '; end; 'X' : UseComSpec:=false; 'Y' : ExtraCompilerOpts:= ExtraCompilerOpts +' '+ Para; end; end else begin If PPFile<>'' then HelpScreen; PPFile:=ForceExtension(Para,'pp'); end; end; if (PPFile='') then HelpScreen; { disable graph,interactive when running remote } if RemoteAddr<>'' then begin DoGraph:=false; DoInteractive:=false; end; SetPPFileInfo; TestName:=Copy(PPFile,1,Pos('.pp',PPFile)-1); Verbose(V_Debug,'Running test '+TestName+', file '+PPFile); end; procedure RunTest; var PPDir : string; Res : boolean; begin Res:=GetConfig(ppfile,Config); if Res then begin Res:=GetCompilerCPU; Res:=GetCompilerTarget; {$ifndef MACOS} RTLUnitsDir:='units/'+{$ifdef LIMIT83FS}CompilerTarget{$else}CompilerFullTarget{$endif}; {$else MACOS} RTLUnitsDir:=':units:'+CompilerFullTarget; {$endif MACOS} if not PathExists(RTLUnitsDir) then Verbose(V_Abort,'Unit path "'+RTLUnitsDir+'" does not exists'); {$ifndef MACOS} OutputDir:='output/'+{$ifdef LIMIT83FS}CompilerTarget{$else}CompilerFullTarget{$endif}; {$else MACOS} OutputDir:=':output:'+CompilerFullTarget; {$endif MACOS} if not PathExists(OutputDir) then Verbose(V_Abort,'Output path "'+OutputDir+'" does not exists'); { Global log files } ResLogFile:=OutputFileName('log',''); LongLogFile:=OutputFileName('longlog',''); FailLogFile:=OutputFileName('faillist',''); { Make subdir in output if needed } PPDir:=SplitPath(PPFile); if PPDir[length(PPDir)] in ['/','\'{$ifdef MACOS},':'{$endif MACOS}] then Delete(PPDir,length(PPDir),1); if PPDir<>'' then begin {$ifndef MACOS} TestOutputDir:=OutputDir+'/'+PPDir; {$else MACOS} TestOutputDir:=OutputDir+PPDir; {$endif MACOS} mkdirtree(TestOutputDir); end else TestOutputDir:=OutputDir; { Per test logfiles } CompilerLogFile:=TestOutputFileName(SplitFileName(PPFile),'log'); ExeLogFile:=TestOutputFileName(SplitFileName(PPFile),'elg'); Verbose(V_Debug,'Using Compiler logfile: '+CompilerLogFile); Verbose(V_Debug,'Using Execution logfile: '+ExeLogFile); end; if Res then begin if Config.UsesGraph and (not DoGraph) then begin AddLog(ResLogFile,skipping_graph_test+PPFileInfo); { avoid a second attempt by writing to elg file } AddLog(EXELogFile,skipping_graph_test+PPFileInfo); Verbose(V_Abort,skipping_graph_test); Res:=false; end; end; if Res then begin if Config.IsInteractive and (not DoInteractive) then begin { avoid a second attempt by writing to elg file } AddLog(EXELogFile,skipping_interactive_test+PPFileInfo); AddLog(ResLogFile,skipping_interactive_test+PPFileInfo); Verbose(V_Abort,skipping_interactive_test); Res:=false; end; end; if Res then begin if Config.IsKnownCompileError and (not DoKnown) then begin { avoid a second attempt by writing to elg file } AddLog(EXELogFile,skipping_known_bug+PPFileInfo); AddLog(ResLogFile,skipping_known_bug+PPFileInfo); Verbose(V_Abort,skipping_known_bug); Res:=false; end; end; if Res and not DoUsual then res:=(Config.IsInteractive and DoInteractive) or (Config.IsKnownRunError and DoKnown) or (Config.UsesGraph and DoGraph); if Res then begin if (Config.MinVersion<>'') and not DoAll then begin Verbose(V_Debug,'Required compiler version: '+Config.MinVersion); Res:=GetCompilerVersion; if CompilerVersion'') and not DoAll then begin Verbose(V_Debug,'Highest compiler version: '+Config.MaxVersion); Res:=GetCompilerVersion; if CompilerVersion>Config.MaxVersion then begin { avoid a second attempt by writing to elg file } AddLog(EXELogFile,skipping_compiler_version_too_high+PPFileInfo); AddLog(ResLogFile,skipping_compiler_version_too_high+PPFileInfo); Verbose(V_Abort,'Compiler version too high '+CompilerVersion+' > '+Config.MaxVersion); Res:=false; end; end; end; if Res then begin if Config.NeedCPU<>'' then begin Verbose(V_Debug,'Required compiler cpu: '+Config.NeedCPU); if not IsInList(CompilerCPU,Config.NeedCPU) then begin { avoid a second attempt by writing to elg file } AddLog(EXELogFile,skipping_other_cpu+PPFileInfo); AddLog(ResLogFile,skipping_other_cpu+PPFileInfo); Verbose(V_Abort,'Compiler cpu "'+CompilerCPU+'" is not in list "'+Config.NeedCPU+'"'); Res:=false; end; end; end; if Res then begin if Config.SkipCPU<>'' then begin Verbose(V_Debug,'Skip compiler cpu: '+Config.SkipCPU); if IsInList(CompilerCPU,Config.SkipCPU) then begin { avoid a second attempt by writing to elg file } AddLog(EXELogFile,skipping_other_cpu+PPFileInfo); AddLog(ResLogFile,skipping_other_cpu+PPFileInfo); Verbose(V_Abort,'Compiler cpu "'+CompilerCPU+'" is in list "'+Config.SkipCPU+'"'); Res:=false; end; end; end; if Res then begin if Config.SkipEmu<>'' then begin Verbose(V_Debug,'Skip emulator: '+emulatorname); if IsInList(emulatorname,Config.SkipEmu) then begin { avoid a second attempt by writing to elg file } AddLog(EXELogFile,skipping_other_cpu+PPFileInfo); AddLog(ResLogFile,skipping_other_cpu+PPFileInfo); Verbose(V_Abort,'Emulator "'+emulatorname+'" is in list "'+Config.SkipEmu+'"'); Res:=false; end; end; end; if Res then begin if Config.NeedTarget<>'' then begin Verbose(V_Debug,'Required compiler target: '+Config.NeedTarget); if not IsInList(CompilerTarget,Config.NeedTarget) then begin { avoid a second attempt by writing to elg file } AddLog(EXELogFile,skipping_other_target+PPFileInfo); AddLog(ResLogFile,skipping_other_target+PPFileInfo); Verbose(V_Abort,'Compiler target "'+CompilerTarget+'" is not in list "'+Config.NeedTarget+'"'); Res:=false; end; end; end; if Res then begin if Config.SkipTarget<>'' then begin Verbose(V_Debug,'Skip compiler target: '+Config.NeedTarget); if IsInList(CompilerTarget,Config.SkipTarget) then begin { avoid a second attempt by writing to elg file } AddLog(EXELogFile,skipping_other_target+PPFileInfo); AddLog(ResLogFile,skipping_other_target+PPFileInfo); Verbose(V_Abort,'Compiler target "'+CompilerTarget+'" is in list "'+Config.SkipTarget+'"'); Res:=false; end; end; end; if Res then begin Res:=RunCompiler; if Res and Config.NeedRecompile then Res:=RunCompiler; end; if Res then begin if (Config.NoRun) then begin { avoid a second attempt by writing to elg file } AddLog(EXELogFile,skipping_run_test+PPFileInfo); AddLog(ResLogFile,skipping_run_test+PPFileInfo); Verbose(V_Debug,skipping_run_test); end else if Config.IsKnownRunError and (not DoKnown) then begin { avoid a second attempt by writing to elg file } AddLog(EXELogFile,skipping_known_bug+PPFileInfo); AddLog(ResLogFile,skipping_known_bug+PPFileInfo); Verbose(V_Abort,skipping_known_bug); end else begin if (not Config.ShouldFail) and DoExecute then begin if FileExists(TestOutputFilename(PPFile,'ppu')) or FileExists(TestOutputFilename(PPFile,'ppo')) or FileExists(TestOutputFilename(PPFile,'ppw')) then begin AddLog(ExeLogFile,skipping_run_unit+PPFileInfo); AddLog(ResLogFile,skipping_run_unit+PPFileInfo); Verbose(V_Debug,'Unit found, skipping run test') end else Res:=RunExecutable; end; end; end; end; begin GetArgs; RunTest; end.