dotest.pp 51 KB

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