dotest.pp 30 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165
  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. args:=args+' -Fl'+TestOutputDir+' ''-k-rpath .''';
  446. {$endif unix}
  447. if Config.NeedOptions<>'' then
  448. args:=args+' '+Config.NeedOptions;
  449. args:=args+' '+ppfile;
  450. Verbose(V_Debug,'Executing '+compilerbin+' '+args);
  451. { also get the output from as and ld that writes to stderr sometimes }
  452. {$ifndef macos}
  453. execres:=ExecuteRedir(CompilerBin,args,'',CompilerLogFile,'stdout');
  454. {$else macos}
  455. {Due to that Toolserver is not reentrant, we have to asm and link via script.}
  456. execres:=ExecuteRedir(CompilerBin,'-s '+args,'',CompilerLogFile,'stdout');
  457. if execres then
  458. execres:=ExecuteRedir(TestOutputDir + ':ppas','','',CompilerLogFile,'stdout');
  459. {$endif macos}
  460. Verbose(V_Debug,'Exitcode '+ToStr(ExecuteResult));
  461. { Error during execution? }
  462. if (not execres) and (ExecuteResult=0) then
  463. begin
  464. AddLog(FailLogFile,TestName);
  465. AddLog(ResLogFile,failed_to_compile+PPFileInfo);
  466. AddLog(LongLogFile,line_separation);
  467. AddLog(LongLogFile,failed_to_compile+PPFileInfo);
  468. CopyFile(CompilerLogFile,LongLogFile,true);
  469. { avoid to try again }
  470. AddLog(ExeLogFile,failed_to_compile+PPFileInfo);
  471. Verbose(V_Abort,'IOStatus: '+ToStr(IOStatus));
  472. exit;
  473. end;
  474. { Check for internal error }
  475. if ExitWithInternalError(CompilerLogFile) then
  476. begin
  477. AddLog(FailLogFile,TestName);
  478. if Config.Note<>'' then
  479. AddLog(FailLogFile,Config.Note);
  480. AddLog(ResLogFile,failed_to_compile+PPFileInfo+' internalerror generated');
  481. AddLog(LongLogFile,line_separation);
  482. AddLog(LongLogFile,failed_to_compile+PPFileInfo);
  483. if Config.Note<>'' then
  484. AddLog(LongLogFile,Config.Note);
  485. CopyFile(CompilerLogFile,LongLogFile,true);
  486. { avoid to try again }
  487. AddLog(ExeLogFile,'Failed to compile '++PPFileInfo);
  488. Verbose(V_Abort,'Internal error in compiler');
  489. exit;
  490. end;
  491. { Should the compile fail ? }
  492. if Config.ShouldFail then
  493. begin
  494. if ExecuteResult<>0 then
  495. begin
  496. AddLog(ResLogFile,success_compilation_failed+PPFileInfo);
  497. { avoid to try again }
  498. AddLog(ExeLogFile,success_compilation_failed+PPFileInfo);
  499. RunCompiler:=true;
  500. end
  501. else
  502. begin
  503. AddLog(FailLogFile,TestName);
  504. if Config.Note<>'' then
  505. AddLog(FailLogFile,Config.Note);
  506. AddLog(ResLogFile,failed_compilation_successful+PPFileInfo);
  507. AddLog(LongLogFile,line_separation);
  508. AddLog(LongLogFile,failed_compilation_successful+PPFileInfo);
  509. { avoid to try again }
  510. AddLog(ExeLogFile,failed_compilation_successful+PPFileInfo);
  511. if Config.Note<>'' then
  512. AddLog(LongLogFile,Config.Note);
  513. CopyFile(CompilerLogFile,LongLogFile,true);
  514. end;
  515. end
  516. else
  517. begin
  518. if (ExecuteResult<>0) and
  519. (((Config.KnownCompileNote<>'') and (Config.KnownCompileError=0)) or
  520. ((Config.KnownCompileError<>0) and (ExecuteResult=Config.KnownCompileError))) then
  521. begin
  522. AddLog(FailLogFile,TestName+known_problem+Config.KnownCompileNote);
  523. AddLog(ResLogFile,failed_to_run+PPFileInfo+known_problem+Config.KnownCompileNote);
  524. AddLog(LongLogFile,line_separation);
  525. AddLog(LongLogFile,known_problem+Config.KnownCompileNote);
  526. AddLog(LongLogFile,failed_to_compile+PPFileInfo+' ('+ToStr(ExecuteResult)+')');
  527. Copyfile(CompilerLogFile,LongLogFile,true);
  528. Verbose(V_Abort,known_problem+'exitcode: '+ToStr(ExecuteResult));
  529. end
  530. else if ExecuteResult<>0 then
  531. begin
  532. AddLog(FailLogFile,TestName);
  533. if Config.Note<>'' then
  534. AddLog(FailLogFile,Config.Note);
  535. AddLog(ResLogFile,failed_to_compile+PPFileInfo);
  536. AddLog(LongLogFile,line_separation);
  537. AddLog(LongLogFile,failed_to_compile+PPFileInfo);
  538. if Config.Note<>'' then
  539. AddLog(LongLogFile,Config.Note);
  540. CopyFile(CompilerLogFile,LongLogFile,true);
  541. { avoid to try again }
  542. AddLog(ExeLogFile,failed_to_compile+PPFileInfo);
  543. Verbose(V_Abort,'Exitcode: '+ToStr(ExecuteResult)+' (expected 0)');
  544. end
  545. else
  546. begin
  547. AddLog(ResLogFile,successfully_compiled+PPFileInfo);
  548. RunCompiler:=true;
  549. end;
  550. end;
  551. end;
  552. function CheckTestExitCode(const OutName:string):boolean;
  553. var
  554. t : text;
  555. s : string;
  556. i,code : integer;
  557. begin
  558. CheckTestExitCode:=false;
  559. { open logfile }
  560. assign(t,Outname);
  561. {$I-}
  562. reset(t);
  563. {$I+}
  564. if ioresult<>0 then
  565. exit;
  566. while not eof(t) do
  567. begin
  568. readln(t,s);
  569. i:=pos('TestExitCode: ',s);
  570. if i>0 then
  571. begin
  572. delete(s,1,i+14-1);
  573. val(s,ExecuteResult,code);
  574. if code=0 then;
  575. CheckTestExitCode:=true;
  576. break;
  577. end;
  578. end;
  579. close(t);
  580. end;
  581. function RunExecutable:boolean;
  582. const
  583. {$ifdef unix}
  584. CurrDir = './';
  585. {$else}
  586. CurrDir = '';
  587. {$endif}
  588. var
  589. OldDir,
  590. FullExeLogFile,
  591. TestRemoteExe,
  592. TestExe : string;
  593. execres : boolean;
  594. function ExecuteRemote(const prog,args:string):boolean;
  595. begin
  596. Verbose(V_Debug,'RemoteExecuting '+Prog+' '+args);
  597. ExecuteRemote:=ExecuteRedir(prog,args,'',EXELogFile,'stdout');
  598. end;
  599. function ExecuteEmulated(const prog,args:string):boolean;
  600. begin
  601. Verbose(V_Debug,'EmulatorExecuting '+Prog+' '+args);
  602. ExecuteEmulated:=ExecuteRedir(prog,args,'',FullExeLogFile,'stdout');
  603. end;
  604. begin
  605. RunExecutable:=false;
  606. execres:=true;
  607. { when remote testing, leave extension away }
  608. if RemoteAddr='' then
  609. TestExe:=OutputFileName(PPFile,ExeExt)
  610. else
  611. TestExe:=OutputFileName(PPFile,'');
  612. if EmulatorName<>'' then
  613. begin
  614. { Get full name out log file, because we change the directory during
  615. execution }
  616. FullExeLogFile:=FExpand(EXELogFile);
  617. {$I-}
  618. GetDir(0,OldDir);
  619. ChDir(TestOutputDir);
  620. {$I+}
  621. ioresult;
  622. execres:=ExecuteEmulated(EmulatorName,CurrDir+SplitFileName(TestExe));
  623. {$I-}
  624. ChDir(OldDir);
  625. {$I+}
  626. end
  627. else if RemoteAddr<>'' then
  628. begin
  629. { We don't want to create subdirs, remove paths from the test }
  630. TestRemoteExe:=RemotePath+'/'+SplitFileName(TestExe);
  631. ExecuteRemote(rshprog,RemotePara+' '+RemoteAddr+' rm -f '+TestRemoteExe);
  632. ExecuteRemote(rcpprog,RemotePara+' '+TestExe+' '+RemoteAddr+':'+TestRemoteExe);
  633. { rsh doesn't pass the exitcode, use a second command to print the exitcode
  634. on the remoteshell to stdout }
  635. execres:=ExecuteRemote(rshprog,RemotePara+' '+RemoteAddr+' '+rquote+'chmod 755 '+TestRemoteExe+
  636. ' ; cd '+RemotePath+' ; '+TestRemoteExe+' ; echo "TestExitCode: $?"'+rquote);
  637. { Check for TestExitCode error in output, sets ExecuteResult }
  638. CheckTestExitCode(EXELogFile);
  639. end
  640. else
  641. begin
  642. { Get full name out log file, because we change the directory during
  643. execution }
  644. FullExeLogFile:=FExpand(EXELogFile);
  645. Verbose(V_Debug,'Executing '+TestExe);
  646. {$I-}
  647. GetDir(0,OldDir);
  648. ChDir(TestOutputDir);
  649. {$I+}
  650. ioresult;
  651. { don't redirect interactive and graph programs }
  652. if Config.IsInteractive or Config.UsesGraph then
  653. execres:=ExecuteRedir(CurrDir+SplitFileName(TestExe),'','','','')
  654. else
  655. execres:=ExecuteRedir(CurrDir+SplitFileName(TestExe),'','',FullExeLogFile,'stdout');
  656. {$I-}
  657. ChDir(OldDir);
  658. {$I+}
  659. ioresult;
  660. end;
  661. { Error during execution? }
  662. Verbose(V_Debug,'Exitcode '+ToStr(ExecuteResult));
  663. if (not execres) and (ExecuteResult=0) then
  664. begin
  665. AddLog(FailLogFile,TestName);
  666. AddLog(ResLogFile,failed_to_run+PPFileInfo);
  667. AddLog(LongLogFile,line_separation);
  668. AddLog(LongLogFile,failed_to_run+PPFileInfo);
  669. CopyFile(EXELogFile,LongLogFile,true);
  670. { avoid to try again }
  671. AddLog(ExeLogFile,failed_to_run+PPFileInfo);
  672. Verbose(V_Abort,'IOStatus: '+ToStr(IOStatus));
  673. exit;
  674. end;
  675. if ExecuteResult<>Config.ResultCode then
  676. begin
  677. if (ExecuteResult<>0) and
  678. (ExecuteResult=Config.KnownRunError) then
  679. begin
  680. AddLog(FailLogFile,TestName+known_problem+Config.KnownRunNote);
  681. AddLog(ResLogFile,failed_to_run+PPFileInfo+known_problem+Config.KnownRunNote);
  682. AddLog(LongLogFile,line_separation);
  683. AddLog(LongLogFile,known_problem+Config.KnownRunNote);
  684. AddLog(LongLogFile,failed_to_run+PPFileInfo+' ('+ToStr(ExecuteResult)+')');
  685. Copyfile(EXELogFile,LongLogFile,true);
  686. Verbose(V_Abort,known_problem+'exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  687. end
  688. else
  689. begin
  690. AddLog(FailLogFile,TestName);
  691. AddLog(ResLogFile,failed_to_run+PPFileInfo);
  692. AddLog(LongLogFile,line_separation);
  693. AddLog(LongLogFile,failed_to_run+PPFileInfo+' ('+ToStr(ExecuteResult)+')');
  694. Copyfile(EXELogFile,LongLogFile,true);
  695. Verbose(V_Abort,'Exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  696. end
  697. end
  698. else
  699. begin
  700. AddLog(ResLogFile,successfully_run+PPFileInfo);
  701. RunExecutable:=true;
  702. end;
  703. if DelExecutable then
  704. begin
  705. Verbose(V_Debug,'Deleting executable '+TestExe);
  706. if RemoteAddr<>'' then
  707. ExecuteRemote(rshprog,RemotePara+' '+RemoteAddr+' rm -f '+TestRemoteExe);
  708. RemoveFile(TestExe);
  709. RemoveFile(ForceExtension(TestExe,ObjExt));
  710. RemoveFile(ForceExtension(TestExe,PPUExt));
  711. end;
  712. end;
  713. procedure getargs;
  714. var
  715. ch : char;
  716. para : string;
  717. i : longint;
  718. procedure helpscreen;
  719. begin
  720. writeln('dotest [Options] <File>');
  721. writeln;
  722. writeln('Options can be:');
  723. writeln(' -C<compiler> set compiler to use');
  724. writeln(' -V verbose');
  725. writeln(' -E execute test also');
  726. writeln(' -X don''t use COMSPEC');
  727. writeln(' -A include ALL tests');
  728. writeln(' -G include graph tests');
  729. writeln(' -K include known bug tests');
  730. writeln(' -I include interactive tests');
  731. writeln(' -M<emulator> run the tests using the given emulator');
  732. writeln(' -R<remote> run the tests remotely with the given rsh/ssh address');
  733. writeln(' -S use ssh instead of rsh');
  734. writeln(' -T remove temporary files (executable,ppu,o)');
  735. writeln(' -P<path> path to the tests tree on the remote machine');
  736. writeln(' -U<remotepara>');
  737. writeln(' pass additional parameter to remote program. Multiple -U can be used');
  738. writeln(' -V be verbose');
  739. writeln(' -W use putty compatible file names when testing (plink and pscp)');
  740. writeln(' -Y<opts> extra options passed to the compiler. Several -Y<opt> can be given.');
  741. halt(1);
  742. end;
  743. begin
  744. PPFile:='';
  745. if exeext<>'' then
  746. CompilerBin:='ppc386.'+exeext
  747. else
  748. CompilerBin:='ppc386';
  749. for i:=1 to paramcount do
  750. begin
  751. para:=Paramstr(i);
  752. if (para[1]='-') then
  753. begin
  754. ch:=Upcase(para[2]);
  755. delete(para,1,2);
  756. case ch of
  757. 'A' :
  758. begin
  759. DoGraph:=true;
  760. DoInteractive:=true;
  761. DoKnown:=true;
  762. DoAll:=true;
  763. end;
  764. 'C' : CompilerBin:=Para;
  765. 'E' : DoExecute:=true;
  766. 'G' : begin
  767. DoGraph:=true;
  768. if para='-' then
  769. DoUsual:=false;
  770. end;
  771. 'I' : begin
  772. DoInteractive:=true;
  773. if para='-' then
  774. DoUsual:=false;
  775. end;
  776. 'K' : begin
  777. DoKnown:=true;
  778. if para='-' then
  779. DoUsual:=false;
  780. end;
  781. 'M' : EmulatorName:=Para;
  782. 'P' : RemotePath:=Para;
  783. 'R' : RemoteAddr:=Para;
  784. 'S' :
  785. begin
  786. rshprog:='ssh';
  787. rcpprog:='scp';
  788. end;
  789. 'T' :
  790. DelExecutable:=true;
  791. 'U' :
  792. RemotePara:=+RemotePara+' '+Para;
  793. 'V' : DoVerbose:=true;
  794. 'W' :
  795. begin
  796. rshprog:='plink';
  797. rcpprog:='pscp';
  798. rquote:=' ';
  799. end;
  800. 'X' : UseComSpec:=false;
  801. 'Y' : ExtraCompilerOpts:= ExtraCompilerOpts +' '+ Para;
  802. end;
  803. end
  804. else
  805. begin
  806. If PPFile<>'' then
  807. HelpScreen;
  808. PPFile:=ForceExtension(Para,'pp');
  809. end;
  810. end;
  811. if (PPFile='') then
  812. HelpScreen;
  813. { disable graph,interactive when running remote }
  814. if RemoteAddr<>'' then
  815. begin
  816. DoGraph:=false;
  817. DoInteractive:=false;
  818. end;
  819. SetPPFileInfo;
  820. TestName:=Copy(PPFile,1,Pos('.pp',PPFile)-1);
  821. Verbose(V_Debug,'Running test '+TestName+', file '+PPFile);
  822. end;
  823. procedure RunTest;
  824. var
  825. PPDir : string;
  826. Res : boolean;
  827. begin
  828. Res:=GetConfig(ppfile,Config);
  829. if Res then
  830. begin
  831. Res:=GetCompilerCPU;
  832. Res:=GetCompilerTarget;
  833. {$ifndef MACOS}
  834. RTLUnitsDir:='units/'+{$ifdef LIMIT83FS}CompilerTarget{$else}CompilerFullTarget{$endif};
  835. {$else MACOS}
  836. RTLUnitsDir:=':units:'+CompilerFullTarget;
  837. {$endif MACOS}
  838. if not PathExists(RTLUnitsDir) then
  839. Verbose(V_Abort,'Unit path "'+RTLUnitsDir+'" does not exists');
  840. {$ifndef MACOS}
  841. OutputDir:='output/'+{$ifdef LIMIT83FS}CompilerTarget{$else}CompilerFullTarget{$endif};
  842. {$else MACOS}
  843. OutputDir:=':output:'+CompilerFullTarget;
  844. {$endif MACOS}
  845. if not PathExists(OutputDir) then
  846. Verbose(V_Abort,'Output path "'+OutputDir+'" does not exists');
  847. { Global log files }
  848. ResLogFile:=OutputFileName('log','');
  849. LongLogFile:=OutputFileName('longlog','');
  850. FailLogFile:=OutputFileName('faillist','');
  851. { Make subdir in output if needed }
  852. PPDir:=SplitPath(PPFile);
  853. if PPDir[length(PPDir)] in ['/','\'{$ifdef MACOS},':'{$endif MACOS}] then
  854. Delete(PPDir,length(PPDir),1);
  855. if PPDir<>'' then
  856. begin
  857. {$ifndef MACOS}
  858. TestOutputDir:=OutputDir+'/'+PPDir;
  859. {$else MACOS}
  860. TestOutputDir:=OutputDir+PPDir;
  861. {$endif MACOS}
  862. mkdirtree(TestOutputDir);
  863. end
  864. else
  865. TestOutputDir:=OutputDir;
  866. { Per test logfiles }
  867. CompilerLogFile:=TestOutputFileName(SplitFileName(PPFile),'log');
  868. ExeLogFile:=TestOutputFileName(SplitFileName(PPFile),'elg');
  869. Verbose(V_Debug,'Using Compiler logfile: '+CompilerLogFile);
  870. Verbose(V_Debug,'Using Execution logfile: '+ExeLogFile);
  871. end;
  872. if Res then
  873. begin
  874. if Config.UsesGraph and (not DoGraph) then
  875. begin
  876. AddLog(ResLogFile,skipping_graph_test+PPFileInfo);
  877. { avoid a second attempt by writing to elg file }
  878. AddLog(EXELogFile,skipping_graph_test+PPFileInfo);
  879. Verbose(V_Abort,skipping_graph_test);
  880. Res:=false;
  881. end;
  882. end;
  883. if Res then
  884. begin
  885. if Config.IsInteractive and (not DoInteractive) then
  886. begin
  887. { avoid a second attempt by writing to elg file }
  888. AddLog(EXELogFile,skipping_interactive_test+PPFileInfo);
  889. AddLog(ResLogFile,skipping_interactive_test+PPFileInfo);
  890. Verbose(V_Abort,skipping_interactive_test);
  891. Res:=false;
  892. end;
  893. end;
  894. if Res then
  895. begin
  896. if Config.IsKnownCompileError and (not DoKnown) then
  897. begin
  898. { avoid a second attempt by writing to elg file }
  899. AddLog(EXELogFile,skipping_known_bug+PPFileInfo);
  900. AddLog(ResLogFile,skipping_known_bug+PPFileInfo);
  901. Verbose(V_Abort,skipping_known_bug);
  902. Res:=false;
  903. end;
  904. end;
  905. if Res and not DoUsual then
  906. res:=(Config.IsInteractive and DoInteractive) or
  907. (Config.IsKnownRunError and DoKnown) or
  908. (Config.UsesGraph and DoGraph);
  909. if Res then
  910. begin
  911. if (Config.MinVersion<>'') and not DoAll then
  912. begin
  913. Verbose(V_Debug,'Required compiler version: '+Config.MinVersion);
  914. Res:=GetCompilerVersion;
  915. if CompilerVersion<Config.MinVersion then
  916. begin
  917. { avoid a second attempt by writing to elg file }
  918. AddLog(EXELogFile,skipping_compiler_version_too_low+PPFileInfo);
  919. AddLog(ResLogFile,skipping_compiler_version_too_low+PPFileInfo);
  920. Verbose(V_Abort,'Compiler version too low '+CompilerVersion+' < '+Config.MinVersion);
  921. Res:=false;
  922. end;
  923. end;
  924. end;
  925. if Res then
  926. begin
  927. if (Config.MaxVersion<>'') and not DoAll then
  928. begin
  929. Verbose(V_Debug,'Highest compiler version: '+Config.MaxVersion);
  930. Res:=GetCompilerVersion;
  931. if CompilerVersion>Config.MaxVersion then
  932. begin
  933. { avoid a second attempt by writing to elg file }
  934. AddLog(EXELogFile,skipping_compiler_version_too_high+PPFileInfo);
  935. AddLog(ResLogFile,skipping_compiler_version_too_high+PPFileInfo);
  936. Verbose(V_Abort,'Compiler version too high '+CompilerVersion+' > '+Config.MaxVersion);
  937. Res:=false;
  938. end;
  939. end;
  940. end;
  941. if Res then
  942. begin
  943. if Config.NeedCPU<>'' then
  944. begin
  945. Verbose(V_Debug,'Required compiler cpu: '+Config.NeedCPU);
  946. if not IsInList(CompilerCPU,Config.NeedCPU) then
  947. begin
  948. { avoid a second attempt by writing to elg file }
  949. AddLog(EXELogFile,skipping_other_cpu+PPFileInfo);
  950. AddLog(ResLogFile,skipping_other_cpu+PPFileInfo);
  951. Verbose(V_Abort,'Compiler cpu "'+CompilerCPU+'" is not in list "'+Config.NeedCPU+'"');
  952. Res:=false;
  953. end;
  954. end;
  955. end;
  956. if Res then
  957. begin
  958. if Config.SkipCPU<>'' then
  959. begin
  960. Verbose(V_Debug,'Skip compiler cpu: '+Config.SkipCPU);
  961. if IsInList(CompilerCPU,Config.SkipCPU) then
  962. begin
  963. { avoid a second attempt by writing to elg file }
  964. AddLog(EXELogFile,skipping_other_cpu+PPFileInfo);
  965. AddLog(ResLogFile,skipping_other_cpu+PPFileInfo);
  966. Verbose(V_Abort,'Compiler cpu "'+CompilerCPU+'" is in list "'+Config.SkipCPU+'"');
  967. Res:=false;
  968. end;
  969. end;
  970. end;
  971. if Res then
  972. begin
  973. if Config.SkipEmu<>'' then
  974. begin
  975. Verbose(V_Debug,'Skip emulator: '+emulatorname);
  976. if IsInList(emulatorname,Config.SkipEmu) then
  977. begin
  978. { avoid a second attempt by writing to elg file }
  979. AddLog(EXELogFile,skipping_other_cpu+PPFileInfo);
  980. AddLog(ResLogFile,skipping_other_cpu+PPFileInfo);
  981. Verbose(V_Abort,'Emulator "'+emulatorname+'" is in list "'+Config.SkipEmu+'"');
  982. Res:=false;
  983. end;
  984. end;
  985. end;
  986. if Res then
  987. begin
  988. if Config.NeedTarget<>'' then
  989. begin
  990. Verbose(V_Debug,'Required compiler target: '+Config.NeedTarget);
  991. if not IsInList(CompilerTarget,Config.NeedTarget) then
  992. begin
  993. { avoid a second attempt by writing to elg file }
  994. AddLog(EXELogFile,skipping_other_target+PPFileInfo);
  995. AddLog(ResLogFile,skipping_other_target+PPFileInfo);
  996. Verbose(V_Abort,'Compiler target "'+CompilerTarget+'" is not in list "'+Config.NeedTarget+'"');
  997. Res:=false;
  998. end;
  999. end;
  1000. end;
  1001. if Res then
  1002. begin
  1003. if Config.SkipTarget<>'' then
  1004. begin
  1005. Verbose(V_Debug,'Skip compiler target: '+Config.NeedTarget);
  1006. if IsInList(CompilerTarget,Config.SkipTarget) then
  1007. begin
  1008. { avoid a second attempt by writing to elg file }
  1009. AddLog(EXELogFile,skipping_other_target+PPFileInfo);
  1010. AddLog(ResLogFile,skipping_other_target+PPFileInfo);
  1011. Verbose(V_Abort,'Compiler target "'+CompilerTarget+'" is in list "'+Config.SkipTarget+'"');
  1012. Res:=false;
  1013. end;
  1014. end;
  1015. end;
  1016. if Res then
  1017. begin
  1018. Res:=RunCompiler;
  1019. if Res and Config.NeedRecompile then
  1020. Res:=RunCompiler;
  1021. end;
  1022. if Res then
  1023. begin
  1024. if (Config.NoRun) then
  1025. begin
  1026. { avoid a second attempt by writing to elg file }
  1027. AddLog(EXELogFile,skipping_run_test+PPFileInfo);
  1028. AddLog(ResLogFile,skipping_run_test+PPFileInfo);
  1029. Verbose(V_Debug,skipping_run_test);
  1030. end
  1031. else if Config.IsKnownRunError and (not DoKnown) then
  1032. begin
  1033. { avoid a second attempt by writing to elg file }
  1034. AddLog(EXELogFile,skipping_known_bug+PPFileInfo);
  1035. AddLog(ResLogFile,skipping_known_bug+PPFileInfo);
  1036. Verbose(V_Abort,skipping_known_bug);
  1037. end
  1038. else
  1039. begin
  1040. if (not Config.ShouldFail) and DoExecute then
  1041. begin
  1042. if FileExists(TestOutputFilename(PPFile,'ppu')) or
  1043. FileExists(TestOutputFilename(PPFile,'ppo')) or
  1044. FileExists(TestOutputFilename(PPFile,'ppw')) then
  1045. begin
  1046. AddLog(ExeLogFile,skipping_run_unit+PPFileInfo);
  1047. AddLog(ResLogFile,skipping_run_unit+PPFileInfo);
  1048. Verbose(V_Debug,'Unit found, skipping run test')
  1049. end
  1050. else
  1051. Res:=RunExecutable;
  1052. end;
  1053. end;
  1054. end;
  1055. end;
  1056. begin
  1057. GetArgs;
  1058. RunTest;
  1059. end.