dotest.pp 59 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078
  1. {
  2. This file is part of the Free Pascal test suite.
  3. Copyright (c) 1999-2002 by the Free Pascal development team.
  4. This program makes the compilation and
  5. execution of individual test sources.
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {$mode objfpc}
  13. {$goto on}
  14. {$H+}
  15. program dotest;
  16. uses
  17. sysutils,
  18. strutils,
  19. dos,
  20. {$ifdef macos}
  21. macutils,
  22. {$endif}
  23. teststr,
  24. testu,
  25. redir,
  26. bench,
  27. classes;
  28. {$ifdef go32v2}
  29. {$define LIMIT83FS}
  30. {$endif}
  31. {$ifdef os2}
  32. {$define LIMIT83FS}
  33. {$endif}
  34. {$ifdef msdos}
  35. {$define LIMIT83FS}
  36. {$endif}
  37. type
  38. tcompinfo = (compver,comptarget,compcpu);
  39. tdelexecutable = (deBefore, deAfter);
  40. tdelexecutables = set of tdelexecutable;
  41. const
  42. ObjExt='o';
  43. PPUExt='ppu';
  44. {$ifdef UNIX}
  45. SrcExeExt='';
  46. {$else UNIX}
  47. {$ifdef MACOS}
  48. SrcExeExt='';
  49. {$else MACOS}
  50. SrcExeExt='.exe';
  51. {$endif MACOS}
  52. {$endif UNIX}
  53. ExeExt : string = '';
  54. DllExt : string = '.so';
  55. DllPrefix: string = 'lib';
  56. DefaultTimeout=60;
  57. READ_ONLY = 0;
  58. var
  59. Config : TConfig;
  60. CompilerLogFile,
  61. ExeLogFile,
  62. LongLogfile,
  63. FailLogfile,
  64. RTLUnitsDir,
  65. TestOutputDir,
  66. OutputDir : string;
  67. CompilerBin,
  68. { CompilerCPU and CompilerTarget are lowercased at start
  69. to avoid need to call lowercase again and again ... }
  70. CompilerCPU,
  71. CompilerTarget,
  72. CompilerVersion,
  73. DefaultCompilerCPU,
  74. DefaultCompilerTarget,
  75. DefaultCompilerVersion : string;
  76. PPFile : TStringList;
  77. PPFileInfo : TStringList;
  78. TestName : string;
  79. Current : longint;
  80. const
  81. DoGraph : boolean = false;
  82. UseOSOnly : boolean = false;
  83. DoInteractive : boolean = false;
  84. DoExecute : boolean = false;
  85. DoKnown : boolean = false;
  86. DoAll : boolean = false;
  87. DoUsual : boolean = true;
  88. { TargetDir : string = ''; unused }
  89. BenchmarkInfo : boolean = false;
  90. ExtraCompilerOpts : string = '';
  91. DelExecutable : TDelExecutables = [];
  92. RemoteAddr : string = '';
  93. RemotePathPrefix : string = '';
  94. RemotePath : string = '/tmp';
  95. RemotePara : string = '';
  96. RemoteRshParas : string = '';
  97. RemoteShell : string = '';
  98. RemoteShellBase : string = '';
  99. RemoteShellNeedsExport : boolean = false;
  100. rshprog : string = 'rsh';
  101. rcpprog : string = 'rcp';
  102. rquote : string = '''';
  103. UseTimeout : boolean = false;
  104. emulatorname : string = '';
  105. EmulatorOpts : string = '';
  106. TargetCanCompileLibraries : boolean = true;
  107. UniqueSuffix: string = '';
  108. const
  109. NoSharedLibSupportPattern='$nosharedlib';
  110. TargetHasNoSharedLibSupport = 'msdos,go32v2';
  111. NoWorkingUnicodeSupport='$nounicode';
  112. TargetHasNoWorkingUnicodeSupport = 'msdos';
  113. NoWorkingThread='$nothread';
  114. TargetHasNoWorkingThreadSupport = 'go32v2,msdos,wasi';
  115. procedure TranslateConfig(var AConfig: TConfig);
  116. begin
  117. AConfig.SkipTarget:=ReplaceText(AConfig.SkipTarget, NoSharedLibSupportPattern, TargetHasNoSharedLibSupport);
  118. AConfig.SkipTarget:=ReplaceText(AConfig.SkipTarget, NoWorkingUnicodeSupport, TargetHasNoWorkingUnicodeSupport);
  119. AConfig.SkipTarget:=ReplaceText(AConfig.SkipTarget, NoWorkingThread, TargetHasNoWorkingThreadSupport);
  120. end;
  121. function ToStr(l:longint):string;
  122. var
  123. s : string;
  124. begin
  125. Str(l,s);
  126. ToStr:=s;
  127. end;
  128. function ToStrZero(l:longint;nbzero : byte):string;
  129. var
  130. s : string;
  131. begin
  132. Str(l,s);
  133. while length(s)<nbzero do
  134. s:='0'+s;
  135. ToStrZero:=s;
  136. end;
  137. function trimspace(const s:string):string;
  138. var
  139. i,j : longint;
  140. begin
  141. i:=length(s);
  142. while (i>0) and (s[i] in [#9,' ']) do
  143. dec(i);
  144. j:=1;
  145. while (j<i) and (s[j] in [#9,' ']) do
  146. inc(j);
  147. trimspace:=Copy(s,j,i-j+1);
  148. end;
  149. function IsInList(const entry,list:string):boolean;
  150. var
  151. i,istart : longint;
  152. begin
  153. IsInList:=false;
  154. i:=0;
  155. while (i<length(list)) do
  156. begin
  157. { Find list item }
  158. istart:=i+1;
  159. while (i<length(list)) and
  160. (list[i+1]<>',') do
  161. inc(i);
  162. if Upcase(entry)=Upcase(TrimSpace(Copy(list,istart,i-istart+1))) then
  163. begin
  164. IsInList:=true;
  165. exit;
  166. end;
  167. { skip , }
  168. inc(i);
  169. end;
  170. end;
  171. procedure SetPPFileInfo;
  172. Var
  173. info : searchrec;
  174. dt : DateTime;
  175. begin
  176. FindFirst (PPFile[current],anyfile,Info);
  177. If DosError=0 then
  178. begin
  179. UnpackTime(info.time,dt);
  180. PPFileInfo.Insert(current,PPFile[current]+' '+ToStr(dt.year)+'/'+ToStrZero(dt.month,2)+'/'+
  181. ToStrZero(dt.day,2)+' '+ToStrZero(dt.Hour,2)+':'+ToStrZero(dt.min,2)+':'+ToStrZero(dt.sec,2));
  182. end
  183. else
  184. PPFileInfo.Insert(current,PPFile[current]);
  185. FindClose (Info);
  186. end;
  187. function ForceExtension(Const HStr,ext:String):String;
  188. {
  189. Return a filename which certainly has the extension ext
  190. }
  191. var
  192. j : longint;
  193. begin
  194. j:=length(Hstr);
  195. while (j>0) and (Hstr[j]<>'.') do
  196. dec(j);
  197. if j=0 then
  198. j:=length(Hstr)+1;
  199. if Ext<>'' then
  200. begin
  201. if Ext[1]='.' then
  202. ForceExtension:=Copy(Hstr,1,j-1)+Ext
  203. else
  204. ForceExtension:=Copy(Hstr,1,j-1)+'.'+Ext
  205. end
  206. else
  207. ForceExtension:=Copy(Hstr,1,j-1);
  208. end;
  209. procedure mkdirtree(const s:string);
  210. var
  211. SErr, hs : string;
  212. Err: longint;
  213. begin
  214. if s='' then
  215. exit;
  216. if s[length(s)] in ['\','/'{$IFDEF MACOS},':'{$ENDIF}] then
  217. hs:=Copy(s,1,length(s)-1)
  218. else
  219. hs:=s;
  220. if not PathExists(hs) then
  221. begin
  222. { Try parent first }
  223. mkdirtree(SplitPath(hs));
  224. { make this dir }
  225. Verbose(V_Debug,'Making directory '+s);
  226. {$I-}
  227. MkDir (HS);
  228. {$I+}
  229. Err := IOResult;
  230. if Err <> 0 then
  231. begin
  232. { did another parallel instance create it in the mean time? }
  233. if not PathExists(hs) then
  234. begin
  235. { no -> error }
  236. Str (Err, SErr);
  237. Verbose (V_Error, 'Directory creation of "'+HS+'" failed ' + SErr);
  238. end;
  239. end;
  240. end;
  241. end;
  242. Function RemoveFile(const f:string):boolean;
  243. var
  244. g : file;
  245. begin
  246. assign(g,f);
  247. {$I-}
  248. erase(g);
  249. {$I+}
  250. RemoveFile:=(ioresult=0);
  251. end;
  252. function Copyfile(const fn1,fn2:string;append:boolean) : longint;
  253. const
  254. bufsize = 16384;
  255. var
  256. f,g : file;
  257. oldfilemode : byte;
  258. st : string;
  259. addsize,
  260. i : longint;
  261. buf : pointer;
  262. begin
  263. if Append then
  264. Verbose(V_Debug,'Appending '+fn1+' to '+fn2)
  265. else
  266. Verbose(V_Debug,'Copying '+fn1+' to '+fn2);
  267. assign(g,fn2);
  268. if append then
  269. begin
  270. {$I-}
  271. reset(g,1);
  272. {$I+}
  273. if ioresult<>0 then
  274. append:=false
  275. else
  276. seek(g,filesize(g));
  277. end;
  278. if not append then
  279. begin
  280. {$I-}
  281. rewrite(g,1);
  282. {$I+}
  283. if ioresult<>0 then
  284. Verbose(V_Error,'Can''t open '+fn2+' for output');
  285. end;
  286. assign(f,fn1);
  287. {$I-}
  288. { Try using read only file mode }
  289. oldfilemode:=filemode;
  290. filemode:=READ_ONLY;
  291. reset(f,1);
  292. {$I+}
  293. addsize:=0;
  294. getmem(buf,bufsize);
  295. if ioresult<>0 then
  296. begin
  297. sleep(1000);
  298. {$I-}
  299. reset(f,1);
  300. {$I+}
  301. if ioresult<>0 then
  302. begin
  303. Verbose(V_Warning,'Can''t open '+fn1);
  304. st:='Can''t open '+fn1;
  305. i:=length(st);
  306. // blocksize is larger than 255, so no check is needed
  307. move(st[1],buf^,i);
  308. blockwrite(g,buf^,i);
  309. freemem(buf,bufsize);
  310. close(g);
  311. filemode:=oldfilemode;
  312. exit;
  313. end;
  314. end;
  315. filemode:=oldfilemode;
  316. repeat
  317. blockread(f,buf^,bufsize,i);
  318. blockwrite(g,buf^,i);
  319. addsize:=addsize+i;
  320. until i<bufsize;
  321. freemem(buf,bufsize);
  322. close(f);
  323. close(g);
  324. CopyFile:=addsize;
  325. end;
  326. procedure AddLog(const logfile,s:string);
  327. var
  328. t : text;
  329. begin
  330. assign(t,logfile);
  331. {$I-}
  332. append(t);
  333. {$I+}
  334. if ioresult<>0 then
  335. begin
  336. {$I-}
  337. rewrite(t);
  338. {$I+}
  339. if ioresult<>0 then
  340. Verbose(V_Abort,'Can''t append to '+logfile);
  341. end;
  342. writeln(t,s);
  343. close(t);
  344. end;
  345. procedure ForceLog(const logfile:string);
  346. var
  347. t : text;
  348. begin
  349. assign(t,logfile);
  350. {$I-}
  351. append(t);
  352. {$I+}
  353. if ioresult<>0 then
  354. begin
  355. {$I-}
  356. rewrite(t);
  357. {$I+}
  358. if ioresult<>0 then
  359. Verbose(V_Abort,'Can''t Create '+logfile);
  360. end;
  361. close(t);
  362. end;
  363. function GetCompilerInfo(c:tcompinfo):boolean;
  364. var
  365. t : text;
  366. hs : string;
  367. begin
  368. GetCompilerInfo:=false;
  369. { Try to get all information in one call, this is
  370. supported in 1.1. Older compilers 1.0.x will only
  371. return the first info }
  372. case c of
  373. compver :
  374. begin
  375. if DefaultCompilerVersion<>'' then
  376. begin
  377. GetCompilerInfo:=true;
  378. exit;
  379. end;
  380. hs:='-iVTPTO';
  381. end;
  382. compcpu :
  383. begin
  384. if DefaultCompilerCPU<>'' then
  385. begin
  386. GetCompilerInfo:=true;
  387. exit;
  388. end;
  389. hs:='-iTPTOV';
  390. end;
  391. comptarget :
  392. begin
  393. if DefaultCompilerTarget<>'' then
  394. begin
  395. GetCompilerInfo:=true;
  396. exit;
  397. end;
  398. hs:='-iTOTPV';
  399. end;
  400. end;
  401. ExecuteRedir(CompilerBin,hs,'','out.'+UniqueSuffix,'');
  402. assign(t,'out.'+UniqueSuffix);
  403. {$I-}
  404. reset(t);
  405. {$ifdef windows}
  406. { try to cope with Windows problems related to AntiVirus scanner
  407. that generate lag time during which access to a given if is forbidden }
  408. if (inoutres=5) then
  409. begin
  410. Sleep(5000);
  411. ioresult;
  412. Verbose(V_Warning,'Windows file not accessible out.'+UniqueSuffix);
  413. reset(t);
  414. end;
  415. {$endif windows}
  416. readln(t,hs);
  417. close(t);
  418. erase(t);
  419. {$I+}
  420. if ioresult<>0 then
  421. Verbose(V_Error,'Can''t get Compiler Info')
  422. else
  423. begin
  424. Verbose(V_Debug,'Retrieved Compiler Info: "'+hs+'"');
  425. case c of
  426. compver :
  427. begin
  428. DefaultCompilerVersion:=GetToken(hs);
  429. DefaultCompilerCPU:=GetToken(hs);
  430. DefaultCompilerTarget:=GetToken(hs);
  431. end;
  432. compcpu :
  433. begin
  434. DefaultCompilerCPU:=GetToken(hs);
  435. DefaultCompilerTarget:=GetToken(hs);
  436. DefaultCompilerVersion:=GetToken(hs);
  437. end;
  438. comptarget :
  439. begin
  440. DefaultCompilerTarget:=GetToken(hs);
  441. DefaultCompilerCPU:=GetToken(hs);
  442. DefaultCompilerVersion:=GetToken(hs);
  443. end;
  444. end;
  445. GetCompilerInfo:=true;
  446. end;
  447. end;
  448. function GetCompilerVersion:boolean;
  449. const
  450. CompilerVersionDebugWritten : boolean = false;
  451. begin
  452. if CompilerVersion='' then
  453. begin
  454. GetCompilerVersion:=GetCompilerInfo(compver);
  455. CompilerVersion:=DefaultCompilerVersion;
  456. end
  457. else
  458. GetCompilerVersion:=true;
  459. if GetCompilerVersion and not CompilerVersionDebugWritten then
  460. begin
  461. Verbose(V_Debug,'Compiler Version: "'+CompilerVersion+'"');
  462. CompilerVersionDebugWritten:=true;
  463. end;
  464. end;
  465. function GetCompilerCPU:boolean;
  466. const
  467. CompilerCPUDebugWritten : boolean = false;
  468. begin
  469. if CompilerCPU='' then
  470. begin
  471. GetCompilerCPU:=GetCompilerInfo(compcpu);
  472. CompilerCPU:=lowercase(DefaultCompilerCPU);
  473. end
  474. else
  475. GetCompilerCPU:=true;
  476. if GetCompilerCPU and not CompilerCPUDebugWritten then
  477. begin
  478. Verbose(V_Debug,'Compiler CPU: "'+CompilerCPU+'"');
  479. CompilerCPUDebugWritten:=true;
  480. end;
  481. end;
  482. function GetCompilerTarget:boolean;
  483. const
  484. CompilerTargetDebugWritten : boolean = false;
  485. begin
  486. if CompilerTarget='' then
  487. begin
  488. GetCompilerTarget:=GetCompilerInfo(comptarget);
  489. CompilerTarget:=lowercase(DefaultCompilerTarget);
  490. end
  491. else
  492. GetCompilerTarget:=true;
  493. if GetCompilerTarget and not CompilerTargetDebugWritten then
  494. begin
  495. Verbose(V_Debug,'Compiler Target: "'+CompilerTarget+'"');
  496. CompilerTargetDebugWritten:=true;
  497. end;
  498. end;
  499. function CompilerFullTarget:string;
  500. begin
  501. if UseOSOnly then
  502. CompilerFullTarget:=CompilerTarget
  503. else
  504. CompilerFullTarget:=CompilerCPU+'-'+CompilerTarget;
  505. end;
  506. { Set the three constants above according to
  507. the current target }
  508. procedure SetTargetDirectoriesStyle;
  509. var
  510. LTarget : string;
  511. begin
  512. { Call this first to ensure that CompilerTarget is not empty }
  513. GetCompilerTarget;
  514. LTarget := CompilerTarget;
  515. TargetHasDosStyleDirectories :=
  516. (LTarget='emx') or
  517. (LTarget='go32v2') or
  518. (LTarget='msdos') or
  519. (LTarget='nativent') or
  520. (LTarget='os2') or
  521. (LTarget='symbian') or
  522. (LTarget='watcom') or
  523. (LTarget='wdosx') or
  524. (LTarget='win16') or
  525. (LTarget='win32') or
  526. (LTarget='win64');
  527. TargetAmigaLike:=
  528. (LTarget='amiga') or
  529. (LTarget='morphos');
  530. TargetIsMacOS:=
  531. (LTarget='macos');
  532. { Base on whether UNIX is defined as default macro
  533. in extradefines in systesms/i_XXX.pas units }
  534. TargetIsUnix:=
  535. (LTarget='linux') or
  536. (LTarget='linux6432') or
  537. (LTarget='freebsd') or
  538. (LTarget='openbsd') or
  539. (LTarget='netbsd') or
  540. (LTarget='beos') or
  541. (LTarget='haiku') or
  542. (LTarget='solaris') or
  543. (LTarget='iphonesim') or
  544. (LTarget='darwin') or
  545. (LTarget='aix') or
  546. (LTarget='android');
  547. { Set ExeExt for CompilerTarget.
  548. This list has been set up 2013-01 using the information in
  549. compiler/system/i_XXX.pas units.
  550. We should update this list when adding new targets PM }
  551. if (TargetHasDosStyleDirectories) or (LTarget='wince') then
  552. begin
  553. ExeExt:='.exe';
  554. DllExt:='.dll';
  555. DllPrefix:='';
  556. end
  557. else if LTarget='atari' then
  558. begin
  559. ExeExt:='.tpp';
  560. DllExt:='.dll';
  561. DllPrefix:='';
  562. end
  563. else if LTarget='gba' then
  564. ExeExt:='.gba'
  565. else if LTarget='nds' then
  566. ExeExt:='.bin'
  567. else if (LTarget='netware') or (LTarget='netwlibc') then
  568. begin
  569. ExeExt:='.nlm';
  570. DllExt:='.nlm';
  571. DllPrefix:='';
  572. end
  573. else if LTarget='wii' then
  574. ExeExt:='.dol'
  575. else if LTarget='wasi' then
  576. ExeExt:='.wasm';
  577. end;
  578. {$ifndef LIMIT83FS}
  579. { Set the UseOSOnly constant above according to
  580. the current target }
  581. procedure SetUseOSOnly;
  582. var
  583. LTarget : string;
  584. begin
  585. { Call this first to ensure that CompilerTarget is not empty }
  586. GetCompilerTarget;
  587. LTarget := CompilerTarget;
  588. UseOSOnly:= (LTarget='emx') or
  589. (LTarget='go32v2') or
  590. (LTarget='msdos') or
  591. (LTarget='os2');
  592. end;
  593. {$endif not LIMIT83FS}
  594. procedure SetTargetCanCompileLibraries;
  595. var
  596. LTarget : string;
  597. begin
  598. { Call this first to ensure that CompilerTarget is not empty }
  599. GetCompilerTarget;
  600. LTarget := CompilerTarget;
  601. { Feel free to add other targets here }
  602. if (LTarget='go32v2') then
  603. TargetCanCompileLibraries:=false;
  604. end;
  605. function OutputFileName(Const s,ext:String):String;
  606. begin
  607. {$ifndef macos}
  608. OutputFileName:=OutputDir+'/'+ForceExtension(s,ext);
  609. {$else macos}
  610. OutputFileName:=ConcatMacPath(OutputDir,ForceExtension(s,ext));
  611. {$endif macos}
  612. end;
  613. function TestOutputFileName(Const pref,base,ext:String):String;
  614. begin
  615. {$ifndef macos}
  616. TestOutputFileName:=TestOutputDir+'/'+ForceExtension(pref+SplitFileName(base),ext);
  617. {$else macos}
  618. TestOutputFileName:=ConcatMacPath(TestOutputDir,ForceExtension(pref+SplitFileName(base),ext));
  619. {$endif macos}
  620. end;
  621. function TestLogFileName(Const pref,base,ext:String):String;
  622. var
  623. LogDir: String;
  624. begin
  625. LogDir:=TestOutputDir;
  626. {$ifndef macos}
  627. if UniqueSuffix<>'' then
  628. LogDir:=LogDir+'/..';
  629. TestLogFileName:=LogDir+'/'+ForceExtension(pref+SplitFileName(base),ext);
  630. {$else macos}
  631. if UniqueSuffix<>'' then
  632. LogDir:=LogDir+'::';
  633. TestLogFileName:=ConcatMacPath(LogDir,ForceExtension(pref+SplitFileName(base),ext));
  634. {$endif macos}
  635. end;
  636. function ExitWithInternalError(const OutName:string):boolean;
  637. var
  638. t : text;
  639. s : string;
  640. begin
  641. ExitWithInternalError:=false;
  642. { open logfile }
  643. assign(t,Outname);
  644. {$I-}
  645. reset(t);
  646. {$I+}
  647. if ioresult<>0 then
  648. exit;
  649. while not eof(t) do
  650. begin
  651. readln(t,s);
  652. if (pos('Fatal: Internal error ',s)>0) or
  653. (pos('Error: Compilation raised exception internally',s)>0) then
  654. begin
  655. ExitWithInternalError:=true;
  656. break;
  657. end;
  658. end;
  659. close(t);
  660. end;
  661. { Takes each option from AddOptions list
  662. considered as a space separated list
  663. and adds the option to args
  664. unless option contains a percent sign,
  665. in that case, the option after % will be added
  666. to args only if CompilerTarget is listed in
  667. the string part before %.
  668. NOTE: this function does not check for
  669. quoted options...
  670. The list before % must of course contain no spaces. }
  671. procedure AppendOptions(AddOptions : string;var args : string);
  672. var
  673. endopt,percentpos : longint;
  674. opttarget, currentopt : string;
  675. begin
  676. Verbose(V_Debug,'AppendOptions called with AddOptions="'+AddOptions+'"');
  677. AddOptions:=trimspace(AddOptions);
  678. repeat
  679. endopt:=pos(' ',AddOptions);
  680. if endopt=0 then
  681. endopt:=length(AddOptions);
  682. currentopt:=trimspace(copy(AddOptions,1,endopt));
  683. AddOptions:=trimspace(copy(Addoptions,endopt+1,length(AddOptions)));
  684. if currentopt<>'' then
  685. begin
  686. percentpos:=pos('%',currentopt);
  687. if (percentpos=0) then
  688. begin
  689. Verbose(V_Debug,'Adding option="'+currentopt+'"');
  690. args:=args+' '+currentopt;
  691. end
  692. else
  693. begin
  694. opttarget:=lowercase(copy(currentopt,1,percentpos-1));
  695. if IsInList(CompilerTarget, opttarget) then
  696. begin
  697. Verbose(V_Debug,'Adding target specific option="'+currentopt+'" for '+opttarget);
  698. args:=args+' '+copy(currentopt,percentpos+1,length(currentopt))
  699. end
  700. else
  701. Verbose(V_Debug,'No matching target "'+currentopt+'"');
  702. end;
  703. end;
  704. until AddOptions='';
  705. end;
  706. { This function removes some incompatible
  707. options from TEST_OPT before adding them to
  708. the list of options passed to the compiler.
  709. %DELOPT=XYZ will remove XYZ exactly
  710. %DELOPT=XYZ* will remove all options starting with XYZ.
  711. NOTE: This fuinction does not handle quoted options. }
  712. function DelOptions(Pattern, opts : string) : string;
  713. var
  714. currentopt : string;
  715. optpos, endopt, startpos, endpos : longint;
  716. iswild : boolean;
  717. begin
  718. opts:=trimspace(opts);
  719. pattern:=trimspace(pattern);
  720. repeat
  721. endpos:=pos(' ',pattern);
  722. if endpos=0 then
  723. endpos:=length(pattern);
  724. currentopt:=trimspace(copy(pattern,1,endpos));
  725. pattern:=trimspace(copy(pattern,endpos+1,length(pattern)));
  726. if currentopt<>'' then
  727. begin
  728. if currentopt[length(currentopt)]='*' then
  729. begin
  730. iswild:=true;
  731. system.delete(currentopt,length(currentopt),1);
  732. end
  733. else
  734. iswild:=false;
  735. startpos:=1;
  736. repeat
  737. optpos:=pos(currentopt,copy(opts,startpos,length(opts)));
  738. if optpos>0 then
  739. begin
  740. { move to index in full opts string }
  741. optpos:=optpos+startpos-1;
  742. { compute position of end of opt }
  743. endopt:=optpos+length(currentopt);
  744. { use that end as start position for next round }
  745. startpos:=endopt;
  746. if iswild then
  747. begin
  748. while (opts[endopt]<>' ') and
  749. (endopt<length(opts)) do
  750. begin
  751. inc(endopt);
  752. inc(startpos);
  753. end;
  754. Verbose(V_Debug,'Pattern match found "'+currentopt+'*" in "'+opts+'"');
  755. system.delete(opts,optpos,endopt-optpos+1);
  756. Verbose(V_Debug,'After opts="'+opts+'"');
  757. end
  758. else
  759. begin
  760. if (endopt>length(opts)) or (opts[endopt]=' ') then
  761. begin
  762. Verbose(V_Debug,'Exact match found "'+currentopt+'" in "'+opts+'"');
  763. system.delete(opts,optpos,endopt-optpos+1);
  764. Verbose(V_Debug,'After opts="'+opts+'"');
  765. end
  766. else
  767. begin
  768. Verbose(V_Debug,'No exact match "'+currentopt+'" in "'+opts+'"');
  769. end;
  770. end;
  771. end;
  772. until optpos=0;
  773. end;
  774. until pattern='';
  775. DelOptions:=opts;
  776. end;
  777. function RunCompiler(const ExtraPara: string):boolean;
  778. var
  779. args,LocalExtraArgs,
  780. wpoargs,wposuffix : string;
  781. passnr,
  782. passes : longint;
  783. execres : boolean;
  784. EndTicks,
  785. StartTicks : int64;
  786. begin
  787. RunCompiler:=false;
  788. args:='-n -T'+CompilerTarget+' -Fu'+RTLUnitsDir;
  789. if ExtraPara<>'' then
  790. args:=args+' '+ExtraPara;
  791. { the helper object files have been copied to the common directory }
  792. if UniqueSuffix<>'' then
  793. args:=args+' -Fo'+TestOutputDir+'/..';
  794. args:=args+' -FE'+TestOutputDir;
  795. if TargetIsMacOS then
  796. args:=args+' -WT '; {tests should be compiled as MPWTool}
  797. if Config.DelOptions<>'' then
  798. LocalExtraArgs:=DelOptions(Config.DelOptions,ExtraCompilerOpts)
  799. else
  800. LocalExtraArgs:=ExtraCompilerOpts;
  801. if LocalExtraArgs<>'' then
  802. args:=args+' '+LocalExtraArgs;
  803. if TargetIsUnix then
  804. begin
  805. { Add runtime library path to current dir to find .so files }
  806. if Config.NeedLibrary then
  807. begin
  808. if (CompilerTarget='darwin') or
  809. (CompilerTarget='aix') then
  810. args:=args+' -Fl'+TestOutputDir
  811. else
  812. { do not use single quote for -k as they are mishandled on
  813. Windows Shells }
  814. args:=args+' -Fl'+TestOutputDir+' -k-rpath -k.'
  815. end;
  816. end;
  817. if Config.NeedOptions<>'' then
  818. AppendOptions(Config.NeedOptions,args);
  819. wpoargs:='';
  820. wposuffix:='';
  821. if (Config.WpoPasses=0) or
  822. (Config.WpoParas='') then
  823. passes:=1
  824. else
  825. passes:=config.wpopasses+1;
  826. args:=args+' '+PPFile[current];
  827. for passnr:=1 to passes do
  828. begin
  829. if (passes>1) then
  830. begin
  831. wposuffix:='_'+tostr(passnr);
  832. wpoargs:=' -OW'+config.wpoparas+' -FW'+TestOutputFileName('',PPFile[current],'wp'+tostr(passnr));
  833. if (passnr>1) then
  834. wpoargs:=wpoargs+' -Ow'+config.wpoparas+' -Fw'+TestOutputFileName('',PPFile[current],'wp'+tostr(passnr-1));
  835. end;
  836. Verbose(V_Debug,'Executing '+compilerbin+' '+args+wpoargs);
  837. { also get the output from as and ld that writes to stderr sometimes }
  838. StartTicks:=GetMicroSTicks;
  839. {$ifndef macos}
  840. execres:=ExecuteRedir(CompilerBin,args+wpoargs,'',CompilerLogFile+wposuffix,'stdout');
  841. {$else macos}
  842. {Due to that Toolserver is not reentrant, we have to asm and link via script.}
  843. execres:=ExecuteRedir(CompilerBin,'-s '+args+wpoargs,'',CompilerLogFile+wposuffix,'stdout');
  844. if execres then
  845. execres:=ExecuteRedir(TestOutputDir + ':ppas','','',CompilerLogFile+wpo_suffix,'stdout');
  846. {$endif macos}
  847. EndTicks:=GetMicroSTicks;
  848. Verbose(V_Debug,'Exitcode '+ToStr(ExecuteResult));
  849. if BenchmarkInfo then
  850. begin
  851. Verbose(V_Normal,'Compilation took '+ToStr(EndTicks-StartTicks)+' us');
  852. end;
  853. if passes > 1 then
  854. CopyFile(CompilerLogFile+wposuffix,CompilerLogFile,true);
  855. { Error during execution? }
  856. if (not execres) and (ExecuteResult=0) then
  857. begin
  858. AddLog(FailLogFile,TestName);
  859. AddLog(ResLogFile,failed_to_compile+PPFileInfo[current]);
  860. AddLog(LongLogFile,line_separation);
  861. AddLog(LongLogFile,failed_to_compile+PPFileInfo[current]);
  862. if CopyFile(CompilerLogFile,LongLogFile,true)=0 then
  863. AddLog(LongLogFile,'IOStatus'+ToStr(IOStatus));
  864. { avoid to try again }
  865. AddLog(ExeLogFile,failed_to_compile+PPFileInfo[current]);
  866. Verbose(V_Warning,'IOStatus: '+ToStr(IOStatus));
  867. exit;
  868. end;
  869. { Check for internal error }
  870. if ExitWithInternalError(CompilerLogFile) then
  871. begin
  872. AddLog(FailLogFile,TestName);
  873. if Config.Note<>'' then
  874. AddLog(FailLogFile,Config.Note);
  875. AddLog(ResLogFile,failed_to_compile+PPFileInfo[current]+' internalerror generated');
  876. AddLog(LongLogFile,line_separation);
  877. AddLog(LongLogFile,failed_to_compile+PPFileInfo[current]);
  878. if Config.Note<>'' then
  879. AddLog(LongLogFile,Config.Note);
  880. if CopyFile(CompilerLogFile,LongLogFile,true)=0 then
  881. AddLog(LongLogFile,'Internal error in compiler');
  882. { avoid to try again }
  883. AddLog(ExeLogFile,failed_to_compile+PPFileInfo[current]);
  884. Verbose(V_Warning,'Internal error in compiler');
  885. exit;
  886. end;
  887. end;
  888. { Should the compile fail ? }
  889. if Config.ShouldFail then
  890. begin
  891. if ExecuteResult<>0 then
  892. begin
  893. AddLog(ResLogFile,success_compilation_failed+PPFileInfo[current]);
  894. { avoid to try again }
  895. AddLog(ExeLogFile,success_compilation_failed+PPFileInfo[current]);
  896. RunCompiler:=true;
  897. end
  898. else
  899. begin
  900. AddLog(FailLogFile,TestName);
  901. if Config.Note<>'' then
  902. AddLog(FailLogFile,Config.Note);
  903. AddLog(ResLogFile,failed_compilation_successful+PPFileInfo[current]);
  904. AddLog(LongLogFile,line_separation);
  905. AddLog(LongLogFile,failed_compilation_successful+PPFileInfo[current]);
  906. { avoid to try again }
  907. AddLog(ExeLogFile,failed_compilation_successful+PPFileInfo[current]);
  908. if Config.Note<>'' then
  909. AddLog(LongLogFile,Config.Note);
  910. CopyFile(CompilerLogFile,LongLogFile,true);
  911. end;
  912. end
  913. else
  914. begin
  915. if (ExecuteResult<>0) and
  916. (((Config.KnownCompileNote<>'') and (Config.KnownCompileError=0)) or
  917. ((Config.KnownCompileError<>0) and (ExecuteResult=Config.KnownCompileError))) then
  918. begin
  919. AddLog(FailLogFile,TestName+known_problem+Config.KnownCompileNote);
  920. AddLog(ResLogFile,failed_to_compile+PPFileInfo[current]+known_problem+Config.KnownCompileNote);
  921. AddLog(LongLogFile,line_separation);
  922. AddLog(LongLogFile,known_problem+Config.KnownCompileNote);
  923. AddLog(LongLogFile,failed_to_compile+PPFileInfo[current]+' ('+ToStr(ExecuteResult)+')');
  924. if Copyfile(CompilerLogFile,LongLogFile,true)=0 then
  925. AddLog(LongLogFile,known_problem+'exitcode: '+ToStr(ExecuteResult));
  926. Verbose(V_Warning,known_problem+'exitcode: '+ToStr(ExecuteResult));
  927. end
  928. else if ExecuteResult<>0 then
  929. begin
  930. AddLog(FailLogFile,TestName);
  931. if Config.Note<>'' then
  932. AddLog(FailLogFile,Config.Note);
  933. AddLog(ResLogFile,failed_to_compile+PPFileInfo[current]);
  934. AddLog(LongLogFile,line_separation);
  935. AddLog(LongLogFile,failed_to_compile+PPFileInfo[current]);
  936. if Config.Note<>'' then
  937. AddLog(LongLogFile,Config.Note);
  938. if CopyFile(CompilerLogFile,LongLogFile,true)=0 then
  939. AddLog(LongLogFile,'Exitcode: '+ToStr(ExecuteResult)+' (expected 0)');
  940. { avoid to try again }
  941. AddLog(ExeLogFile,failed_to_compile+PPFileInfo[current]);
  942. Verbose(V_Warning,'Exitcode: '+ToStr(ExecuteResult)+' (expected 0)');
  943. end
  944. else
  945. begin
  946. AddLog(ResLogFile,successfully_compiled+PPFileInfo[current]);
  947. RunCompiler:=true;
  948. end;
  949. end;
  950. end;
  951. function CheckTestExitCode(const OutName:string):boolean;
  952. var
  953. t : text;
  954. s : string;
  955. i,code : integer;
  956. begin
  957. CheckTestExitCode:=false;
  958. { open logfile }
  959. assign(t,Outname);
  960. {$I-}
  961. reset(t);
  962. {$I+}
  963. if ioresult<>0 then
  964. exit;
  965. while not eof(t) do
  966. begin
  967. readln(t,s);
  968. i:=pos('TestExitCode: ',s);
  969. if i>0 then
  970. begin
  971. delete(s,1,i+14-1);
  972. val(s,ExecuteResult,code);
  973. if code=0 then
  974. CheckTestExitCode:=true;
  975. break;
  976. end;
  977. end;
  978. close(t);
  979. end;
  980. function LibraryExists(const PPFile : string; out FileName : string) : boolean;
  981. begin
  982. { Check if a dynamic library XXX was created }
  983. { Windows XXX.dll style }
  984. FileName:=TestOutputFilename('',PPFile,'dll');
  985. if FileExists(FileName) then
  986. begin
  987. LibraryExists:=true;
  988. exit;
  989. end;
  990. { Linux libXXX.so style }
  991. FileName:=TestOutputFilename('lib',PPFile,'so');
  992. if FileExists(FileName) then
  993. begin
  994. LibraryExists:=true;
  995. exit;
  996. end;
  997. { Darwin libXXX.dylib style }
  998. FileName:=TestOutputFilename('lib',PPFile,'dylib');
  999. if FileExists(FileName) then
  1000. begin
  1001. LibraryExists:=true;
  1002. exit;
  1003. end;
  1004. { MacOS LibXXX style }
  1005. FileName:=TestOutputFilename('Lib',PPFile,'');
  1006. if FileExists(FileName) then
  1007. begin
  1008. LibraryExists:=true;
  1009. exit;
  1010. end;
  1011. { Netware wlic XXX.nlm style }
  1012. FileName:=TestOutputFilename('',PPFile,'nlm');
  1013. if FileExists(FileName) then
  1014. begin
  1015. LibraryExists:=true;
  1016. exit;
  1017. end;
  1018. { Amiga XXX.library style }
  1019. FileName:=TestOutputFilename('',PPFile,'library');
  1020. if FileExists(FileName) then
  1021. begin
  1022. LibraryExists:=true;
  1023. exit;
  1024. end;
  1025. LibraryExists:=false;
  1026. end;
  1027. function ExecuteRemote(prog,args:string;out StartTicks,EndTicks : int64):boolean;
  1028. const
  1029. MaxTrials = 5;
  1030. var
  1031. Trials : longint;
  1032. Res : boolean;
  1033. begin
  1034. if SplitFileExt(prog)='' then
  1035. prog:=prog+SrcExeExt;
  1036. Verbose(V_Debug,'RemoteExecuting '+Prog+' '+args);
  1037. StartTicks:=GetMicroSTicks;
  1038. Res:=false;
  1039. Trials:=0;
  1040. While (Trials<MaxTrials) and not Res do
  1041. begin
  1042. inc(Trials);
  1043. Res:=ExecuteRedir(prog,args,'',EXELogFile,'stdout');
  1044. if not Res then
  1045. Verbose(V_Debug,'Call to '+prog+' failed: '+
  1046. 'IOStatus='+ToStr(IOStatus)+
  1047. ' RedirErrorOut='+ToStr(RedirErrorOut)+
  1048. ' RedirErrorIn='+ToStr(RedirErrorIn)+
  1049. ' RedirErrorError='+ToStr(RedirErrorError)+
  1050. ' ExecuteResult='+ToStr(ExecuteResult));
  1051. end;
  1052. if Trials>1 then
  1053. Verbose(V_Debug,'Done in '+tostr(trials)+' trials');
  1054. EndTicks:=GetMicroSTicks;
  1055. ExecuteRemote:=res;
  1056. end;
  1057. function ExecuteEmulated(const prog,args,FullExeLogFile:string;out StartTicks,EndTicks : int64):boolean;
  1058. begin
  1059. Verbose(V_Debug,'EmulatorExecuting '+Prog+' '+args);
  1060. StartTicks:=GetMicroSTicks;
  1061. ExecuteEmulated:=ExecuteRedir(prog,args,'',FullExeLogFile,'stdout');
  1062. EndTicks:=GetMicroSTicks;
  1063. end;
  1064. function MaybeCopyFiles(const FileToCopy : string) : boolean;
  1065. var
  1066. TestRemoteExe,
  1067. pref : string;
  1068. LocalFile, RemoteFile, s: string;
  1069. LocalPath: string;
  1070. i : integer;
  1071. execres : boolean;
  1072. EndTicks,
  1073. StartTicks : int64;
  1074. FileList : TStringList;
  1075. RelativeToConfigMarker : TObject;
  1076. function BuildFileList: TStringList;
  1077. var
  1078. s : string;
  1079. index : longint;
  1080. begin
  1081. s:=Config.Files;
  1082. if (length(s) = 0) and (Config.ConfigFileSrc='') then
  1083. begin
  1084. Result:=nil;
  1085. exit;
  1086. end;
  1087. Result:=TStringList.Create;
  1088. if s<>'' then
  1089. repeat
  1090. index:=pos(' ',s);
  1091. if index=0 then
  1092. LocalFile:=s
  1093. else
  1094. LocalFile:=copy(s,1,index-1);
  1095. Result.Add(LocalFile);
  1096. if index=0 then
  1097. break;
  1098. s:=copy(s,index+1,length(s)-index);
  1099. until false;
  1100. if Config.ConfigFileSrc<>'' then
  1101. begin
  1102. if Config.ConfigFileSrc=Config.ConfigFileDst then
  1103. Result.AddObject(Config.ConfigFileSrc,RelativeToConfigMarker)
  1104. else
  1105. Result.AddObject(Config.ConfigFileSrc+'='+Config.ConfigFileDst,RelativeToConfigMarker);
  1106. end;
  1107. end;
  1108. begin
  1109. RelativeToConfigMarker:=TObject.Create;
  1110. if RemoteAddr='' then
  1111. begin
  1112. FileList:=BuildFileList;
  1113. if assigned(FileList) then
  1114. begin
  1115. LocalPath:=SplitPath(PPFile[current]);
  1116. if Length(LocalPath) > 0 then
  1117. LocalPath:=LocalPath+'/';
  1118. for i:=0 to FileList.count-1 do
  1119. begin
  1120. if FileList.Names[i]<>'' then
  1121. begin
  1122. LocalFile:=FileList.Names[i];
  1123. RemoteFile:=FileList.ValueFromIndex[i];
  1124. end
  1125. else
  1126. begin
  1127. LocalFile:=FileList[i];
  1128. RemoteFile:=LocalFile;
  1129. end;
  1130. if FileList.Objects[i]=RelativeToConfigMarker then
  1131. s:='config/'+LocalFile
  1132. else
  1133. s:=LocalPath+LocalFile;
  1134. CopyFile(s,TestOutputDir+'/'+RemoteFile,false);
  1135. end;
  1136. FileList.Free;
  1137. end;
  1138. RelativeToConfigMarker.Free;
  1139. exit(true);
  1140. end;
  1141. execres:=true;
  1142. { Check if library should be deleted. Do not copy to remote target in such case. }
  1143. if (deAfter in DelExecutable) and (Config.DelFiles <> '') then
  1144. if SplitFileName(FileToCopy) = DllPrefix + Trim(Config.DelFiles) + DllExt then
  1145. exit;
  1146. { We don't want to create subdirs, remove paths from the test }
  1147. TestRemoteExe:=RemotePath+'/'+SplitFileName(FileToCopy);
  1148. if deBefore in DelExecutable then
  1149. begin
  1150. s:=RemoteRshParas+' rm ';
  1151. if rshprog <> 'adb' then
  1152. s:=s+'-f ';
  1153. ExecuteRemote(rshprog,s+TestRemoteExe,
  1154. StartTicks,EndTicks);
  1155. end;
  1156. execres:=ExecuteRemote(rcpprog,RemotePara+' '+FileToCopy+' '+
  1157. RemotePathPrefix+TestRemoteExe,StartTicks,EndTicks);
  1158. if not execres then
  1159. begin
  1160. Verbose(V_normal, 'Could not copy executable '+FileToCopy);
  1161. RelativeToConfigMarker.Free;
  1162. exit(execres);
  1163. end;
  1164. FileList:=BuildFileList;
  1165. if assigned(FileList) then
  1166. begin
  1167. LocalPath:=SplitPath(PPFile[current]);
  1168. if Length(LocalPath) > 0 then
  1169. LocalPath:=LocalPath+'/';
  1170. for i:=0 to FileList.count-1 do
  1171. begin
  1172. if FileList.Names[i]<>'' then
  1173. begin
  1174. LocalFile:=FileList.Names[i];
  1175. RemoteFile:=FileList.ValueFromIndex[i];
  1176. end
  1177. else
  1178. begin
  1179. LocalFile:=FileList[i];
  1180. RemoteFile:=LocalFile;
  1181. end;
  1182. RemoteFile:=RemotePath+'/'+SplitFileName(RemoteFile);
  1183. if FileList.Objects[i]=RelativeToConfigMarker then
  1184. LocalFile:='config/'+LocalFile
  1185. else
  1186. LocalFile:=LocalPath+LocalFile;
  1187. if DoVerbose and (rcpprog='pscp') then
  1188. pref:='-v '
  1189. else
  1190. pref:='';
  1191. execres:=ExecuteRemote(rcpprog,pref+RemotePara+' '+LocalFile+' '+
  1192. RemotePathPrefix+RemoteFile,StartTicks,EndTicks);
  1193. if not execres then
  1194. begin
  1195. Verbose(V_normal, 'Could not copy required file '+LocalFile);
  1196. FileList.Free;
  1197. RelativeToConfigMarker.Free;
  1198. exit(false);
  1199. end;
  1200. end;
  1201. end;
  1202. FileList.Free;
  1203. MaybeCopyFiles:=execres;
  1204. RelativeToConfigMarker.Free;
  1205. end;
  1206. function RunExecutable:boolean;
  1207. const
  1208. {$ifdef unix}
  1209. CurrDir = './';
  1210. {$else}
  1211. CurrDir = '';
  1212. {$endif}
  1213. var
  1214. OldDir, s, ss,
  1215. execcmd,
  1216. FullExeLogFile,
  1217. TestRemoteExe,
  1218. TestExe : string;
  1219. execres : boolean;
  1220. EndTicks,
  1221. StartTicks : int64;
  1222. OldExecuteResult: longint;
  1223. begin
  1224. RunExecutable:=false;
  1225. execres:=true;
  1226. TestExe:=TestOutputFilename('',PPFile[current],ExeExt);
  1227. execres:=MaybeCopyFiles(TestExe);
  1228. if EmulatorName<>'' then
  1229. begin
  1230. { Get full name out log file, because we change the directory during
  1231. execution }
  1232. FullExeLogFile:=FExpand(EXELogFile);
  1233. {$I-}
  1234. GetDir(0,OldDir);
  1235. ChDir(TestOutputDir);
  1236. {$I+}
  1237. ioresult;
  1238. s:=CurrDir+SplitFileName(TestExe);
  1239. { Add -Ssource_file_name for dosbox_wrapper }
  1240. if pos('dosbox_wrapper',EmulatorName)>0 then
  1241. s:=s+' -S'+PPFile[current];
  1242. execres:=ExecuteEmulated(EmulatorName,EmulatorOpts+' '+s,FullExeLogFile,StartTicks,EndTicks);
  1243. {$I-}
  1244. ChDir(OldDir);
  1245. {$I+}
  1246. end
  1247. else if RemoteAddr<>'' then
  1248. begin
  1249. TestRemoteExe:=RemotePath+'/'+SplitFileName(TestExe);
  1250. { rsh doesn't pass the exitcode, use a second command to print the exitcode
  1251. on the remoteshell to stdout }
  1252. if DoVerbose and (rshprog='plink') then
  1253. execcmd:='-v '+RemoteRshParas
  1254. else
  1255. execcmd:=RemoteRshParas;
  1256. execcmd:=execcmd+' '+rquote+
  1257. 'chmod 755 '+TestRemoteExe+
  1258. ' && cd '+RemotePath+' && { ';
  1259. { Using -rpath . at compile time does not seem
  1260. to work for programs copied over to remote machine,
  1261. at least not for FreeBSD.
  1262. Does this work for all shells? }
  1263. if Config.NeedLibrary then
  1264. begin
  1265. if RemoteShellNeedsExport then
  1266. if CompilerTarget='darwin' then
  1267. execcmd:=execcmd+' DYLD_LIBRARY_PATH=.; export DYLD_LIBRARY_PATH;'
  1268. else
  1269. execcmd:=execcmd+' LD_LIBRARY_PATH=.; export LD_LIBRARY_PATH;'
  1270. else
  1271. if CompilerTarget='darwin' then
  1272. execcmd:=execcmd+' setenv DYLD_LIBRARY_PATH=.; '
  1273. else
  1274. execcmd:=execcmd+' setenv LD_LIBRARY_PATH=.; '
  1275. end;
  1276. if UseTimeout then
  1277. begin
  1278. if Config.Timeout=0 then
  1279. Config.Timeout:=DefaultTimeout;
  1280. str(Config.Timeout,s);
  1281. if (RemoteShellBase='bash') then
  1282. execcmd:=execcmd+'ulimit -t '+s+'; '
  1283. else
  1284. execcmd:=execcmd+'timeout -9 '+s;
  1285. end;
  1286. { as we moved to RemotePath, if path is not absolute
  1287. we need to use ./execfilename only }
  1288. if not isabsolute(TestRemoteExe) then
  1289. execcmd:=execcmd+' ./'+SplitFileName(TestRemoteExe)
  1290. else
  1291. execcmd:=execcmd+' '+TestRemoteExe;
  1292. execcmd:=execcmd+' ; echo TestExitCode: $?';
  1293. if (deAfter in DelExecutable) and
  1294. not Config.NeededAfter then
  1295. begin
  1296. { Delete executable if not needed after }
  1297. execcmd:=execcmd+' ; rm ';
  1298. if rshprog <> 'adb' then
  1299. execcmd:=execcmd+'-f ';
  1300. execcmd:=execcmd+SplitFileName(TestRemoteExe);
  1301. end;
  1302. execcmd:=execcmd+'; }'+rquote;
  1303. execres:=ExecuteRemote(rshprog,execcmd,StartTicks,EndTicks);
  1304. { Check for TestExitCode error in output, sets ExecuteResult }
  1305. if not CheckTestExitCode(EXELogFile) then
  1306. Verbose(V_Debug,'Failed to check exit code for '+execcmd);
  1307. if (deAfter in DelExecutable) and ( (Config.DelFiles <> '') or (Config.Files <> '')) then
  1308. begin
  1309. ss:=Trim(Config.DelFiles + ' ' + Config.Files);
  1310. execcmd:=RemoteRshParas+' ' + rquote + 'cd ' + RemotePath + ' && { ';
  1311. while ss <> '' do
  1312. begin
  1313. s:=Trim(GetToken(ss, [' ',',',';']));
  1314. if s = '' then
  1315. break;
  1316. if ExtractFileExt(s) = '' then
  1317. // If file has no extension, treat it as exe or shared lib
  1318. execcmd:=execcmd + 'rm ' + s + ExeExt + '; rm ' + DllPrefix + s + DllExt
  1319. else
  1320. execcmd:=execcmd + 'rm ' + s;
  1321. execcmd:=execcmd + '; ';
  1322. end;
  1323. execcmd:=execcmd+'}'+rquote;
  1324. // Save ExecuteResult and EXELogFile
  1325. OldExecuteResult:=ExecuteResult;
  1326. s:=EXELogFile;
  1327. // Output results of cleanup commands to stdout
  1328. EXELogFile:='';
  1329. ExecuteRemote(rshprog,execcmd,StartTicks,EndTicks);
  1330. // Restore
  1331. EXELogFile:=s;
  1332. ExecuteResult:=OldExecuteResult;
  1333. end;
  1334. end
  1335. else
  1336. begin
  1337. { Get full name out log file, because we change the directory during
  1338. execution }
  1339. FullExeLogFile:=FExpand(EXELogFile);
  1340. Verbose(V_Debug,'Executing '+TestExe);
  1341. {$I-}
  1342. GetDir(0,OldDir);
  1343. ChDir(TestOutputDir);
  1344. {$I+}
  1345. ioresult;
  1346. { don't redirect interactive and graph programs }
  1347. StartTicks:=GetMicroSTicks;
  1348. if Config.IsInteractive or Config.UsesGraph then
  1349. execres:=ExecuteRedir(CurrDir+SplitFileName(TestExe),'','','','')
  1350. else
  1351. execres:=ExecuteRedir(CurrDir+SplitFileName(TestExe),'','',FullExeLogFile,'stdout');
  1352. EndTicks:=GetMicroSTicks;
  1353. {$I-}
  1354. ChDir(OldDir);
  1355. {$I+}
  1356. ioresult;
  1357. end;
  1358. { Error during execution? }
  1359. Verbose(V_Debug,'Exitcode '+ToStr(ExecuteResult));
  1360. if BenchmarkInfo then
  1361. begin
  1362. Verbose(V_Normal,'Execution took '+ToStr(EndTicks-StartTicks)+' us');
  1363. end;
  1364. if (not execres) and (ExecuteResult=0) then
  1365. begin
  1366. AddLog(FailLogFile,TestName);
  1367. AddLog(ResLogFile,failed_to_run+PPFileInfo[current]);
  1368. AddLog(LongLogFile,line_separation);
  1369. AddLog(LongLogFile,failed_to_run+PPFileInfo[current]);
  1370. if CopyFile(EXELogFile,LongLogFile,true)=0 then
  1371. AddLog(LongLogFile,'IOStatus: '+ToStr(IOStatus));
  1372. { avoid to try again }
  1373. AddLog(ExeLogFile,failed_to_run+PPFileInfo[current]);
  1374. Verbose(V_Warning,'IOStatus: '+ToStr(IOStatus));
  1375. exit;
  1376. end;
  1377. if ExecuteResult<>Config.ResultCode then
  1378. begin
  1379. if (ExecuteResult<>0) and
  1380. (ExecuteResult=Config.KnownRunError) then
  1381. begin
  1382. AddLog(FailLogFile,TestName+known_problem+Config.KnownRunNote);
  1383. AddLog(ResLogFile,failed_to_run+PPFileInfo[current]+known_problem+Config.KnownRunNote);
  1384. AddLog(LongLogFile,line_separation);
  1385. AddLog(LongLogFile,known_problem+Config.KnownRunNote);
  1386. AddLog(LongLogFile,failed_to_run+PPFileInfo[current]+' ('+ToStr(ExecuteResult)+')');
  1387. if Copyfile(EXELogFile,LongLogFile,true)=0 then
  1388. begin
  1389. AddLog(LongLogFile,known_problem+'exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  1390. AddLog(ExeLogFile,known_problem+'exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  1391. end;
  1392. Verbose(V_Warning,known_problem+'exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  1393. end
  1394. else
  1395. begin
  1396. AddLog(FailLogFile,TestName);
  1397. AddLog(ResLogFile,failed_to_run+PPFileInfo[current]);
  1398. AddLog(LongLogFile,line_separation);
  1399. AddLog(LongLogFile,failed_to_run+PPFileInfo[current]+' ('+ToStr(ExecuteResult)+')');
  1400. if Copyfile(EXELogFile,LongLogFile,true)=0 then
  1401. begin
  1402. AddLog(LongLogFile,'Exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  1403. AddLog(ExeLogFile,'Exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  1404. end;
  1405. Verbose(V_Warning,'Exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  1406. end
  1407. end
  1408. else
  1409. begin
  1410. AddLog(ResLogFile,successfully_run+PPFileInfo[current]);
  1411. RunExecutable:=true;
  1412. end;
  1413. if (deAfter in DelExecutable) and not Config.NeededAfter then
  1414. begin
  1415. Verbose(V_Debug,'Deleting executable '+TestExe);
  1416. RemoveFile(TestExe);
  1417. RemoveFile(ForceExtension(TestExe,ObjExt));
  1418. RemoveFile(ForceExtension(TestExe,PPUExt));
  1419. end;
  1420. end;
  1421. { Try to collect information concerning the remote configuration
  1422. Currently only records RemoteShell name and sets
  1423. RemoteShellNeedsExport boolean variable }
  1424. procedure SetRemoteConfiguration;
  1425. var
  1426. f : text;
  1427. StartTicks,EndTicks : int64;
  1428. begin
  1429. if RemoteAddr='' then
  1430. exit;
  1431. if rshprog = 'adb' then
  1432. begin
  1433. RemoteShellNeedsExport:=true;
  1434. exit;
  1435. end;
  1436. ExeLogFile:='__remote.tmp';
  1437. ExecuteRemote(rshprog,RemoteRshParas+
  1438. ' "echo SHELL=${SHELL}"',StartTicks,EndTicks);
  1439. Assign(f,ExeLogFile);
  1440. Reset(f);
  1441. While not eof(f) do
  1442. begin
  1443. Readln(f,RemoteShellBase);
  1444. if pos('SHELL=',RemoteShellBase)>0 then
  1445. begin
  1446. RemoteShell:=TrimSpace(Copy(RemoteShellBase,pos('SHELL=',RemoteShellBase)+6,
  1447. length(RemoteShellBase)));
  1448. Verbose(V_Debug,'Remote shell is "'+RemoteShell+'"');
  1449. RemoteShellBase:=SplitFileBase(RemoteShell);
  1450. if (RemoteShellBase='bash') or (RemoteShellBase='sh') then
  1451. RemoteShellNeedsExport:=true;
  1452. end;
  1453. end;
  1454. Close(f);
  1455. end;
  1456. procedure getargs;
  1457. procedure helpscreen;
  1458. begin
  1459. writeln('dotest [Options] <File>');
  1460. writeln;
  1461. writeln('Options can be:');
  1462. writeln(' !ENV_NAME parse environment variable ENV_NAME for options');
  1463. writeln(' -A include ALL tests');
  1464. writeln(' -ADB use ADB to run tests');
  1465. writeln(' -B delete executable before remote upload');
  1466. writeln(' -C<compiler> set compiler to use');
  1467. writeln(' -D display execution time');
  1468. writeln(' -E execute test also');
  1469. writeln(' -G include graph tests');
  1470. writeln(' -I include interactive tests');
  1471. writeln(' -K include known bug tests');
  1472. writeln(' -L<ext> set extension of temporary files (prevent conflicts with parallel invocations)');
  1473. writeln(' -M<emulator> run the tests using the given emulator');
  1474. writeln(' -N<emulator opts.> pass options to the emulator');
  1475. writeln(' -O use timeout wrapper for (remote) execution');
  1476. writeln(' -P<path> path to the tests tree on the remote machine');
  1477. writeln(' -R<remote> run the tests remotely with the given rsh/ssh address');
  1478. writeln(' -S use ssh instead of rsh');
  1479. writeln(' -T[cpu-]<os> run tests for target cpu and os');
  1480. writeln(' -U<remotepara>');
  1481. writeln(' pass additional parameter to remote program. Multiple -U can be used');
  1482. writeln(' -V be verbose');
  1483. writeln(' -W use putty compatible file names when testing (plink and pscp)');
  1484. writeln(' -X don''t use COMSPEC');
  1485. writeln(' -Y<opts> extra options passed to the compiler. Several -Y<opt> can be given.');
  1486. writeln(' -Z remove temporary files (executable,ppu,o)');
  1487. halt(1);
  1488. end;
  1489. procedure interpret_option (para : string);
  1490. var
  1491. ch : char;
  1492. j : longint;
  1493. begin
  1494. Verbose(V_Debug,'Interpreting option"'+para+'"');
  1495. ch:=Upcase(para[2]);
  1496. delete(para,1,2);
  1497. case ch of
  1498. 'A' :
  1499. if UpperCase(para) = 'DB' then
  1500. begin
  1501. rshprog:='adb';
  1502. rcpprog:='adb';
  1503. rquote:='"';
  1504. if RemoteAddr = '' then
  1505. RemoteAddr:='1'; // fake remote addr (default device will be used)
  1506. end
  1507. else
  1508. begin
  1509. DoGraph:=true;
  1510. DoInteractive:=true;
  1511. DoKnown:=true;
  1512. DoAll:=true;
  1513. end;
  1514. 'B' : Include(DelExecutable,deBefore);
  1515. 'C' : CompilerBin:=Para;
  1516. 'D' : BenchMarkInfo:=true;
  1517. 'E' : DoExecute:=true;
  1518. 'G' : begin
  1519. DoGraph:=true;
  1520. if para='-' then
  1521. DoUsual:=false;
  1522. end;
  1523. 'I' : begin
  1524. DoInteractive:=true;
  1525. if para='-' then
  1526. DoUsual:=false;
  1527. end;
  1528. 'K' : begin
  1529. DoKnown:=true;
  1530. if para='-' then
  1531. DoUsual:=false;
  1532. end;
  1533. 'L' : begin
  1534. UniqueSuffix:=Para;
  1535. if UniqueSuffix='' then
  1536. UniqueSuffix:=toStr(system.GetProcessID);
  1537. end;
  1538. 'M' : EmulatorName:=Para;
  1539. 'N' : EmulatorOpts:=Para;
  1540. 'O' : UseTimeout:=true;
  1541. 'P' : RemotePath:=Para;
  1542. 'R' : RemoteAddr:=Para;
  1543. 'S' :
  1544. begin
  1545. rshprog:='ssh';
  1546. rcpprog:='scp';
  1547. end;
  1548. 'T' :
  1549. begin
  1550. j:=Pos('-',Para);
  1551. if j>0 then
  1552. begin
  1553. CompilerCPU:=Copy(Para,1,j-1);
  1554. CompilerTarget:=Copy(Para,j+1,length(para));
  1555. end
  1556. else
  1557. CompilerTarget:=Para
  1558. end;
  1559. 'U' :
  1560. RemotePara:=RemotePara+' '+Para;
  1561. 'V' : DoVerbose:=true;
  1562. 'W' :
  1563. begin
  1564. rshprog:='plink';
  1565. rcpprog:='pscp';
  1566. rquote:='"';
  1567. end;
  1568. 'X' : UseComSpec:=false;
  1569. 'Y' : ExtraCompilerOpts:= ExtraCompilerOpts +' '+ Para;
  1570. 'Z' : Include(DelExecutable,deAfter);
  1571. end;
  1572. end;
  1573. procedure interpret_env(arg : string);
  1574. var
  1575. para : string;
  1576. pspace : longint;
  1577. begin
  1578. Verbose(V_Debug,'Interpreting environment option"'+arg+'"');
  1579. { Get rid of leading '!' }
  1580. delete(arg,1,1);
  1581. arg:=getenv(arg);
  1582. Verbose(V_Debug,'Environment value is "'+arg+'"');
  1583. while (length(arg)>0) do
  1584. begin
  1585. while (length(arg)>0) and (arg[1]=' ') do
  1586. delete(arg,1,1);
  1587. pspace:=pos(' ',arg);
  1588. if pspace=0 then
  1589. pspace:=length(arg)+1;
  1590. para:=copy(arg,1,pspace-1);
  1591. if (length(para)>0) and (para[1]='-') then
  1592. interpret_option (para)
  1593. else
  1594. begin
  1595. PPFile.Insert(current,ForceExtension(Para,'pp'));
  1596. inc(current);
  1597. end;
  1598. delete(arg,1,pspace);
  1599. end;
  1600. end;
  1601. var
  1602. param : string;
  1603. i : longint;
  1604. begin
  1605. CompilerBin:='ppc386'+srcexeext;
  1606. for i:=1 to paramcount do
  1607. begin
  1608. param:=Paramstr(i);
  1609. if (param[1]='-') then
  1610. interpret_option(param)
  1611. else if (param[1]='!') then
  1612. interpret_env(param)
  1613. else
  1614. begin
  1615. PPFile.Insert(current,ForceExtension(Param,'pp'));
  1616. inc(current);
  1617. end;
  1618. end;
  1619. if current=0 then
  1620. HelpScreen;
  1621. { disable graph,interactive when running remote }
  1622. if RemoteAddr<>'' then
  1623. begin
  1624. DoGraph:=false;
  1625. DoInteractive:=false;
  1626. end;
  1627. { If we use PuTTY plink program with -load option,
  1628. the IP address or name should not be added to
  1629. the command line }
  1630. if (rshprog='plink') and (pos('-load',RemotePara)>0) then
  1631. RemoteRshParas:=RemotePara
  1632. else
  1633. if rshprog='adb' then
  1634. begin
  1635. if RemoteAddr <> '1' then
  1636. RemotePara:=Trim('-s ' + RemoteAddr + ' ' + RemotePara);
  1637. RemoteRshParas:=Trim(RemotePara + ' shell');
  1638. end
  1639. else
  1640. RemoteRshParas:=RemotePara+' '+RemoteAddr;
  1641. if rcpprog = 'adb' then
  1642. begin
  1643. RemotePathPrefix:='';
  1644. RemotePara:=Trim(RemotePara + ' push');
  1645. end
  1646. else
  1647. RemotePathPrefix:=RemoteAddr + ':';
  1648. end;
  1649. procedure RunTest;
  1650. var
  1651. PPDir,LibraryName,LogSuffix,PPPrefix : string;
  1652. Res : boolean;
  1653. begin
  1654. Res:=GetConfig(PPFile[current],Config);
  1655. TranslateConfig(Config);
  1656. if Res then
  1657. begin
  1658. Res:=GetCompilerCPU;
  1659. Res:=GetCompilerTarget;
  1660. {$ifndef MACOS}
  1661. RTLUnitsDir:='tstunits/'+CompilerFullTarget;
  1662. {$else MACOS}
  1663. RTLUnitsDir:=':tstunits:'+CompilerFullTarget;
  1664. {$endif MACOS}
  1665. if not PathExists(RTLUnitsDir) then
  1666. Verbose(V_Abort,'Unit path "'+RTLUnitsDir+'" does not exists');
  1667. {$ifndef MACOS}
  1668. OutputDir:='output/'+CompilerFullTarget;
  1669. {$else MACOS}
  1670. OutputDir:=':output:'+CompilerFullTarget;
  1671. {$endif MACOS}
  1672. if not PathExists(OutputDir) then
  1673. Verbose(V_Abort,'Output path "'+OutputDir+'" does not exists');
  1674. { Make subdir in output if needed }
  1675. PPDir:=SplitPath(PPFile[current]);
  1676. if PPDir[length(PPDir)] in ['/','\'{$ifdef MACOS},':'{$endif MACOS}] then
  1677. Delete(PPDir,length(PPDir),1);
  1678. if PPDir<>'' then
  1679. begin
  1680. {$ifndef MACOS}
  1681. { handle paths that are parallel to the tests directory (let's hope
  1682. that noone uses ../../ -.- ) }
  1683. { ToDo: check relative paths on MACOS }
  1684. PPPrefix:=Copy(PPDir,1,3);
  1685. if (PPPrefix='../') or (PPPrefix='..\') then
  1686. PPDir:='root/'+Copy(PPDir,4,length(PPDir));
  1687. TestOutputDir:=OutputDir+'/'+PPDir;
  1688. if UniqueSuffix<>'' then
  1689. TestOutputDir:=TestOutputDir+'/'+UniqueSuffix;
  1690. {$else MACOS}
  1691. TestOutputDir:=OutputDir+PPDir;
  1692. if UniqueSuffix<>'' then
  1693. TestOutputDir:=TestOutputDir+':'+UniqueSuffix;
  1694. {$endif MACOS}
  1695. mkdirtree(TestOutputDir);
  1696. end
  1697. else
  1698. TestOutputDir:=OutputDir;
  1699. if UniqueSuffix<>'' then
  1700. LogSuffix:=UniqueSuffix
  1701. else
  1702. LogSuffix:=SplitBasePath(PPDir)+'log';
  1703. ResLogFile:=OutputFileName('log',LogSuffix);
  1704. LongLogFile:=OutputFileName('longlog',LogSuffix);
  1705. FailLogFile:=OutputFileName('faillist',LogSuffix);
  1706. ForceLog(ResLogFile);
  1707. ForceLog(LongLogFile);
  1708. ForceLog(FailLogFile);
  1709. { Per test logfiles }
  1710. CompilerLogFile:=TestLogFileName('',SplitFileName(PPFile[current]),'log');
  1711. ExeLogFile:=TestLogFileName('',SplitFileName(PPFile[current]),'elg');
  1712. Verbose(V_Debug,'Using Compiler logfile: '+CompilerLogFile);
  1713. Verbose(V_Debug,'Using Execution logfile: '+ExeLogFile);
  1714. end;
  1715. if Res then
  1716. begin
  1717. if Config.UsesGraph and (not DoGraph) then
  1718. begin
  1719. AddLog(ResLogFile,skipping_graph_test+PPFileInfo[current]);
  1720. { avoid a second attempt by writing to elg file }
  1721. AddLog(EXELogFile,skipping_graph_test+PPFileInfo[current]);
  1722. Verbose(V_Warning,skipping_graph_test);
  1723. Res:=false;
  1724. end;
  1725. end;
  1726. if Res then
  1727. begin
  1728. if Config.IsInteractive and (not DoInteractive) then
  1729. begin
  1730. { avoid a second attempt by writing to elg file }
  1731. AddLog(EXELogFile,skipping_interactive_test+PPFileInfo[current]);
  1732. AddLog(ResLogFile,skipping_interactive_test+PPFileInfo[current]);
  1733. Verbose(V_Warning,skipping_interactive_test);
  1734. Res:=false;
  1735. end;
  1736. end;
  1737. if Res then
  1738. begin
  1739. if Config.IsKnownCompileError and (not DoKnown) then
  1740. begin
  1741. { avoid a second attempt by writing to elg file }
  1742. AddLog(EXELogFile,skipping_known_bug+PPFileInfo[current]);
  1743. AddLog(ResLogFile,skipping_known_bug+PPFileInfo[current]);
  1744. Verbose(V_Warning,skipping_known_bug);
  1745. Res:=false;
  1746. end;
  1747. end;
  1748. if Res and not DoUsual then
  1749. res:=(Config.IsInteractive and DoInteractive) or
  1750. (Config.IsKnownRunError and DoKnown) or
  1751. (Config.UsesGraph and DoGraph);
  1752. if Res then
  1753. begin
  1754. if (Config.MinVersion<>'') and not DoAll then
  1755. begin
  1756. Verbose(V_Debug,'Required compiler version: '+Config.MinVersion);
  1757. Res:=GetCompilerVersion;
  1758. if CompilerVersion<Config.MinVersion then
  1759. begin
  1760. { avoid a second attempt by writing to elg file }
  1761. AddLog(EXELogFile,skipping_compiler_version_too_low+PPFileInfo[current]);
  1762. AddLog(ResLogFile,skipping_compiler_version_too_low+PPFileInfo[current]);
  1763. Verbose(V_Warning,'Compiler version too low '+CompilerVersion+' < '+Config.MinVersion);
  1764. Res:=false;
  1765. end;
  1766. end;
  1767. end;
  1768. if Res then
  1769. begin
  1770. if (Config.MaxVersion<>'') and not DoAll then
  1771. begin
  1772. Verbose(V_Debug,'Highest compiler version: '+Config.MaxVersion);
  1773. Res:=GetCompilerVersion;
  1774. if CompilerVersion>Config.MaxVersion then
  1775. begin
  1776. { avoid a second attempt by writing to elg file }
  1777. AddLog(EXELogFile,skipping_compiler_version_too_high+PPFileInfo[current]);
  1778. AddLog(ResLogFile,skipping_compiler_version_too_high+PPFileInfo[current]);
  1779. Verbose(V_Warning,'Compiler version too high '+CompilerVersion+' > '+Config.MaxVersion);
  1780. Res:=false;
  1781. end;
  1782. end;
  1783. end;
  1784. if Res then
  1785. begin
  1786. if Config.NeedCPU<>'' then
  1787. begin
  1788. Verbose(V_Debug,'Required compiler cpu: '+Config.NeedCPU);
  1789. if not IsInList(CompilerCPU,Config.NeedCPU) then
  1790. begin
  1791. { avoid a second attempt by writing to elg file }
  1792. AddLog(EXELogFile,skipping_other_cpu+PPFileInfo[current]);
  1793. AddLog(ResLogFile,skipping_other_cpu+PPFileInfo[current]);
  1794. Verbose(V_Warning,'Compiler cpu "'+CompilerCPU+'" is not in list "'+Config.NeedCPU+'"');
  1795. Res:=false;
  1796. end;
  1797. end;
  1798. end;
  1799. if Res then
  1800. begin
  1801. if Config.SkipCPU<>'' then
  1802. begin
  1803. Verbose(V_Debug,'Skip compiler cpu: '+Config.SkipCPU);
  1804. if IsInList(CompilerCPU,Config.SkipCPU) then
  1805. begin
  1806. { avoid a second attempt by writing to elg file }
  1807. AddLog(EXELogFile,skipping_other_cpu+PPFileInfo[current]);
  1808. AddLog(ResLogFile,skipping_other_cpu+PPFileInfo[current]);
  1809. Verbose(V_Warning,'Compiler cpu "'+CompilerCPU+'" is in list "'+Config.SkipCPU+'"');
  1810. Res:=false;
  1811. end;
  1812. end;
  1813. end;
  1814. if Res then
  1815. begin
  1816. if Config.SkipEmu<>'' then
  1817. begin
  1818. Verbose(V_Debug,'Skip emulator: '+emulatorname);
  1819. if IsInList(emulatorname,Config.SkipEmu) then
  1820. begin
  1821. { avoid a second attempt by writing to elg file }
  1822. AddLog(EXELogFile,skipping_other_cpu+PPFileInfo[current]);
  1823. AddLog(ResLogFile,skipping_other_cpu+PPFileInfo[current]);
  1824. Verbose(V_Warning,'Emulator "'+emulatorname+'" is in list "'+Config.SkipEmu+'"');
  1825. Res:=false;
  1826. end;
  1827. end;
  1828. end;
  1829. if Res then
  1830. begin
  1831. if Config.NeedTarget<>'' then
  1832. begin
  1833. Verbose(V_Debug,'Required compiler target: '+Config.NeedTarget);
  1834. if not IsInList(CompilerTarget,Config.NeedTarget) then
  1835. begin
  1836. { avoid a second attempt by writing to elg file }
  1837. AddLog(EXELogFile,skipping_other_target+PPFileInfo[current]);
  1838. AddLog(ResLogFile,skipping_other_target+PPFileInfo[current]);
  1839. Verbose(V_Warning,'Compiler target "'+CompilerTarget+'" is not in list "'+Config.NeedTarget+'"');
  1840. Res:=false;
  1841. end;
  1842. end;
  1843. end;
  1844. if Res then
  1845. begin
  1846. if Config.SkipTarget<>'' then
  1847. begin
  1848. Verbose(V_Debug,'Skip compiler target: '+Config.SkipTarget);
  1849. if IsInList(CompilerTarget,Config.SkipTarget) then
  1850. begin
  1851. { avoid a second attempt by writing to elg file }
  1852. AddLog(EXELogFile,skipping_other_target+PPFileInfo[current]);
  1853. AddLog(ResLogFile,skipping_other_target+PPFileInfo[current]);
  1854. Verbose(V_Warning,'Compiler target "'+CompilerTarget+'" is in list "'+Config.SkipTarget+'"');
  1855. Res:=false;
  1856. end;
  1857. end;
  1858. end;
  1859. if Res then
  1860. begin
  1861. { Use known bug, to avoid adding a new entry for this PM 2011-06-24 }
  1862. if Config.NeedLibrary and not TargetCanCompileLibraries then
  1863. begin
  1864. AddLog(EXELogFile,skipping_known_bug+PPFileInfo[current]);
  1865. AddLog(ResLogFile,skipping_known_bug+PPFileInfo[current]);
  1866. Verbose(V_Warning,'Compiler target "'+CompilerTarget+'" does not support library compilation');
  1867. Res:=false;
  1868. end;
  1869. end;
  1870. if Res then
  1871. begin
  1872. Res:=RunCompiler('');
  1873. if Res and Config.NeedRecompile then
  1874. Res:=RunCompiler(Config.RecompileOpt);
  1875. end;
  1876. if Res and (not Config.ShouldFail) then
  1877. begin
  1878. if (Config.NoRun) then
  1879. begin
  1880. { avoid a second attempt by writing to elg file }
  1881. AddLog(EXELogFile,skipping_run_test+PPFileInfo[current]);
  1882. AddLog(ResLogFile,skipping_run_test+PPFileInfo[current]);
  1883. Verbose(V_Debug,skipping_run_test);
  1884. if LibraryExists(PPFile[current],LibraryName) then
  1885. MaybeCopyFiles(LibraryName);
  1886. end
  1887. else if Config.IsKnownRunError and (not DoKnown) then
  1888. begin
  1889. { avoid a second attempt by writing to elg file }
  1890. AddLog(EXELogFile,skipping_known_bug+PPFileInfo[current]);
  1891. AddLog(ResLogFile,skipping_known_bug+PPFileInfo[current]);
  1892. Verbose(V_Warning,skipping_known_bug);
  1893. end
  1894. else
  1895. begin
  1896. if DoExecute then
  1897. begin
  1898. if FileExists(TestOutputFilename('',PPFile[current],'ppu')) or
  1899. FileExists(TestOutputFilename('',PPFile[current],'ppo')) or
  1900. FileExists(TestOutputFilename('',PPFile[current],'ppw')) then
  1901. begin
  1902. AddLog(ExeLogFile,skipping_run_unit+PPFileInfo[current]);
  1903. AddLog(ResLogFile,skipping_run_unit+PPFileInfo[current]);
  1904. Verbose(V_Debug,'Unit found, skipping run test')
  1905. end
  1906. else if LibraryExists(PPFile[current],LibraryName) then
  1907. begin
  1908. Verbose(V_Debug,'Library found, skipping run test');
  1909. MaybeCopyFiles(LibraryName);
  1910. end
  1911. else
  1912. Res:=RunExecutable;
  1913. end;
  1914. end;
  1915. end;
  1916. end;
  1917. begin
  1918. Current:=0;
  1919. PPFile:=TStringList.Create;
  1920. PPFile.Capacity:=10;
  1921. PPFileInfo:=TStringList.Create;
  1922. PPFileInfo.Capacity:=10;
  1923. GetArgs;
  1924. SetTargetDirectoriesStyle;
  1925. SetTargetCanCompileLibraries;
  1926. SetRemoteConfiguration;
  1927. {$ifdef LIMIT83fs}
  1928. UseOSOnly:=true;
  1929. {$else not LIMIT83fs}
  1930. SetUseOSOnly;
  1931. {$endif not LIMIT83fs}
  1932. Verbose(V_Debug,'Found '+ToStr(PPFile.Count)+' tests to run');
  1933. if current>0 then
  1934. for current:=0 to PPFile.Count-1 do
  1935. begin
  1936. SetPPFileInfo;
  1937. TestName:=Copy(PPFile[current],1,Pos('.pp',PPFile[current])-1);
  1938. Verbose(V_Normal,'Running test '+TestName+', file '+PPFile[current]);
  1939. RunTest;
  1940. end;
  1941. PPFile.Free;
  1942. PPFileInfo.Free;
  1943. end.