dotest.pp 57 KB

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