dotest.pp 51 KB

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