dotest.pp 22 KB

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