dotest.pp 31 KB

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