dotest.pp 27 KB

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