dotest.pp 31 KB

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