dotest.pp 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215
  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. OldDir,
  627. FullExeLogFile,
  628. TestRemoteExe,
  629. TestExe : string;
  630. execres : boolean;
  631. function ExecuteRemote(const prog,args:string):boolean;
  632. begin
  633. Verbose(V_Debug,'RemoteExecuting '+Prog+' '+args);
  634. ExecuteRemote:=ExecuteRedir(prog,args,'',EXELogFile,'stdout');
  635. end;
  636. function ExecuteEmulated(const prog,args:string):boolean;
  637. begin
  638. Verbose(V_Debug,'EmulatorExecuting '+Prog+' '+args);
  639. ExecuteEmulated:=ExecuteRedir(prog,args,'',FullExeLogFile,'stdout');
  640. end;
  641. begin
  642. RunExecutable:=false;
  643. execres:=true;
  644. { when remote testing, leave extension away }
  645. if RemoteAddr='' then
  646. TestExe:=OutputFileName(PPFile,ExeExt)
  647. else
  648. TestExe:=OutputFileName(PPFile,'');
  649. if EmulatorName<>'' then
  650. begin
  651. { Get full name out log file, because we change the directory during
  652. execution }
  653. FullExeLogFile:=FExpand(EXELogFile);
  654. {$I-}
  655. GetDir(0,OldDir);
  656. ChDir(TestOutputDir);
  657. {$I+}
  658. ioresult;
  659. execres:=ExecuteEmulated(EmulatorName,CurrDir+SplitFileName(TestExe));
  660. {$I-}
  661. ChDir(OldDir);
  662. {$I+}
  663. end
  664. else if RemoteAddr<>'' then
  665. begin
  666. { We don't want to create subdirs, remove paths from the test }
  667. TestRemoteExe:=RemotePath+'/'+SplitFileName(TestExe);
  668. ExecuteRemote(rshprog,RemotePara+' '+RemoteAddr+' rm -f '+TestRemoteExe);
  669. ExecuteRemote(rcpprog,RemotePara+' '+TestExe+' '+RemoteAddr+':'+TestRemoteExe);
  670. { rsh doesn't pass the exitcode, use a second command to print the exitcode
  671. on the remoteshell to stdout }
  672. execres:=ExecuteRemote(rshprog,RemotePara+' '+RemoteAddr+' '+rquote+'chmod 755 '+TestRemoteExe+
  673. ' ; cd '+RemotePath+' ; '+TestRemoteExe+' ; echo "TestExitCode: $?"'+rquote);
  674. { Check for TestExitCode error in output, sets ExecuteResult }
  675. CheckTestExitCode(EXELogFile);
  676. end
  677. else
  678. begin
  679. { Get full name out log file, because we change the directory during
  680. execution }
  681. FullExeLogFile:=FExpand(EXELogFile);
  682. Verbose(V_Debug,'Executing '+TestExe);
  683. {$I-}
  684. GetDir(0,OldDir);
  685. ChDir(TestOutputDir);
  686. {$I+}
  687. ioresult;
  688. { don't redirect interactive and graph programs }
  689. if Config.IsInteractive or Config.UsesGraph then
  690. execres:=ExecuteRedir(CurrDir+SplitFileName(TestExe),'','','','')
  691. else
  692. execres:=ExecuteRedir(CurrDir+SplitFileName(TestExe),'','',FullExeLogFile,'stdout');
  693. {$I-}
  694. ChDir(OldDir);
  695. {$I+}
  696. ioresult;
  697. end;
  698. { Error during execution? }
  699. Verbose(V_Debug,'Exitcode '+ToStr(ExecuteResult));
  700. if (not execres) and (ExecuteResult=0) then
  701. begin
  702. AddLog(FailLogFile,TestName);
  703. AddLog(ResLogFile,failed_to_run+PPFileInfo);
  704. AddLog(LongLogFile,line_separation);
  705. AddLog(LongLogFile,failed_to_run+PPFileInfo);
  706. CopyFile(EXELogFile,LongLogFile,true);
  707. { avoid to try again }
  708. AddLog(ExeLogFile,failed_to_run+PPFileInfo);
  709. Verbose(V_Abort,'IOStatus: '+ToStr(IOStatus));
  710. exit;
  711. end;
  712. if ExecuteResult<>Config.ResultCode then
  713. begin
  714. if (ExecuteResult<>0) and
  715. (ExecuteResult=Config.KnownRunError) then
  716. begin
  717. AddLog(FailLogFile,TestName+known_problem+Config.KnownRunNote);
  718. AddLog(ResLogFile,failed_to_run+PPFileInfo+known_problem+Config.KnownRunNote);
  719. AddLog(LongLogFile,line_separation);
  720. AddLog(LongLogFile,known_problem+Config.KnownRunNote);
  721. AddLog(LongLogFile,failed_to_run+PPFileInfo+' ('+ToStr(ExecuteResult)+')');
  722. Copyfile(EXELogFile,LongLogFile,true);
  723. Verbose(V_Abort,known_problem+'exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  724. end
  725. else
  726. begin
  727. AddLog(FailLogFile,TestName);
  728. AddLog(ResLogFile,failed_to_run+PPFileInfo);
  729. AddLog(LongLogFile,line_separation);
  730. AddLog(LongLogFile,failed_to_run+PPFileInfo+' ('+ToStr(ExecuteResult)+')');
  731. Copyfile(EXELogFile,LongLogFile,true);
  732. Verbose(V_Abort,'Exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  733. end
  734. end
  735. else
  736. begin
  737. AddLog(ResLogFile,successfully_run+PPFileInfo);
  738. RunExecutable:=true;
  739. end;
  740. if DelExecutable then
  741. begin
  742. Verbose(V_Debug,'Deleting executable '+TestExe);
  743. if RemoteAddr<>'' then
  744. ExecuteRemote(rshprog,RemotePara+' '+RemoteAddr+' rm -f '+TestRemoteExe);
  745. RemoveFile(TestExe);
  746. RemoveFile(ForceExtension(TestExe,ObjExt));
  747. RemoveFile(ForceExtension(TestExe,PPUExt));
  748. end;
  749. end;
  750. procedure getargs;
  751. var
  752. ch : char;
  753. para : string;
  754. i,j : longint;
  755. procedure helpscreen;
  756. begin
  757. writeln('dotest [Options] <File>');
  758. writeln;
  759. writeln('Options can be:');
  760. writeln(' -C<compiler> set compiler to use');
  761. writeln(' -V verbose');
  762. writeln(' -E execute test also');
  763. writeln(' -X don''t use COMSPEC');
  764. writeln(' -A include ALL tests');
  765. writeln(' -G include graph tests');
  766. writeln(' -K include known bug tests');
  767. writeln(' -I include interactive tests');
  768. writeln(' -M<emulator> run the tests using the given emulator');
  769. writeln(' -R<remote> run the tests remotely with the given rsh/ssh address');
  770. writeln(' -S use ssh instead of rsh');
  771. writeln(' -T[cpu-]<os> run tests for target cpu and os');
  772. writeln(' -P<path> path to the tests tree on the remote machine');
  773. writeln(' -U<remotepara>');
  774. writeln(' pass additional parameter to remote program. Multiple -U can be used');
  775. writeln(' -V be verbose');
  776. writeln(' -W use putty compatible file names when testing (plink and pscp)');
  777. writeln(' -Y<opts> extra options passed to the compiler. Several -Y<opt> can be given.');
  778. writeln(' -Z remove temporary files (executable,ppu,o)');
  779. halt(1);
  780. end;
  781. begin
  782. PPFile:='';
  783. if exeext<>'' then
  784. CompilerBin:='ppc386.'+exeext
  785. else
  786. CompilerBin:='ppc386';
  787. for i:=1 to paramcount do
  788. begin
  789. para:=Paramstr(i);
  790. if (para[1]='-') then
  791. begin
  792. ch:=Upcase(para[2]);
  793. delete(para,1,2);
  794. case ch of
  795. 'A' :
  796. begin
  797. DoGraph:=true;
  798. DoInteractive:=true;
  799. DoKnown:=true;
  800. DoAll:=true;
  801. end;
  802. 'C' : CompilerBin:=Para;
  803. 'E' : DoExecute:=true;
  804. 'G' : begin
  805. DoGraph:=true;
  806. if para='-' then
  807. DoUsual:=false;
  808. end;
  809. 'I' : begin
  810. DoInteractive:=true;
  811. if para='-' then
  812. DoUsual:=false;
  813. end;
  814. 'K' : begin
  815. DoKnown:=true;
  816. if para='-' then
  817. DoUsual:=false;
  818. end;
  819. 'M' : EmulatorName:=Para;
  820. 'P' : RemotePath:=Para;
  821. 'R' : RemoteAddr:=Para;
  822. 'S' :
  823. begin
  824. rshprog:='ssh';
  825. rcpprog:='scp';
  826. end;
  827. 'T' :
  828. begin
  829. j:=Pos('-',Para);
  830. if j>0 then
  831. begin
  832. CompilerCPU:=Copy(Para,1,j-1);
  833. CompilerTarget:=Copy(Para,j+1,255);
  834. end
  835. else
  836. CompilerTarget:=Para
  837. end;
  838. 'U' :
  839. RemotePara:=RemotePara+' '+Para;
  840. 'V' : DoVerbose:=true;
  841. 'W' :
  842. begin
  843. rshprog:='plink';
  844. rcpprog:='pscp';
  845. rquote:=' ';
  846. end;
  847. 'X' : UseComSpec:=false;
  848. 'Y' : ExtraCompilerOpts:= ExtraCompilerOpts +' '+ Para;
  849. 'Z' :
  850. DelExecutable:=true;
  851. end;
  852. end
  853. else
  854. begin
  855. If PPFile<>'' then
  856. HelpScreen;
  857. PPFile:=ForceExtension(Para,'pp');
  858. end;
  859. end;
  860. if (PPFile='') then
  861. HelpScreen;
  862. { disable graph,interactive when running remote }
  863. if RemoteAddr<>'' then
  864. begin
  865. DoGraph:=false;
  866. DoInteractive:=false;
  867. end;
  868. SetPPFileInfo;
  869. TestName:=Copy(PPFile,1,Pos('.pp',PPFile)-1);
  870. Verbose(V_Debug,'Running test '+TestName+', file '+PPFile);
  871. end;
  872. procedure RunTest;
  873. var
  874. PPDir : string;
  875. Res : boolean;
  876. begin
  877. Res:=GetConfig(ppfile,Config);
  878. if Res then
  879. begin
  880. Res:=GetCompilerCPU;
  881. Res:=GetCompilerTarget;
  882. {$ifndef MACOS}
  883. RTLUnitsDir:='units/'+{$ifdef LIMIT83FS}CompilerTarget{$else}CompilerFullTarget{$endif};
  884. {$else MACOS}
  885. RTLUnitsDir:=':units:'+CompilerFullTarget;
  886. {$endif MACOS}
  887. if not PathExists(RTLUnitsDir) then
  888. Verbose(V_Abort,'Unit path "'+RTLUnitsDir+'" does not exists');
  889. {$ifndef MACOS}
  890. OutputDir:='output/'+{$ifdef LIMIT83FS}CompilerTarget{$else}CompilerFullTarget{$endif};
  891. {$else MACOS}
  892. OutputDir:=':output:'+CompilerFullTarget;
  893. {$endif MACOS}
  894. if not PathExists(OutputDir) then
  895. Verbose(V_Abort,'Output path "'+OutputDir+'" does not exists');
  896. { Global log files }
  897. ResLogFile:=OutputFileName('log','');
  898. LongLogFile:=OutputFileName('longlog','');
  899. FailLogFile:=OutputFileName('faillist','');
  900. { Make subdir in output if needed }
  901. PPDir:=SplitPath(PPFile);
  902. if PPDir[length(PPDir)] in ['/','\'{$ifdef MACOS},':'{$endif MACOS}] then
  903. Delete(PPDir,length(PPDir),1);
  904. if PPDir<>'' then
  905. begin
  906. {$ifndef MACOS}
  907. TestOutputDir:=OutputDir+'/'+PPDir;
  908. {$else MACOS}
  909. TestOutputDir:=OutputDir+PPDir;
  910. {$endif MACOS}
  911. mkdirtree(TestOutputDir);
  912. end
  913. else
  914. TestOutputDir:=OutputDir;
  915. { Per test logfiles }
  916. CompilerLogFile:=TestOutputFileName(SplitFileName(PPFile),'log');
  917. ExeLogFile:=TestOutputFileName(SplitFileName(PPFile),'elg');
  918. Verbose(V_Debug,'Using Compiler logfile: '+CompilerLogFile);
  919. Verbose(V_Debug,'Using Execution logfile: '+ExeLogFile);
  920. end;
  921. if Res then
  922. begin
  923. if Config.UsesGraph and (not DoGraph) then
  924. begin
  925. AddLog(ResLogFile,skipping_graph_test+PPFileInfo);
  926. { avoid a second attempt by writing to elg file }
  927. AddLog(EXELogFile,skipping_graph_test+PPFileInfo);
  928. Verbose(V_Abort,skipping_graph_test);
  929. Res:=false;
  930. end;
  931. end;
  932. if Res then
  933. begin
  934. if Config.IsInteractive and (not DoInteractive) then
  935. begin
  936. { avoid a second attempt by writing to elg file }
  937. AddLog(EXELogFile,skipping_interactive_test+PPFileInfo);
  938. AddLog(ResLogFile,skipping_interactive_test+PPFileInfo);
  939. Verbose(V_Abort,skipping_interactive_test);
  940. Res:=false;
  941. end;
  942. end;
  943. if Res then
  944. begin
  945. if Config.IsKnownCompileError and (not DoKnown) then
  946. begin
  947. { avoid a second attempt by writing to elg file }
  948. AddLog(EXELogFile,skipping_known_bug+PPFileInfo);
  949. AddLog(ResLogFile,skipping_known_bug+PPFileInfo);
  950. Verbose(V_Abort,skipping_known_bug);
  951. Res:=false;
  952. end;
  953. end;
  954. if Res and not DoUsual then
  955. res:=(Config.IsInteractive and DoInteractive) or
  956. (Config.IsKnownRunError and DoKnown) or
  957. (Config.UsesGraph and DoGraph);
  958. if Res then
  959. begin
  960. if (Config.MinVersion<>'') and not DoAll then
  961. begin
  962. Verbose(V_Debug,'Required compiler version: '+Config.MinVersion);
  963. Res:=GetCompilerVersion;
  964. if CompilerVersion<Config.MinVersion then
  965. begin
  966. { avoid a second attempt by writing to elg file }
  967. AddLog(EXELogFile,skipping_compiler_version_too_low+PPFileInfo);
  968. AddLog(ResLogFile,skipping_compiler_version_too_low+PPFileInfo);
  969. Verbose(V_Abort,'Compiler version too low '+CompilerVersion+' < '+Config.MinVersion);
  970. Res:=false;
  971. end;
  972. end;
  973. end;
  974. if Res then
  975. begin
  976. if (Config.MaxVersion<>'') and not DoAll then
  977. begin
  978. Verbose(V_Debug,'Highest compiler version: '+Config.MaxVersion);
  979. Res:=GetCompilerVersion;
  980. if CompilerVersion>Config.MaxVersion then
  981. begin
  982. { avoid a second attempt by writing to elg file }
  983. AddLog(EXELogFile,skipping_compiler_version_too_high+PPFileInfo);
  984. AddLog(ResLogFile,skipping_compiler_version_too_high+PPFileInfo);
  985. Verbose(V_Abort,'Compiler version too high '+CompilerVersion+' > '+Config.MaxVersion);
  986. Res:=false;
  987. end;
  988. end;
  989. end;
  990. if Res then
  991. begin
  992. if Config.NeedCPU<>'' then
  993. begin
  994. Verbose(V_Debug,'Required compiler cpu: '+Config.NeedCPU);
  995. if not IsInList(CompilerCPU,Config.NeedCPU) then
  996. begin
  997. { avoid a second attempt by writing to elg file }
  998. AddLog(EXELogFile,skipping_other_cpu+PPFileInfo);
  999. AddLog(ResLogFile,skipping_other_cpu+PPFileInfo);
  1000. Verbose(V_Abort,'Compiler cpu "'+CompilerCPU+'" is not in list "'+Config.NeedCPU+'"');
  1001. Res:=false;
  1002. end;
  1003. end;
  1004. end;
  1005. if Res then
  1006. begin
  1007. if Config.SkipCPU<>'' then
  1008. begin
  1009. Verbose(V_Debug,'Skip compiler cpu: '+Config.SkipCPU);
  1010. if IsInList(CompilerCPU,Config.SkipCPU) then
  1011. begin
  1012. { avoid a second attempt by writing to elg file }
  1013. AddLog(EXELogFile,skipping_other_cpu+PPFileInfo);
  1014. AddLog(ResLogFile,skipping_other_cpu+PPFileInfo);
  1015. Verbose(V_Abort,'Compiler cpu "'+CompilerCPU+'" is in list "'+Config.SkipCPU+'"');
  1016. Res:=false;
  1017. end;
  1018. end;
  1019. end;
  1020. if Res then
  1021. begin
  1022. if Config.SkipEmu<>'' then
  1023. begin
  1024. Verbose(V_Debug,'Skip emulator: '+emulatorname);
  1025. if IsInList(emulatorname,Config.SkipEmu) then
  1026. begin
  1027. { avoid a second attempt by writing to elg file }
  1028. AddLog(EXELogFile,skipping_other_cpu+PPFileInfo);
  1029. AddLog(ResLogFile,skipping_other_cpu+PPFileInfo);
  1030. Verbose(V_Abort,'Emulator "'+emulatorname+'" is in list "'+Config.SkipEmu+'"');
  1031. Res:=false;
  1032. end;
  1033. end;
  1034. end;
  1035. if Res then
  1036. begin
  1037. if Config.NeedTarget<>'' then
  1038. begin
  1039. Verbose(V_Debug,'Required compiler target: '+Config.NeedTarget);
  1040. if not IsInList(CompilerTarget,Config.NeedTarget) then
  1041. begin
  1042. { avoid a second attempt by writing to elg file }
  1043. AddLog(EXELogFile,skipping_other_target+PPFileInfo);
  1044. AddLog(ResLogFile,skipping_other_target+PPFileInfo);
  1045. Verbose(V_Abort,'Compiler target "'+CompilerTarget+'" is not in list "'+Config.NeedTarget+'"');
  1046. Res:=false;
  1047. end;
  1048. end;
  1049. end;
  1050. if Res then
  1051. begin
  1052. if Config.SkipTarget<>'' then
  1053. begin
  1054. Verbose(V_Debug,'Skip compiler target: '+Config.NeedTarget);
  1055. if IsInList(CompilerTarget,Config.SkipTarget) then
  1056. begin
  1057. { avoid a second attempt by writing to elg file }
  1058. AddLog(EXELogFile,skipping_other_target+PPFileInfo);
  1059. AddLog(ResLogFile,skipping_other_target+PPFileInfo);
  1060. Verbose(V_Abort,'Compiler target "'+CompilerTarget+'" is in list "'+Config.SkipTarget+'"');
  1061. Res:=false;
  1062. end;
  1063. end;
  1064. end;
  1065. if Res then
  1066. begin
  1067. Res:=RunCompiler;
  1068. if Res and Config.NeedRecompile then
  1069. Res:=RunCompiler;
  1070. end;
  1071. if Res then
  1072. begin
  1073. if (Config.NoRun) then
  1074. begin
  1075. { avoid a second attempt by writing to elg file }
  1076. AddLog(EXELogFile,skipping_run_test+PPFileInfo);
  1077. AddLog(ResLogFile,skipping_run_test+PPFileInfo);
  1078. Verbose(V_Debug,skipping_run_test);
  1079. end
  1080. else if Config.IsKnownRunError and (not DoKnown) then
  1081. begin
  1082. { avoid a second attempt by writing to elg file }
  1083. AddLog(EXELogFile,skipping_known_bug+PPFileInfo);
  1084. AddLog(ResLogFile,skipping_known_bug+PPFileInfo);
  1085. Verbose(V_Abort,skipping_known_bug);
  1086. end
  1087. else
  1088. begin
  1089. if (not Config.ShouldFail) and DoExecute then
  1090. begin
  1091. if FileExists(TestOutputFilename(PPFile,'ppu')) or
  1092. FileExists(TestOutputFilename(PPFile,'ppo')) or
  1093. FileExists(TestOutputFilename(PPFile,'ppw')) then
  1094. begin
  1095. AddLog(ExeLogFile,skipping_run_unit+PPFileInfo);
  1096. AddLog(ResLogFile,skipping_run_unit+PPFileInfo);
  1097. Verbose(V_Debug,'Unit found, skipping run test')
  1098. end
  1099. else
  1100. Res:=RunExecutable;
  1101. end;
  1102. end;
  1103. end;
  1104. end;
  1105. begin
  1106. GetArgs;
  1107. RunTest;
  1108. end.