dotest.pp 32 KB

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