dotest.pp 25 KB

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