dotest.pp 48 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749
  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. {$goto on}
  14. program dotest;
  15. uses
  16. dos,
  17. {$ifdef macos}
  18. macutils,
  19. {$endif}
  20. teststr,
  21. testu,
  22. redir,
  23. bench,
  24. classes;
  25. {$ifdef go32v2}
  26. {$define LIMIT83FS}
  27. {$endif}
  28. {$ifdef os2}
  29. {$define LIMIT83FS}
  30. {$endif}
  31. type
  32. tcompinfo = (compver,comptarget,compcpu);
  33. tdelexecutable = (deBefore, deAfter);
  34. tdelexecutables = set of tdelexecutable;
  35. const
  36. ObjExt='o';
  37. PPUExt='ppu';
  38. {$ifdef UNIX}
  39. SrcExeExt='';
  40. {$else UNIX}
  41. {$ifdef MACOS}
  42. SrcExeExt='';
  43. {$else MACOS}
  44. SrcExeExt='.exe';
  45. {$endif MACOS}
  46. {$endif UNIX}
  47. ExeExt : string = '';
  48. DefaultTimeout=60;
  49. var
  50. Config : TConfig;
  51. CompilerLogFile,
  52. ExeLogFile,
  53. LongLogfile,
  54. FailLogfile,
  55. RTLUnitsDir,
  56. TestOutputDir,
  57. OutputDir : string;
  58. CompilerBin,
  59. { CompilerCPU and CompilerTarget are lowercased at start
  60. to avoid need to call lowercase again and again ... }
  61. CompilerCPU,
  62. CompilerTarget,
  63. CompilerVersion,
  64. DefaultCompilerCPU,
  65. DefaultCompilerTarget,
  66. DefaultCompilerVersion : string;
  67. PPFile : TStringList;
  68. PPFileInfo : TStringList;
  69. TestName : string;
  70. Current : longint;
  71. const
  72. DoGraph : boolean = false;
  73. UseOSOnly : boolean = false;
  74. DoInteractive : boolean = false;
  75. DoExecute : boolean = false;
  76. DoKnown : boolean = false;
  77. DoAll : boolean = false;
  78. DoUsual : boolean = true;
  79. { TargetDir : string = ''; unused }
  80. BenchmarkInfo : boolean = false;
  81. ExtraCompilerOpts : string = '';
  82. DelExecutable : TDelExecutables = [];
  83. RemoteAddr : string = '';
  84. RemotePath : string = '/tmp';
  85. RemotePara : string = '';
  86. RemoteShell : string = '';
  87. RemoteShellBase : string = '';
  88. RemoteShellNeedsExport : boolean = false;
  89. rshprog : string = 'rsh';
  90. rcpprog : string = 'rcp';
  91. rquote : char = '''';
  92. UseTimeout : boolean = false;
  93. emulatorname : string = '';
  94. TargetCanCompileLibraries : boolean = true;
  95. { Constants used in IsAbsolute function }
  96. TargetHasDosStyleDirectories : boolean = false;
  97. TargetAmigaLike : boolean = false;
  98. TargetIsMacOS : boolean = false;
  99. TargetIsUnix : boolean = false;
  100. { extracted from rtl/macos/macutils.inc }
  101. function IsMacFullPath (const path: string): Boolean;
  102. begin
  103. if Pos(':', path) = 0 then {its partial}
  104. IsMacFullPath := false
  105. else if path[1] = ':' then
  106. IsMacFullPath := false
  107. else
  108. IsMacFullPath := true
  109. end;
  110. Function IsAbsolute (Const F : String) : boolean;
  111. {
  112. Returns True if the name F is a absolute file name
  113. }
  114. begin
  115. IsAbsolute:=false;
  116. if TargetHasDosStyleDirectories then
  117. begin
  118. if (F[1]='/') or (F[1]='\') then
  119. IsAbsolute:=true;
  120. if (Length(F)>2) and (F[2]=':') and ((F[3]='\') or (F[3]='/')) then
  121. IsAbsolute:=true;
  122. end
  123. else if TargetAmigaLike then
  124. begin
  125. if (length(F)>0) and (Pos(':',F) <> 0) then
  126. IsAbsolute:=true;
  127. end
  128. else if TargetIsMacOS then
  129. begin
  130. IsAbsolute:=IsMacFullPath(F);
  131. end
  132. { generic case }
  133. else if (F[1]='/') then
  134. IsAbsolute:=true;
  135. end;
  136. Function FileExists (Const F : String) : Boolean;
  137. {
  138. Returns True if the file exists, False if not.
  139. }
  140. Var
  141. info : searchrec;
  142. begin
  143. FindFirst (F,anyfile,Info);
  144. FileExists:=DosError=0;
  145. FindClose (Info);
  146. end;
  147. Function PathExists (Const F : String) : Boolean;
  148. {
  149. Returns True if the file exists, False if not.
  150. }
  151. Var
  152. info : searchrec;
  153. begin
  154. FindFirst (F,anyfile,Info);
  155. PathExists:=(DosError=0) and (Info.Attr and Directory=Directory);
  156. FindClose (Info);
  157. end;
  158. function ToStr(l:longint):string;
  159. var
  160. s : string;
  161. begin
  162. Str(l,s);
  163. ToStr:=s;
  164. end;
  165. function ToStrZero(l:longint;nbzero : byte):string;
  166. var
  167. s : string;
  168. begin
  169. Str(l,s);
  170. while length(s)<nbzero do
  171. s:='0'+s;
  172. ToStrZero:=s;
  173. end;
  174. function trimspace(const s:string):string;
  175. var
  176. i,j : longint;
  177. begin
  178. i:=length(s);
  179. while (i>0) and (s[i] in [#9,' ']) do
  180. dec(i);
  181. j:=1;
  182. while (j<i) and (s[j] in [#9,' ']) do
  183. inc(j);
  184. trimspace:=Copy(s,j,i-j+1);
  185. end;
  186. function IsInList(const entry,list:string):boolean;
  187. var
  188. i,istart : longint;
  189. begin
  190. IsInList:=false;
  191. i:=0;
  192. while (i<length(list)) do
  193. begin
  194. { Find list item }
  195. istart:=i+1;
  196. while (i<length(list)) and
  197. (list[i+1]<>',') do
  198. inc(i);
  199. if Upcase(entry)=Upcase(TrimSpace(Copy(list,istart,i-istart+1))) then
  200. begin
  201. IsInList:=true;
  202. exit;
  203. end;
  204. { skip , }
  205. inc(i);
  206. end;
  207. end;
  208. procedure SetPPFileInfo;
  209. Var
  210. info : searchrec;
  211. dt : DateTime;
  212. begin
  213. FindFirst (PPFile[current],anyfile,Info);
  214. If DosError=0 then
  215. begin
  216. UnpackTime(info.time,dt);
  217. PPFileInfo.Insert(current,PPFile[current]+' '+ToStr(dt.year)+'/'+ToStrZero(dt.month,2)+'/'+
  218. ToStrZero(dt.day,2)+' '+ToStrZero(dt.Hour,2)+':'+ToStrZero(dt.min,2)+':'+ToStrZero(dt.sec,2));
  219. end
  220. else
  221. PPFileInfo.Insert(current,PPFile[current]);
  222. FindClose (Info);
  223. end;
  224. function SplitPath(const s:string):string;
  225. var
  226. i : longint;
  227. begin
  228. i:=Length(s);
  229. while (i>0) and not(s[i] in ['/','\'{$IFDEF MACOS},':'{$ENDIF}]) do
  230. dec(i);
  231. SplitPath:=Copy(s,1,i);
  232. end;
  233. Function SplitFileName(const s:string):string;
  234. var
  235. p : dirstr;
  236. n : namestr;
  237. e : extstr;
  238. begin
  239. FSplit(s,p,n,e);
  240. SplitFileName:=n+e;
  241. end;
  242. Function SplitFileBase(const s:string):string;
  243. var
  244. p : dirstr;
  245. n : namestr;
  246. e : extstr;
  247. begin
  248. FSplit(s,p,n,e);
  249. SplitFileBase:=n;
  250. end;
  251. function ForceExtension(Const HStr,ext:String):String;
  252. {
  253. Return a filename which certainly has the extension ext
  254. }
  255. var
  256. j : longint;
  257. begin
  258. j:=length(Hstr);
  259. while (j>0) and (Hstr[j]<>'.') do
  260. dec(j);
  261. if j=0 then
  262. j:=length(Hstr)+1;
  263. if Ext<>'' then
  264. begin
  265. if Ext[1]='.' then
  266. ForceExtension:=Copy(Hstr,1,j-1)+Ext
  267. else
  268. ForceExtension:=Copy(Hstr,1,j-1)+'.'+Ext
  269. end
  270. else
  271. ForceExtension:=Copy(Hstr,1,j-1);
  272. end;
  273. procedure mkdirtree(const s:string);
  274. var
  275. hs : string;
  276. begin
  277. if s='' then
  278. exit;
  279. if s[length(s)] in ['\','/'{$IFDEF MACOS},':'{$ENDIF}] then
  280. hs:=Copy(s,1,length(s)-1)
  281. else
  282. hs:=s;
  283. if not PathExists(hs) then
  284. begin
  285. { Try parent first }
  286. mkdirtree(SplitPath(hs));
  287. { make this dir }
  288. Verbose(V_Debug,'Making Directory '+s);
  289. {$I-}
  290. mkdir(s);
  291. {$I+}
  292. ioresult;
  293. end;
  294. end;
  295. Function RemoveFile(const f:string):boolean;
  296. var
  297. g : file;
  298. begin
  299. assign(g,f);
  300. {$I-}
  301. erase(g);
  302. {$I+}
  303. RemoveFile:=(ioresult=0);
  304. end;
  305. function Copyfile(const fn1,fn2:string;append:boolean) : longint;
  306. const
  307. bufsize = 16384;
  308. var
  309. f,g : file;
  310. addsize,
  311. i : longint;
  312. buf : pointer;
  313. begin
  314. if Append then
  315. Verbose(V_Debug,'Appending '+fn1+' to '+fn2)
  316. else
  317. Verbose(V_Debug,'Copying '+fn1+' to '+fn2);
  318. assign(f,fn1);
  319. assign(g,fn2);
  320. {$I-}
  321. reset(f,1);
  322. {$I+}
  323. addsize:=0;
  324. if ioresult<>0 then
  325. Verbose(V_Error,'Can''t open '+fn1);
  326. if append then
  327. begin
  328. {$I-}
  329. reset(g,1);
  330. {$I+}
  331. if ioresult<>0 then
  332. append:=false
  333. else
  334. seek(g,filesize(g));
  335. end;
  336. if not append then
  337. begin
  338. {$I-}
  339. rewrite(g,1);
  340. {$I+}
  341. if ioresult<>0 then
  342. Verbose(V_Error,'Can''t open '+fn2+' for output');
  343. end;
  344. getmem(buf,bufsize);
  345. repeat
  346. blockread(f,buf^,bufsize,i);
  347. blockwrite(g,buf^,i);
  348. addsize:=addsize+i;
  349. until i<bufsize;
  350. freemem(buf,bufsize);
  351. close(f);
  352. close(g);
  353. CopyFile:=addsize;
  354. end;
  355. procedure AddLog(const logfile,s:string);
  356. var
  357. t : text;
  358. begin
  359. assign(t,logfile);
  360. {$I-}
  361. append(t);
  362. {$I+}
  363. if ioresult<>0 then
  364. begin
  365. {$I-}
  366. rewrite(t);
  367. {$I+}
  368. if ioresult<>0 then
  369. Verbose(V_Abort,'Can''t append to '+logfile);
  370. end;
  371. writeln(t,s);
  372. close(t);
  373. end;
  374. function GetCompilerInfo(c:tcompinfo):boolean;
  375. function GetToken(var s:string):string;
  376. var
  377. i : longint;
  378. begin
  379. i:=pos(' ',s);
  380. if i=0 then
  381. i:=length(s)+1;
  382. GetToken:=Copy(s,1,i-1);
  383. Delete(s,1,i);
  384. end;
  385. var
  386. t : text;
  387. hs : string;
  388. begin
  389. GetCompilerInfo:=false;
  390. { Try to get all information in one call, this is
  391. supported in 1.1. Older compilers 1.0.x will only
  392. return the first info }
  393. case c of
  394. compver :
  395. begin
  396. if DefaultCompilerVersion<>'' then
  397. begin
  398. GetCompilerInfo:=true;
  399. exit;
  400. end;
  401. hs:='-iVTPTO';
  402. end;
  403. compcpu :
  404. begin
  405. if DefaultCompilerCPU<>'' then
  406. begin
  407. GetCompilerInfo:=true;
  408. exit;
  409. end;
  410. hs:='-iTPTOV';
  411. end;
  412. comptarget :
  413. begin
  414. if DefaultCompilerTarget<>'' then
  415. begin
  416. GetCompilerInfo:=true;
  417. exit;
  418. end;
  419. hs:='-iTOTPV';
  420. end;
  421. end;
  422. ExecuteRedir(CompilerBin,hs,'','out','');
  423. assign(t,'out');
  424. {$I-}
  425. reset(t);
  426. readln(t,hs);
  427. close(t);
  428. erase(t);
  429. {$I+}
  430. if ioresult<>0 then
  431. Verbose(V_Error,'Can''t get Compiler Info')
  432. else
  433. begin
  434. Verbose(V_Debug,'Retrieved Compiler Info: "'+hs+'"');
  435. case c of
  436. compver :
  437. begin
  438. DefaultCompilerVersion:=GetToken(hs);
  439. DefaultCompilerCPU:=GetToken(hs);
  440. DefaultCompilerTarget:=GetToken(hs);
  441. end;
  442. compcpu :
  443. begin
  444. DefaultCompilerCPU:=GetToken(hs);
  445. DefaultCompilerTarget:=GetToken(hs);
  446. DefaultCompilerVersion:=GetToken(hs);
  447. end;
  448. comptarget :
  449. begin
  450. DefaultCompilerTarget:=GetToken(hs);
  451. DefaultCompilerCPU:=GetToken(hs);
  452. DefaultCompilerVersion:=GetToken(hs);
  453. end;
  454. end;
  455. GetCompilerInfo:=true;
  456. end;
  457. end;
  458. function GetCompilerVersion:boolean;
  459. const
  460. CompilerVersionDebugWritten : boolean = false;
  461. begin
  462. if CompilerVersion='' then
  463. begin
  464. GetCompilerVersion:=GetCompilerInfo(compver);
  465. CompilerVersion:=DefaultCompilerVersion;
  466. end
  467. else
  468. GetCompilerVersion:=true;
  469. if GetCompilerVersion and not CompilerVersionDebugWritten then
  470. begin
  471. Verbose(V_Debug,'Compiler Version: "'+CompilerVersion+'"');
  472. CompilerVersionDebugWritten:=true;
  473. end;
  474. end;
  475. function GetCompilerCPU:boolean;
  476. const
  477. CompilerCPUDebugWritten : boolean = false;
  478. begin
  479. if CompilerCPU='' then
  480. begin
  481. GetCompilerCPU:=GetCompilerInfo(compcpu);
  482. CompilerCPU:=lowercase(DefaultCompilerCPU);
  483. end
  484. else
  485. GetCompilerCPU:=true;
  486. if GetCompilerCPU and not CompilerCPUDebugWritten then
  487. begin
  488. Verbose(V_Debug,'Compiler CPU: "'+CompilerCPU+'"');
  489. CompilerCPUDebugWritten:=true;
  490. end;
  491. end;
  492. function GetCompilerTarget:boolean;
  493. const
  494. CompilerTargetDebugWritten : boolean = false;
  495. begin
  496. if CompilerTarget='' then
  497. begin
  498. GetCompilerTarget:=GetCompilerInfo(comptarget);
  499. CompilerTarget:=lowercase(DefaultCompilerTarget);
  500. end
  501. else
  502. GetCompilerTarget:=true;
  503. if GetCompilerTarget and not CompilerTargetDebugWritten then
  504. begin
  505. Verbose(V_Debug,'Compiler Target: "'+CompilerTarget+'"');
  506. CompilerTargetDebugWritten:=true;
  507. end;
  508. end;
  509. function CompilerFullTarget:string;
  510. begin
  511. if UseOSOnly then
  512. CompilerFullTarget:=CompilerTarget
  513. else
  514. CompilerFullTarget:=CompilerCPU+'-'+CompilerTarget;
  515. end;
  516. { Set the three constants above according to
  517. the current target }
  518. procedure SetTargetDirectoriesStyle;
  519. var
  520. LTarget : string;
  521. res : boolean;
  522. begin
  523. { Call this first to ensure that CompilerTarget is not empty }
  524. res:=GetCompilerTarget;
  525. LTarget := CompilerTarget;
  526. TargetHasDosStyleDirectories :=
  527. (LTarget='emx') or
  528. (LTarget='go32v2') or
  529. (LTarget='nativent') or
  530. (LTarget='os2') or
  531. (LTarget='symbian') or
  532. (LTarget='watcom') or
  533. (LTarget='wdosx') or
  534. (LTarget='win32') or
  535. (LTarget='win64');
  536. TargetAmigaLike:=
  537. (LTarget='amiga') or
  538. (LTarget='morphos');
  539. TargetIsMacOS:=
  540. (LTarget='macos');
  541. { Base on whether UNIX is defined as default macro
  542. in extradefines in systesms/i_XXX.pas units }
  543. TargetIsUnix:=
  544. (LTarget='linux') or
  545. (LTarget='linux6432') or
  546. (LTarget='freebsd') or
  547. (LTarget='openbsd') or
  548. (LTarget='netbsd') or
  549. (LTarget='beos') or
  550. (LTarget='haiku') or
  551. (LTarget='solaris') or
  552. (LTarget='iphonesim') or
  553. (LTarget='darwin');
  554. { Set ExeExt for CompilerTarget.
  555. This list has been set up 2011-06 using the information in
  556. compiler/system/i_XXX.pas units.
  557. We should update this list when adding new targets PM }
  558. if (TargetHasDosStyleDirectories) then
  559. ExeExt:='.exe'
  560. else if LTarget='atari' then
  561. ExeExt:='.tpp'
  562. else if LTarget='gba' then
  563. ExeExt:='.gba'
  564. else if LTarget='nds' then
  565. ExeExt:='.bin'
  566. else if (LTarget='netware') or (LTarget='netwlibc') then
  567. ExeExt:='.nlm'
  568. else if LTarget='wii' then
  569. ExeExt:='.dol'
  570. else if LTarget='wince' then
  571. ExeExt:='.exe';
  572. end;
  573. {$ifndef LIMIT83FS}
  574. { Set the UseOSOnly constant above according to
  575. the current target }
  576. procedure SetUseOSOnly;
  577. var
  578. LTarget : string;
  579. res : boolean;
  580. begin
  581. { Call this first to ensure that CompilerTarget is not empty }
  582. res:=GetCompilerTarget;
  583. LTarget := CompilerTarget;
  584. UseOSOnly:= (LTarget='emx') or
  585. (LTarget='go32v2') or
  586. (LTarget='os2');
  587. end;
  588. {$endif not LIMIT83FS}
  589. procedure SetTargetCanCompileLibraries;
  590. var
  591. LTarget : string;
  592. res : boolean;
  593. begin
  594. { Call this first to ensure that CompilerTarget is not empty }
  595. res:=GetCompilerTarget;
  596. LTarget := CompilerTarget;
  597. { Feel free to add other targets here }
  598. if (LTarget='go32v2') then
  599. TargetCanCompileLibraries:=false;
  600. end;
  601. function OutputFileName(Const s,ext:String):String;
  602. begin
  603. {$ifndef macos}
  604. OutputFileName:=OutputDir+'/'+ForceExtension(s,ext);
  605. {$else macos}
  606. OutputFileName:=ConcatMacPath(OutputDir,ForceExtension(s,ext));
  607. {$endif macos}
  608. end;
  609. function TestOutputFileName(Const pref,base,ext:String):String;
  610. begin
  611. {$ifndef macos}
  612. TestOutputFileName:=TestOutputDir+'/'+ForceExtension(pref+SplitFileName(base),ext);
  613. {$else macos}
  614. TestOutputFileName:=ConcatMacPath(TestOutputDir,ForceExtension(pref+SplitFileName(base),ext));
  615. {$endif macos}
  616. end;
  617. function MaybePrependUnimplemented(const LogStr:string):string;
  618. begin
  619. if Config.NotImplemented then
  620. MaybePrependUnimplemented:=strunimplemented+LogStr
  621. else
  622. MaybePrependUnimplemented:=LogStr;
  623. end;
  624. function ExitWithInternalError(const OutName:string):boolean;
  625. var
  626. t : text;
  627. s : string;
  628. begin
  629. ExitWithInternalError:=false;
  630. { open logfile }
  631. assign(t,Outname);
  632. {$I-}
  633. reset(t);
  634. {$I+}
  635. if ioresult<>0 then
  636. exit;
  637. while not eof(t) do
  638. begin
  639. readln(t,s);
  640. if pos('Fatal: Internal error ',s)>0 then
  641. begin
  642. ExitWithInternalError:=true;
  643. break;
  644. end;
  645. end;
  646. close(t);
  647. end;
  648. function RunCompiler:boolean;
  649. var
  650. args,
  651. wpoargs : string;
  652. passnr,
  653. passes : longint;
  654. execres : boolean;
  655. EndTicks,
  656. StartTicks : int64;
  657. begin
  658. RunCompiler:=false;
  659. args:='-n -T'+CompilerTarget+' -Fu'+RTLUnitsDir;
  660. args:=args+' -FE'+TestOutputDir;
  661. if TargetIsMacOS then
  662. args:=args+' -WT '; {tests should be compiled as MPWTool}
  663. if ExtraCompilerOpts<>'' then
  664. args:=args+ExtraCompilerOpts;
  665. if TargetIsUnix then
  666. begin
  667. { Add runtime library path to current dir to find .so files }
  668. if Config.NeedLibrary then
  669. begin
  670. if CompilerTarget<>'darwin' then
  671. { do not use single quote for -k as they are mishandled on
  672. Windows Shells }
  673. args:=args+' -Fl'+TestOutputDir+' -k-rpath -k.'
  674. else
  675. args:=args+' -Fl'+TestOutputDir;
  676. end;
  677. end;
  678. if Config.NeedOptions<>'' then
  679. args:=args+' '+Config.NeedOptions;
  680. wpoargs:='';
  681. if (Config.WpoPasses=0) or
  682. (Config.WpoParas='') then
  683. passes:=1
  684. else
  685. passes:=config.wpopasses+1;
  686. args:=args+' '+PPFile[current];
  687. for passnr:=1 to passes do
  688. begin
  689. if (passes>1) then
  690. begin
  691. wpoargs:=' -OW'+config.wpoparas+' -FW'+TestOutputFileName('',PPFile[current],'wp'+tostr(passnr));
  692. if (passnr>1) then
  693. wpoargs:=wpoargs+' -Ow'+config.wpoparas+' -Fw'+TestOutputFileName('',PPFile[current],'wp'+tostr(passnr-1));
  694. end;
  695. Verbose(V_Debug,'Executing '+compilerbin+' '+args+wpoargs);
  696. { also get the output from as and ld that writes to stderr sometimes }
  697. StartTicks:=GetMicroSTicks;
  698. {$ifndef macos}
  699. execres:=ExecuteRedir(CompilerBin,args+wpoargs,'',CompilerLogFile,'stdout');
  700. {$else macos}
  701. {Due to that Toolserver is not reentrant, we have to asm and link via script.}
  702. execres:=ExecuteRedir(CompilerBin,'-s '+args+wpoargs,'',CompilerLogFile,'stdout');
  703. if execres then
  704. execres:=ExecuteRedir(TestOutputDir + ':ppas','','',CompilerLogFile,'stdout');
  705. {$endif macos}
  706. EndTicks:=GetMicroSTicks;
  707. Verbose(V_Debug,'Exitcode '+ToStr(ExecuteResult));
  708. if BenchmarkInfo then
  709. begin
  710. Verbose(V_Normal,'Compilation took '+ToStr(EndTicks-StartTicks)+' us');
  711. end;
  712. { Error during execution? }
  713. if (not execres) and (ExecuteResult=0) then
  714. begin
  715. AddLog(FailLogFile,TestName);
  716. AddLog(ResLogFile,MaybePrependUnimplemented(failed_to_compile)+PPFileInfo[current]);
  717. AddLog(LongLogFile,line_separation);
  718. AddLog(LongLogFile,MaybePrependUnimplemented(failed_to_compile)+PPFileInfo[current]);
  719. if CopyFile(CompilerLogFile,LongLogFile,true)=0 then
  720. AddLog(LongLogFile,'IOStatus'+ToStr(IOStatus));
  721. { avoid to try again }
  722. AddLog(ExeLogFile,MaybePrependUnimplemented(failed_to_compile)+PPFileInfo[current]);
  723. Verbose(V_Warning,'IOStatus: '+ToStr(IOStatus));
  724. exit;
  725. end;
  726. { Check for internal error }
  727. if ExitWithInternalError(CompilerLogFile) then
  728. begin
  729. AddLog(FailLogFile,TestName);
  730. if Config.Note<>'' then
  731. AddLog(FailLogFile,Config.Note);
  732. AddLog(ResLogFile,MaybePrependUnimplemented(failed_to_compile)+PPFileInfo[current]+' internalerror generated');
  733. AddLog(LongLogFile,line_separation);
  734. AddLog(LongLogFile,MaybePrependUnimplemented(failed_to_compile)+PPFileInfo[current]);
  735. if Config.Note<>'' then
  736. AddLog(LongLogFile,Config.Note);
  737. if CopyFile(CompilerLogFile,LongLogFile,true)=0 then
  738. AddLog(LongLogFile,'Internal error in compiler');
  739. { avoid to try again }
  740. AddLog(ExeLogFile,MaybePrependUnimplemented(failed_to_compile)+PPFileInfo[current]);
  741. Verbose(V_Warning,'Internal error in compiler');
  742. exit;
  743. end;
  744. end;
  745. { Should the compile fail ? }
  746. if Config.ShouldFail then
  747. begin
  748. if ExecuteResult<>0 then
  749. begin
  750. AddLog(ResLogFile,MaybePrependUnimplemented(success_compilation_failed)+PPFileInfo[current]);
  751. { avoid to try again }
  752. AddLog(ExeLogFile,MaybePrependUnimplemented(success_compilation_failed)+PPFileInfo[current]);
  753. RunCompiler:=true;
  754. end
  755. else
  756. begin
  757. AddLog(FailLogFile,TestName);
  758. if Config.Note<>'' then
  759. AddLog(FailLogFile,Config.Note);
  760. AddLog(ResLogFile,MaybePrependUnimplemented(failed_compilation_successful)+PPFileInfo[current]);
  761. AddLog(LongLogFile,line_separation);
  762. AddLog(LongLogFile,MaybePrependUnimplemented(failed_compilation_successful)+PPFileInfo[current]);
  763. { avoid to try again }
  764. AddLog(ExeLogFile,MaybePrependUnimplemented(failed_compilation_successful)+PPFileInfo[current]);
  765. if Config.Note<>'' then
  766. AddLog(LongLogFile,Config.Note);
  767. CopyFile(CompilerLogFile,LongLogFile,true);
  768. end;
  769. end
  770. else
  771. begin
  772. if (ExecuteResult<>0) and
  773. (((Config.KnownCompileNote<>'') and (Config.KnownCompileError=0)) or
  774. ((Config.KnownCompileError<>0) and (ExecuteResult=Config.KnownCompileError))) then
  775. begin
  776. AddLog(FailLogFile,TestName+known_problem+Config.KnownCompileNote);
  777. AddLog(ResLogFile,MaybePrependUnimplemented(failed_to_compile)+PPFileInfo[current]+known_problem+Config.KnownCompileNote);
  778. AddLog(LongLogFile,line_separation);
  779. AddLog(LongLogFile,known_problem+Config.KnownCompileNote);
  780. AddLog(LongLogFile,MaybePrependUnimplemented(failed_to_compile)+PPFileInfo[current]+' ('+ToStr(ExecuteResult)+')');
  781. if Copyfile(CompilerLogFile,LongLogFile,true)=0 then
  782. AddLog(LongLogFile,known_problem+'exitcode: '+ToStr(ExecuteResult));
  783. Verbose(V_Warning,known_problem+'exitcode: '+ToStr(ExecuteResult));
  784. end
  785. else if ExecuteResult<>0 then
  786. begin
  787. AddLog(FailLogFile,TestName);
  788. if Config.Note<>'' then
  789. AddLog(FailLogFile,Config.Note);
  790. AddLog(ResLogFile,MaybePrependUnimplemented(failed_to_compile)+PPFileInfo[current]);
  791. AddLog(LongLogFile,line_separation);
  792. AddLog(LongLogFile,MaybePrependUnimplemented(failed_to_compile)+PPFileInfo[current]);
  793. if Config.Note<>'' then
  794. AddLog(LongLogFile,Config.Note);
  795. if CopyFile(CompilerLogFile,LongLogFile,true)=0 then
  796. AddLog(LongLogFile,'Exitcode: '+ToStr(ExecuteResult)+' (expected 0)');
  797. { avoid to try again }
  798. AddLog(ExeLogFile,MaybePrependUnimplemented(failed_to_compile)+PPFileInfo[current]);
  799. Verbose(V_Warning,'Exitcode: '+ToStr(ExecuteResult)+' (expected 0)');
  800. end
  801. else
  802. begin
  803. AddLog(ResLogFile,MaybePrependUnimplemented(successfully_compiled)+PPFileInfo[current]);
  804. RunCompiler:=true;
  805. end;
  806. end;
  807. end;
  808. function CheckTestExitCode(const OutName:string):boolean;
  809. var
  810. t : text;
  811. s : string;
  812. i,code : integer;
  813. begin
  814. CheckTestExitCode:=false;
  815. { open logfile }
  816. assign(t,Outname);
  817. {$I-}
  818. reset(t);
  819. {$I+}
  820. if ioresult<>0 then
  821. exit;
  822. while not eof(t) do
  823. begin
  824. readln(t,s);
  825. i:=pos('TestExitCode: ',s);
  826. if i>0 then
  827. begin
  828. delete(s,1,i+14-1);
  829. val(s,ExecuteResult,code);
  830. if code=0 then
  831. CheckTestExitCode:=true;
  832. break;
  833. end;
  834. end;
  835. close(t);
  836. end;
  837. function LibraryExists(const PPFile : string; var FileName : string) : boolean;
  838. begin
  839. { Check if a dynamic library XXX was created }
  840. { Windows XXX.dll style }
  841. FileName:=TestOutputFilename('',PPFile,'dll');
  842. if FileExists(FileName) then
  843. begin
  844. LibraryExists:=true;
  845. exit;
  846. end;
  847. { Linux libXXX.so style }
  848. FileName:=TestOutputFilename('lib',PPFile,'so');
  849. if FileExists(FileName) then
  850. begin
  851. LibraryExists:=true;
  852. exit;
  853. end;
  854. { Darwin libXXX.dylib style }
  855. FileName:=TestOutputFilename('lib',PPFile,'dylib');
  856. if FileExists(FileName) then
  857. begin
  858. LibraryExists:=true;
  859. exit;
  860. end;
  861. { MacOS LibXXX style }
  862. FileName:=TestOutputFilename('Lib',PPFile,'');
  863. if FileExists(FileName) then
  864. begin
  865. LibraryExists:=true;
  866. exit;
  867. end;
  868. { Netware wlic XXX.nlm style }
  869. FileName:=TestOutputFilename('',PPFile,'nlm');
  870. if FileExists(FileName) then
  871. begin
  872. LibraryExists:=true;
  873. exit;
  874. end;
  875. { Amiga XXX.library style }
  876. FileName:=TestOutputFilename('',PPFile,'library');
  877. if FileExists(FileName) then
  878. begin
  879. LibraryExists:=true;
  880. exit;
  881. end;
  882. LibraryExists:=false;
  883. end;
  884. function ExecuteRemote(const prog,args:string;var StartTicks,EndTicks : int64):boolean;
  885. const
  886. MaxTrials = 5;
  887. var
  888. Trials : longint;
  889. Res : boolean;
  890. begin
  891. Verbose(V_Debug,'RemoteExecuting '+Prog+' '+args);
  892. StartTicks:=GetMicroSTicks;
  893. Res:=false;
  894. Trials:=0;
  895. While (Trials<MaxTrials) and not Res do
  896. begin
  897. inc(Trials);
  898. Res:=ExecuteRedir(prog,args,'',EXELogFile,'stdout');
  899. if not Res then
  900. Verbose(V_Debug,'Call to '+prog+' failed: '+
  901. 'IOStatus='+ToStr(IOStatus)+
  902. ' RedirErrorOut='+ToStr(RedirErrorOut)+
  903. ' RedirErrorIn='+ToStr(RedirErrorIn)+
  904. ' RedirErrorError='+ToStr(RedirErrorError)+
  905. ' ExecuteResult='+ToStr(ExecuteResult));
  906. end;
  907. if Trials>1 then
  908. Verbose(V_Debug,'Done in '+tostr(trials)+' trials');
  909. EndTicks:=GetMicroSTicks;
  910. ExecuteRemote:=res;
  911. end;
  912. function ExecuteEmulated(const prog,args,FullExeLogFile:string;var StartTicks,EndTicks : int64):boolean;
  913. begin
  914. Verbose(V_Debug,'EmulatorExecuting '+Prog+' '+args);
  915. StartTicks:=GetMicroSTicks;
  916. ExecuteEmulated:=ExecuteRedir(prog,args,'',FullExeLogFile,'stdout');
  917. EndTicks:=GetMicroSTicks;
  918. end;
  919. function MaybeCopyFiles(const FileToCopy : string) : boolean;
  920. var
  921. TestRemoteExe,
  922. s : string;
  923. pref : string;
  924. LocalFile, RemoteFile: string;
  925. LocalPath: string;
  926. index : integer;
  927. execres : boolean;
  928. EndTicks,
  929. StartTicks : int64;
  930. begin
  931. if RemoteAddr='' then
  932. begin
  933. exit(false);
  934. end;
  935. execres:=true;
  936. { We don't want to create subdirs, remove paths from the test }
  937. TestRemoteExe:=RemotePath+'/'+SplitFileName(FileToCopy);
  938. if deBefore in DelExecutable then
  939. ExecuteRemote(rshprog,RemotePara+' '+RemoteAddr+' rm -f '+TestRemoteExe,
  940. StartTicks,EndTicks);
  941. execres:=ExecuteRemote(rcpprog,RemotePara+' '+FileToCopy+' '+
  942. RemoteAddr+':'+TestRemoteExe,StartTicks,EndTicks);
  943. if not execres then
  944. begin
  945. Verbose(V_normal, 'Could not copy executable '+FileToCopy);
  946. exit(execres);
  947. end;
  948. s:=Config.Files;
  949. if length(s) > 0 then
  950. begin
  951. LocalPath:=SplitPath(PPFile[current]);
  952. if Length(LocalPath) > 0 then
  953. LocalPath:=LocalPath+'/';
  954. repeat
  955. index:=pos(' ',s);
  956. if index=0 then
  957. LocalFile:=s
  958. else
  959. LocalFile:=copy(s,1,index-1);
  960. RemoteFile:=RemotePath+'/'+SplitFileName(LocalFile);
  961. LocalFile:=LocalPath+LocalFile;
  962. if DoVerbose and (rcpprog='pscp') then
  963. pref:='-v '
  964. else
  965. pref:='';
  966. execres:=ExecuteRemote(rcpprog,pref+RemotePara+' '+LocalFile+' '+
  967. RemoteAddr+':'+RemoteFile,StartTicks,EndTicks);
  968. if not execres then
  969. begin
  970. Verbose(V_normal, 'Could not copy required file '+LocalFile);
  971. exit(false);
  972. end;
  973. if index=0 then
  974. break;
  975. s:=copy(s,index+1,length(s)-index);
  976. until false;
  977. end;
  978. MaybeCopyFiles:=execres;
  979. end;
  980. function RunExecutable:boolean;
  981. const
  982. {$ifdef unix}
  983. CurrDir = './';
  984. {$else}
  985. CurrDir = '';
  986. {$endif}
  987. var
  988. OldDir, s,
  989. execcmd,
  990. FullExeLogFile,
  991. TestRemoteExe,
  992. TestExe : string;
  993. execres : boolean;
  994. EndTicks,
  995. StartTicks : int64;
  996. begin
  997. RunExecutable:=false;
  998. execres:=true;
  999. TestExe:=OutputFileName(PPFile[current],ExeExt);
  1000. if EmulatorName<>'' then
  1001. begin
  1002. { Get full name out log file, because we change the directory during
  1003. execution }
  1004. FullExeLogFile:=FExpand(EXELogFile);
  1005. {$I-}
  1006. GetDir(0,OldDir);
  1007. ChDir(TestOutputDir);
  1008. {$I+}
  1009. ioresult;
  1010. s:=CurrDir+SplitFileName(TestExe);
  1011. execres:=ExecuteEmulated(EmulatorName,s,FullExeLogFile,StartTicks,EndTicks);
  1012. {$I-}
  1013. ChDir(OldDir);
  1014. {$I+}
  1015. end
  1016. else if RemoteAddr<>'' then
  1017. begin
  1018. execres:=MaybeCopyFiles(TestExe);
  1019. TestRemoteExe:=RemotePath+'/'+SplitFileName(TestExe);
  1020. { rsh doesn't pass the exitcode, use a second command to print the exitcode
  1021. on the remoteshell to stdout }
  1022. if DoVerbose and (rshprog='plink') then
  1023. execcmd:='-v '
  1024. else
  1025. execcmd:='';
  1026. execcmd:=execcmd+RemotePara+' '+RemoteAddr+' '+rquote+
  1027. 'chmod 755 '+TestRemoteExe+
  1028. ' ; cd '+RemotePath+' ; ';
  1029. { Using -rpath . at compile time does not seem
  1030. to work for programs copied over to remote machine,
  1031. at least not for FreeBSD.
  1032. Does this work for all shells? }
  1033. if Config.NeedLibrary then
  1034. begin
  1035. if RemoteShellNeedsExport then
  1036. execcmd:=execcmd+' LD_LIBRARY_PATH=.; export LD_LIBRARY_PATH;'
  1037. else
  1038. execcmd:=execcmd+' setenv LD_LIBRARY_PATH=.; ';
  1039. end;
  1040. if UseTimeout then
  1041. begin
  1042. if Config.Timeout=0 then
  1043. Config.Timeout:=DefaultTimeout;
  1044. str(Config.Timeout,s);
  1045. if (RemoteShellBase='bash') then
  1046. execcmd:=execcmd+'ulimit -t '+s+'; '
  1047. else
  1048. execcmd:=execcmd+'timeout -9 '+s;
  1049. end;
  1050. { as we moved to RemotePath, if path is not absolute
  1051. we need to use ./execfilename only }
  1052. if not isabsolute(TestRemoteExe) then
  1053. execcmd:=execcmd+' ./'+SplitFileName(TestRemoteExe)
  1054. else
  1055. execcmd:=execcmd+' '+TestRemoteExe;
  1056. execcmd:=execcmd+' ; echo "TestExitCode: $?"';
  1057. if (deAfter in DelExecutable) and
  1058. not Config.NeededAfter then
  1059. execcmd:=execcmd+' ; rm -f '+TestRemoteExe;
  1060. execcmd:=execcmd+rquote;
  1061. execres:=ExecuteRemote(rshprog,execcmd,StartTicks,EndTicks);
  1062. { Check for TestExitCode error in output, sets ExecuteResult }
  1063. if not CheckTestExitCode(EXELogFile) then
  1064. Verbose(V_Debug,'Failed to check exit code for '+execcmd);
  1065. end
  1066. else
  1067. begin
  1068. { Get full name out log file, because we change the directory during
  1069. execution }
  1070. FullExeLogFile:=FExpand(EXELogFile);
  1071. Verbose(V_Debug,'Executing '+TestExe);
  1072. {$I-}
  1073. GetDir(0,OldDir);
  1074. ChDir(TestOutputDir);
  1075. {$I+}
  1076. ioresult;
  1077. { don't redirect interactive and graph programs }
  1078. StartTicks:=GetMicroSTicks;
  1079. if Config.IsInteractive or Config.UsesGraph then
  1080. execres:=ExecuteRedir(CurrDir+SplitFileName(TestExe),'','','','')
  1081. else
  1082. execres:=ExecuteRedir(CurrDir+SplitFileName(TestExe),'','',FullExeLogFile,'stdout');
  1083. EndTicks:=GetMicroSTicks;
  1084. {$I-}
  1085. ChDir(OldDir);
  1086. {$I+}
  1087. ioresult;
  1088. end;
  1089. { Error during execution? }
  1090. Verbose(V_Debug,'Exitcode '+ToStr(ExecuteResult));
  1091. if BenchmarkInfo then
  1092. begin
  1093. Verbose(V_Normal,'Execution took '+ToStr(EndTicks-StartTicks)+' us');
  1094. end;
  1095. if (not execres) and (ExecuteResult=0) then
  1096. begin
  1097. AddLog(FailLogFile,TestName);
  1098. AddLog(ResLogFile,MaybePrependUnimplemented(failed_to_run)+PPFileInfo[current]);
  1099. AddLog(LongLogFile,line_separation);
  1100. AddLog(LongLogFile,MaybePrependUnimplemented(failed_to_run)+PPFileInfo[current]);
  1101. if CopyFile(EXELogFile,LongLogFile,true)=0 then
  1102. AddLog(LongLogFile,'IOStatus: '+ToStr(IOStatus));
  1103. { avoid to try again }
  1104. AddLog(ExeLogFile,MaybePrependUnimplemented(failed_to_run)+PPFileInfo[current]);
  1105. Verbose(V_Warning,'IOStatus: '+ToStr(IOStatus));
  1106. exit;
  1107. end;
  1108. if ExecuteResult<>Config.ResultCode then
  1109. begin
  1110. if (ExecuteResult<>0) and
  1111. (ExecuteResult=Config.KnownRunError) then
  1112. begin
  1113. AddLog(FailLogFile,TestName+known_problem+Config.KnownRunNote);
  1114. AddLog(ResLogFile,MaybePrependUnimplemented(failed_to_run)+PPFileInfo[current]+known_problem+Config.KnownRunNote);
  1115. AddLog(LongLogFile,line_separation);
  1116. AddLog(LongLogFile,known_problem+Config.KnownRunNote);
  1117. AddLog(LongLogFile,MaybePrependUnimplemented(failed_to_run)+PPFileInfo[current]+' ('+ToStr(ExecuteResult)+')');
  1118. if Copyfile(EXELogFile,LongLogFile,true)=0 then
  1119. begin
  1120. AddLog(LongLogFile,known_problem+'exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  1121. AddLog(ExeLogFile,known_problem+'exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  1122. end;
  1123. Verbose(V_Warning,known_problem+'exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  1124. end
  1125. else
  1126. begin
  1127. AddLog(FailLogFile,TestName);
  1128. AddLog(ResLogFile,MaybePrependUnimplemented(failed_to_run)+PPFileInfo[current]);
  1129. AddLog(LongLogFile,line_separation);
  1130. AddLog(LongLogFile,MaybePrependUnimplemented(failed_to_run)+PPFileInfo[current]+' ('+ToStr(ExecuteResult)+')');
  1131. if Copyfile(EXELogFile,LongLogFile,true)=0 then
  1132. begin
  1133. AddLog(LongLogFile,'Exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  1134. AddLog(ExeLogFile,'Exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  1135. end;
  1136. Verbose(V_Warning,'Exitcode: '+ToStr(ExecuteResult)+' (expected '+ToStr(Config.ResultCode)+')');
  1137. end
  1138. end
  1139. else
  1140. begin
  1141. AddLog(ResLogFile,MaybePrependUnimplemented(successfully_run)+PPFileInfo[current]);
  1142. RunExecutable:=true;
  1143. end;
  1144. if (deAfter in DelExecutable) and not Config.NeededAfter then
  1145. begin
  1146. Verbose(V_Debug,'Deleting executable '+TestExe);
  1147. RemoveFile(TestExe);
  1148. RemoveFile(ForceExtension(TestExe,ObjExt));
  1149. RemoveFile(ForceExtension(TestExe,PPUExt));
  1150. end;
  1151. end;
  1152. { Try to collect information concerning the remote configuration
  1153. Currently only records RemoteShell name and sets
  1154. RemoteShellNeedsExport boolean variable }
  1155. procedure SetRemoteConfiguration;
  1156. var
  1157. f : text;
  1158. StartTicks,EndTicks : int64;
  1159. begin
  1160. if RemoteAddr='' then
  1161. exit;
  1162. ExeLogFile:='__remote.tmp';
  1163. ExecuteRemote(rshprog,RemotePara+' '+RemoteAddr+
  1164. ' "echo SHELL=${SHELL}"',StartTicks,EndTicks);
  1165. Assign(f,ExeLogFile);
  1166. Reset(f);
  1167. While not eof(f) do
  1168. begin
  1169. Readln(f,RemoteShellBase);
  1170. if pos('SHELL=',RemoteShellBase)>0 then
  1171. begin
  1172. RemoteShell:=TrimSpace(Copy(RemoteShellBase,pos('SHELL=',RemoteShellBase)+6,
  1173. length(RemoteShellBase)));
  1174. Verbose(V_Debug,'Remote shell is "'+RemoteShell+'"');
  1175. RemoteShellBase:=SplitFileBase(RemoteShell);
  1176. if (RemoteShellBase='bash') or (RemoteShellBase='sh') then
  1177. RemoteShellNeedsExport:=true;
  1178. end;
  1179. end;
  1180. Close(f);
  1181. end;
  1182. procedure getargs;
  1183. procedure helpscreen;
  1184. begin
  1185. writeln('dotest [Options] <File>');
  1186. writeln;
  1187. writeln('Options can be:');
  1188. writeln(' !ENV_NAME parse environment variable ENV_NAME for options');
  1189. writeln(' -A include ALL tests');
  1190. writeln(' -B delete executable before remote upload');
  1191. writeln(' -C<compiler> set compiler to use');
  1192. writeln(' -D display execution time');
  1193. writeln(' -E execute test also');
  1194. writeln(' -G include graph tests');
  1195. writeln(' -I include interactive tests');
  1196. writeln(' -K include known bug tests');
  1197. writeln(' -M<emulator> run the tests using the given emulator');
  1198. writeln(' -O use timeout wrapper for (remote) execution');
  1199. writeln(' -P<path> path to the tests tree on the remote machine');
  1200. writeln(' -R<remote> run the tests remotely with the given rsh/ssh address');
  1201. writeln(' -S use ssh instead of rsh');
  1202. writeln(' -T[cpu-]<os> run tests for target cpu and os');
  1203. writeln(' -U<remotepara>');
  1204. writeln(' pass additional parameter to remote program. Multiple -U can be used');
  1205. writeln(' -V be verbose');
  1206. writeln(' -W use putty compatible file names when testing (plink and pscp)');
  1207. writeln(' -X don''t use COMSPEC');
  1208. writeln(' -Y<opts> extra options passed to the compiler. Several -Y<opt> can be given.');
  1209. writeln(' -Z remove temporary files (executable,ppu,o)');
  1210. halt(1);
  1211. end;
  1212. procedure interpret_option (para : string);
  1213. var
  1214. ch : char;
  1215. j : longint;
  1216. begin
  1217. Verbose(V_Debug,'Interpreting option"'+para+'"');
  1218. ch:=Upcase(para[2]);
  1219. delete(para,1,2);
  1220. case ch of
  1221. 'A' :
  1222. begin
  1223. DoGraph:=true;
  1224. DoInteractive:=true;
  1225. DoKnown:=true;
  1226. DoAll:=true;
  1227. end;
  1228. 'B' : Include(DelExecutable,deBefore);
  1229. 'C' : CompilerBin:=Para;
  1230. 'D' : BenchMarkInfo:=true;
  1231. 'E' : DoExecute:=true;
  1232. 'G' : begin
  1233. DoGraph:=true;
  1234. if para='-' then
  1235. DoUsual:=false;
  1236. end;
  1237. 'I' : begin
  1238. DoInteractive:=true;
  1239. if para='-' then
  1240. DoUsual:=false;
  1241. end;
  1242. 'K' : begin
  1243. DoKnown:=true;
  1244. if para='-' then
  1245. DoUsual:=false;
  1246. end;
  1247. 'M' : EmulatorName:=Para;
  1248. 'O' : UseTimeout:=true;
  1249. 'P' : RemotePath:=Para;
  1250. 'R' : RemoteAddr:=Para;
  1251. 'S' :
  1252. begin
  1253. rshprog:='ssh';
  1254. rcpprog:='scp';
  1255. end;
  1256. 'T' :
  1257. begin
  1258. j:=Pos('-',Para);
  1259. if j>0 then
  1260. begin
  1261. CompilerCPU:=Copy(Para,1,j-1);
  1262. CompilerTarget:=Copy(Para,j+1,length(para));
  1263. end
  1264. else
  1265. CompilerTarget:=Para
  1266. end;
  1267. 'U' :
  1268. RemotePara:=RemotePara+' '+Para;
  1269. 'V' : DoVerbose:=true;
  1270. 'W' :
  1271. begin
  1272. rshprog:='plink';
  1273. rcpprog:='pscp';
  1274. rquote:='"';
  1275. end;
  1276. 'X' : UseComSpec:=false;
  1277. 'Y' : ExtraCompilerOpts:= ExtraCompilerOpts +' '+ Para;
  1278. 'Z' : Include(DelExecutable,deAfter);
  1279. end;
  1280. end;
  1281. procedure interpret_env(arg : string);
  1282. var
  1283. para : string;
  1284. pspace : longint;
  1285. begin
  1286. Verbose(V_Debug,'Interpreting environment option"'+arg+'"');
  1287. { Get rid of leading '!' }
  1288. delete(arg,1,1);
  1289. arg:=getenv(arg);
  1290. Verbose(V_Debug,'Environment value is "'+arg+'"');
  1291. while (length(arg)>0) do
  1292. begin
  1293. while (length(arg)>0) and (arg[1]=' ') do
  1294. delete(arg,1,1);
  1295. pspace:=pos(' ',arg);
  1296. if pspace=0 then
  1297. pspace:=length(arg)+1;
  1298. para:=copy(arg,1,pspace-1);
  1299. if (length(para)>0) and (para[1]='-') then
  1300. interpret_option (para)
  1301. else
  1302. begin
  1303. PPFile.Insert(current,ForceExtension(Para,'pp'));
  1304. inc(current);
  1305. end;
  1306. delete(arg,1,pspace);
  1307. end;
  1308. end;
  1309. var
  1310. param : string;
  1311. i : longint;
  1312. begin
  1313. CompilerBin:='ppc386'+srcexeext;
  1314. for i:=1 to paramcount do
  1315. begin
  1316. param:=Paramstr(i);
  1317. if (param[1]='-') then
  1318. interpret_option(param)
  1319. else if (param[1]='!') then
  1320. interpret_env(param)
  1321. else
  1322. begin
  1323. PPFile.Insert(current,ForceExtension(Param,'pp'));
  1324. inc(current);
  1325. end;
  1326. end;
  1327. if current=0 then
  1328. HelpScreen;
  1329. { disable graph,interactive when running remote }
  1330. if RemoteAddr<>'' then
  1331. begin
  1332. DoGraph:=false;
  1333. DoInteractive:=false;
  1334. end;
  1335. end;
  1336. procedure RunTest;
  1337. var
  1338. PPDir,LibraryName : string;
  1339. Res : boolean;
  1340. begin
  1341. Res:=GetConfig(PPFile[current],Config);
  1342. if Res then
  1343. begin
  1344. Res:=GetCompilerCPU;
  1345. Res:=GetCompilerTarget;
  1346. {$ifndef MACOS}
  1347. RTLUnitsDir:='units/'+CompilerFullTarget;
  1348. {$else MACOS}
  1349. RTLUnitsDir:=':units:'+CompilerFullTarget;
  1350. {$endif MACOS}
  1351. if not PathExists(RTLUnitsDir) then
  1352. Verbose(V_Abort,'Unit path "'+RTLUnitsDir+'" does not exists');
  1353. {$ifndef MACOS}
  1354. OutputDir:='output/'+CompilerFullTarget;
  1355. {$else MACOS}
  1356. OutputDir:=':output:'+CompilerFullTarget;
  1357. {$endif MACOS}
  1358. if not PathExists(OutputDir) then
  1359. Verbose(V_Abort,'Output path "'+OutputDir+'" does not exists');
  1360. { Global log files }
  1361. ResLogFile:=OutputFileName('log','');
  1362. LongLogFile:=OutputFileName('longlog','');
  1363. FailLogFile:=OutputFileName('faillist','');
  1364. { Make subdir in output if needed }
  1365. PPDir:=SplitPath(PPFile[current]);
  1366. if PPDir[length(PPDir)] in ['/','\'{$ifdef MACOS},':'{$endif MACOS}] then
  1367. Delete(PPDir,length(PPDir),1);
  1368. if PPDir<>'' then
  1369. begin
  1370. {$ifndef MACOS}
  1371. TestOutputDir:=OutputDir+'/'+PPDir;
  1372. {$else MACOS}
  1373. TestOutputDir:=OutputDir+PPDir;
  1374. {$endif MACOS}
  1375. mkdirtree(TestOutputDir);
  1376. end
  1377. else
  1378. TestOutputDir:=OutputDir;
  1379. { Per test logfiles }
  1380. CompilerLogFile:=TestOutputFileName('',SplitFileName(PPFile[current]),'log');
  1381. ExeLogFile:=TestOutputFileName('',SplitFileName(PPFile[current]),'elg');
  1382. Verbose(V_Debug,'Using Compiler logfile: '+CompilerLogFile);
  1383. Verbose(V_Debug,'Using Execution logfile: '+ExeLogFile);
  1384. end;
  1385. if Res then
  1386. begin
  1387. if Config.UsesGraph and (not DoGraph) then
  1388. begin
  1389. AddLog(ResLogFile,skipping_graph_test+PPFileInfo[current]);
  1390. { avoid a second attempt by writing to elg file }
  1391. AddLog(EXELogFile,skipping_graph_test+PPFileInfo[current]);
  1392. Verbose(V_Warning,skipping_graph_test);
  1393. Res:=false;
  1394. end;
  1395. end;
  1396. if Res then
  1397. begin
  1398. if Config.IsInteractive and (not DoInteractive) then
  1399. begin
  1400. { avoid a second attempt by writing to elg file }
  1401. AddLog(EXELogFile,skipping_interactive_test+PPFileInfo[current]);
  1402. AddLog(ResLogFile,skipping_interactive_test+PPFileInfo[current]);
  1403. Verbose(V_Warning,skipping_interactive_test);
  1404. Res:=false;
  1405. end;
  1406. end;
  1407. if Res then
  1408. begin
  1409. if Config.IsKnownCompileError and (not DoKnown) then
  1410. begin
  1411. { avoid a second attempt by writing to elg file }
  1412. AddLog(EXELogFile,skipping_known_bug+PPFileInfo[current]);
  1413. AddLog(ResLogFile,skipping_known_bug+PPFileInfo[current]);
  1414. Verbose(V_Warning,skipping_known_bug);
  1415. Res:=false;
  1416. end;
  1417. end;
  1418. if Res and not DoUsual then
  1419. res:=(Config.IsInteractive and DoInteractive) or
  1420. (Config.IsKnownRunError and DoKnown) or
  1421. (Config.UsesGraph and DoGraph);
  1422. if Res then
  1423. begin
  1424. if (Config.MinVersion<>'') and not DoAll then
  1425. begin
  1426. Verbose(V_Debug,'Required compiler version: '+Config.MinVersion);
  1427. Res:=GetCompilerVersion;
  1428. if CompilerVersion<Config.MinVersion then
  1429. begin
  1430. { avoid a second attempt by writing to elg file }
  1431. AddLog(EXELogFile,skipping_compiler_version_too_low+PPFileInfo[current]);
  1432. AddLog(ResLogFile,skipping_compiler_version_too_low+PPFileInfo[current]);
  1433. Verbose(V_Warning,'Compiler version too low '+CompilerVersion+' < '+Config.MinVersion);
  1434. Res:=false;
  1435. end;
  1436. end;
  1437. end;
  1438. if Res then
  1439. begin
  1440. if (Config.MaxVersion<>'') and not DoAll then
  1441. begin
  1442. Verbose(V_Debug,'Highest compiler version: '+Config.MaxVersion);
  1443. Res:=GetCompilerVersion;
  1444. if CompilerVersion>Config.MaxVersion then
  1445. begin
  1446. { avoid a second attempt by writing to elg file }
  1447. AddLog(EXELogFile,skipping_compiler_version_too_high+PPFileInfo[current]);
  1448. AddLog(ResLogFile,skipping_compiler_version_too_high+PPFileInfo[current]);
  1449. Verbose(V_Warning,'Compiler version too high '+CompilerVersion+' > '+Config.MaxVersion);
  1450. Res:=false;
  1451. end;
  1452. end;
  1453. end;
  1454. if Res then
  1455. begin
  1456. if Config.NeedCPU<>'' then
  1457. begin
  1458. Verbose(V_Debug,'Required compiler cpu: '+Config.NeedCPU);
  1459. if not IsInList(CompilerCPU,Config.NeedCPU) then
  1460. begin
  1461. { avoid a second attempt by writing to elg file }
  1462. AddLog(EXELogFile,skipping_other_cpu+PPFileInfo[current]);
  1463. AddLog(ResLogFile,skipping_other_cpu+PPFileInfo[current]);
  1464. Verbose(V_Warning,'Compiler cpu "'+CompilerCPU+'" is not in list "'+Config.NeedCPU+'"');
  1465. Res:=false;
  1466. end;
  1467. end;
  1468. end;
  1469. if Res then
  1470. begin
  1471. if Config.SkipCPU<>'' then
  1472. begin
  1473. Verbose(V_Debug,'Skip compiler cpu: '+Config.SkipCPU);
  1474. if IsInList(CompilerCPU,Config.SkipCPU) then
  1475. begin
  1476. { avoid a second attempt by writing to elg file }
  1477. AddLog(EXELogFile,skipping_other_cpu+PPFileInfo[current]);
  1478. AddLog(ResLogFile,skipping_other_cpu+PPFileInfo[current]);
  1479. Verbose(V_Warning,'Compiler cpu "'+CompilerCPU+'" is in list "'+Config.SkipCPU+'"');
  1480. Res:=false;
  1481. end;
  1482. end;
  1483. end;
  1484. if Res then
  1485. begin
  1486. if Config.SkipEmu<>'' then
  1487. begin
  1488. Verbose(V_Debug,'Skip emulator: '+emulatorname);
  1489. if IsInList(emulatorname,Config.SkipEmu) then
  1490. begin
  1491. { avoid a second attempt by writing to elg file }
  1492. AddLog(EXELogFile,skipping_other_cpu+PPFileInfo[current]);
  1493. AddLog(ResLogFile,skipping_other_cpu+PPFileInfo[current]);
  1494. Verbose(V_Warning,'Emulator "'+emulatorname+'" is in list "'+Config.SkipEmu+'"');
  1495. Res:=false;
  1496. end;
  1497. end;
  1498. end;
  1499. if Res then
  1500. begin
  1501. if Config.NeedTarget<>'' then
  1502. begin
  1503. Verbose(V_Debug,'Required compiler target: '+Config.NeedTarget);
  1504. if not IsInList(CompilerTarget,Config.NeedTarget) then
  1505. begin
  1506. { avoid a second attempt by writing to elg file }
  1507. AddLog(EXELogFile,skipping_other_target+PPFileInfo[current]);
  1508. AddLog(ResLogFile,skipping_other_target+PPFileInfo[current]);
  1509. Verbose(V_Warning,'Compiler target "'+CompilerTarget+'" is not in list "'+Config.NeedTarget+'"');
  1510. Res:=false;
  1511. end;
  1512. end;
  1513. end;
  1514. if Res then
  1515. begin
  1516. if Config.SkipTarget<>'' then
  1517. begin
  1518. Verbose(V_Debug,'Skip compiler target: '+Config.SkipTarget);
  1519. if IsInList(CompilerTarget,Config.SkipTarget) then
  1520. begin
  1521. { avoid a second attempt by writing to elg file }
  1522. AddLog(EXELogFile,skipping_other_target+PPFileInfo[current]);
  1523. AddLog(ResLogFile,skipping_other_target+PPFileInfo[current]);
  1524. Verbose(V_Warning,'Compiler target "'+CompilerTarget+'" is in list "'+Config.SkipTarget+'"');
  1525. Res:=false;
  1526. end;
  1527. end;
  1528. end;
  1529. if Res then
  1530. begin
  1531. { Use known bug, to avoid adding a new entry for this PM 2011-06-24 }
  1532. if Config.NeedLibrary and not TargetCanCompileLibraries then
  1533. begin
  1534. AddLog(EXELogFile,skipping_known_bug+PPFileInfo[current]);
  1535. AddLog(ResLogFile,skipping_known_bug+PPFileInfo[current]);
  1536. Verbose(V_Warning,'Compiler target "'+CompilerTarget+'" does not support library compilation');
  1537. Res:=false;
  1538. end;
  1539. end;
  1540. if Res then
  1541. begin
  1542. Res:=RunCompiler;
  1543. if Res and Config.NeedRecompile then
  1544. Res:=RunCompiler;
  1545. end;
  1546. if Res and (not Config.ShouldFail) then
  1547. begin
  1548. if (Config.NoRun) then
  1549. begin
  1550. { avoid a second attempt by writing to elg file }
  1551. AddLog(EXELogFile,skipping_run_test+PPFileInfo[current]);
  1552. AddLog(ResLogFile,skipping_run_test+PPFileInfo[current]);
  1553. Verbose(V_Debug,skipping_run_test);
  1554. if LibraryExists(PPFile[current],LibraryName) then
  1555. MaybeCopyFiles(LibraryName);
  1556. end
  1557. else if Config.IsKnownRunError and (not DoKnown) then
  1558. begin
  1559. { avoid a second attempt by writing to elg file }
  1560. AddLog(EXELogFile,skipping_known_bug+PPFileInfo[current]);
  1561. AddLog(ResLogFile,skipping_known_bug+PPFileInfo[current]);
  1562. Verbose(V_Warning,skipping_known_bug);
  1563. end
  1564. else
  1565. begin
  1566. if DoExecute then
  1567. begin
  1568. if FileExists(TestOutputFilename('',PPFile[current],'ppu')) or
  1569. FileExists(TestOutputFilename('',PPFile[current],'ppo')) or
  1570. FileExists(TestOutputFilename('',PPFile[current],'ppw')) then
  1571. begin
  1572. AddLog(ExeLogFile,skipping_run_unit+PPFileInfo[current]);
  1573. AddLog(ResLogFile,skipping_run_unit+PPFileInfo[current]);
  1574. Verbose(V_Debug,'Unit found, skipping run test')
  1575. end
  1576. else if LibraryExists(PPFile[current],LibraryName) then
  1577. begin
  1578. Verbose(V_Debug,'Library found, skipping run test');
  1579. MaybeCopyFiles(LibraryName);
  1580. end
  1581. else
  1582. Res:=RunExecutable;
  1583. end;
  1584. end;
  1585. end;
  1586. end;
  1587. begin
  1588. Current:=0;
  1589. PPFile:=TStringList.Create;
  1590. PPFile.Capacity:=10;
  1591. PPFileInfo:=TStringList.Create;
  1592. PPFileInfo.Capacity:=10;
  1593. GetArgs;
  1594. SetTargetDirectoriesStyle;
  1595. SetTargetCanCompileLibraries;
  1596. SetRemoteConfiguration;
  1597. {$ifdef LIMIT83fs}
  1598. UseOSOnly:=true;
  1599. {$else not LIMIT83fs}
  1600. SetUseOSOnly;
  1601. {$endif not LIMIT83fs}
  1602. Verbose(V_Debug,'Found '+ToStr(PPFile.Count)+' tests to run');
  1603. if current>0 then
  1604. for current:=0 to PPFile.Count-1 do
  1605. begin
  1606. SetPPFileInfo;
  1607. TestName:=Copy(PPFile[current],1,Pos('.pp',PPFile[current])-1);
  1608. Verbose(V_Normal,'Running test '+TestName+', file '+PPFile[current]);
  1609. RunTest;
  1610. end;
  1611. PPFile.Free;
  1612. PPFileInfo.Free;
  1613. end.