dotest.pp 39 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443
  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. {$H+}
  13. {$goto on}
  14. program dotest;
  15. uses
  16. dos,
  17. {$ifdef macos}
  18. macutils,
  19. {$endif}
  20. teststr,
  21. testu,
  22. redir,
  23. bench,
  24. classes;
  25. {$ifdef go32v2}
  26. {$define LIMIT83FS}
  27. {$endif}
  28. {$ifdef os2}
  29. {$define LIMIT83FS}
  30. {$endif}
  31. type
  32. tcompinfo = (compver,comptarget,compcpu);
  33. tdelexecutable = (deBefore, deAfter);
  34. tdelexecutables = set of tdelexecutable;
  35. const
  36. ObjExt='o';
  37. PPUExt='ppu';
  38. {$ifdef UNIX}
  39. ExeExt='';
  40. {$else UNIX}
  41. {$ifdef MACOS}
  42. ExeExt='';
  43. {$else MACOS}
  44. ExeExt='exe';
  45. {$endif MACOS}
  46. {$endif UNIX}
  47. DefaultTimeout=60;
  48. var
  49. Config : TConfig;
  50. CompilerLogFile,
  51. ExeLogFile,
  52. LongLogfile,
  53. FailLogfile,
  54. RTLUnitsDir,
  55. TestOutputDir,
  56. OutputDir : string;
  57. CompilerBin,
  58. CompilerCPU,
  59. CompilerTarget,
  60. CompilerVersion,
  61. DefaultCompilerCPU,
  62. DefaultCompilerTarget,
  63. DefaultCompilerVersion : string;
  64. PPFile : TStringList;
  65. PPFileInfo : TStringList;
  66. TestName : string;
  67. Current : longint;
  68. const
  69. DoGraph : boolean = false;
  70. DoInteractive : boolean = false;
  71. DoExecute : boolean = false;
  72. DoKnown : boolean = false;
  73. DoAll : boolean = false;
  74. DoUsual : boolean = true;
  75. TargetDir : string = '';
  76. BenchmarkInfo : boolean = false;
  77. ExtraCompilerOpts : string = '';
  78. DelExecutable : TDelExecutables = [];
  79. RemoteAddr : string = '';
  80. RemotePath : string = '/tmp';
  81. RemotePara : string = '';
  82. rshprog : string = 'rsh';
  83. rcpprog : string = 'rcp';
  84. rquote : char = '''';
  85. UseTimeout : boolean = false;
  86. emulatorname : string = '';
  87. { Constants used in IsAbsolute function }
  88. TargetHasDosStyleDirectories : boolean = false;
  89. TargetAmigaLike : boolean = false;
  90. TargetIsMacOS : boolean = false;
  91. { Set the three constants above according to
  92. the current target }
  93. procedure SetTargetDirectoriesStyle;
  94. var
  95. LTarget : string;
  96. begin
  97. LTarget := lowercase(CompilerTarget);
  98. TargetHasDosStyleDirectories :=
  99. (LTarget='go32v2') or
  100. (LTarget='win32') or
  101. (LTarget='win64') or
  102. (LTarget='watcom') or
  103. (LTarget='os2');
  104. TargetAmigaLike:=
  105. (LTarget='amiga') or
  106. (LTarget='morphos');
  107. TargetIsMacOS:=
  108. (LTarget='macos');
  109. end;
  110. { extracted from rtl/macos/macutils.inc }
  111. function IsMacFullPath (const path: string): Boolean;
  112. begin
  113. if Pos(':', path) = 0 then {its partial}
  114. IsMacFullPath := false
  115. else if path[1] = ':' then
  116. IsMacFullPath := false
  117. else
  118. IsMacFullPath := true
  119. end;
  120. Function IsAbsolute (Const F : String) : boolean;
  121. {
  122. Returns True if the name F is a absolute file name
  123. }
  124. begin
  125. IsAbsolute:=false;
  126. if TargetHasDosStyleDirectories then
  127. begin
  128. if (F[1]='/') or (F[1]='\') then
  129. IsAbsolute:=true;
  130. if (Length(F)>2) and (F[2]=':') and ((F[3]='\') or (F[3]='/')) then
  131. IsAbsolute:=true;
  132. end
  133. else if TargetAmigaLike then
  134. begin
  135. if (length(F)>0) and (Pos(':',F) <> 0) then
  136. IsAbsolute:=true;
  137. end
  138. else if TargetIsMacOS then
  139. begin
  140. IsAbsolute:=IsMacFullPath(F);
  141. end
  142. { generic case }
  143. else if (F[1]='/') then
  144. IsAbsolute:=true;
  145. end;
  146. Function FileExists (Const F : String) : Boolean;
  147. {
  148. Returns True if the file exists, False if not.
  149. }
  150. Var
  151. info : searchrec;
  152. begin
  153. FindFirst (F,anyfile,Info);
  154. FileExists:=DosError=0;
  155. FindClose (Info);
  156. end;
  157. Function PathExists (Const F : String) : Boolean;
  158. {
  159. Returns True if the file exists, False if not.
  160. }
  161. Var
  162. info : searchrec;
  163. begin
  164. FindFirst (F,anyfile,Info);
  165. PathExists:=(DosError=0) and (Info.Attr and Directory=Directory);
  166. FindClose (Info);
  167. end;
  168. function ToStr(l:longint):string;
  169. var
  170. s : string;
  171. begin
  172. Str(l,s);
  173. ToStr:=s;
  174. end;
  175. function ToStrZero(l:longint;nbzero : byte):string;
  176. var
  177. s : string;
  178. begin
  179. Str(l,s);
  180. while length(s)<nbzero do
  181. s:='0'+s;
  182. ToStrZero:=s;
  183. end;
  184. function trimspace(const s:string):string;
  185. var
  186. i,j : longint;
  187. begin
  188. i:=length(s);
  189. while (i>0) and (s[i] in [#9,' ']) do
  190. dec(i);
  191. j:=1;
  192. while (j<i) and (s[j] in [#9,' ']) do
  193. inc(j);
  194. trimspace:=Copy(s,j,i-j+1);
  195. end;
  196. function IsInList(const entry,list:string):boolean;
  197. var
  198. i,istart : longint;
  199. begin
  200. IsInList:=false;
  201. i:=0;
  202. while (i<length(list)) do
  203. begin
  204. { Find list item }
  205. istart:=i+1;
  206. while (i<length(list)) and
  207. (list[i+1]<>',') do
  208. inc(i);
  209. if Upcase(entry)=Upcase(TrimSpace(Copy(list,istart,i-istart+1))) then
  210. begin
  211. IsInList:=true;
  212. exit;
  213. end;
  214. { skip , }
  215. inc(i);
  216. end;
  217. end;
  218. procedure SetPPFileInfo;
  219. Var
  220. info : searchrec;
  221. dt : DateTime;
  222. begin
  223. FindFirst (PPFile[current],anyfile,Info);
  224. If DosError=0 then
  225. begin
  226. UnpackTime(info.time,dt);
  227. PPFileInfo.Insert(current,PPFile[current]+' '+ToStr(dt.year)+'/'+ToStrZero(dt.month,2)+'/'+
  228. ToStrZero(dt.day,2)+' '+ToStrZero(dt.Hour,2)+':'+ToStrZero(dt.min,2)+':'+ToStrZero(dt.sec,2));
  229. end
  230. else
  231. PPFileInfo.Insert(current,PPFile[current]);
  232. FindClose (Info);
  233. end;
  234. function SplitPath(const s:string):string;
  235. var
  236. i : longint;
  237. begin
  238. i:=Length(s);
  239. while (i>0) and not(s[i] in ['/','\'{$IFDEF MACOS},':'{$ENDIF}]) do
  240. dec(i);
  241. SplitPath:=Copy(s,1,i);
  242. end;
  243. Function SplitFileName(const s:string):string;
  244. var
  245. p : dirstr;
  246. n : namestr;
  247. e : extstr;
  248. begin
  249. FSplit(s,p,n,e);
  250. SplitFileName:=n+e;
  251. end;
  252. function ForceExtension(Const HStr,ext:String):String;
  253. {
  254. Return a filename which certainly has the extension ext
  255. }
  256. var
  257. j : longint;
  258. begin
  259. j:=length(Hstr);
  260. while (j>0) and (Hstr[j]<>'.') do
  261. dec(j);
  262. if j=0 then
  263. j:=255;
  264. if Ext<>'' then
  265. ForceExtension:=Copy(Hstr,1,j-1)+'.'+Ext
  266. else
  267. ForceExtension:=Copy(Hstr,1,j-1);
  268. end;
  269. procedure mkdirtree(const s:string);
  270. var
  271. hs : string;
  272. begin
  273. if s='' then
  274. exit;
  275. if s[length(s)] in ['\','/'{$IFDEF MACOS},':'{$ENDIF}] then
  276. hs:=Copy(s,1,length(s)-1)
  277. else
  278. hs:=s;
  279. if not PathExists(hs) then
  280. begin
  281. { Try parent first }
  282. mkdirtree(SplitPath(hs));
  283. { make this dir }
  284. Verbose(V_Debug,'Making Directory '+s);
  285. {$I-}
  286. mkdir(s);
  287. {$I+}
  288. ioresult;
  289. end;
  290. end;
  291. Function RemoveFile(const f:string):boolean;
  292. var
  293. g : file;
  294. begin
  295. assign(g,f);
  296. {$I-}
  297. erase(g);
  298. {$I+}
  299. RemoveFile:=(ioresult=0);
  300. end;
  301. function Copyfile(const fn1,fn2:string;append:boolean) : longint;
  302. const
  303. bufsize = 16384;
  304. var
  305. f,g : file;
  306. addsize,
  307. i : longint;
  308. buf : pointer;
  309. begin
  310. if Append then
  311. Verbose(V_Debug,'Appending '+fn1+' to '+fn2)
  312. else
  313. Verbose(V_Debug,'Copying '+fn1+' to '+fn2);
  314. assign(f,fn1);
  315. assign(g,fn2);
  316. {$I-}
  317. reset(f,1);
  318. {$I+}
  319. addsize:=0;
  320. if ioresult<>0 then
  321. Verbose(V_Error,'Can''t open '+fn1);
  322. if append then
  323. begin
  324. {$I-}
  325. reset(g,1);
  326. {$I+}
  327. if ioresult<>0 then
  328. append:=false
  329. else
  330. seek(g,filesize(g));
  331. end;
  332. if not append then
  333. begin
  334. {$I-}
  335. rewrite(g,1);
  336. {$I+}
  337. if ioresult<>0 then
  338. Verbose(V_Error,'Can''t open '+fn2+' for output');
  339. end;
  340. getmem(buf,bufsize);
  341. repeat
  342. blockread(f,buf^,bufsize,i);
  343. blockwrite(g,buf^,i);
  344. addsize:=addsize+i;
  345. until i<bufsize;
  346. freemem(buf,bufsize);
  347. close(f);
  348. close(g);
  349. CopyFile:=addsize;
  350. end;
  351. procedure AddLog(const logfile,s:string);
  352. var
  353. t : text;
  354. begin
  355. assign(t,logfile);
  356. {$I-}
  357. append(t);
  358. {$I+}
  359. if ioresult<>0 then
  360. begin
  361. {$I-}
  362. rewrite(t);
  363. {$I+}
  364. if ioresult<>0 then
  365. Verbose(V_Abort,'Can''t append to '+logfile);
  366. end;
  367. writeln(t,s);
  368. close(t);
  369. end;
  370. function GetCompilerInfo(c:tcompinfo):boolean;
  371. function GetToken(var s:string):string;
  372. var
  373. i : longint;
  374. begin
  375. i:=pos(' ',s);
  376. if i=0 then
  377. i:=length(s)+1;
  378. GetToken:=Copy(s,1,i-1);
  379. Delete(s,1,i);
  380. end;
  381. var
  382. t : text;
  383. hs : string;
  384. begin
  385. GetCompilerInfo:=false;
  386. { Try to get all information in one call, this is
  387. supported in 1.1. Older compilers 1.0.x will only
  388. return the first info }
  389. case c of
  390. compver :
  391. begin
  392. if DefaultCompilerVersion<>'' then
  393. begin
  394. GetCompilerInfo:=true;
  395. exit;
  396. end;
  397. hs:='-iVTPTO';
  398. end;
  399. compcpu :
  400. begin
  401. if DefaultCompilerCPU<>'' then
  402. begin
  403. GetCompilerInfo:=true;
  404. exit;
  405. end;
  406. hs:='-iTPTOV';
  407. end;
  408. comptarget :
  409. begin
  410. if DefaultCompilerTarget<>'' then
  411. begin
  412. GetCompilerInfo:=true;
  413. exit;
  414. end;
  415. hs:='-iTOTPV';
  416. end;
  417. end;
  418. ExecuteRedir(CompilerBin,hs,'','out','');
  419. assign(t,'out');
  420. {$I-}
  421. reset(t);
  422. readln(t,hs);
  423. close(t);
  424. erase(t);
  425. {$I+}
  426. if ioresult<>0 then
  427. Verbose(V_Error,'Can''t get Compiler Info')
  428. else
  429. begin
  430. Verbose(V_Debug,'Retrieved Compiler Info: "'+hs+'"');
  431. case c of
  432. compver :
  433. begin
  434. DefaultCompilerVersion:=GetToken(hs);
  435. DefaultCompilerCPU:=GetToken(hs);
  436. DefaultCompilerTarget:=GetToken(hs);
  437. end;
  438. compcpu :
  439. begin
  440. DefaultCompilerCPU:=GetToken(hs);
  441. DefaultCompilerTarget:=GetToken(hs);
  442. DefaultCompilerVersion:=GetToken(hs);
  443. end;
  444. comptarget :
  445. begin
  446. DefaultCompilerTarget:=GetToken(hs);
  447. DefaultCompilerCPU:=GetToken(hs);
  448. DefaultCompilerVersion:=GetToken(hs);
  449. end;
  450. end;
  451. GetCompilerInfo:=true;
  452. end;
  453. end;
  454. function GetCompilerVersion:boolean;
  455. begin
  456. if CompilerVersion='' then
  457. begin
  458. GetCompilerVersion:=GetCompilerInfo(compver);
  459. CompilerVersion:=DefaultCompilerVersion;
  460. end
  461. else
  462. GetCompilerVersion:=true;
  463. if GetCompilerVersion then
  464. Verbose(V_Debug,'Compiler Version: "'+CompilerVersion+'"');
  465. end;
  466. function GetCompilerCPU:boolean;
  467. begin
  468. if CompilerCPU='' then
  469. begin
  470. GetCompilerCPU:=GetCompilerInfo(compcpu);
  471. CompilerCPU:=DefaultCompilerCPU;
  472. end
  473. else
  474. GetCompilerCPU:=true;
  475. if GetCompilerCPU then
  476. Verbose(V_Debug,'Compiler CPU: "'+CompilerCPU+'"');
  477. end;
  478. function GetCompilerTarget:boolean;
  479. begin
  480. if CompilerTarget='' then
  481. begin
  482. GetCompilerTarget:=GetCompilerInfo(comptarget);
  483. CompilerTarget:=DefaultCompilerTarget;
  484. end
  485. else
  486. GetCompilerTarget:=true;
  487. if GetCompilerTarget then
  488. Verbose(V_Debug,'Compiler Target: "'+CompilerTarget+'"');
  489. end;
  490. function CompilerFullTarget:string;
  491. begin
  492. CompilerFullTarget:=CompilerCPU+'-'+CompilerTarget;
  493. end;
  494. function OutputFileName(Const s,ext:String):String;
  495. begin
  496. {$ifndef macos}
  497. OutputFileName:=OutputDir+'/'+ForceExtension(s,ext);
  498. {$else macos}
  499. OutputFileName:=ConcatMacPath(OutputDir,ForceExtension(s,ext));
  500. {$endif macos}
  501. end;
  502. function TestOutputFileName(Const s,ext:String):String;
  503. begin
  504. {$ifndef macos}
  505. TestOutputFileName:=TestOutputDir+'/'+ForceExtension(SplitFileName(s),ext);
  506. {$else macos}
  507. TestOutputFileName:=ConcatMacPath(TestOutputDir,ForceExtension(SplitFileName(s),ext));
  508. {$endif macos}
  509. end;
  510. function ExitWithInternalError(const OutName:string):boolean;
  511. var
  512. t : text;
  513. s : string;
  514. begin
  515. ExitWithInternalError:=false;
  516. { open logfile }
  517. assign(t,Outname);
  518. {$I-}
  519. reset(t);
  520. {$I+}
  521. if ioresult<>0 then
  522. exit;
  523. while not eof(t) do
  524. begin
  525. readln(t,s);
  526. if pos('Fatal: Internal error ',s)>0 then
  527. begin
  528. ExitWithInternalError:=true;
  529. break;
  530. end;
  531. end;
  532. close(t);
  533. end;
  534. function RunCompiler:boolean;
  535. var
  536. args,
  537. wpoargs : string;
  538. passnr,
  539. passes : longint;
  540. execres : boolean;
  541. EndTicks,
  542. StartTicks : int64;
  543. begin
  544. RunCompiler:=false;
  545. args:='-n -T'+CompilerTarget+' -Fu'+RTLUnitsDir;
  546. args:=args+' -FE'+TestOutputDir;
  547. {$ifdef macos}
  548. args:=args+' -WT '; {tests should be compiled as MPWTool}
  549. {$endif macos}
  550. if ExtraCompilerOpts<>'' then
  551. args:=args+ExtraCompilerOpts;
  552. {$ifdef unix}
  553. { Add runtime library path to current dir to find .so files }
  554. if Config.NeedLibrary then
  555. {$ifndef darwin}
  556. args:=args+' -Fl'+TestOutputDir+' ''-k-rpath .''';
  557. {$else darwin}
  558. args:=args+' -Fl'+TestOutputDir;
  559. {$endif darwin}
  560. {$endif unix}
  561. if Config.NeedOptions<>'' then
  562. args:=args+' '+Config.NeedOptions;
  563. wpoargs:='';
  564. if (Config.WpoPasses=0) or
  565. (Config.WpoParas='') then
  566. passes:=1
  567. else
  568. passes:=config.wpopasses+1;
  569. args:=args+' '+PPFile[current];
  570. for passnr:=1 to passes do
  571. begin
  572. if (passes>1) then
  573. begin
  574. wpoargs:=' -OW'+config.wpoparas+' -FW'+TestOutputFileName(PPFile[current],'wp'+tostr(passnr));
  575. if (passnr>1) then
  576. wpoargs:=wpoargs+' -Ow'+config.wpoparas+' -Fw'+TestOutputFileName(PPFile[current],'wp'+tostr(passnr-1));
  577. end;
  578. Verbose(V_Debug,'Executing '+compilerbin+' '+args+wpoargs);
  579. { also get the output from as and ld that writes to stderr sometimes }
  580. StartTicks:=GetMicroSTicks;
  581. {$ifndef macos}
  582. execres:=ExecuteRedir(CompilerBin,args+wpoargs,'',CompilerLogFile,'stdout');
  583. {$else macos}
  584. {Due to that Toolserver is not reentrant, we have to asm and link via script.}
  585. execres:=ExecuteRedir(CompilerBin,'-s '+args+wpoargs,'',CompilerLogFile,'stdout');
  586. if execres then
  587. execres:=ExecuteRedir(TestOutputDir + ':ppas','','',CompilerLogFile,'stdout');
  588. {$endif macos}
  589. EndTicks:=GetMicroSTicks;
  590. Verbose(V_Debug,'Exitcode '+ToStr(ExecuteResult));
  591. if BenchmarkInfo then
  592. begin
  593. Verbose(V_Normal,'Compilation took '+ToStr(EndTicks-StartTicks)+' us');
  594. end;
  595. { Error during execution? }
  596. if (not execres) and (ExecuteResult=0) then
  597. begin
  598. AddLog(FailLogFile,TestName);
  599. AddLog(ResLogFile,failed_to_compile+PPFileInfo[current]);
  600. AddLog(LongLogFile,line_separation);
  601. AddLog(LongLogFile,failed_to_compile+PPFileInfo[current]);
  602. if CopyFile(CompilerLogFile,LongLogFile,true)=0 then
  603. AddLog(LongLogFile,'IOStatus'+ToStr(IOStatus));
  604. { avoid to try again }
  605. AddLog(ExeLogFile,failed_to_compile+PPFileInfo[current]);
  606. Verbose(V_Warning,'IOStatus: '+ToStr(IOStatus));
  607. exit;
  608. end;
  609. { Check for internal error }
  610. if ExitWithInternalError(CompilerLogFile) then
  611. begin
  612. AddLog(FailLogFile,TestName);
  613. if Config.Note<>'' then
  614. AddLog(FailLogFile,Config.Note);
  615. AddLog(ResLogFile,failed_to_compile+PPFileInfo[current]+' internalerror generated');
  616. AddLog(LongLogFile,line_separation);
  617. AddLog(LongLogFile,failed_to_compile+PPFileInfo[current]);
  618. if Config.Note<>'' then
  619. AddLog(LongLogFile,Config.Note);
  620. if CopyFile(CompilerLogFile,LongLogFile,true)=0 then
  621. AddLog(LongLogFile,'Internal error in compiler');
  622. { avoid to try again }
  623. AddLog(ExeLogFile,'Failed to compile '+PPFileInfo[current]);
  624. Verbose(V_Warning,'Internal error in compiler');
  625. exit;
  626. end;
  627. end;
  628. { Should the compile fail ? }
  629. if Config.ShouldFail then
  630. begin
  631. if ExecuteResult<>0 then
  632. begin
  633. AddLog(ResLogFile,success_compilation_failed+PPFileInfo[current]);
  634. { avoid to try again }
  635. AddLog(ExeLogFile,success_compilation_failed+PPFileInfo[current]);
  636. RunCompiler:=true;
  637. end
  638. else
  639. begin
  640. AddLog(FailLogFile,TestName);
  641. if Config.Note<>'' then
  642. AddLog(FailLogFile,Config.Note);
  643. AddLog(ResLogFile,failed_compilation_successful+PPFileInfo[current]);
  644. AddLog(LongLogFile,line_separation);
  645. AddLog(LongLogFile,failed_compilation_successful+PPFileInfo[current]);
  646. { avoid to try again }
  647. AddLog(ExeLogFile,failed_compilation_successful+PPFileInfo[current]);
  648. if Config.Note<>'' then
  649. AddLog(LongLogFile,Config.Note);
  650. CopyFile(CompilerLogFile,LongLogFile,true);
  651. end;
  652. end
  653. else
  654. begin
  655. if (ExecuteResult<>0) and
  656. (((Config.KnownCompileNote<>'') and (Config.KnownCompileError=0)) or
  657. ((Config.KnownCompileError<>0) and (ExecuteResult=Config.KnownCompileError))) then
  658. begin
  659. AddLog(FailLogFile,TestName+known_problem+Config.KnownCompileNote);
  660. AddLog(ResLogFile,failed_to_run+PPFileInfo[current]+known_problem+Config.KnownCompileNote);
  661. AddLog(LongLogFile,line_separation);
  662. AddLog(LongLogFile,known_problem+Config.KnownCompileNote);
  663. AddLog(LongLogFile,failed_to_compile+PPFileInfo[current]+' ('+ToStr(ExecuteResult)+')');
  664. if Copyfile(CompilerLogFile,LongLogFile,true)=0 then
  665. AddLog(LongLogFile,known_problem+'exitcode: '+ToStr(ExecuteResult));
  666. Verbose(V_Warning,known_problem+'exitcode: '+ToStr(ExecuteResult));
  667. end
  668. else if ExecuteResult<>0 then
  669. begin
  670. AddLog(FailLogFile,TestName);
  671. if Config.Note<>'' then
  672. AddLog(FailLogFile,Config.Note);
  673. AddLog(ResLogFile,failed_to_compile+PPFileInfo[current]);
  674. AddLog(LongLogFile,line_separation);
  675. AddLog(LongLogFile,failed_to_compile+PPFileInfo[current]);
  676. if Config.Note<>'' then
  677. AddLog(LongLogFile,Config.Note);
  678. if CopyFile(CompilerLogFile,LongLogFile,true)=0 then
  679. AddLog(LongLogFile,'Exitcode: '+ToStr(ExecuteResult)+' (expected 0)');
  680. { avoid to try again }
  681. AddLog(ExeLogFile,failed_to_compile+PPFileInfo[current]);
  682. Verbose(V_Warning,'Exitcode: '+ToStr(ExecuteResult)+' (expected 0)');
  683. end
  684. else
  685. begin
  686. AddLog(ResLogFile,successfully_compiled+PPFileInfo[current]);
  687. RunCompiler:=true;
  688. end;
  689. end;
  690. end;
  691. function CheckTestExitCode(const OutName:string):boolean;
  692. var
  693. t : text;
  694. s : string;
  695. i,code : integer;
  696. begin
  697. CheckTestExitCode:=false;
  698. { open logfile }
  699. assign(t,Outname);
  700. {$I-}
  701. reset(t);
  702. {$I+}
  703. if ioresult<>0 then
  704. exit;
  705. while not eof(t) do
  706. begin
  707. readln(t,s);
  708. i:=pos('TestExitCode: ',s);
  709. if i>0 then
  710. begin
  711. delete(s,1,i+14-1);
  712. val(s,ExecuteResult,code);
  713. if code=0 then;
  714. CheckTestExitCode:=true;
  715. break;
  716. end;
  717. end;
  718. close(t);
  719. end;
  720. function RunExecutable:boolean;
  721. const
  722. MaxTrials = 5;
  723. {$ifdef unix}
  724. CurrDir = './';
  725. {$else}
  726. CurrDir = '';
  727. {$endif}
  728. var
  729. s,
  730. OldDir,
  731. FullExeLogFile,
  732. TestRemoteExe,
  733. TestExe : string;
  734. LocalFile, RemoteFile: string;
  735. LocalPath: string;
  736. execcmd,
  737. pref : string;
  738. execres : boolean;
  739. index : integer;
  740. EndTicks,
  741. StartTicks : int64;
  742. function ExecuteRemote(const prog,args:string):boolean;
  743. var
  744. Trials : longint;
  745. begin
  746. Verbose(V_Debug,'RemoteExecuting '+Prog+' '+args);
  747. StartTicks:=GetMicroSTicks;
  748. ExecuteRemote:=false;
  749. Trials:=0;
  750. While (Trials<MaxTrials) and not ExecuteRemote do
  751. begin
  752. inc(Trials);
  753. ExecuteRemote:=ExecuteRedir(prog,args,'',EXELogFile,'stdout');
  754. end;
  755. if Trials>1 then
  756. Verbose(V_Debug,'Done in '+tostr(trials)+' trials');
  757. EndTicks:=GetMicroSTicks;
  758. end;
  759. function ExecuteEmulated(const prog,args:string):boolean;
  760. begin
  761. Verbose(V_Debug,'EmulatorExecuting '+Prog+' '+args);
  762. StartTicks:=GetMicroSTicks;
  763. ExecuteEmulated:=ExecuteRedir(prog,args,'',FullExeLogFile,'stdout');
  764. EndTicks:=GetMicroSTicks;
  765. end;
  766. label
  767. done;
  768. begin
  769. RunExecutable:=false;
  770. execres:=true;
  771. { when remote testing, leave extension away }
  772. if (RemoteAddr='') or (rcpprog='pscp') then
  773. TestExe:=OutputFileName(PPFile[current],ExeExt)
  774. else
  775. TestExe:=OutputFileName(PPFile[current],'');
  776. if EmulatorName<>'' then
  777. begin
  778. { Get full name out log file, because we change the directory during
  779. execution }
  780. FullExeLogFile:=FExpand(EXELogFile);
  781. {$I-}
  782. GetDir(0,OldDir);
  783. ChDir(TestOutputDir);
  784. {$I+}
  785. ioresult;
  786. s:=CurrDir+SplitFileName(TestExe);
  787. execres:=ExecuteEmulated(EmulatorName,s);
  788. {$I-}
  789. ChDir(OldDir);
  790. {$I+}
  791. end
  792. else if RemoteAddr<>'' then
  793. begin
  794. { We don't want to create subdirs, remove paths from the test }
  795. TestRemoteExe:=RemotePath+'/'+SplitFileName(TestExe);
  796. if deBefore in DelExecutable then
  797. ExecuteRemote(rshprog,RemotePara+' '+RemoteAddr+' rm -f '+TestRemoteExe);
  798. execres:=ExecuteRemote(rcpprog,RemotePara+' '+TestExe+' '+RemoteAddr+':'+TestRemoteExe);
  799. if not execres then
  800. begin
  801. Verbose(V_normal, 'Could not copy executable '+TestExe);
  802. goto done;
  803. end;
  804. s:=Config.Files;
  805. if length(s) > 0 then
  806. begin
  807. LocalPath:=SplitPath(PPFile[current]);
  808. if Length(LocalPath) > 0 then
  809. LocalPath:=LocalPath+'/';
  810. repeat
  811. index:=pos(' ',s);
  812. if index=0 then
  813. LocalFile:=s
  814. else
  815. LocalFile:=copy(s,1,index-1);
  816. RemoteFile:=RemotePath+'/'+SplitFileName(LocalFile);
  817. LocalFile:=LocalPath+LocalFile;
  818. if DoVerbose and (rcpprog='pscp') then
  819. pref:='-v '
  820. else
  821. pref:='';
  822. execres:=ExecuteRemote(rcpprog,pref+RemotePara+' '+LocalFile+' '+RemoteAddr+':'+RemoteFile);
  823. if not execres then
  824. begin
  825. Verbose(V_normal, 'Could not copy required file '+LocalFile);
  826. goto done;
  827. end;
  828. if index=0 then
  829. break;
  830. s:=copy(s,index+1,length(s)-index);
  831. until false;
  832. end;
  833. { rsh doesn't pass the exitcode, use a second command to print the exitcode
  834. on the remoteshell to stdout }
  835. if DoVerbose and (rshprog='plink') then
  836. execcmd:='-v '
  837. else
  838. execcmd:='';
  839. execcmd:=execcmd+RemotePara+' '+RemoteAddr+' '+rquote+
  840. 'chmod 755 '+TestRemoteExe+' ; ';
  841. // ' ; cd '+RemotePath+' ;'; incompatible with directory
  842. // present on TestRemoteExe
  843. if UseTimeout then
  844. begin
  845. execcmd:=execcmd+'timeout -9 ';
  846. if Config.Timeout=0 then
  847. Config.Timeout:=DefaultTimeout;
  848. str(Config.Timeout,s);
  849. execcmd:=execcmd+s;
  850. end;
  851. if not isabsolute(TestRemoteExe) then
  852. execcmd:=execcmd+' ./'+TestRemoteExe
  853. else
  854. execcmd:=execcmd+' '+TestRemoteExe;
  855. execcmd:=execcmd+' ; echo "TestExitCode: $?"';
  856. if (deAfter in DelExecutable) and
  857. not Config.NeededAfter then
  858. execcmd:=execcmd+' ; rm -f '+TestRemoteExe;
  859. execcmd:=execcmd+rquote;
  860. execres:=ExecuteRemote(rshprog,execcmd);
  861. { Check for TestExitCode error in output, sets ExecuteResult }
  862. CheckTestExitCode(EXELogFile);
  863. end
  864. else
  865. begin
  866. { Get full name out log file, because we change the directory during
  867. execution }
  868. FullExeLogFile:=FExpand(EXELogFile);
  869. Verbose(V_Debug,'Executing '+TestExe);
  870. {$I-}
  871. GetDir(0,OldDir);
  872. ChDir(TestOutputDir);
  873. {$I+}
  874. ioresult;
  875. { don't redirect interactive and graph programs }
  876. StartTicks:=GetMicroSTicks;
  877. if Config.IsInteractive or Config.UsesGraph then
  878. execres:=ExecuteRedir(CurrDir+SplitFileName(TestExe),'','','','')
  879. else
  880. execres:=ExecuteRedir(CurrDir+SplitFileName(TestExe),'','',FullExeLogFile,'stdout');
  881. EndTicks:=GetMicroSTicks;
  882. {$I-}
  883. ChDir(OldDir);
  884. {$I+}
  885. ioresult;
  886. end;
  887. { Error during execution? }
  888. Verbose(V_Debug,'Exitcode '+ToStr(ExecuteResult));
  889. if BenchmarkInfo then
  890. begin
  891. Verbose(V_Normal,'Execution took '+ToStr(EndTicks-StartTicks)+' us');
  892. end;
  893. done:
  894. if (not execres) and (ExecuteResult=0) then
  895. begin
  896. AddLog(FailLogFile,TestName);
  897. AddLog(ResLogFile,failed_to_run+PPFileInfo[current]);
  898. AddLog(LongLogFile,line_separation);
  899. AddLog(LongLogFile,failed_to_run+PPFileInfo[current]);
  900. if CopyFile(EXELogFile,LongLogFile,true)=0 then
  901. AddLog(LongLogFile,'IOStatus: '+ToStr(IOStatus));
  902. { avoid to try again }
  903. AddLog(ExeLogFile,failed_to_run+PPFileInfo[current]);
  904. Verbose(V_Warning,'IOStatus: '+ToStr(IOStatus));
  905. exit;
  906. end;
  907. if ExecuteResult<>Config.ResultCode then
  908. begin
  909. if (ExecuteResult<>0) and
  910. (ExecuteResult=Config.KnownRunError) then
  911. begin
  912. AddLog(FailLogFile,TestName+known_problem+Config.KnownRunNote);
  913. AddLog(ResLogFile,failed_to_run+PPFileInfo[current]+known_problem+Config.KnownRunNote);
  914. AddLog(LongLogFile,line_separation);
  915. AddLog(LongLogFile,known_problem+Config.KnownRunNote);
  916. AddLog(LongLogFile,failed_to_run+PPFileInfo[current]+' ('+ToStr(ExecuteResult)+')');
  917. if Copyfile(EXELogFile,LongLogFile,true)=0 then
  918. begin
  919. AddLog(LongLogFile,known_problem+'exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  920. AddLog(ExeLogFile,known_problem+'exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  921. end;
  922. Verbose(V_Warning,known_problem+'exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  923. end
  924. else
  925. begin
  926. AddLog(FailLogFile,TestName);
  927. AddLog(ResLogFile,failed_to_run+PPFileInfo[current]);
  928. AddLog(LongLogFile,line_separation);
  929. AddLog(LongLogFile,failed_to_run+PPFileInfo[current]+' ('+ToStr(ExecuteResult)+')');
  930. if Copyfile(EXELogFile,LongLogFile,true)=0 then
  931. begin
  932. AddLog(LongLogFile,'Exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  933. AddLog(ExeLogFile,'Exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  934. end;
  935. Verbose(V_Warning,'Exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  936. end
  937. end
  938. else
  939. begin
  940. AddLog(ResLogFile,successfully_run+PPFileInfo[current]);
  941. RunExecutable:=true;
  942. end;
  943. if (deAfter in DelExecutable) and not Config.NeededAfter then
  944. begin
  945. Verbose(V_Debug,'Deleting executable '+TestExe);
  946. RemoveFile(TestExe);
  947. RemoveFile(ForceExtension(TestExe,ObjExt));
  948. RemoveFile(ForceExtension(TestExe,PPUExt));
  949. end;
  950. end;
  951. procedure getargs;
  952. var
  953. ch : char;
  954. para : string;
  955. i,j : longint;
  956. procedure helpscreen;
  957. begin
  958. writeln('dotest [Options] <File>');
  959. writeln;
  960. writeln('Options can be:');
  961. writeln(' -A include ALL tests');
  962. writeln(' -B delete executable before remote upload');
  963. writeln(' -C<compiler> set compiler to use');
  964. writeln(' -D display execution time');
  965. writeln(' -E execute test also');
  966. writeln(' -G include graph tests');
  967. writeln(' -I include interactive tests');
  968. writeln(' -K include known bug tests');
  969. writeln(' -M<emulator> run the tests using the given emulator');
  970. writeln(' -O use timeout wrapper for (remote) execution');
  971. writeln(' -P<path> path to the tests tree on the remote machine');
  972. writeln(' -R<remote> run the tests remotely with the given rsh/ssh address');
  973. writeln(' -S use ssh instead of rsh');
  974. writeln(' -T[cpu-]<os> run tests for target cpu and os');
  975. writeln(' -U<remotepara>');
  976. writeln(' pass additional parameter to remote program. Multiple -U can be used');
  977. writeln(' -V be verbose');
  978. writeln(' -W use putty compatible file names when testing (plink and pscp)');
  979. writeln(' -X don''t use COMSPEC');
  980. writeln(' -Y<opts> extra options passed to the compiler. Several -Y<opt> can be given.');
  981. writeln(' -Z remove temporary files (executable,ppu,o)');
  982. halt(1);
  983. end;
  984. begin
  985. if exeext<>'' then
  986. CompilerBin:='ppc386.'+exeext
  987. else
  988. CompilerBin:='ppc386';
  989. for i:=1 to paramcount do
  990. begin
  991. para:=Paramstr(i);
  992. if (para[1]='-') then
  993. begin
  994. ch:=Upcase(para[2]);
  995. delete(para,1,2);
  996. case ch of
  997. 'A' :
  998. begin
  999. DoGraph:=true;
  1000. DoInteractive:=true;
  1001. DoKnown:=true;
  1002. DoAll:=true;
  1003. end;
  1004. 'B' : Include(DelExecutable,deBefore);
  1005. 'C' : CompilerBin:=Para;
  1006. 'D' : BenchMarkInfo:=true;
  1007. 'E' : DoExecute:=true;
  1008. 'G' : begin
  1009. DoGraph:=true;
  1010. if para='-' then
  1011. DoUsual:=false;
  1012. end;
  1013. 'I' : begin
  1014. DoInteractive:=true;
  1015. if para='-' then
  1016. DoUsual:=false;
  1017. end;
  1018. 'K' : begin
  1019. DoKnown:=true;
  1020. if para='-' then
  1021. DoUsual:=false;
  1022. end;
  1023. 'M' : EmulatorName:=Para;
  1024. 'O' : UseTimeout:=true;
  1025. 'P' : RemotePath:=Para;
  1026. 'R' : RemoteAddr:=Para;
  1027. 'S' :
  1028. begin
  1029. rshprog:='ssh';
  1030. rcpprog:='scp';
  1031. end;
  1032. 'T' :
  1033. begin
  1034. j:=Pos('-',Para);
  1035. if j>0 then
  1036. begin
  1037. CompilerCPU:=Copy(Para,1,j-1);
  1038. CompilerTarget:=Copy(Para,j+1,255);
  1039. end
  1040. else
  1041. CompilerTarget:=Para
  1042. end;
  1043. 'U' :
  1044. RemotePara:=RemotePara+' '+Para;
  1045. 'V' : DoVerbose:=true;
  1046. 'W' :
  1047. begin
  1048. rshprog:='plink';
  1049. rcpprog:='pscp';
  1050. rquote:='"';
  1051. end;
  1052. 'X' : UseComSpec:=false;
  1053. 'Y' : ExtraCompilerOpts:= ExtraCompilerOpts +' '+ Para;
  1054. 'Z' : Include(DelExecutable,deAfter);
  1055. end;
  1056. end
  1057. else
  1058. begin
  1059. PPFile.Insert(current,ForceExtension(Para,'pp'));
  1060. inc(current);
  1061. end;
  1062. end;
  1063. if current=0 then
  1064. HelpScreen;
  1065. { disable graph,interactive when running remote }
  1066. if RemoteAddr<>'' then
  1067. begin
  1068. DoGraph:=false;
  1069. DoInteractive:=false;
  1070. end;
  1071. end;
  1072. procedure RunTest;
  1073. var
  1074. PPDir : string;
  1075. Res : boolean;
  1076. begin
  1077. Res:=GetConfig(PPFile[current],Config);
  1078. if Res then
  1079. begin
  1080. Res:=GetCompilerCPU;
  1081. Res:=GetCompilerTarget;
  1082. {$ifndef MACOS}
  1083. RTLUnitsDir:='units/'+{$ifdef LIMIT83FS}CompilerTarget{$else}CompilerFullTarget{$endif};
  1084. {$else MACOS}
  1085. RTLUnitsDir:=':units:'+CompilerFullTarget;
  1086. {$endif MACOS}
  1087. if not PathExists(RTLUnitsDir) then
  1088. Verbose(V_Abort,'Unit path "'+RTLUnitsDir+'" does not exists');
  1089. {$ifndef MACOS}
  1090. OutputDir:='output/'+{$ifdef LIMIT83FS}CompilerTarget{$else}CompilerFullTarget{$endif};
  1091. {$else MACOS}
  1092. OutputDir:=':output:'+CompilerFullTarget;
  1093. {$endif MACOS}
  1094. if not PathExists(OutputDir) then
  1095. Verbose(V_Abort,'Output path "'+OutputDir+'" does not exists');
  1096. { Global log files }
  1097. ResLogFile:=OutputFileName('log','');
  1098. LongLogFile:=OutputFileName('longlog','');
  1099. FailLogFile:=OutputFileName('faillist','');
  1100. { Make subdir in output if needed }
  1101. PPDir:=SplitPath(PPFile[current]);
  1102. if PPDir[length(PPDir)] in ['/','\'{$ifdef MACOS},':'{$endif MACOS}] then
  1103. Delete(PPDir,length(PPDir),1);
  1104. if PPDir<>'' then
  1105. begin
  1106. {$ifndef MACOS}
  1107. TestOutputDir:=OutputDir+'/'+PPDir;
  1108. {$else MACOS}
  1109. TestOutputDir:=OutputDir+PPDir;
  1110. {$endif MACOS}
  1111. mkdirtree(TestOutputDir);
  1112. end
  1113. else
  1114. TestOutputDir:=OutputDir;
  1115. { Per test logfiles }
  1116. CompilerLogFile:=TestOutputFileName(SplitFileName(PPFile[current]),'log');
  1117. ExeLogFile:=TestOutputFileName(SplitFileName(PPFile[current]),'elg');
  1118. Verbose(V_Debug,'Using Compiler logfile: '+CompilerLogFile);
  1119. Verbose(V_Debug,'Using Execution logfile: '+ExeLogFile);
  1120. end;
  1121. if Res then
  1122. begin
  1123. if Config.UsesGraph and (not DoGraph) then
  1124. begin
  1125. AddLog(ResLogFile,skipping_graph_test+PPFileInfo[current]);
  1126. { avoid a second attempt by writing to elg file }
  1127. AddLog(EXELogFile,skipping_graph_test+PPFileInfo[current]);
  1128. Verbose(V_Warning,skipping_graph_test);
  1129. Res:=false;
  1130. end;
  1131. end;
  1132. if Res then
  1133. begin
  1134. if Config.IsInteractive and (not DoInteractive) then
  1135. begin
  1136. { avoid a second attempt by writing to elg file }
  1137. AddLog(EXELogFile,skipping_interactive_test+PPFileInfo[current]);
  1138. AddLog(ResLogFile,skipping_interactive_test+PPFileInfo[current]);
  1139. Verbose(V_Warning,skipping_interactive_test);
  1140. Res:=false;
  1141. end;
  1142. end;
  1143. if Res then
  1144. begin
  1145. if Config.IsKnownCompileError and (not DoKnown) then
  1146. begin
  1147. { avoid a second attempt by writing to elg file }
  1148. AddLog(EXELogFile,skipping_known_bug+PPFileInfo[current]);
  1149. AddLog(ResLogFile,skipping_known_bug+PPFileInfo[current]);
  1150. Verbose(V_Warning,skipping_known_bug);
  1151. Res:=false;
  1152. end;
  1153. end;
  1154. if Res and not DoUsual then
  1155. res:=(Config.IsInteractive and DoInteractive) or
  1156. (Config.IsKnownRunError and DoKnown) or
  1157. (Config.UsesGraph and DoGraph);
  1158. if Res then
  1159. begin
  1160. if (Config.MinVersion<>'') and not DoAll then
  1161. begin
  1162. Verbose(V_Debug,'Required compiler version: '+Config.MinVersion);
  1163. Res:=GetCompilerVersion;
  1164. if CompilerVersion<Config.MinVersion then
  1165. begin
  1166. { avoid a second attempt by writing to elg file }
  1167. AddLog(EXELogFile,skipping_compiler_version_too_low+PPFileInfo[current]);
  1168. AddLog(ResLogFile,skipping_compiler_version_too_low+PPFileInfo[current]);
  1169. Verbose(V_Warning,'Compiler version too low '+CompilerVersion+' < '+Config.MinVersion);
  1170. Res:=false;
  1171. end;
  1172. end;
  1173. end;
  1174. if Res then
  1175. begin
  1176. if (Config.MaxVersion<>'') and not DoAll then
  1177. begin
  1178. Verbose(V_Debug,'Highest compiler version: '+Config.MaxVersion);
  1179. Res:=GetCompilerVersion;
  1180. if CompilerVersion>Config.MaxVersion then
  1181. begin
  1182. { avoid a second attempt by writing to elg file }
  1183. AddLog(EXELogFile,skipping_compiler_version_too_high+PPFileInfo[current]);
  1184. AddLog(ResLogFile,skipping_compiler_version_too_high+PPFileInfo[current]);
  1185. Verbose(V_Warning,'Compiler version too high '+CompilerVersion+' > '+Config.MaxVersion);
  1186. Res:=false;
  1187. end;
  1188. end;
  1189. end;
  1190. if Res then
  1191. begin
  1192. if Config.NeedCPU<>'' then
  1193. begin
  1194. Verbose(V_Debug,'Required compiler cpu: '+Config.NeedCPU);
  1195. if not IsInList(CompilerCPU,Config.NeedCPU) then
  1196. begin
  1197. { avoid a second attempt by writing to elg file }
  1198. AddLog(EXELogFile,skipping_other_cpu+PPFileInfo[current]);
  1199. AddLog(ResLogFile,skipping_other_cpu+PPFileInfo[current]);
  1200. Verbose(V_Warning,'Compiler cpu "'+CompilerCPU+'" is not in list "'+Config.NeedCPU+'"');
  1201. Res:=false;
  1202. end;
  1203. end;
  1204. end;
  1205. if Res then
  1206. begin
  1207. if Config.SkipCPU<>'' then
  1208. begin
  1209. Verbose(V_Debug,'Skip compiler cpu: '+Config.SkipCPU);
  1210. if IsInList(CompilerCPU,Config.SkipCPU) then
  1211. begin
  1212. { avoid a second attempt by writing to elg file }
  1213. AddLog(EXELogFile,skipping_other_cpu+PPFileInfo[current]);
  1214. AddLog(ResLogFile,skipping_other_cpu+PPFileInfo[current]);
  1215. Verbose(V_Warning,'Compiler cpu "'+CompilerCPU+'" is in list "'+Config.SkipCPU+'"');
  1216. Res:=false;
  1217. end;
  1218. end;
  1219. end;
  1220. if Res then
  1221. begin
  1222. if Config.SkipEmu<>'' then
  1223. begin
  1224. Verbose(V_Debug,'Skip emulator: '+emulatorname);
  1225. if IsInList(emulatorname,Config.SkipEmu) then
  1226. begin
  1227. { avoid a second attempt by writing to elg file }
  1228. AddLog(EXELogFile,skipping_other_cpu+PPFileInfo[current]);
  1229. AddLog(ResLogFile,skipping_other_cpu+PPFileInfo[current]);
  1230. Verbose(V_Warning,'Emulator "'+emulatorname+'" is in list "'+Config.SkipEmu+'"');
  1231. Res:=false;
  1232. end;
  1233. end;
  1234. end;
  1235. if Res then
  1236. begin
  1237. if Config.NeedTarget<>'' then
  1238. begin
  1239. Verbose(V_Debug,'Required compiler target: '+Config.NeedTarget);
  1240. if not IsInList(CompilerTarget,Config.NeedTarget) then
  1241. begin
  1242. { avoid a second attempt by writing to elg file }
  1243. AddLog(EXELogFile,skipping_other_target+PPFileInfo[current]);
  1244. AddLog(ResLogFile,skipping_other_target+PPFileInfo[current]);
  1245. Verbose(V_Warning,'Compiler target "'+CompilerTarget+'" is not in list "'+Config.NeedTarget+'"');
  1246. Res:=false;
  1247. end;
  1248. end;
  1249. end;
  1250. if Res then
  1251. begin
  1252. if Config.SkipTarget<>'' then
  1253. begin
  1254. Verbose(V_Debug,'Skip compiler target: '+Config.NeedTarget);
  1255. if IsInList(CompilerTarget,Config.SkipTarget) then
  1256. begin
  1257. { avoid a second attempt by writing to elg file }
  1258. AddLog(EXELogFile,skipping_other_target+PPFileInfo[current]);
  1259. AddLog(ResLogFile,skipping_other_target+PPFileInfo[current]);
  1260. Verbose(V_Warning,'Compiler target "'+CompilerTarget+'" is in list "'+Config.SkipTarget+'"');
  1261. Res:=false;
  1262. end;
  1263. end;
  1264. end;
  1265. if Res then
  1266. begin
  1267. Res:=RunCompiler;
  1268. if Res and Config.NeedRecompile then
  1269. Res:=RunCompiler;
  1270. end;
  1271. if Res and (not Config.ShouldFail) then
  1272. begin
  1273. if (Config.NoRun) then
  1274. begin
  1275. { avoid a second attempt by writing to elg file }
  1276. AddLog(EXELogFile,skipping_run_test+PPFileInfo[current]);
  1277. AddLog(ResLogFile,skipping_run_test+PPFileInfo[current]);
  1278. Verbose(V_Debug,skipping_run_test);
  1279. end
  1280. else if Config.IsKnownRunError and (not DoKnown) then
  1281. begin
  1282. { avoid a second attempt by writing to elg file }
  1283. AddLog(EXELogFile,skipping_known_bug+PPFileInfo[current]);
  1284. AddLog(ResLogFile,skipping_known_bug+PPFileInfo[current]);
  1285. Verbose(V_Warning,skipping_known_bug);
  1286. end
  1287. else
  1288. begin
  1289. if DoExecute then
  1290. begin
  1291. if FileExists(TestOutputFilename(PPFile[current],'ppu')) or
  1292. FileExists(TestOutputFilename(PPFile[current],'ppo')) or
  1293. FileExists(TestOutputFilename(PPFile[current],'ppw')) then
  1294. begin
  1295. AddLog(ExeLogFile,skipping_run_unit+PPFileInfo[current]);
  1296. AddLog(ResLogFile,skipping_run_unit+PPFileInfo[current]);
  1297. Verbose(V_Debug,'Unit found, skipping run test')
  1298. end
  1299. else
  1300. Res:=RunExecutable;
  1301. end;
  1302. end;
  1303. end;
  1304. end;
  1305. begin
  1306. Current:=0;
  1307. PPFile:=TStringList.Create;
  1308. PPFile.Capacity:=10;
  1309. PPFileInfo:=TStringList.Create;
  1310. PPFileInfo.Capacity:=10;
  1311. GetArgs;
  1312. SetTargetDirectoriesStyle;
  1313. Verbose(V_Debug,'Found '+ToStr(PPFile.Count)+' tests to run');
  1314. if current>0 then
  1315. for current:=0 to PPFile.Count-1 do
  1316. begin
  1317. SetPPFileInfo;
  1318. TestName:=Copy(PPFile[current],1,Pos('.pp',PPFile[current])-1);
  1319. Verbose(V_Normal,'Running test '+TestName+', file '+PPFile[current]);
  1320. RunTest;
  1321. end;
  1322. PPFile.Free;
  1323. PPFileInfo.Free;
  1324. end.