dotest.pp 24 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956
  1. {
  2. $Id$
  3. This file is part of the Free Pascal test suite.
  4. Copyright (c) 1999-2002 by the Free Pascal development team.
  5. This program makes the compilation and
  6. execution of individual test sources.
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. **********************************************************************}
  13. {$H+}
  14. program dotest;
  15. uses
  16. dos,
  17. teststr,
  18. testu,
  19. redir;
  20. type
  21. tcompinfo = (compver,comptarget,compcpu);
  22. const
  23. {$ifdef UNIX}
  24. ExeExt='';
  25. {$else UNIX}
  26. ExeExt='exe';
  27. {$endif UNIX}
  28. var
  29. Config : TConfig;
  30. CompilerBin : string;
  31. CompilerCPU : string;
  32. CompilerTarget : string;
  33. CompilerVersion : string;
  34. PPFile : string;
  35. PPFileInfo : string;
  36. TestName : string;
  37. Note : string;
  38. const
  39. LongLogfile : string[32] = 'longlog';
  40. FailLogfile : string[32] = 'faillist';
  41. DoGraph : boolean = false;
  42. DoInteractive : boolean = false;
  43. DoExecute : boolean = false;
  44. DoKnown : boolean = false;
  45. DoAll : boolean = false;
  46. DoUsual : boolean = true;
  47. Function FileExists (Const F : String) : Boolean;
  48. {
  49. Returns True if the file exists, False if not.
  50. }
  51. Var
  52. info : searchrec;
  53. begin
  54. FindFirst (F,anyfile,Info);
  55. FileExists:=DosError=0;
  56. FindClose (Info);
  57. end;
  58. function ToStr(l:longint):string;
  59. var
  60. s : string;
  61. begin
  62. Str(l,s);
  63. ToStr:=s;
  64. end;
  65. function ToStrZero(l:longint;nbzero : byte):string;
  66. var
  67. s : string;
  68. begin
  69. Str(l,s);
  70. while length(s)<nbzero do
  71. s:='0'+s;
  72. ToStrZero:=s;
  73. end;
  74. function trimspace(const s:string):string;
  75. var
  76. i,j : longint;
  77. begin
  78. i:=length(s);
  79. while (i>0) and (s[i] in [#9,' ']) do
  80. dec(i);
  81. j:=1;
  82. while (j<i) and (s[j] in [#9,' ']) do
  83. inc(j);
  84. trimspace:=Copy(s,j,i-j+1);
  85. end;
  86. function IsInList(const entry,list:string):boolean;
  87. var
  88. i,istart : longint;
  89. begin
  90. IsInList:=false;
  91. i:=0;
  92. while (i<length(list)) do
  93. begin
  94. { Find list item }
  95. istart:=i+1;
  96. while (i<length(list)) and
  97. (list[i+1]<>',') do
  98. inc(i);
  99. if Upcase(entry)=Upcase(TrimSpace(Copy(list,istart,i-istart+1))) then
  100. begin
  101. IsInList:=true;
  102. exit;
  103. end;
  104. { skip , }
  105. inc(i);
  106. end;
  107. end;
  108. procedure SetPPFileInfo;
  109. Var
  110. info : searchrec;
  111. dt : DateTime;
  112. begin
  113. FindFirst (PPFile,anyfile,Info);
  114. If DosError=0 then
  115. begin
  116. UnpackTime(info.time,dt);
  117. PPFileInfo:=PPFile+' '+ToStr(dt.year)+'/'+ToStrZero(dt.month,2)+'/'+
  118. ToStrZero(dt.day,2)+' '+ToStrZero(dt.Hour,2)+':'+ToStrZero(dt.min,2)+':'+ToStrZero(dt.sec,2);
  119. end
  120. else
  121. PPFileInfo:=PPfile;
  122. FindClose (Info);
  123. end;
  124. function SplitPath(const s:string):string;
  125. var
  126. i : longint;
  127. begin
  128. i:=Length(s);
  129. while (i>0) and not(s[i] in ['/','\']) do
  130. dec(i);
  131. SplitPath:=Copy(s,1,i);
  132. end;
  133. function ForceExtension(Const HStr,ext:String):String;
  134. {
  135. Return a filename which certainly has the extension ext
  136. }
  137. var
  138. j : longint;
  139. begin
  140. j:=length(Hstr);
  141. while (j>0) and (Hstr[j]<>'.') do
  142. dec(j);
  143. if j=0 then
  144. j:=255;
  145. if Ext<>'' then
  146. ForceExtension:=Copy(Hstr,1,j-1)+'.'+Ext
  147. else
  148. ForceExtension:=Copy(Hstr,1,j-1);
  149. end;
  150. procedure Copyfile(const fn1,fn2:string;append:boolean);
  151. const
  152. bufsize = 16384;
  153. var
  154. f,g : file;
  155. i : longint;
  156. buf : pointer;
  157. begin
  158. if Append then
  159. Verbose(V_Debug,'Appending '+fn1+' to '+fn2)
  160. else
  161. Verbose(V_Debug,'Copying '+fn1+' to '+fn2);
  162. assign(f,fn1);
  163. assign(g,fn2);
  164. {$I-}
  165. reset(f,1);
  166. {$I+}
  167. if ioresult<>0 then
  168. Verbose(V_Error,'Can''t open '+fn1);
  169. if append then
  170. begin
  171. {$I-}
  172. reset(g,1);
  173. {$I+}
  174. if ioresult<>0 then
  175. append:=false
  176. else
  177. seek(g,filesize(g));
  178. end;
  179. if not append then
  180. begin
  181. {$I-}
  182. rewrite(g,1);
  183. {$I+}
  184. if ioresult<>0 then
  185. Verbose(V_Error,'Can''t open '+fn2+' for output');
  186. end;
  187. getmem(buf,bufsize);
  188. repeat
  189. blockread(f,buf^,bufsize,i);
  190. blockwrite(g,buf^,i);
  191. until i<bufsize;
  192. freemem(buf,bufsize);
  193. close(f);
  194. close(g);
  195. end;
  196. procedure AddLog(const logfile,s:string);
  197. var
  198. t : text;
  199. begin
  200. assign(t,logfile);
  201. {$I-}
  202. append(t);
  203. {$I+}
  204. if ioresult<>0 then
  205. begin
  206. {$I-}
  207. rewrite(t);
  208. {$I+}
  209. if ioresult<>0 then
  210. Verbose(V_Abort,'Can''t append to '+logfile);
  211. end;
  212. writeln(t,s);
  213. close(t);
  214. end;
  215. function GetConfig(const fn:string;var r:TConfig):boolean;
  216. var
  217. t : text;
  218. part,code : integer;
  219. l : longint;
  220. s,res : string;
  221. function GetEntry(const entry:string):boolean;
  222. var
  223. i : longint;
  224. begin
  225. Getentry:=false;
  226. Res:='';
  227. if Upcase(Copy(s,1,length(entry)))=Upcase(entry) then
  228. begin
  229. Delete(s,1,length(entry));
  230. TrimB(s);
  231. if (s<>'') then
  232. begin
  233. if (s[1]='=') then
  234. begin
  235. delete(s,1,1);
  236. i:=pos('}',s);
  237. if i=0 then
  238. i:=255
  239. else
  240. dec(i);
  241. res:=Copy(s,1,i);
  242. TrimB(res);
  243. TrimE(res);
  244. end;
  245. Verbose(V_Debug,'Config: '+Entry+' = "'+Res+'"');
  246. GetEntry:=true;
  247. end;
  248. end;
  249. end;
  250. begin
  251. FillChar(r,sizeof(r),0);
  252. GetConfig:=false;
  253. Verbose(V_Debug,'Reading '+fn);
  254. assign(t,fn);
  255. {$I-}
  256. reset(t);
  257. {$I+}
  258. if ioresult<>0 then
  259. begin
  260. Verbose(V_Error,'Can''t open '+fn);
  261. exit;
  262. end;
  263. Note:='';
  264. while not eof(t) do
  265. begin
  266. readln(t,s);
  267. if s<>'' then
  268. begin
  269. if s[1]='{' then
  270. begin
  271. delete(s,1,1);
  272. TrimB(s);
  273. if (s<>'') and (s[1]='%') then
  274. begin
  275. delete(s,1,1);
  276. if GetEntry('OPT') then
  277. r.NeedOptions:=res
  278. else
  279. if GetEntry('TARGET') then
  280. r.NeedTarget:=res
  281. else
  282. if GetEntry('SKIPTARGET') then
  283. r.SkipTarget:=res
  284. else
  285. if GetEntry('CPU') then
  286. r.NeedCPU:=res
  287. else
  288. if GetEntry('SKIPCPU') then
  289. r.SkipCPU:=res
  290. else
  291. if GetEntry('VERSION') then
  292. r.NeedVersion:=res
  293. else
  294. if GetEntry('RESULT') then
  295. Val(res,r.ResultCode,code)
  296. else
  297. if GetEntry('GRAPH') then
  298. r.UsesGraph:=true
  299. else
  300. if GetEntry('FAIL') then
  301. r.ShouldFail:=true
  302. else
  303. if GetEntry('RECOMPILE') then
  304. r.NeedRecompile:=true
  305. else
  306. if GetEntry('NORUN') then
  307. r.NoRun:=true
  308. else
  309. if GetEntry('NEEDLIBRARY') then
  310. r.NeedLibrary:=true
  311. else
  312. if GetEntry('KNOWNRUNERROR') then
  313. begin
  314. if res<>'' then
  315. begin
  316. val(res,l,code);
  317. if code>1 then
  318. begin
  319. part:=code;
  320. val(copy(res,1,code-1),l,code);
  321. delete(res,1,part);
  322. end;
  323. if code=0 then
  324. r.KnownRunError:=l;
  325. if res<>'' then
  326. r.KnownRunNote:=res;
  327. end;
  328. end
  329. else
  330. if GetEntry('KNOWN') then
  331. r.IsKnown:=true
  332. else
  333. if GetEntry('INTERACTIVE') then
  334. r.IsInteractive:=true
  335. else
  336. if GetEntry('NOTE') then
  337. begin
  338. Note:='Note: '+res;
  339. Verbose(V_Normal,Note);
  340. end
  341. else
  342. Verbose(V_Error,'Unknown entry: '+s);
  343. end;
  344. end
  345. else
  346. break;
  347. end;
  348. end;
  349. close(t);
  350. GetConfig:=true;
  351. end;
  352. function GetCompilerInfo(c:tcompinfo):boolean;
  353. function GetToken(var s:string):string;
  354. var
  355. i : longint;
  356. begin
  357. i:=pos(' ',s);
  358. if i=0 then
  359. i:=length(s)+1;
  360. GetToken:=Copy(s,1,i-1);
  361. Delete(s,1,i);
  362. end;
  363. var
  364. t : text;
  365. hs : string;
  366. begin
  367. GetCompilerInfo:=false;
  368. { Try to get all information in one call, this is
  369. supported in 1.1. Older compilers 1.0.x will only
  370. return the first info }
  371. case c of
  372. compver :
  373. hs:='-iVTPTO';
  374. compcpu :
  375. hs:='-iTPTOV';
  376. comptarget :
  377. hs:='-iTOTPV';
  378. end;
  379. ExecuteRedir(CompilerBin,hs,'','out','');
  380. assign(t,'out');
  381. {$I-}
  382. reset(t);
  383. readln(t,hs);
  384. close(t);
  385. erase(t);
  386. {$I+}
  387. if ioresult<>0 then
  388. Verbose(V_Error,'Can''t get Compiler Info')
  389. else
  390. begin
  391. Verbose(V_Debug,'Retrieved Compiler Info: "'+hs+'"');
  392. case c of
  393. compver :
  394. begin
  395. CompilerVersion:=GetToken(hs);
  396. CompilerCPU:=GetToken(hs);
  397. CompilerTarget:=GetToken(hs);
  398. end;
  399. compcpu :
  400. begin
  401. CompilerCPU:=GetToken(hs);
  402. CompilerTarget:=GetToken(hs);
  403. CompilerVersion:=GetToken(hs);
  404. end;
  405. comptarget :
  406. begin
  407. CompilerTarget:=GetToken(hs);
  408. CompilerCPU:=GetToken(hs);
  409. CompilerVersion:=GetToken(hs);
  410. end;
  411. end;
  412. GetCompilerInfo:=true;
  413. end;
  414. end;
  415. function GetCompilerVersion:boolean;
  416. begin
  417. if CompilerVersion='' then
  418. GetCompilerVersion:=GetCompilerInfo(compver)
  419. else
  420. GetCompilerVersion:=true;
  421. if GetCompilerVersion then
  422. Verbose(V_Debug,'Current Compiler Version: "'+CompilerVersion+'"');
  423. end;
  424. function GetCompilerCPU:boolean;
  425. begin
  426. if CompilerCPU='' then
  427. GetCompilerCPU:=GetCompilerInfo(compcpu)
  428. else
  429. GetCompilerCPU:=true;
  430. if GetCompilerCPU then
  431. Verbose(V_Debug,'Current Compiler CPU: "'+CompilerCPU+'"');
  432. end;
  433. function GetCompilerTarget:boolean;
  434. begin
  435. if CompilerTarget='' then
  436. GetCompilerTarget:=GetCompilerInfo(comptarget)
  437. else
  438. GetCompilerTarget:=true;
  439. if GetCompilerTarget then
  440. Verbose(V_Debug,'Current Compiler Target: "'+CompilerTarget+'"');
  441. end;
  442. function ExitWithInternalError(const OutName:string):boolean;
  443. var
  444. t : text;
  445. s : string;
  446. begin
  447. ExitWithInternalError:=false;
  448. { open logfile }
  449. assign(t,Outname);
  450. {$I-}
  451. reset(t);
  452. {$I+}
  453. if ioresult<>0 then
  454. exit;
  455. while not eof(t) do
  456. begin
  457. readln(t,s);
  458. if pos('Fatal: Internal error ',s)>0 then
  459. begin
  460. ExitWithInternalError:=true;
  461. break;
  462. end;
  463. end;
  464. close(t);
  465. end;
  466. function RunCompiler:boolean;
  467. var
  468. outname,
  469. args : string;
  470. begin
  471. RunCompiler:=false;
  472. OutName:=ForceExtension(PPFile,'log');
  473. args:='-n -Fuunits';
  474. {$ifdef unix}
  475. { Add runtime library path to current dir to find .so files }
  476. if Config.NeedLibrary then
  477. args:=args+' ''-k-rpath .''';
  478. {$endif unix}
  479. if Config.NeedOptions<>'' then
  480. args:=args+' '+Config.NeedOptions;
  481. args:=args+' '+ppfile;
  482. Verbose(V_Debug,'Executing '+compilerbin+' '+args);
  483. { also get the output from as and ld that writes to stderr sometimes }
  484. ExecuteRedir(CompilerBin,args,'',OutName,OutName);
  485. Verbose(V_Debug,'Exitcode '+ToStr(ExecuteResult));
  486. { Check for internal error }
  487. if ExitWithInternalError(OutName) then
  488. begin
  489. AddLog(FailLogFile,TestName);
  490. if Note<>'' then
  491. AddLog(FailLogFile,Note);
  492. AddLog(ResLogFile,failed_to_compile+PPFileInfo+' internalerror generated');
  493. AddLog(LongLogFile,line_separation);
  494. AddLog(LongLogFile,failed_to_compile+PPFileInfo);
  495. if Note<>'' then
  496. AddLog(LongLogFile,Note);
  497. CopyFile(OutName,LongLogFile,true);
  498. { avoid to try again }
  499. AddLog(ForceExtension(PPFile,'elg'),'Failed to compile '++PPFileInfo);
  500. Verbose(V_Abort,'Internal error in compiler');
  501. exit;
  502. end;
  503. { Shoud the compile fail ? }
  504. if Config.ShouldFail then
  505. begin
  506. if ExecuteResult<>0 then
  507. begin
  508. AddLog(ResLogFile,success_compilation_failed+PPFileInfo);
  509. { avoid to try again }
  510. AddLog(ForceExtension(PPFile,'elg'),success_compilation_failed+PPFileInfo);
  511. RunCompiler:=true;
  512. end
  513. else
  514. begin
  515. AddLog(FailLogFile,TestName);
  516. if Note<>'' then
  517. AddLog(FailLogFile,Note);
  518. AddLog(ResLogFile,failed_compilation_successful+PPFileInfo);
  519. AddLog(LongLogFile,line_separation);
  520. AddLog(LongLogFile,failed_compilation_successful+PPFileInfo);
  521. { avoid to try again }
  522. AddLog(ForceExtension(PPFile,'elg'),failed_compilation_successful+PPFileInfo);
  523. if Note<>'' then
  524. AddLog(LongLogFile,Note);
  525. CopyFile(OutName,LongLogFile,true);
  526. end;
  527. end
  528. else
  529. begin
  530. if ExecuteResult<>0 then
  531. begin
  532. AddLog(FailLogFile,TestName);
  533. if Note<>'' then
  534. AddLog(FailLogFile,Note);
  535. AddLog(ResLogFile,failed_to_compile+PPFileInfo);
  536. AddLog(LongLogFile,line_separation);
  537. AddLog(LongLogFile,failed_to_compile+PPFileInfo);
  538. if Note<>'' then
  539. AddLog(LongLogFile,Note);
  540. CopyFile(OutName,LongLogFile,true);
  541. { avoid to try again }
  542. AddLog(ForceExtension(PPFile,'elg'),failed_to_compile+PPFileInfo);
  543. Verbose(V_Abort,'Exitcode: '+ToStr(ExecuteResult)+' (expected 0)');
  544. end
  545. else
  546. begin
  547. AddLog(ResLogFile,successfully_compiled+PPFileInfo);
  548. RunCompiler:=true;
  549. end;
  550. end;
  551. end;
  552. function RunExecutable:boolean;
  553. var
  554. outname,
  555. TestExe : string;
  556. begin
  557. RunExecutable:=false;
  558. TestExe:=ForceExtension(PPFile,ExeExt);
  559. OutName:=ForceExtension(PPFile,'elg');
  560. Verbose(V_Debug,'Executing '+TestExe);
  561. { don't redirect interactive and graph programs .. }
  562. if Config.IsInteractive or Config.UsesGraph then
  563. ExecuteRedir(TestExe,'','','','')
  564. else
  565. ExecuteRedir(TestExe,'','',OutName,'');
  566. Verbose(V_Debug,'Exitcode '+ToStr(ExecuteResult));
  567. if ExecuteResult<>Config.ResultCode then
  568. begin
  569. if (ExecuteResult<>0) and
  570. (ExecuteResult=Config.KnownRunError) then
  571. begin
  572. AddLog(FailLogFile,TestName+known_problem+Config.KnownRunNote);
  573. AddLog(ResLogFile,failed_to_run+PPFileInfo+known_problem+Config.KnownRunNote);
  574. AddLog(LongLogFile,line_separation);
  575. AddLog(LongLogFile,known_problem+Config.KnownRunNote);
  576. AddLog(LongLogFile,failed_to_run+PPFileInfo+' ('+ToStr(ExecuteResult)+')');
  577. Copyfile(OutName,LongLogFile,true);
  578. Verbose(V_Abort,known_problem+'exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  579. end
  580. else
  581. begin
  582. AddLog(FailLogFile,TestName);
  583. AddLog(ResLogFile,failed_to_run+PPFileInfo);
  584. AddLog(LongLogFile,line_separation);
  585. AddLog(LongLogFile,failed_to_run+PPFileInfo+' ('+ToStr(ExecuteResult)+')');
  586. Copyfile(OutName,LongLogFile,true);
  587. Verbose(V_Abort,'Exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  588. end
  589. end
  590. else
  591. begin
  592. AddLog(ResLogFile,successfully_run+PPFileInfo);
  593. RunExecutable:=true;
  594. end;
  595. end;
  596. procedure getargs;
  597. var
  598. ch : char;
  599. para : string;
  600. i : longint;
  601. procedure helpscreen;
  602. begin
  603. writeln('dotest [Options] <File>');
  604. writeln;
  605. writeln('Options can be:');
  606. writeln(' -C<compiler> set compiler to use');
  607. writeln(' -V verbose');
  608. writeln(' -E execute test also');
  609. writeln(' -X don''t use COMSPEC');
  610. writeln(' -A include ALL tests');
  611. writeln(' -G include graph tests');
  612. writeln(' -K include known bug tests');
  613. writeln(' -I include interactive tests');
  614. halt(1);
  615. end;
  616. begin
  617. PPFile:='';
  618. if exeext<>'' then
  619. CompilerBin:='ppc386.'+exeext
  620. else
  621. CompilerBin:='ppc386';
  622. for i:=1 to paramcount do
  623. begin
  624. para:=Paramstr(i);
  625. if (para[1]='-') then
  626. begin
  627. ch:=Upcase(para[2]);
  628. delete(para,1,2);
  629. case ch of
  630. 'A' :
  631. begin
  632. DoGraph:=true;
  633. DoInteractive:=true;
  634. DoKnown:=true;
  635. DoAll:=true;
  636. end;
  637. 'C' : CompilerBin:=Para;
  638. 'E' : DoExecute:=true;
  639. 'G' : begin
  640. DoGraph:=true;
  641. if para='-' then
  642. DoUsual:=false;
  643. end;
  644. 'I' : begin
  645. DoInteractive:=true;
  646. if para='-' then
  647. DoUsual:=false;
  648. end;
  649. 'K' : begin
  650. DoKnown:=true;
  651. if para='-' then
  652. DoUsual:=false;
  653. end;
  654. 'V' : DoVerbose:=true;
  655. 'X' : UseComSpec:=false;
  656. end;
  657. end
  658. else
  659. begin
  660. If PPFile<>'' then
  661. HelpScreen;
  662. PPFile:=ForceExtension(Para,'pp');
  663. end;
  664. end;
  665. if (PPFile='') then
  666. HelpScreen;
  667. SetPPFileInfo;
  668. TestName:=Copy(PPFile,1,Pos('.pp',PPFile)-1);
  669. Verbose(V_Debug,'Running test '+TestName+', file '+PPFile);
  670. end;
  671. procedure RunTest;
  672. var
  673. Res : boolean;
  674. OutName : string;
  675. begin
  676. Res:=GetConfig(ppfile,Config);
  677. OutName:=ForceExtension(PPFile,'elg');
  678. if Res then
  679. begin
  680. if Config.UsesGraph and (not DoGraph) then
  681. begin
  682. AddLog(ResLogFile,skipping_graph_test+PPFileInfo);
  683. { avoid a second attempt by writing to elg file }
  684. AddLog(OutName,skipping_graph_test+PPFileInfo);
  685. Verbose(V_Abort,skipping_graph_test);
  686. Res:=false;
  687. end;
  688. end;
  689. if Res then
  690. begin
  691. if Config.IsInteractive and (not DoInteractive) then
  692. begin
  693. { avoid a second attempt by writing to elg file }
  694. AddLog(OutName,skipping_interactive_test+PPFileInfo);
  695. AddLog(ResLogFile,skipping_interactive_test+PPFileInfo);
  696. Verbose(V_Abort,skipping_interactive_test);
  697. Res:=false;
  698. end;
  699. end;
  700. if Res then
  701. begin
  702. if Config.IsKnown and (not DoKnown) then
  703. begin
  704. { avoid a second attempt by writing to elg file }
  705. AddLog(OutName,skipping_known_bug+PPFileInfo);
  706. AddLog(ResLogFile,skipping_known_bug+PPFileInfo);
  707. Verbose(V_Abort,skipping_known_bug);
  708. Res:=false;
  709. end;
  710. end;
  711. if Res and not DoUsual then
  712. res:=(Config.IsInteractive and DoInteractive) or
  713. (Config.IsKnown and DoKnown) or
  714. (Config.UsesGraph and DoGraph);
  715. if Res then
  716. begin
  717. if (Config.NeedVersion<>'') and not DoAll then
  718. begin
  719. Verbose(V_Debug,'Required compiler version: '+Config.NeedVersion);
  720. Res:=GetCompilerVersion;
  721. if CompilerVersion<Config.NeedVersion then
  722. begin
  723. { avoid a second attempt by writing to elg file }
  724. AddLog(OutName,skipping_compiler_version_too_low+PPFileInfo);
  725. AddLog(ResLogFile,skipping_compiler_version_too_low+PPFileInfo);
  726. Verbose(V_Abort,'Compiler version too low '+CompilerVersion+' < '+Config.NeedVersion);
  727. Res:=false;
  728. end;
  729. end;
  730. end;
  731. if Res then
  732. begin
  733. if Config.NeedCPU<>'' then
  734. begin
  735. Verbose(V_Debug,'Required compiler cpu: '+Config.NeedCPU);
  736. Res:=GetCompilerCPU;
  737. if not IsInList(CompilerCPU,Config.NeedCPU) then
  738. begin
  739. { avoid a second attempt by writing to elg file }
  740. AddLog(OutName,skipping_other_cpu+PPFileInfo);
  741. AddLog(ResLogFile,skipping_other_cpu+PPFileInfo);
  742. Verbose(V_Abort,'Compiler cpu "'+CompilerCPU+'" is not in list "'+Config.NeedCPU+'"');
  743. Res:=false;
  744. end;
  745. end;
  746. end;
  747. if Res then
  748. begin
  749. if Config.SkipCPU<>'' then
  750. begin
  751. Verbose(V_Debug,'Skip compiler cpu: '+Config.NeedCPU);
  752. Res:=GetCompilerCPU;
  753. if IsInList(CompilerCPU,Config.SkipCPU) then
  754. begin
  755. { avoid a second attempt by writing to elg file }
  756. AddLog(OutName,skipping_other_cpu+PPFileInfo);
  757. AddLog(ResLogFile,skipping_other_cpu+PPFileInfo);
  758. Verbose(V_Abort,'Compiler cpu "'+CompilerCPU+'" is in list "'+Config.SkipCPU+'"');
  759. Res:=false;
  760. end;
  761. end;
  762. end;
  763. if Res then
  764. begin
  765. if Config.NeedTarget<>'' then
  766. begin
  767. Verbose(V_Debug,'Required compiler target: '+Config.NeedTarget);
  768. Res:=GetCompilerTarget;
  769. if not IsInList(CompilerTarget,Config.NeedTarget) then
  770. begin
  771. { avoid a second attempt by writing to elg file }
  772. AddLog(OutName,skipping_other_target+PPFileInfo);
  773. AddLog(ResLogFile,skipping_other_target+PPFileInfo);
  774. Verbose(V_Abort,'Compiler target "'+CompilerTarget+'" is not in list "'+Config.NeedTarget+'"');
  775. Res:=false;
  776. end;
  777. end;
  778. end;
  779. if Res then
  780. begin
  781. if Config.SkipTarget<>'' then
  782. begin
  783. Verbose(V_Debug,'Skip compiler target: '+Config.NeedTarget);
  784. Res:=GetCompilerTarget;
  785. if IsInList(CompilerTarget,Config.SkipTarget) then
  786. begin
  787. { avoid a second attempt by writing to elg file }
  788. AddLog(OutName,skipping_other_target+PPFileInfo);
  789. AddLog(ResLogFile,skipping_other_target+PPFileInfo);
  790. Verbose(V_Abort,'Compiler target "'+CompilerTarget+'" is in list "'+Config.SkipTarget+'"');
  791. Res:=false;
  792. end;
  793. end;
  794. end;
  795. if Res then
  796. begin
  797. Res:=RunCompiler;
  798. if Res and Config.NeedRecompile then
  799. Res:=RunCompiler;
  800. end;
  801. if Res then
  802. begin
  803. if (Config.NoRun) then
  804. begin
  805. { avoid a second attempt by writing to elg file }
  806. AddLog(OutName,skipping_run_test+PPFileInfo);
  807. AddLog(ResLogFile,skipping_run_test+PPFileInfo);
  808. Verbose(V_Debug,skipping_run_test);
  809. end
  810. else
  811. begin
  812. if (not Config.ShouldFail) and DoExecute then
  813. begin
  814. if FileExists(ForceExtension(PPFile,'ppu')) or
  815. FileExists(ForceExtension(PPFile,'ppo')) or
  816. FileExists(ForceExtension(PPFile,'ppw')) then
  817. begin
  818. AddLog(ForceExtension(PPFile,'elg'),skipping_run_unit+PPFileInfo);
  819. AddLog(ResLogFile,skipping_run_unit+PPFileInfo);
  820. Verbose(V_Debug,'Unit found, skipping run test')
  821. end
  822. else
  823. Res:=RunExecutable;
  824. end;
  825. end;
  826. end;
  827. end;
  828. begin
  829. GetArgs;
  830. RunTest;
  831. end.
  832. {
  833. $Log$
  834. Revision 1.25 2002-12-24 22:30:41 peter
  835. * small verbosity update
  836. Revision 1.24 2002/12/24 21:47:49 peter
  837. * NeedTarget, SkipTarget, SkipCPU added
  838. * Retrieve compiler info in a single call for 1.1 compiler
  839. Revision 1.23 2002/12/17 15:04:32 michael
  840. + Added dbdigest to store results in a database
  841. Revision 1.22 2002/12/15 13:30:46 peter
  842. * NEEDLIBRARY option to add -rpath to the linker for unix. This is
  843. needed to test runtime library tests. The library needs the -FE.
  844. option to place the .so in the correct directory
  845. Revision 1.21 2002/12/05 16:03:34 pierre
  846. + -X option to disable UseComSpec
  847. Revision 1.20 2002/11/18 16:42:43 pierre
  848. + KNOWNRUNERROR added
  849. Revision 1.19 2002/11/18 01:31:07 pierre
  850. + use -n option
  851. + use -G- for only graph
  852. + use -I- for only interactive
  853. + use -K- for only known bugs.
  854. Revision 1.18 2002/11/14 10:36:12 pierre
  855. * add internalerror info to log file
  856. Revision 1.17 2002/11/13 15:26:24 pierre
  857. + digest program added
  858. Revision 1.16 2002/11/13 15:19:44 pierre
  859. log strings moved to teststr unit
  860. Revision 1.15 2002/09/07 15:40:56 peter
  861. * old logs removed and tabs fixed
  862. Revision 1.14 2002/04/21 18:15:32 peter
  863. * Check for internal errors
  864. Revision 1.13 2002/03/03 13:27:28 hajny
  865. + added support for OS/2 units (.ppo)
  866. Revision 1.12 2002/01/29 13:24:16 pierre
  867. + also generate .elg file for units
  868. Revision 1.11 2002/01/29 12:51:08 pierre
  869. + PPFileInfo to also display time stamp of test file
  870. * generate .elg file in several cases
  871. to avoid trying to recompute the same test
  872. over and over again.
  873. }