dotest.pp 28 KB

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