dotest.pp 30 KB

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