dotest.pp 31 KB

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