dotest.pp 54 KB

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