12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736 |
- {
- 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+}
- {$goto on}
- program dotest;
- uses
- dos,
- {$ifdef macos}
- macutils,
- {$endif}
- teststr,
- testu,
- redir,
- bench,
- classes;
- {$ifdef go32v2}
- {$define LIMIT83FS}
- {$endif}
- {$ifdef os2}
- {$define LIMIT83FS}
- {$endif}
- type
- tcompinfo = (compver,comptarget,compcpu);
- tdelexecutable = (deBefore, deAfter);
- tdelexecutables = set of tdelexecutable;
- const
- ObjExt='o';
- PPUExt='ppu';
- {$ifdef UNIX}
- SrcExeExt='';
- {$else UNIX}
- {$ifdef MACOS}
- SrcExeExt='';
- {$else MACOS}
- SrcExeExt='.exe';
- {$endif MACOS}
- {$endif UNIX}
- ExeExt : string = '';
- DefaultTimeout=60;
- var
- Config : TConfig;
- CompilerLogFile,
- ExeLogFile,
- LongLogfile,
- FailLogfile,
- RTLUnitsDir,
- TestOutputDir,
- OutputDir : string;
- CompilerBin,
- { CompilerCPU and CompilerTarget are lowercased at start
- to avoid need to call lowercase again and again ... }
- CompilerCPU,
- CompilerTarget,
- CompilerVersion,
- DefaultCompilerCPU,
- DefaultCompilerTarget,
- DefaultCompilerVersion : string;
- PPFile : TStringList;
- PPFileInfo : TStringList;
- TestName : string;
- Current : longint;
- const
- DoGraph : boolean = false;
- UseOSOnly : boolean = false;
- DoInteractive : boolean = false;
- DoExecute : boolean = false;
- DoKnown : boolean = false;
- DoAll : boolean = false;
- DoUsual : boolean = true;
- { TargetDir : string = ''; unused }
- BenchmarkInfo : boolean = false;
- ExtraCompilerOpts : string = '';
- DelExecutable : TDelExecutables = [];
- RemoteAddr : string = '';
- RemotePath : string = '/tmp';
- RemotePara : string = '';
- RemoteShell : string = '';
- RemoteShellBase : string = '';
- RemoteShellNeedsExport : boolean = false;
- rshprog : string = 'rsh';
- rcpprog : string = 'rcp';
- rquote : char = '''';
- UseTimeout : boolean = false;
- emulatorname : string = '';
- TargetCanCompileLibraries : boolean = true;
- { 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;
- 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)<nbzero do
- s:='0'+s;
- ToStrZero:=s;
- end;
- function trimspace(const s:string):string;
- var
- i,j : longint;
- begin
- i:=length(s);
- while (i>0) and (s[i] in [#9,' ']) do
- dec(i);
- j:=1;
- while (j<i) and (s[j] in [#9,' ']) do
- inc(j);
- trimspace:=Copy(s,j,i-j+1);
- end;
- function IsInList(const entry,list:string):boolean;
- var
- i,istart : longint;
- begin
- IsInList:=false;
- i:=0;
- while (i<length(list)) do
- begin
- { Find list item }
- istart:=i+1;
- while (i<length(list)) and
- (list[i+1]<>',') 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[current],anyfile,Info);
- If DosError=0 then
- begin
- UnpackTime(info.time,dt);
- PPFileInfo.Insert(current,PPFile[current]+' '+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.Insert(current,PPFile[current]);
- 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 SplitFileBase(const s:string):string;
- var
- p : dirstr;
- n : namestr;
- e : extstr;
- begin
- FSplit(s,p,n,e);
- SplitFileBase:=n;
- 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 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;
- function Copyfile(const fn1,fn2:string;append:boolean) : longint;
- const
- bufsize = 16384;
- var
- f,g : file;
- addsize,
- 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+}
- addsize:=0;
- 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);
- addsize:=addsize+i;
- until i<bufsize;
- freemem(buf,bufsize);
- close(f);
- close(g);
- CopyFile:=addsize;
- end;
- procedure AddLog(const logfile,s:string);
- var
- t : text;
- begin
- assign(t,logfile);
- {$I-}
- append(t);
- {$I+}
- if ioresult<>0 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 :
- begin
- if DefaultCompilerVersion<>'' then
- begin
- GetCompilerInfo:=true;
- exit;
- end;
- hs:='-iVTPTO';
- end;
- compcpu :
- begin
- if DefaultCompilerCPU<>'' then
- begin
- GetCompilerInfo:=true;
- exit;
- end;
- hs:='-iTPTOV';
- end;
- comptarget :
- begin
- if DefaultCompilerTarget<>'' then
- begin
- GetCompilerInfo:=true;
- exit;
- end;
- hs:='-iTOTPV';
- end;
- 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
- DefaultCompilerVersion:=GetToken(hs);
- DefaultCompilerCPU:=GetToken(hs);
- DefaultCompilerTarget:=GetToken(hs);
- end;
- compcpu :
- begin
- DefaultCompilerCPU:=GetToken(hs);
- DefaultCompilerTarget:=GetToken(hs);
- DefaultCompilerVersion:=GetToken(hs);
- end;
- comptarget :
- begin
- DefaultCompilerTarget:=GetToken(hs);
- DefaultCompilerCPU:=GetToken(hs);
- DefaultCompilerVersion:=GetToken(hs);
- end;
- end;
- GetCompilerInfo:=true;
- end;
- end;
- function GetCompilerVersion:boolean;
- const
- CompilerVersionDebugWritten : boolean = false;
- begin
- if CompilerVersion='' then
- begin
- GetCompilerVersion:=GetCompilerInfo(compver);
- CompilerVersion:=DefaultCompilerVersion;
- end
- else
- GetCompilerVersion:=true;
- if GetCompilerVersion and not CompilerVersionDebugWritten then
- begin
- Verbose(V_Debug,'Compiler Version: "'+CompilerVersion+'"');
- CompilerVersionDebugWritten:=true;
- end;
- end;
- function GetCompilerCPU:boolean;
- const
- CompilerCPUDebugWritten : boolean = false;
- begin
- if CompilerCPU='' then
- begin
- GetCompilerCPU:=GetCompilerInfo(compcpu);
- CompilerCPU:=lowercase(DefaultCompilerCPU);
- end
- else
- GetCompilerCPU:=true;
- if GetCompilerCPU and not CompilerCPUDebugWritten then
- begin
- Verbose(V_Debug,'Compiler CPU: "'+CompilerCPU+'"');
- CompilerCPUDebugWritten:=true;
- end;
- end;
- function GetCompilerTarget:boolean;
- const
- CompilerTargetDebugWritten : boolean = false;
- begin
- if CompilerTarget='' then
- begin
- GetCompilerTarget:=GetCompilerInfo(comptarget);
- CompilerTarget:=lowercase(DefaultCompilerTarget);
- end
- else
- GetCompilerTarget:=true;
- if GetCompilerTarget and not CompilerTargetDebugWritten then
- begin
- Verbose(V_Debug,'Compiler Target: "'+CompilerTarget+'"');
- CompilerTargetDebugWritten:=true;
- end;
- end;
- function CompilerFullTarget:string;
- begin
- if UseOSOnly then
- CompilerFullTarget:=CompilerTarget
- else
- CompilerFullTarget:=CompilerCPU+'-'+CompilerTarget;
- end;
- { Set the three constants above according to
- the current target }
- procedure SetTargetDirectoriesStyle;
- var
- LTarget : string;
- res : boolean;
- begin
- { Call this first to ensure that CompilerTarget is not empty }
- res:=GetCompilerTarget;
- LTarget := CompilerTarget;
- TargetHasDosStyleDirectories :=
- (LTarget='emx') or
- (LTarget='go32v2') or
- (LTarget='nativent') or
- (LTarget='os2') or
- (LTarget='symbian') or
- (LTarget='watcom') or
- (LTarget='wdosx') or
- (LTarget='win32') or
- (LTarget='win64');
- TargetAmigaLike:=
- (LTarget='amiga') or
- (LTarget='morphos');
- TargetIsMacOS:=
- (LTarget='macos');
- { Base on whether UNIX is defined as default macro
- in extradefines in systesms/i_XXX.pas units }
- TargetIsUnix:=
- (LTarget='linux') or
- (LTarget='linux6432') or
- (LTarget='freebsd') or
- (LTarget='openbsd') or
- (LTarget='netbsd') or
- (LTarget='beos') or
- (LTarget='haiku') or
- (LTarget='solaris') or
- (LTarget='iphonesim') or
- (LTarget='darwin');
- { Set ExeExt for CompilerTarget.
- This list has been set up 2011-06 using the information in
- compiler/system/i_XXX.pas units.
- We should update this list when adding new targets PM }
- if (TargetHasDosStyleDirectories) then
- ExeExt:='.exe'
- else if LTarget='atari' then
- ExeExt:='.tpp'
- else if LTarget='gba' then
- ExeExt:='.gba'
- else if LTarget='nds' then
- ExeExt:='.bin'
- else if (LTarget='netware') or (LTarget='netwlibc') then
- ExeExt:='.nlm'
- else if LTarget='wii' then
- ExeExt:='.dol'
- else if LTarget='wince' then
- ExeExt:='.exe';
- end;
- {$ifndef LIMIT83FS}
- { Set the UseOSOnly constant above according to
- the current target }
- procedure SetUseOSOnly;
- var
- LTarget : string;
- res : boolean;
- begin
- { Call this first to ensure that CompilerTarget is not empty }
- res:=GetCompilerTarget;
- LTarget := CompilerTarget;
- UseOSOnly:= (LTarget='emx') or
- (LTarget='go32v2') or
- (LTarget='os2');
- end;
- {$endif not LIMIT83FS}
- procedure SetTargetCanCompileLibraries;
- var
- LTarget : string;
- res : boolean;
- begin
- { Call this first to ensure that CompilerTarget is not empty }
- res:=GetCompilerTarget;
- LTarget := CompilerTarget;
- { Feel free to add other targets here }
- if (LTarget='go32v2') then
- TargetCanCompileLibraries:=false;
- 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 pref,base,ext:String):String;
- begin
- {$ifndef macos}
- TestOutputFileName:=TestOutputDir+'/'+ForceExtension(pref+SplitFileName(base),ext);
- {$else macos}
- TestOutputFileName:=ConcatMacPath(TestOutputDir,ForceExtension(pref+SplitFileName(base),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,
- wpoargs : string;
- passnr,
- passes : longint;
- execres : boolean;
- EndTicks,
- StartTicks : int64;
- begin
- RunCompiler:=false;
- args:='-n -T'+CompilerTarget+' -Fu'+RTLUnitsDir;
- args:=args+' -FE'+TestOutputDir;
- if TargetIsMacOS then
- args:=args+' -WT '; {tests should be compiled as MPWTool}
- if ExtraCompilerOpts<>'' then
- args:=args+ExtraCompilerOpts;
- if TargetIsUnix then
- begin
- { Add runtime library path to current dir to find .so files }
- if Config.NeedLibrary then
- begin
- if CompilerTarget<>'darwin' then
- args:=args+' -Fl'+TestOutputDir+' ''-k-rpath .'''
- else
- args:=args+' -Fl'+TestOutputDir;
- end;
- end;
- if Config.NeedOptions<>'' then
- args:=args+' '+Config.NeedOptions;
- wpoargs:='';
- if (Config.WpoPasses=0) or
- (Config.WpoParas='') then
- passes:=1
- else
- passes:=config.wpopasses+1;
- args:=args+' '+PPFile[current];
- for passnr:=1 to passes do
- begin
- if (passes>1) then
- begin
- wpoargs:=' -OW'+config.wpoparas+' -FW'+TestOutputFileName('',PPFile[current],'wp'+tostr(passnr));
- if (passnr>1) then
- wpoargs:=wpoargs+' -Ow'+config.wpoparas+' -Fw'+TestOutputFileName('',PPFile[current],'wp'+tostr(passnr-1));
- 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}
- {Due to that Toolserver is not reentrant, we have to asm and link via script.}
- execres:=ExecuteRedir(CompilerBin,'-s '+args+wpoargs,'',CompilerLogFile,'stdout');
- 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
- begin
- AddLog(FailLogFile,TestName);
- AddLog(ResLogFile,failed_to_compile+PPFileInfo[current]);
- AddLog(LongLogFile,line_separation);
- AddLog(LongLogFile,failed_to_compile+PPFileInfo[current]);
- 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));
- 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[current]+' internalerror generated');
- AddLog(LongLogFile,line_separation);
- AddLog(LongLogFile,failed_to_compile+PPFileInfo[current]);
- if Config.Note<>'' then
- AddLog(LongLogFile,Config.Note);
- 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');
- exit;
- end;
- end;
- { Should the compile fail ? }
- if Config.ShouldFail then
- begin
- if ExecuteResult<>0 then
- begin
- AddLog(ResLogFile,success_compilation_failed+PPFileInfo[current]);
- { avoid to try again }
- AddLog(ExeLogFile,success_compilation_failed+PPFileInfo[current]);
- RunCompiler:=true;
- end
- else
- begin
- AddLog(FailLogFile,TestName);
- if Config.Note<>'' then
- AddLog(FailLogFile,Config.Note);
- AddLog(ResLogFile,failed_compilation_successful+PPFileInfo[current]);
- AddLog(LongLogFile,line_separation);
- AddLog(LongLogFile,failed_compilation_successful+PPFileInfo[current]);
- { avoid to try again }
- AddLog(ExeLogFile,failed_compilation_successful+PPFileInfo[current]);
- 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[current]+known_problem+Config.KnownCompileNote);
- AddLog(LongLogFile,line_separation);
- AddLog(LongLogFile,known_problem+Config.KnownCompileNote);
- AddLog(LongLogFile,failed_to_compile+PPFileInfo[current]+' ('+ToStr(ExecuteResult)+')');
- 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
- begin
- AddLog(FailLogFile,TestName);
- if Config.Note<>'' then
- AddLog(FailLogFile,Config.Note);
- AddLog(ResLogFile,failed_to_compile+PPFileInfo[current]);
- AddLog(LongLogFile,line_separation);
- AddLog(LongLogFile,failed_to_compile+PPFileInfo[current]);
- if Config.Note<>'' then
- AddLog(LongLogFile,Config.Note);
- 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)');
- end
- else
- begin
- AddLog(ResLogFile,successfully_compiled+PPFileInfo[current]);
- 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 LibraryExists(const PPFile : string; var FileName : string) : boolean;
- begin
- { Check if a dynamic library XXX was created }
- { Windows XXX.dll style }
- FileName:=TestOutputFilename('',PPFile,'dll');
- if FileExists(FileName) then
- begin
- LibraryExists:=true;
- exit;
- end;
- { Linux libXXX.so style }
- FileName:=TestOutputFilename('lib',PPFile,'so');
- if FileExists(FileName) then
- begin
- LibraryExists:=true;
- exit;
- end;
- { Darwin libXXX.dylib style }
- FileName:=TestOutputFilename('lib',PPFile,'dylib');
- if FileExists(FileName) then
- begin
- LibraryExists:=true;
- exit;
- end;
- { MacOS LibXXX style }
- FileName:=TestOutputFilename('Lib',PPFile,'');
- if FileExists(FileName) then
- begin
- LibraryExists:=true;
- exit;
- end;
- { Netware wlic XXX.nlm style }
- FileName:=TestOutputFilename('',PPFile,'nlm');
- if FileExists(FileName) then
- begin
- LibraryExists:=true;
- exit;
- end;
- { Amiga XXX.library style }
- FileName:=TestOutputFilename('',PPFile,'library');
- if FileExists(FileName) then
- begin
- LibraryExists:=true;
- exit;
- end;
- LibraryExists:=false;
- end;
- function ExecuteRemote(const prog,args:string;var StartTicks,EndTicks : int64):boolean;
- const
- MaxTrials = 5;
- var
- Trials : longint;
- Res : boolean;
- begin
- Verbose(V_Debug,'RemoteExecuting '+Prog+' '+args);
- StartTicks:=GetMicroSTicks;
- Res:=false;
- Trials:=0;
- While (Trials<MaxTrials) and not Res do
- begin
- inc(Trials);
- Res:=ExecuteRedir(prog,args,'',EXELogFile,'stdout');
- if not Res then
- Verbose(V_Debug,'Call to '+prog+' failed: '+
- 'IOStatus='+ToStr(IOStatus)+
- ' RedirErrorOut='+ToStr(RedirErrorOut)+
- ' RedirErrorIn='+ToStr(RedirErrorIn)+
- ' RedirErrorError='+ToStr(RedirErrorError)+
- ' ExecuteResult='+ToStr(ExecuteResult));
- end;
- if Trials>1 then
- Verbose(V_Debug,'Done in '+tostr(trials)+' trials');
- EndTicks:=GetMicroSTicks;
- ExecuteRemote:=res;
- end;
- function ExecuteEmulated(const prog,args,FullExeLogFile:string;var StartTicks,EndTicks : int64):boolean;
- begin
- Verbose(V_Debug,'EmulatorExecuting '+Prog+' '+args);
- StartTicks:=GetMicroSTicks;
- ExecuteEmulated:=ExecuteRedir(prog,args,'',FullExeLogFile,'stdout');
- EndTicks:=GetMicroSTicks;
- end;
- function MaybeCopyFiles(const FileToCopy : string) : boolean;
- var
- TestRemoteExe,
- s : string;
- pref : string;
- LocalFile, RemoteFile: string;
- LocalPath: string;
- index : integer;
- execres : boolean;
- EndTicks,
- StartTicks : int64;
- begin
- if RemoteAddr='' then
- begin
- exit(false);
- end;
- execres:=true;
- { We don't want to create subdirs, remove paths from the test }
- TestRemoteExe:=RemotePath+'/'+SplitFileName(FileToCopy);
- if deBefore in DelExecutable then
- ExecuteRemote(rshprog,RemotePara+' '+RemoteAddr+' rm -f '+TestRemoteExe,
- StartTicks,EndTicks);
- execres:=ExecuteRemote(rcpprog,RemotePara+' '+FileToCopy+' '+
- RemoteAddr+':'+TestRemoteExe,StartTicks,EndTicks);
- if not execres then
- begin
- Verbose(V_normal, 'Could not copy executable '+FileToCopy);
- exit(execres);
- end;
- s:=Config.Files;
- if length(s) > 0 then
- begin
- LocalPath:=SplitPath(PPFile[current]);
- if Length(LocalPath) > 0 then
- LocalPath:=LocalPath+'/';
- repeat
- index:=pos(' ',s);
- if index=0 then
- LocalFile:=s
- else
- LocalFile:=copy(s,1,index-1);
- RemoteFile:=RemotePath+'/'+SplitFileName(LocalFile);
- LocalFile:=LocalPath+LocalFile;
- if DoVerbose and (rcpprog='pscp') then
- pref:='-v '
- else
- pref:='';
- execres:=ExecuteRemote(rcpprog,pref+RemotePara+' '+LocalFile+' '+
- RemoteAddr+':'+RemoteFile,StartTicks,EndTicks);
- if not execres then
- begin
- Verbose(V_normal, 'Could not copy required file '+LocalFile);
- exit(false);
- end;
- if index=0 then
- break;
- s:=copy(s,index+1,length(s)-index);
- until false;
- end;
- MaybeCopyFiles:=execres;
- end;
- function RunExecutable:boolean;
- const
- {$ifdef unix}
- CurrDir = './';
- {$else}
- CurrDir = '';
- {$endif}
- var
- OldDir, s,
- execcmd,
- FullExeLogFile,
- TestRemoteExe,
- TestExe : string;
- execres : boolean;
- EndTicks,
- StartTicks : int64;
- begin
- RunExecutable:=false;
- execres:=true;
- TestExe:=OutputFileName(PPFile[current],ExeExt);
- 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;
- s:=CurrDir+SplitFileName(TestExe);
- execres:=ExecuteEmulated(EmulatorName,s,FullExeLogFile,StartTicks,EndTicks);
- {$I-}
- ChDir(OldDir);
- {$I+}
- end
- else if RemoteAddr<>'' then
- begin
- execres:=MaybeCopyFiles(TestExe);
- TestRemoteExe:=RemotePath+'/'+SplitFileName(TestExe);
- { rsh doesn't pass the exitcode, use a second command to print the exitcode
- on the remoteshell to stdout }
- if DoVerbose and (rshprog='plink') then
- execcmd:='-v '
- else
- execcmd:='';
- execcmd:=execcmd+RemotePara+' '+RemoteAddr+' '+rquote+
- 'chmod 755 '+TestRemoteExe+
- ' ; cd '+RemotePath+' ; ';
- { Using -rpath . at compile time does not seem
- to work for programs copied over to remote machine,
- at least not for FreeBSD.
- Does this work for all shells? }
- if Config.NeedLibrary then
- begin
- if RemoteShellNeedsExport then
- execcmd:=execcmd+' LD_LIBRARY_PATH=.; export LD_LIBRARY_PATH;'
- else
- execcmd:=execcmd+' setenv LD_LIBRARY_PATH=.; ';
- end;
- if UseTimeout then
- begin
- execcmd:=execcmd+'timeout -9 ';
- if Config.Timeout=0 then
- Config.Timeout:=DefaultTimeout;
- str(Config.Timeout,s);
- execcmd:=execcmd+s;
- end;
- { as we moved to RemotePath, if path is not absolute
- we need to use ./execfilename only }
- if not isabsolute(TestRemoteExe) then
- execcmd:=execcmd+' ./'+SplitFileName(TestRemoteExe)
- else
- execcmd:=execcmd+' '+TestRemoteExe;
- execcmd:=execcmd+' ; echo "TestExitCode: $?"';
- if (deAfter in DelExecutable) and
- not Config.NeededAfter then
- execcmd:=execcmd+' ; rm -f '+TestRemoteExe;
- execcmd:=execcmd+rquote;
- execres:=ExecuteRemote(rshprog,execcmd,StartTicks,EndTicks);
- { Check for TestExitCode error in output, sets ExecuteResult }
- if not CheckTestExitCode(EXELogFile) then
- Verbose(V_Debug,'Failed to check exit code for '+execcmd);
- 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 }
- StartTicks:=GetMicroSTicks;
- if Config.IsInteractive or Config.UsesGraph then
- execres:=ExecuteRedir(CurrDir+SplitFileName(TestExe),'','','','')
- else
- execres:=ExecuteRedir(CurrDir+SplitFileName(TestExe),'','',FullExeLogFile,'stdout');
- EndTicks:=GetMicroSTicks;
- {$I-}
- ChDir(OldDir);
- {$I+}
- ioresult;
- end;
- { Error during execution? }
- Verbose(V_Debug,'Exitcode '+ToStr(ExecuteResult));
- if BenchmarkInfo then
- begin
- Verbose(V_Normal,'Execution took '+ToStr(EndTicks-StartTicks)+' us');
- end;
- if (not execres) and (ExecuteResult=0) then
- begin
- AddLog(FailLogFile,TestName);
- AddLog(ResLogFile,failed_to_run+PPFileInfo[current]);
- AddLog(LongLogFile,line_separation);
- AddLog(LongLogFile,failed_to_run+PPFileInfo[current]);
- 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));
- 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[current]+known_problem+Config.KnownRunNote);
- AddLog(LongLogFile,line_separation);
- AddLog(LongLogFile,known_problem+Config.KnownRunNote);
- AddLog(LongLogFile,failed_to_run+PPFileInfo[current]+' ('+ToStr(ExecuteResult)+')');
- 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
- begin
- AddLog(FailLogFile,TestName);
- AddLog(ResLogFile,failed_to_run+PPFileInfo[current]);
- AddLog(LongLogFile,line_separation);
- AddLog(LongLogFile,failed_to_run+PPFileInfo[current]+' ('+ToStr(ExecuteResult)+')');
- 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
- else
- begin
- AddLog(ResLogFile,successfully_run+PPFileInfo[current]);
- RunExecutable:=true;
- end;
- if (deAfter in DelExecutable) and not Config.NeededAfter then
- begin
- Verbose(V_Debug,'Deleting executable '+TestExe);
- RemoveFile(TestExe);
- RemoveFile(ForceExtension(TestExe,ObjExt));
- RemoveFile(ForceExtension(TestExe,PPUExt));
- end;
- end;
- { Try to collect information concerning the remote configuration
- Currently only records RemoteShell name and sets
- RemoteShellNeedsExport boolean variable }
- procedure SetRemoteConfiguration;
- var
- f : text;
- StartTicks,EndTicks : int64;
- begin
- if RemoteAddr='' then
- exit;
- ExeLogFile:='__remote.tmp';
- ExecuteRemote(rshprog,RemotePara+' '+RemoteAddr+
- ' "echo SHELL=${SHELL}"',StartTicks,EndTicks);
- Assign(f,ExeLogFile);
- Reset(f);
- While not eof(f) do
- begin
- Readln(f,RemoteShellBase);
- if pos('SHELL=',RemoteShellBase)>0 then
- begin
- RemoteShell:=TrimSpace(Copy(RemoteShellBase,pos('SHELL=',RemoteShellBase)+6,
- length(RemoteShellBase)));
- Verbose(V_Debug,'Remote shell is "'+RemoteShell+'"');
- RemoteShellBase:=SplitFileBase(RemoteShell);
- if (RemoteShellBase='bash') or (RemoteShellBase='sh') then
- RemoteShellNeedsExport:=true;
- end;
- end;
- Close(f);
- end;
- procedure getargs;
- procedure helpscreen;
- begin
- writeln('dotest [Options] <File>');
- writeln;
- writeln('Options can be:');
- writeln(' !ENV_NAME parse environment variable ENV_NAME for options');
- writeln(' -A include ALL tests');
- writeln(' -B delete executable before remote upload');
- writeln(' -C<compiler> set compiler to use');
- writeln(' -D display execution time');
- writeln(' -E execute test also');
- writeln(' -G include graph tests');
- writeln(' -I include interactive tests');
- 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(' -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);
- end;
- procedure interpret_option (para : string);
- var
- ch : char;
- j : longint;
- begin
- Verbose(V_Debug,'Interpreting option"'+para+'"');
- ch:=Upcase(para[2]);
- delete(para,1,2);
- case ch of
- 'A' :
- begin
- DoGraph:=true;
- DoInteractive:=true;
- DoKnown:=true;
- DoAll:=true;
- end;
- 'B' : Include(DelExecutable,deBefore);
- 'C' : CompilerBin:=Para;
- 'D' : BenchMarkInfo:=true;
- '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;
- 'O' : UseTimeout:=true;
- 'P' : RemotePath:=Para;
- 'R' : RemoteAddr:=Para;
- 'S' :
- begin
- rshprog:='ssh';
- rcpprog:='scp';
- end;
- 'T' :
- begin
- j:=Pos('-',Para);
- if j>0 then
- begin
- CompilerCPU:=Copy(Para,1,j-1);
- CompilerTarget:=Copy(Para,j+1,length(para));
- end
- else
- CompilerTarget:=Para
- end;
- 'U' :
- RemotePara:=RemotePara+' '+Para;
- 'V' : DoVerbose:=true;
- 'W' :
- begin
- rshprog:='plink';
- rcpprog:='pscp';
- rquote:='"';
- end;
- 'X' : UseComSpec:=false;
- 'Y' : ExtraCompilerOpts:= ExtraCompilerOpts +' '+ Para;
- 'Z' : Include(DelExecutable,deAfter);
- end;
- end;
- procedure interpret_env(arg : string);
- var
- para : string;
- pspace : longint;
- begin
- Verbose(V_Debug,'Interpreting environment option"'+arg+'"');
- { Get rid of leading '!' }
- delete(arg,1,1);
- arg:=getenv(arg);
- Verbose(V_Debug,'Environment value is "'+arg+'"');
- while (length(arg)>0) do
- begin
- while (length(arg)>0) and (arg[1]=' ') do
- delete(arg,1,1);
- pspace:=pos(' ',arg);
- if pspace=0 then
- pspace:=length(arg)+1;
- para:=copy(arg,1,pspace-1);
- if (length(para)>0) and (para[1]='-') then
- interpret_option (para)
- else
- begin
- PPFile.Insert(current,ForceExtension(Para,'pp'));
- inc(current);
- end;
- delete(arg,1,pspace);
- end;
- end;
- var
- param : string;
- i : longint;
- begin
- CompilerBin:='ppc386'+srcexeext;
- for i:=1 to paramcount do
- begin
- param:=Paramstr(i);
- if (param[1]='-') then
- interpret_option(param)
- else if (param[1]='!') then
- interpret_env(param)
- else
- begin
- PPFile.Insert(current,ForceExtension(Param,'pp'));
- inc(current);
- end;
- end;
- if current=0 then
- HelpScreen;
- { disable graph,interactive when running remote }
- if RemoteAddr<>'' then
- begin
- DoGraph:=false;
- DoInteractive:=false;
- end;
- end;
- procedure RunTest;
- var
- PPDir,LibraryName : string;
- Res : boolean;
- begin
- Res:=GetConfig(PPFile[current],Config);
- if Res then
- begin
- Res:=GetCompilerCPU;
- Res:=GetCompilerTarget;
- {$ifndef MACOS}
- RTLUnitsDir:='units/'+CompilerFullTarget;
- {$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/'+CompilerFullTarget;
- {$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[current]);
- 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[current]),'log');
- ExeLogFile:=TestOutputFileName('',SplitFileName(PPFile[current]),'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[current]);
- { avoid a second attempt by writing to elg file }
- AddLog(EXELogFile,skipping_graph_test+PPFileInfo[current]);
- Verbose(V_Warning,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[current]);
- AddLog(ResLogFile,skipping_interactive_test+PPFileInfo[current]);
- Verbose(V_Warning,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[current]);
- AddLog(ResLogFile,skipping_known_bug+PPFileInfo[current]);
- Verbose(V_Warning,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<Config.MinVersion then
- begin
- { avoid a second attempt by writing to elg file }
- AddLog(EXELogFile,skipping_compiler_version_too_low+PPFileInfo[current]);
- AddLog(ResLogFile,skipping_compiler_version_too_low+PPFileInfo[current]);
- Verbose(V_Warning,'Compiler version too low '+CompilerVersion+' < '+Config.MinVersion);
- Res:=false;
- end;
- end;
- end;
- if Res then
- begin
- if (Config.MaxVersion<>'') 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[current]);
- AddLog(ResLogFile,skipping_compiler_version_too_high+PPFileInfo[current]);
- Verbose(V_Warning,'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[current]);
- AddLog(ResLogFile,skipping_other_cpu+PPFileInfo[current]);
- Verbose(V_Warning,'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[current]);
- AddLog(ResLogFile,skipping_other_cpu+PPFileInfo[current]);
- Verbose(V_Warning,'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[current]);
- AddLog(ResLogFile,skipping_other_cpu+PPFileInfo[current]);
- Verbose(V_Warning,'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[current]);
- AddLog(ResLogFile,skipping_other_target+PPFileInfo[current]);
- Verbose(V_Warning,'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.SkipTarget);
- if IsInList(CompilerTarget,Config.SkipTarget) then
- begin
- { avoid a second attempt by writing to elg file }
- AddLog(EXELogFile,skipping_other_target+PPFileInfo[current]);
- AddLog(ResLogFile,skipping_other_target+PPFileInfo[current]);
- Verbose(V_Warning,'Compiler target "'+CompilerTarget+'" is in list "'+Config.SkipTarget+'"');
- Res:=false;
- end;
- end;
- end;
- if Res then
- begin
- { Use known bug, to avoid adding a new entry for this PM 2011-06-24 }
- if Config.NeedLibrary and not TargetCanCompileLibraries then
- begin
- AddLog(EXELogFile,skipping_known_bug+PPFileInfo[current]);
- AddLog(ResLogFile,skipping_known_bug+PPFileInfo[current]);
- Verbose(V_Warning,'Compiler target "'+CompilerTarget+'" does not support library compilation');
- Res:=false;
- end;
- end;
- if Res then
- begin
- Res:=RunCompiler;
- if Res and Config.NeedRecompile then
- Res:=RunCompiler;
- end;
- if Res and (not Config.ShouldFail) then
- begin
- if (Config.NoRun) then
- begin
- { avoid a second attempt by writing to elg file }
- AddLog(EXELogFile,skipping_run_test+PPFileInfo[current]);
- AddLog(ResLogFile,skipping_run_test+PPFileInfo[current]);
- Verbose(V_Debug,skipping_run_test);
- if LibraryExists(PPFile[current],LibraryName) then
- MaybeCopyFiles(LibraryName);
- 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[current]);
- AddLog(ResLogFile,skipping_known_bug+PPFileInfo[current]);
- Verbose(V_Warning,skipping_known_bug);
- end
- else
- begin
- if DoExecute then
- begin
- if FileExists(TestOutputFilename('',PPFile[current],'ppu')) or
- FileExists(TestOutputFilename('',PPFile[current],'ppo')) or
- FileExists(TestOutputFilename('',PPFile[current],'ppw')) then
- begin
- AddLog(ExeLogFile,skipping_run_unit+PPFileInfo[current]);
- AddLog(ResLogFile,skipping_run_unit+PPFileInfo[current]);
- Verbose(V_Debug,'Unit found, skipping run test')
- end
- else if LibraryExists(PPFile[current],LibraryName) then
- begin
- Verbose(V_Debug,'Library found, skipping run test');
- MaybeCopyFiles(LibraryName);
- end
- else
- Res:=RunExecutable;
- end;
- end;
- end;
- end;
- begin
- Current:=0;
- PPFile:=TStringList.Create;
- PPFile.Capacity:=10;
- PPFileInfo:=TStringList.Create;
- PPFileInfo.Capacity:=10;
- GetArgs;
- SetTargetDirectoriesStyle;
- SetTargetCanCompileLibraries;
- SetRemoteConfiguration;
- {$ifdef LIMIT83fs}
- UseOSOnly:=true;
- {$else not LIMIT83fs}
- SetUseOSOnly;
- {$endif not LIMIT83fs}
- Verbose(V_Debug,'Found '+ToStr(PPFile.Count)+' tests to run');
- if current>0 then
- for current:=0 to PPFile.Count-1 do
- begin
- SetPPFileInfo;
- TestName:=Copy(PPFile[current],1,Pos('.pp',PPFile[current])-1);
- Verbose(V_Normal,'Running test '+TestName+', file '+PPFile[current]);
- RunTest;
- end;
- PPFile.Free;
- PPFileInfo.Free;
- end.
|