utests.pp 38 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402
  1. {$mode objfpc}
  2. {$h+}
  3. unit utests;
  4. interface
  5. uses cgiapp,sysutils,mysql41conn,sqldb,whtml,dbwhtml,db,
  6. tresults,
  7. Classes,ftFont,fpimage,fpimgcanv,fpWritePng,fpcanvas;
  8. {$ifndef TEST}
  9. const
  10. CGI = 'testsuite.cgi';
  11. {$else TEST}
  12. const
  13. CGI = 'testsuite-new.cgi';
  14. {$endif TEST}
  15. Type
  16. TTestSuite = Class(TCgiApplication)
  17. Private
  18. FHTMLWriter : THtmlWriter;
  19. FComboBoxProducer : TComboBoxProducer;
  20. FDB : TSQLConnection;
  21. FTrans : TSQLTransaction;
  22. FRunID,
  23. FCompareRunID,
  24. FTestFileID,
  25. FTestFileName,
  26. FVersion,
  27. FCPU,
  28. FOS : String;
  29. FDate : TDateTime;
  30. FDebug,
  31. FNoSkipped,
  32. FOnlyFailed : Boolean;
  33. FRunSkipCount,
  34. FRunFailedCount,
  35. FRunCount : Integer;
  36. FAction,
  37. FLimit : Integer;
  38. FTestLastDays : Integer;
  39. Procedure GetOverviewRowAttr(Sender : TObject; Var BGColor : String;
  40. Var Align : THTMLAlign; Var VAlign : THTMLValign;
  41. Var CustomAttr : String) ;
  42. Procedure GetRunRowAttr(Sender : TObject; Var BGColor : String;
  43. Var Align : THTMLAlign; Var VAlign : THTMLValign;
  44. Var CustomAttr : String) ;
  45. Procedure FormatFailedOverview(Sender : TObject; Var CellData : String);
  46. Procedure FormatTestRunOverview(Sender : TObject; Var CellData : String);
  47. Procedure FormatFileDetails(Sender: TObject; var CellData: String);
  48. Procedure FormatTestResult(Sender: TObject; var CellData: String);
  49. Procedure DoDrawPie(Img : TFPCustomImage; Skipped,Failed,Total : Integer);
  50. Public
  51. Function CreateDataset(Qry : String) : TSQLQuery;
  52. Function CreateTableProducer(DS : TDataset) :TTableProducer;
  53. Procedure DefaultTableFromQuery(Qry,ALink : String; IncludeRecordCount : Boolean);
  54. Procedure ComboBoxFromQuery(Const ComboName,Qry : String);
  55. Procedure ComboBoxFromQuery(Const ComboName,Qry,Value : String);
  56. Function GetSingleTon(Const Qry : String) : String;
  57. Function GetOSName(ID : String) : String;
  58. Function GetCPUName(ID : String) : String;
  59. Function GetVersionName(ID : String) : String;
  60. Function GetTestFileName(ID : String) : String;
  61. Function InitCGIVars : Integer;
  62. Procedure DoRun; override;
  63. Procedure EmitOverviewForm;
  64. Procedure ShowRunResults;
  65. Procedure ShowRunComparison;
  66. Procedure ShowOneTest;
  67. Function ConnectToDB : Boolean;
  68. procedure DisconnectFromDB;
  69. Procedure EmitTitle(ATitle : String);
  70. Procedure EmitEnd;
  71. Procedure ShowRunOverview;
  72. Procedure CreateRunPie;
  73. Function ShowRunData : Boolean;
  74. end;
  75. implementation
  76. Const
  77. {$i utests.cfg}
  78. { if utests.cfg is missed, create one with the following contents:
  79. DefDatabase = 'TESTSUITE';
  80. DefHost = '';
  81. DefDBUser = ''; // fill this in when compiling.
  82. DefPassword = ''; // fill this in, too.
  83. }
  84. Const
  85. SDetailsURL = CGI + '?action=1&run1id=%s';
  86. Procedure TTestSuite.DoRun;
  87. begin
  88. Try
  89. Try
  90. Case InitCGIVars of
  91. 0 : EmitOverviewForm;
  92. 1 :
  93. if Length(FCompareRunID) = 0 then
  94. ShowRunResults
  95. else
  96. ShowRunComparison;
  97. 2 : CreateRunPie;
  98. 3 : ShowOneTest;
  99. {$ifdef TEST}
  100. 98 :
  101. begin
  102. EmitOverviewForm;
  103. Writeln(stdout,'<PRE>');
  104. FreeMem(pointer($ffffffff));
  105. Writeln(stdout,'</PRE>');
  106. end;
  107. 99 :
  108. begin
  109. EmitOverviewForm;
  110. Writeln(stdout,'<PRE>');
  111. Dump_stack(stdout,get_frame);
  112. Writeln(stdout,'</PRE>');
  113. end;
  114. {$endif TEST}
  115. end;
  116. finally
  117. EmitEnd;
  118. DisConnectFromDB;
  119. end;
  120. Finally
  121. Terminate;
  122. end;
  123. end;
  124. Function TTestSuite.InitCGIVars : Integer;
  125. Var
  126. S : String;
  127. begin
  128. FHtmlWriter:=THTMLWriter.Create(Response);
  129. FComboBoxProducer:=TComboBoxProducer.Create(Self);
  130. DateSeparator:='/';
  131. Result:=0;
  132. S:=RequestVariables['action'];
  133. if Length(S) = 0 then
  134. S:=RequestVariables['TESTACTION'];
  135. FAction:=StrToIntDef(S,0);
  136. S:=RequestVariables['limit'];
  137. if Length(S) = 0 then
  138. S:=RequestVariables['TESTLIMIT'];
  139. FLimit:=StrToIntDef(S,50);
  140. FVersion:=RequestVariables['version'];
  141. if Length(FVersion) = 0 then
  142. FVersion:=RequestVariables['TESTVERSION'];
  143. FOS:=RequestVariables['os'];
  144. if Length(FOS) = 0 then
  145. FOS:=RequestVariables['TESTOS'];
  146. FCPU:=RequestVariables['cpu'];
  147. if Length(FCPU) = 0 then
  148. FCPU:=RequestVariables['TESTCPU'];
  149. FRunID:=RequestVariables['run1id'];
  150. if Length(FRunID) = 0 then
  151. FRunID:=RequestVariables['TESTRUN'];
  152. S:=RequestVariables['lastdays'];
  153. if Length(S) = 0 then
  154. S:=RequestVariables['TESTLASTDAYS'];
  155. FTestLastDays:=StrToIntDef(S,31);
  156. S:=RequestVariables['date'];
  157. if Length(S) = 0 then
  158. S:=RequestVariables['TESTDATE'];
  159. if Length(S) > 0 then
  160. try
  161. FDate:=StrToDate(S);
  162. except
  163. FDate:=0;
  164. end;
  165. S:=RequestVariables['failedonly'];
  166. if Length(S) = 0 then
  167. S:=RequestVariables['TESTFAILEDONLY'];
  168. FOnlyFailed:=(S='1');
  169. S:=RequestVariables['noskipped'];
  170. if Length(S) = 0 then
  171. S:=RequestVariables['TESTNOSKIPPED'];
  172. FNoSkipped:=(S='1');
  173. FCompareRunID:=RequestVariables['run2id'];
  174. FTestFileID:=RequestVariables['testfileid'];
  175. FTestFileName:=RequestVariables['testfilename'];
  176. FRunCount:=StrToIntDef(RequestVariables['PIETOTAL'],0);
  177. FRunSkipCount:=StrToIntDef(RequestVariables['PIESKIPPED'],0);
  178. FRunFailedCount:=StrToIntDef(RequestVariables['PIEFAILED'],0);
  179. S:=RequestVariables['DEBUGCGI'];
  180. FDebug:=(S='1');
  181. Result:=FAction;
  182. end;
  183. Function TTestSuite.ConnectToDB : Boolean;
  184. begin
  185. Result:=False;
  186. FDB:=TMySQL41Connection.Create(Self);
  187. FDB.HostName:=DefHost;
  188. FDB.DatabaseName:=DefDatabase;
  189. FDB.UserName:=DefDBUser;
  190. FDB.Password:=DefPassword;
  191. FTrans := TSQLTransaction.Create(nil);
  192. FTrans.DataBase := FDB;
  193. FDB.Transaction := FTrans;
  194. FDB.Connected:=True;
  195. Result:=True;
  196. end;
  197. procedure TTestSuite.DisconnectFromDB;
  198. begin
  199. If Assigned(FDB) then
  200. begin
  201. if (FDB.Connected) then
  202. FDB.Connected:=False;
  203. FreeAndNil(FDB);
  204. FreeAndNil(FTrans);
  205. end;
  206. end;
  207. Procedure TTestSuite.ComboBoxFromQuery(Const ComboName,Qry: String);
  208. begin
  209. ComboBoxFromQuery(ComboName,Qry,'')
  210. end;
  211. Procedure TTestSuite.ComboBoxFromQuery(Const ComboName,Qry,Value : String);
  212. Var
  213. Q : TSQLQuery;
  214. begin
  215. Q:=TSQLQuery.Create(Self);
  216. try
  217. Q.Database:=FDB;
  218. Q.Transaction:=FTrans;
  219. Q.SQL.Text:=Qry;
  220. Q.Open;
  221. FComboboxProducer.Dataset:=Q;
  222. FComboBoxProducer.ValueField:=Q.Fields[0].FieldName;
  223. FComboBoxProducer.DataField:=Q.Fields[1].FieldName;
  224. FComboBoxProducer.Value:=Value;
  225. FComboBoxProducer.InputName:=ComboName;
  226. FComboBoxProducer.CreateComboBox(Response);
  227. Finally
  228. Q.Free;
  229. end;
  230. end;
  231. Function TTestSuite.GetSingleton(Const Qry : String) : String;
  232. Var
  233. Q : TSQLQuery;
  234. begin
  235. Result:='';
  236. if FDEbug then
  237. begin
  238. system.Writeln('Query=',Qry);
  239. system.flush(output);
  240. end;
  241. Q:=TSQLQuery.Create(Self);
  242. try
  243. Q.Database:=FDB;
  244. Q.Transaction:=FTrans;
  245. Q.SQL.Text:=Qry;
  246. Q.Open;
  247. Try
  248. if FDebug and (Q.FieldCount<>1) then
  249. begin
  250. system.Writeln('GetSingleton number of fields is not 1, but ',
  251. Q.FieldCount);
  252. system.flush(output);
  253. end;
  254. If Not (Q.EOF and Q.BOF) then
  255. Result:=Q.Fields[0].AsString;
  256. Finally
  257. Q.Close;
  258. end;
  259. finally
  260. Q.Free;
  261. end;
  262. end;
  263. Procedure TTestSuite.EmitTitle(ATitle : String);
  264. begin
  265. AddResponseLn('<HTML>');
  266. AddResponseLn('<TITLE>'+ATitle+'</TITLE>');
  267. AddResponseLn('<BODY>');
  268. end;
  269. Procedure TTestSuite.EmitOverviewForm;
  270. begin
  271. ConnectToDB;
  272. ContentType:='text/html';
  273. EmitContentType;
  274. EmitTitle(Title);
  275. With FHTMLWriter do
  276. begin
  277. HeaderStart(1);
  278. Write('View Test suite results');
  279. HeaderEnd(1);
  280. Write('Please specify search criteria:');
  281. ParagraphStart;
  282. FormStart(CGI,'');
  283. TableStart(2,true);
  284. RowStart;
  285. CellStart;
  286. Write('Operating system:');
  287. CellNext;
  288. ComboBoxFromQuery('os','SELECT TO_ID,TO_NAME FROM TESTOS ORDER BY TO_NAME',FOS);
  289. CellEnd;
  290. RowNext;
  291. CellStart;
  292. Write('Processor:');
  293. CellNext;
  294. ComboBoxFromQuery('cpu','SELECT TC_ID,TC_NAME FROM TESTCPU ORDER BY TC_NAME',FCPU);
  295. CellEnd;
  296. RowNext;
  297. CellStart;
  298. Write('Version');
  299. CellNext;
  300. ComboBoxFromQuery('version','SELECT TV_ID,TV_VERSION FROM TESTVERSION ORDER BY TV_VERSION DESC',FVERSION);
  301. CellEnd;
  302. RowNext;
  303. CellStart;
  304. Write('Date');
  305. CellNext;
  306. If (FDate=0) then
  307. EmitInput('date','')
  308. else
  309. EmitInput('date',DateToStr(FDate));
  310. CellEnd;
  311. RowNext;
  312. CellStart;
  313. Write('Only failed tests');
  314. CellNext;
  315. EmitCheckBox('failedonly','1',FonlyFailed);
  316. CellEnd;
  317. RowNext;
  318. CellStart;
  319. Write('Hide skipped tests');
  320. CellNext;
  321. EmitCheckBox('noskipped','1',FNoSkipped);
  322. CellEnd;
  323. RowEnd;
  324. TableEnd;
  325. ParaGraphStart;
  326. EmitSubmitButton('','Search');
  327. EmitResetButton('','Reset form');
  328. FormEnd;
  329. end;
  330. ShowRunOverview;
  331. end;
  332. procedure TTestSuite.EmitEnd;
  333. begin
  334. AddResponseLn('</BODY>');
  335. AddResponseLn('</HTML>');
  336. end;
  337. procedure TTestSuite.GetOverviewRowAttr(Sender: TObject; var BGColor: String;
  338. var Align: THTMLAlign; var VAlign: THTMLValign; var CustomAttr: String);
  339. begin
  340. If ((Sender as TTAbleProducer).CurrentRow mod 2=0) then
  341. BGColor:='#EEEEEE'
  342. end;
  343. Function TTestSuite.CreateDataset(Qry : String) : TSQLQuery;
  344. begin
  345. Result:=TSQLQuery.Create(Self);
  346. With Result do
  347. begin
  348. Database:=FDB;
  349. Transaction := FTrans;
  350. SQL.Text:=Qry;
  351. end;
  352. end;
  353. Function TTestSuite.CreateTableProducer(DS : TDataset) :TTableProducer;
  354. begin
  355. Result:=TTableProducer.Create(Self);
  356. Result.Dataset:=DS;
  357. end;
  358. Procedure TTestSuite.DefaultTableFromQuery(Qry,Alink : String; IncludeRecordCount : Boolean);
  359. Var
  360. Q : TSQLQuery;
  361. begin
  362. If FDebug then
  363. Writeln('Query : '+Qry);
  364. Q:=CreateDataset(Qry);
  365. With Q do
  366. try
  367. Open;
  368. Try
  369. With CreateTableProducer(Q) do
  370. Try
  371. Border:=True;
  372. If (Alink<>'') then
  373. begin
  374. CreateColumns(Nil);
  375. If TableColumns.Count>0 then
  376. (TableColumns.Items[0] as TTableColumn).ActionURL:=ALink;
  377. end;
  378. CreateTable(Response);
  379. Finally
  380. Free;
  381. end;
  382. If IncludeRecordCount then
  383. FHTMLWriter.DumpLn(Format('<p>Record count: %d </p>',[Q.RecordCount]));
  384. Finally
  385. Close;
  386. end;
  387. finally
  388. Free;
  389. end;
  390. end;
  391. Procedure TTestSuite.ShowRunOverview;
  392. Const
  393. SOverview = 'SELECT TU_ID as ID,TU_DATE as Date,TC_NAME as CPU,TO_NAME as OS,'+
  394. 'TV_VERSION as Version,COUNT(TR_ID) as Count,'+
  395. '(TU_SUCCESSFULLYFAILED+TU_SUCCESFULLYCOMPILED+TU_SUCCESSFULLYRUN) AS OK,'+
  396. '(TU_FAILEDTOCOMPILE+TU_FAILEDTORUN+TU_FAILEDTOFAIL) as Failed,'+
  397. '(TU_SUCCESSFULLYFAILED+TU_SUCCESFULLYCOMPILED+TU_SUCCESSFULLYRUN+'+
  398. 'TU_FAILEDTOCOMPILE+TU_FAILEDTORUN+TU_FAILEDTOFAIL) as Total,'+
  399. 'TU_SUBMITTER as Submitter, TU_MACHINE as Machine, TU_COMMENT as Comment '+
  400. 'FROM TESTRESULTS,TESTRUN,TESTCPU,TESTOS,TESTVERSION '+
  401. 'WHERE '+
  402. '(TC_ID=TU_CPU_FK) AND '+
  403. '(TO_ID=TU_OS_FK) AND '+
  404. '(TV_ID=TU_VERSION_FK) AND '+
  405. '(TR_TESTRUN_FK=TU_ID) '+
  406. '%s '+
  407. 'GROUP BY TU_ID '+
  408. 'ORDER BY TU_ID DESC LIMIT %d';
  409. Var
  410. S,A,Qry : String;
  411. Q : TSQLQuery;
  412. begin
  413. S:='';
  414. If (FCPU<>'') and (GetCPUName(FCPU)<>'All') then
  415. S:=S+' AND (TU_CPU_FK='+FCPU+')';
  416. If (FVersion<>'') and (GetVersionName(FVersion)<>'All') then
  417. S:=S+' AND (TU_VERSION_FK='+FVERSION+')';
  418. if (FOS<>'') and (GetOSName(FOS)<>'All') then
  419. S:=S+' AND (TU_OS_FK='+FOS+')';
  420. If (Round(FDate)<>0) then
  421. S:=S+' AND (TU_DATE="'+FormatDateTime('YYYY/MM/DD',FDate)+'")';
  422. If FOnlyFailed then
  423. S:=S+' AND (TR_OK="-")';
  424. A:=SDetailsURL;
  425. If FOnlyFailed then
  426. A:=A+'&failedonly=1';
  427. If FNoSkipped then
  428. A:=A+'&noskipped=1';
  429. Qry:=Format(SOverview,[S,FLimit]);
  430. If FDebug then
  431. Writeln('Query : '+Qry);
  432. Q:=CreateDataset(Qry);
  433. With Q do
  434. try
  435. Open;
  436. Try
  437. With CreateTableProducer(Q) do
  438. Try
  439. Border:=True;
  440. OnGetRowAttributes:=@GetOverViewRowAttr;
  441. CreateColumns(Nil);
  442. TableColumns.ColumnByName('ID').ActionURL:=A;
  443. TableColumns.ColumnByNAme('Failed').OnGetCellContents:=@FormatFailedOverview;
  444. CreateTable(Response);
  445. Finally
  446. Free;
  447. end;
  448. FHTMLWriter.DumpLn(Format('<p>Record count: %d</p>',[Q.RecordCount]));
  449. Finally
  450. Close;
  451. end;
  452. finally
  453. Free;
  454. end;
  455. end;
  456. Function TTestSuite.GetOSName(ID : String) : String;
  457. begin
  458. if (ID<>'') then
  459. Result:=GetSingleTon('SELECT TO_NAME FROM TESTOS WHERE TO_ID='+ID);
  460. end;
  461. Function TTestSuite.GetTestFileName(ID : String) : String;
  462. begin
  463. if (ID<>'') then
  464. Result:=GetSingleTon('SELECT T_NAME FROM TESTS WHERE T_ID='+ID);
  465. end;
  466. Function TTestSuite.GetCPUName(ID : String) : String;
  467. begin
  468. if (ID<>'') then
  469. Result:=GetSingleTon('SELECT TC_NAME FROM TESTCPU WHERE TC_ID='+ID);
  470. end;
  471. Function TTestSuite.GetVersionName(ID : String) : String;
  472. begin
  473. if (ID<>'') then
  474. Result:=GetSingleton('SELECT TV_VERSION FROM TESTVERSION WHERE TV_ID='+ID);
  475. end;
  476. Function TTestSuite.ShowRunData : Boolean;
  477. Const
  478. SGetRunData = 'SELECT TU_ID,TU_DATE,TC_NAME,TO_NAME,' +
  479. 'TU_SUBMITTER,TU_MACHINE,TU_COMMENT,TV_VERSION '+
  480. ' FROM TESTRUN,TESTCPU,TESTOS,TESTVERSION '+
  481. 'WHERE '+
  482. ' (TC_ID=TU_CPU_FK) AND '+
  483. ' (TO_ID=TU_OS_FK) AND '+
  484. ' (TV_ID=TU_VERSION_FK) AND '+
  485. ' (TU_ID=%s)';
  486. Var
  487. Q1,Q2 : TSQLQuery;
  488. F : TField;
  489. Date1, Date2: TDateTime;
  490. begin
  491. Result:=(FRunID<>'');
  492. If Result then
  493. begin
  494. Q1:=CreateDataset(Format(SGetRunData,[FRunID]));
  495. if Length(FCompareRunID) > 0 then
  496. Q2:=CreateDataset(Format(SGetRunData,[FCompareRunID]))
  497. else
  498. Q2:=nil;
  499. Try
  500. Q1.Open;
  501. if Q2 <> nil then
  502. Q2.Open;
  503. Result:=Not (Q1.EOF and Q1.BOF);
  504. If Result then
  505. With FHTMLWriter do
  506. begin
  507. FormStart(CGI,'get');
  508. EmitHiddenVar('action', '1');
  509. TableStart(3,true);
  510. RowStart;
  511. CellStart;
  512. Write('Run ID:');
  513. CellNext;
  514. EmitInput('run1id',FRunID);
  515. CellNext;
  516. EmitInput('run2id',FCompareRunID);
  517. CellEnd;
  518. RowNext;
  519. CellStart;
  520. Write('Operating system:');
  521. CellNext;
  522. Write(Q1.FieldByName('TO_NAME').AsString);
  523. CellNext;
  524. if Q2 <> nil then
  525. Write(Q2.FieldByName('TO_NAME').AsString);
  526. CellEnd;
  527. RowNext;
  528. CellStart;
  529. Write('Processor:');
  530. CellNext;
  531. Write(Q1.FieldByName('TC_NAME').AsString);
  532. CellNext;
  533. if Q2 <> nil then
  534. Write(Q2.FieldByName('TC_NAME').AsString);
  535. CellEnd;
  536. RowNext;
  537. CellStart;
  538. Write('Version:');
  539. CellNext;
  540. Write(Q1.FieldByNAme('TV_VERSION').AsString);
  541. CellNext;
  542. if Q2 <> nil then
  543. Write(Q2.FieldByNAme('TV_VERSION').AsString);
  544. CellEnd;
  545. RowNext;
  546. CellStart;
  547. Write('Comment:');
  548. CellNext;
  549. Write(Q1.FieldByName('TU_COMMENT').AsString);
  550. CellNext;
  551. if Q2 <> nil then
  552. Write(Q2.FieldByName('TU_COMMENT').AsString);
  553. CellEnd;
  554. RowNext;
  555. CellStart;
  556. Write('Machine:');
  557. CellNext;
  558. Write(Q1.FieldByName('TU_MACHINE').AsString);
  559. CellNext;
  560. if Q2 <> nil then
  561. Write(Q2.FieldByName('TU_MACHINE').AsString);
  562. CellEnd;
  563. RowNext;
  564. CellStart;
  565. Write('Submitter:');
  566. CellNext;
  567. Write(Q1.FieldByName('TU_SUBMITTER').AsString);
  568. CellNext;
  569. if Q2 <> nil then
  570. Write(Q2.FieldByName('TU_SUBMITTER').AsString);
  571. CellEnd;
  572. RowNext;
  573. CellStart;
  574. Write('Date:');
  575. CellNext;
  576. F := Q1.FieldByName('TU_DATE');
  577. Date1 := F.AsDateTime;
  578. Write(F.AsString);
  579. CellNext;
  580. if Q2 <> nil then
  581. begin
  582. F := Q2.FieldByName('TU_DATE');
  583. Date2 := F.AsDateTime;
  584. Write(F.AsString);
  585. end;
  586. CellEnd;
  587. RowEnd;
  588. TableEnd;
  589. ParagraphStart;
  590. EmitCheckBox('noskipped','1',FNoSkipped);
  591. Write(' Hide skipped tests');
  592. ParagraphEnd;
  593. ParagraphStart;
  594. EmitCheckBox('failedonly','1',FonlyFailed);
  595. Write(' Hide successful tests');
  596. ParagraphEnd;
  597. ParaGraphStart;
  598. EmitSubmitButton('','Show/Compare');
  599. EmitResetButton('','Reset form');
  600. ParagraphEnd;
  601. FormEnd;
  602. { give warning if dates reversed }
  603. if (Q2 <> nil) and (Date1 > Date2) then
  604. begin
  605. ParagraphStart;
  606. Write('Warning: testruns are not compared in chronological order.');
  607. ParagraphEnd;
  608. end;
  609. end;
  610. Finally
  611. Q1.Close;
  612. Q1.Free;
  613. if Q2 <> nil then
  614. begin
  615. Q2.Close;
  616. Q2.Free;
  617. end;
  618. end;
  619. end;
  620. end;
  621. Procedure TTestSuite.ShowRunResults;
  622. Var
  623. S : String;
  624. Qry : String;
  625. Q : TSQLQuery;
  626. FL : String;
  627. begin
  628. ConnectToDB;
  629. ContentType:='text/html';
  630. EmitContentType;
  631. EmitTitle(Title+' : Search Results');
  632. With FHTMLWriter do
  633. begin
  634. HeaderStart(1);
  635. Write('Test suite results for run '+FRunID);
  636. HeaderEnd(1);
  637. HeaderStart(2);
  638. Write('Test run data : ');
  639. HeaderEnd(2);
  640. If ShowRunData then
  641. begin
  642. HeaderStart(2);
  643. Write('Detailed test run results:');
  644. FL:='';
  645. If FOnlyFailed or FNoSkipped then
  646. begin
  647. FL:='';
  648. If FOnlyFailed then
  649. FL:='successful';
  650. if FNoSkipped then
  651. begin
  652. If (FL<>'') then
  653. FL:=FL+' and ';
  654. FL:=FL+'skipped';
  655. end;
  656. Write(' ('+FL+' tests are hidden)');
  657. end;
  658. HeaderEnd(2);
  659. ParaGraphStart;
  660. S:='SELECT T_ID as Id,T_NAME as Filename,TR_SKIP as Skipped'
  661. +',TR_OK as OK,TR_RESULT as Result'
  662. +' FROM TESTRESULTS,TESTS'
  663. +' WHERE (TR_TEST_FK=T_ID) AND (TR_TESTRUN_FK='+FRunID+') ';
  664. If FOnlyFailed then
  665. S:=S+' AND (TR_OK="-")';
  666. If FNoSkipped then
  667. S:=S+' AND (TR_SKIP="-")';
  668. S:=S+' ORDER BY TR_ID ';
  669. Qry:=S;
  670. If FDebug then
  671. begin
  672. Writeln('Query : '+Qry);
  673. Flush(stdout);
  674. end;
  675. FRunCount:=0;
  676. FRunSkipCount:=0;
  677. FRunFailedCount:=0;
  678. Q:=CreateDataset(Qry);
  679. With Q do
  680. try
  681. Open;
  682. Try
  683. With CreateTableProducer(Q) do
  684. Try
  685. Border:=True;
  686. FL:='Id,Filename';
  687. If Not FNoSkipped then
  688. FL:=FL+',Skipped';
  689. If Not FOnlyFailed then
  690. FL:=FL+',OK';
  691. FL:=FL+',Result';
  692. CreateColumns(FL);
  693. OnGetRowAttributes:=@GetRunRowAttr;
  694. TableColumns.ColumnByNAme('Filename').OnGetCellContents:=
  695. @FormatFileDetails;
  696. TableColumns.ColumnByNAme('Result').OnGetCellContents:=
  697. @FormatTestResult;
  698. //(TableColumns.Items[0] as TTableColumn).ActionURL:=ALink;
  699. CreateTable(Response);
  700. Finally
  701. Free;
  702. end;
  703. DumpLn(Format('<p>Record count: %d </p>',[Q.RecordCount]));
  704. Finally
  705. Close;
  706. end;
  707. finally
  708. Free;
  709. end;
  710. If Not (FRunCount=0) and not (FNoSkipped or FOnlyFailed) then
  711. begin
  712. ParaGraphStart;
  713. TagStart('IMG',Format('Src="'+CGI+'?action=2&pietotal=%d&piefailed=%d&pieskipped=%d"',[FRunCount,FRunFailedCount,FRunSkipCount]));
  714. end;
  715. end
  716. else
  717. Write('No data for test run with ID: '+FRunID);
  718. end;
  719. end;
  720. Procedure TTestSuite.ShowOneTest;
  721. Var
  722. S : String;
  723. Qry : String;
  724. Q : TSQLQuery;
  725. i : longint;
  726. FieldName,FieldValue,
  727. Log,Comment,Source : String;
  728. Res : Boolean;
  729. begin
  730. ConnectToDB;
  731. ContentType:='text/html';
  732. EmitContentType;
  733. if FTestFileID='' then
  734. FTestFileID:=GetSingleton('SELECT T_ID FROM TESTS WHERE T_NAME LIKE ''%'+
  735. FTestFileName+'%''');
  736. if FTestFileID<>'' then
  737. FTestFileName:=GetTestFileName(FTestFileID);
  738. EmitTitle(Title+' : File '+FTestFileName+' Results');
  739. With FHTMLWriter do
  740. begin
  741. HeaderStart(1);
  742. Write('Test suite results for test file '+FTestFileName);
  743. HeaderEnd(1);
  744. HeaderStart(2);
  745. Write('Test run data : ');
  746. HeaderEnd(2);
  747. if FRunID<>'' then
  748. begin
  749. Res:=ShowRunData;
  750. Res:=true;
  751. end
  752. else
  753. begin
  754. // This is useless as it is now
  755. // It should be integrated into a form probably PM
  756. Write('Only failed tests');
  757. EmitCheckBox('failedonly','1',FonlyFailed);
  758. Write('Hide skipped tests');
  759. EmitCheckBox('noskipped','1',FNoSkipped);
  760. Res:=true;
  761. end;
  762. If Res then
  763. begin
  764. HeaderStart(2);
  765. Write('Test file "'+FTestFileName+'" information:');
  766. HeaderEnd(2);
  767. ParaGraphStart;
  768. if FTestFileID<>'' then
  769. S:='SELECT * FROM TESTS WHERE T_ID='+FTestFileID
  770. else
  771. S:='SELECT * FROM TESTS WHERE T_NAME='+FTestFileName;
  772. Q:=CreateDataSet(S);
  773. With Q do
  774. Try
  775. Open;
  776. Try
  777. For i:=0 to FieldCount-1 do
  778. begin
  779. FieldValue:=Fields[i].AsString;
  780. FieldName:=Fields[i].DisplayName;
  781. if (FieldValue<>'') and (FieldValue<>'-') and
  782. (FieldName<>'T_NAME') and (FieldName<>'T_SOURCE') then
  783. begin
  784. if (FieldValue='+') then
  785. Write('Flag ');
  786. Write(FieldName);
  787. Write(' ');
  788. if FieldValue='+' then
  789. Write(' set')
  790. else
  791. Write(FieldValue);
  792. DumpLn('<BR>');
  793. end;
  794. end;
  795. Finally
  796. Close;
  797. end;
  798. Finally
  799. Free;
  800. end;
  801. ParaGraphEnd;
  802. HeaderStart(2);
  803. Write('Detailed test run results:');
  804. HeaderEnd(2);
  805. ParaGraphStart;
  806. S:='SELECT TR_ID,TR_TESTRUN_FK,TR_TEST_FK,TR_OK, TR_SKIP,TR_RESULT '
  807. //S:='SELECT * '
  808. +' FROM TESTRESULTS '
  809. +' WHERE (TR_TEST_FK='+FTestFileID+')';
  810. If FOnlyFailed then
  811. S:=S+' AND (TR_OK="-")';
  812. if Fcomparerunid<>'' then
  813. S:=S+' AND ((TR_TESTRUN_FK='+Frunid+') OR '+
  814. '(TR_TESTRUN_FK='+Fcomparerunid+'))'
  815. else if Frunid<>'' then
  816. S:=S+' AND (TR_TESTRUN_FK='+Frunid+')'
  817. else
  818. S:=S+' ORDER BY TR_TESTRUN_FK DESC LIMIT '+IntToStr(FLimit);
  819. Qry:=S;
  820. If FDebug then
  821. begin
  822. Writeln('Query : '+Qry);
  823. Flush(stdout);
  824. end;
  825. FRunCount:=0;
  826. FRunSkipCount:=0;
  827. FRunFailedCount:=0;
  828. Q:=CreateDataset(Qry);
  829. With Q do
  830. try
  831. Open;
  832. Try
  833. With CreateTableProducer(Q) do
  834. Try
  835. Border:=True;
  836. //FL:='TR_ID,TR_TESTRUN_FK,T_NAME,T_CPU,T_VERSION';
  837. CreateColumns(Nil);
  838. TableColumns.ColumnByNAme('TR_TESTRUN_FK').OnGetCellContents:=
  839. @FormatTestRunOverview;
  840. //OnGetRowAttributes:=@GetRunRowAttr;
  841. TableColumns.ColumnByNAme('TR_RESULT').OnGetCellContents:=
  842. @FormatTestResult;
  843. //(TableColumns.Items[0] as TTableColumn).ActionURL:=ALink;
  844. CreateTable(Response);
  845. Finally
  846. Free;
  847. end;
  848. DumpLn(Format('<p>Record count: %d </p>',[Q.RecordCount]));
  849. Finally
  850. Close;
  851. end;
  852. finally
  853. Free;
  854. end;
  855. //If FDebug then
  856. if FRunId<>'' then
  857. begin
  858. log:='';
  859. Try
  860. log:=getsingleton('select TR_LOG from TESTRESULTS where (TR_TEST_FK='+ftestfileid
  861. +') and (TR_TESTRUN_FK='+frunid+')');
  862. if Log<>'' then
  863. begin
  864. HeaderStart(2);
  865. Write('Log of '+FRunId+':');
  866. HeaderEnd(2);
  867. PreformatStart;
  868. system.Write(Log);
  869. system.flush(output);
  870. PreformatEnd;
  871. end;
  872. Finally
  873. if Log='' then
  874. begin
  875. HeaderStart(2);
  876. Write('No log of '+FRunId+'.');
  877. HeaderEnd(2);
  878. end;
  879. end;
  880. end;
  881. if FCompareRunId<>'' then
  882. begin
  883. log:='';
  884. Try
  885. log:=getsingleton('select TR_LOG from TESTRESULTS where (TR_TEST_FK='+ftestfileid
  886. +') and (TR_TESTRUN_FK='+fcomparerunid+')');
  887. if Log<>'' then
  888. begin
  889. HeaderStart(2);
  890. Write('Log of '+FCompareRunId+':');
  891. HeaderEnd(2);
  892. PreformatStart;
  893. system.Write(Log);
  894. system.flush(output);
  895. PreformatEnd;
  896. end;
  897. Finally
  898. if Log='' then
  899. begin
  900. HeaderStart(2);
  901. Write('No log of '+FCompareRunId+'.');
  902. HeaderEnd(2);
  903. end;
  904. end;
  905. end;
  906. if FDebug then
  907. Write('After Log.');
  908. Source:='';
  909. Try
  910. Source:=getsingleton('select T_SOURCE from TESTS where T_ID='+ftestfileid);
  911. if Source<>'' then
  912. begin
  913. HeaderStart(2);
  914. Write('Source:');
  915. HeaderEnd(2);
  916. PreformatStart;
  917. system.Write(Source);
  918. system.flush(output);
  919. PreformatEnd;
  920. end;
  921. Finally
  922. if Source='' then
  923. begin
  924. HeaderStart(3);
  925. DumpLn('<P>No Source in TestSuite DataBase.</P>');
  926. DumpLn('Link to SVN view of '+
  927. '<A HREF="http://www.freepascal.org'+
  928. '/cgi-bin/viewcvs.cgi/trunk/tests/'+
  929. FTestFileName+'?view=markup'+
  930. '" TARGET="_blank"> '+FTestFileName+'</A> source. ');
  931. HeaderEnd(3);
  932. end
  933. else
  934. begin
  935. HeaderStart(3);
  936. DumpLn('Link to SVN view of '+
  937. '<A HREF="http://www.freepascal.org'+
  938. '/cgi-bin/viewcvs.cgi/trunk/tests/'+
  939. FTestFileName+'?view=markup'+
  940. '" TARGET="_blank"> '+FTestFileName+'</A> source. ');
  941. HeaderEnd(3);
  942. end;
  943. end;
  944. if FDebug then
  945. Write('After Source.');
  946. end
  947. else
  948. Write(Format('No data for test file with ID: %s',[FTestFileID]));
  949. end;
  950. end;
  951. Procedure TTestSuite.ShowRunComparison;
  952. Var
  953. S : String;
  954. Qry : String;
  955. Q : TSQLQuery;
  956. FL : String;
  957. begin
  958. ConnectToDB;
  959. ContentType:='text/html';
  960. EmitContentType;
  961. EmitTitle(Title+' : Compare 2 runs');
  962. With FHTMLWriter do
  963. begin
  964. HeaderStart(1);
  965. Write('Test suite results for run '+FRunID+' vs. '+FCompareRunID);
  966. HeaderEnd(1);
  967. HeaderStart(2);
  968. Write('Test run data: ');
  969. HeaderEnd(2);
  970. If ShowRunData then
  971. begin
  972. HeaderStart(2);
  973. Write('Detailed test run results:');
  974. FL:='';
  975. If FOnlyFailed or FNoSkipped then
  976. begin
  977. FL:='';
  978. If FOnlyFailed then
  979. FL:='successful';
  980. if FNoSkipped then
  981. begin
  982. If (FL<>'') then
  983. FL:=FL+' and ';
  984. FL:=FL+'skipped';
  985. end;
  986. Write(' ('+FL+' tests are hidden)');
  987. end;
  988. HeaderEnd(2);
  989. ParaGraphStart;
  990. Q:=CreateDataset('');
  991. Q.SQL.Text:='CREATE TEMPORARY TABLE tr1 like TESTRESULTS;';
  992. Q.ExecSQL;
  993. Q.SQL.Text:='CREATE TEMPORARY TABLE tr2 like TESTRESULTS;';
  994. Q.ExecSQL;
  995. Q.SQL.Text:='INSERT INTO tr1 SELECT * FROM TESTRESULTS '+
  996. 'WHERE TR_TESTRUN_FK='+FRunID+';';
  997. Q.ExecSQL;
  998. Q.SQL.Text:='INSERT INTO tr2 SELECT * FROM TESTRESULTS '+
  999. 'WHERE TR_TESTRUN_FK='+FCompareRunID+';';
  1000. Q.ExecSQL;
  1001. S:='SELECT T_ID as Id,T_NAME as Filename,tr1.TR_SKIP as Run1_Skipped,'
  1002. +'tr2.TR_SKIP as Run2_Skipped,tr1.TR_OK as Run1_OK,'
  1003. +'tr2.TR_OK as Run2_OK, tr1.TR_Result as Run1_Result,'
  1004. +'tr2.TR_RESULT as Run2_Result '
  1005. +'FROM TESTS, tr2 LEFT JOIN tr1 USING (TR_TEST_FK) '
  1006. +'WHERE ((tr1.TR_SKIP IS NULL) or'
  1007. +' (tr2.TR_SKIP IS NULL) or '
  1008. +' (%s (tr1.TR_Result<>tr2.TR_Result)))'
  1009. +'and (T_ID=tr2.TR_TEST_FK)';
  1010. If FNoSkipped then
  1011. begin
  1012. Qry:='(((tr1.TR_SKIP="+") and (tr2.TR_OK="-") and (tr2.TR_SKIP="-")) or '
  1013. +'((tr1.TR_OK="-") and (tr1.TR_SKIP="-") and (tr2.TR_SKIP="+")) or '
  1014. +'((tr1.TR_SKIP="-") and (tr2.TR_SKIP="-"))) and ';
  1015. end
  1016. else
  1017. Qry:='';
  1018. Qry:=Format(S,[Qry]);
  1019. If FDebug then
  1020. begin
  1021. Writeln('Query: '+Qry);
  1022. Flush(stdout);
  1023. end;
  1024. FRunCount:=0;
  1025. FRunSkipCount:=0;
  1026. FRunFailedCount:=0;
  1027. Q.SQL.Text:=Qry;
  1028. With Q do
  1029. try
  1030. Open;
  1031. Try
  1032. With CreateTableProducer(Q) do
  1033. Try
  1034. Border:=True;
  1035. FL:='Filename,Run1_OK,Run2_OK';
  1036. If Not FNoSkipped then
  1037. FL:=FL+',Run1_Skipped,Run2_Skipped';
  1038. FL:=FL+',Run1_Result,Run2_Result';
  1039. CreateColumns(FL);
  1040. OnGetRowAttributes:=@GetRunRowAttr;
  1041. TableColumns.ColumnByNAme('Run1_Result').OnGetCellContents:=
  1042. @FormatTestResult;
  1043. TableColumns.ColumnByNAme('Run2_Result').OnGetCellContents:=
  1044. @FormatTestResult;
  1045. TableColumns.ColumnByNAme('Filename').OnGetCellContents:=
  1046. @FormatFileDetails;
  1047. //(TableColumns.Items[0] as TTableColumn).ActionURL:=ALink;
  1048. CreateTable(Response);
  1049. Finally
  1050. Free;
  1051. end;
  1052. Writeln('<p>Record count: ',Q.RecordCount,'</p>');
  1053. Finally
  1054. Close;
  1055. end;
  1056. finally
  1057. Free;
  1058. end;
  1059. If Not (FRunCount=0) and not (FNoSkipped or FOnlyFailed) then
  1060. begin
  1061. ParaGraphStart;
  1062. TagStart('IMG',Format('Src="'+CGI+'?action=2&pietotal=%d&piefailed=%d&pieskipped=%d"',[FRunCount,FRunFailedCount,FRunSkipCount]));
  1063. end;
  1064. end
  1065. else
  1066. Write('No data for test run with ID: '+FRunID);
  1067. end;
  1068. end;
  1069. procedure TTestSuite.GetRunRowAttr(Sender: TObject; var BGColor: String;
  1070. var Align: THTMLAlign; var VAlign: THTMLValign; var CustomAttr: String);
  1071. Var
  1072. P : TTableProducer;
  1073. Skip1Field, Skip2Field, Run1Field, Run2Field : TField;
  1074. begin
  1075. P:=(Sender as TTAbleProducer);
  1076. Inc(FRunCount);
  1077. If (FOnlyFailed and FNoSkipped) then
  1078. begin
  1079. If (P.CurrentRow Mod 2)=0 then
  1080. BGColor:='#EEEEEE'
  1081. end
  1082. else
  1083. begin
  1084. Skip1Field := P.Dataset.FindField('Skipped');
  1085. if Skip1Field = nil then
  1086. begin
  1087. Skip1Field := P.Dataset.FindField('Run1_Skipped');
  1088. Skip2Field := P.Dataset.FindField('Run2_Skipped');
  1089. end
  1090. else
  1091. Skip2Field := nil;
  1092. Run1Field := P.Dataset.FindField('OK');
  1093. if Run1Field = nil then
  1094. Run1Field := P.Dataset.FindField('Run1_OK');
  1095. Run2Field := P.Dataset.FindField('OK');
  1096. if Run2Field = nil then
  1097. Run2Field := P.Dataset.FindField('Run2_OK');
  1098. If (not FNoSkipped) and ((Skip1Field.AsString='+')
  1099. or ((Skip2Field <> nil) and (Skip2Field.AsString = '+'))) then
  1100. begin
  1101. Inc(FRunSkipCount);
  1102. BGColor:='yellow'; // Yellow
  1103. end
  1104. else If Run2Field.AsString='+' then
  1105. begin
  1106. if Run1Field.AsString='' then
  1107. BGColor:='#68DFB8'
  1108. else if Run1Field.ASString<>'+' then
  1109. BGColor:='#98FB98'; // pale Green
  1110. end
  1111. else if Run2Field.AsString='-' then
  1112. begin
  1113. Inc(FRunFailedCount);
  1114. if Run1Field.AsString='' then
  1115. BGColor:='#FF82AB' // Light red
  1116. else if Run1Field.AsString<>'-' then
  1117. BGColor:='#FF225B';
  1118. end;
  1119. end;
  1120. end;
  1121. procedure TTestSuite.FormatFailedOverview(Sender: TObject; var CellData: String);
  1122. Var
  1123. S: String;
  1124. P : TTableProducer;
  1125. begin
  1126. P:=(Sender as TTableProducer);
  1127. S:=Format(SDetailsURL,[P.DataSet.FieldByName('ID').AsString]);
  1128. S:=S+'&failedonly=1&noskipped=1';
  1129. CellData:=Format('<A HREF="%s">%s</A>',[S,CellData]);
  1130. end;
  1131. procedure TTestSuite.FormatTestRunOverview(Sender: TObject; var CellData: String);
  1132. Var
  1133. S: String;
  1134. P : TTableProducer;
  1135. begin
  1136. P:=(Sender as TTableProducer);
  1137. S:=Format(SDetailsURL,[P.DataSet.FieldByName('TR_TESTRUN_FK').AsString]);
  1138. if FOnlyFailed then
  1139. S:=S+'&failedonly=1';
  1140. if FNoSkipped then
  1141. S:=S+'&noskipped=1';
  1142. CellData:=Format('<A HREF="%s">%s</A>',[S,CellData]);
  1143. end;
  1144. procedure TTestSuite.FormatFileDetails(Sender: TObject; var CellData: String);
  1145. Var
  1146. S: String;
  1147. P : TTableProducer;
  1148. begin
  1149. P:=(Sender as TTableProducer);
  1150. if FCompareRunID<>'' then
  1151. S:=Format(CGI + '?action=3&run1id=%s&run2id=%s&testfileid=%s',
  1152. [FRunID,FCompareRunID,P.DataSet.FieldByName('Id').AsString])
  1153. else
  1154. S:=Format(CGI + '?action=3&run1id=%s&testfileid=%s',
  1155. [FRunID,P.DataSet.FieldByName('Id').AsString]);
  1156. CellData:=Format('<A HREF="%s">%s</A>',[S,CellData]);
  1157. end;
  1158. procedure TTestSuite.FormatTestResult(Sender: TObject; var CellData: String);
  1159. Var
  1160. Res : longint;
  1161. Error:word;
  1162. TS : TTestStatus;
  1163. P : TTableProducer;
  1164. begin
  1165. P:=(Sender as TTableProducer);
  1166. Val(CellData,Res,Error);
  1167. if (Error=0) and (Res>=longint(FirstStatus)) and
  1168. (Res<=longint(LastStatus)) then
  1169. begin
  1170. TS:=TTestStatus(Res);
  1171. CellData:=StatusText[TS];
  1172. end;
  1173. end;
  1174. Procedure TTestSuite.CreateRunPie;
  1175. Var
  1176. I : TFPMemoryImage;
  1177. M : TMemoryStream;
  1178. begin
  1179. ftFont.InitEngine;
  1180. FontMgr.SearchPath:='/usr/lib/X11/fonts/truetype';
  1181. I:=TFPMemoryImage.Create(320,320);
  1182. try
  1183. If FRunCount=0 Then
  1184. Raise Exception.Create('Invalid parameters passed to script: No total count');
  1185. DoDrawPie(I,FRunSkipCount,FRunFailedCount,FRunCount);
  1186. M:=TMemoryStream.Create;
  1187. Try
  1188. With TFPWriterPNG.Create do
  1189. try
  1190. UseAlpha:=True;
  1191. ImageWrite(M,I);
  1192. Finally
  1193. Free;
  1194. end;
  1195. ContentType:='image/png';
  1196. EmitContentType;
  1197. M.Position:=0;
  1198. Response.CopyFrom(M,M.Size);
  1199. Finally
  1200. M.Free;
  1201. end;
  1202. Finally
  1203. I.Free;
  1204. end;
  1205. end;
  1206. Procedure TTestSuite.DoDrawPie(Img : TFPCustomImage; Skipped,Failed,Total : Integer);
  1207. Var
  1208. Cnv : TFPImageCanvas;
  1209. W,H,FH,CR,ra : Integer;
  1210. A1,A2,FR,SR,PR : Double;
  1211. R : TRect;
  1212. F : TFreeTypeFont;
  1213. Procedure AddPie(X,Y,R : Integer; AStart,AStop : Double; Col : TFPColor);
  1214. Var
  1215. DX,Dy : Integer;
  1216. begin
  1217. DX:=Round(R*Cos(A1));
  1218. DY:=Round(R*Sin(A1));
  1219. Cnv.Line(X,Y,X+DX,Y-DY);
  1220. DX:=Round(Ra*Cos(A2));
  1221. DY:=Round(Ra*Sin(A2));
  1222. Cnv.Line(X,Y,X+DX,Y-Dy);
  1223. DX:=Round(R/2*Cos((A1+A2)/2));
  1224. DY:=Round(R/2*Sin((A1+A2)/2));
  1225. Cnv.Brush.FpColor:=Col;
  1226. Cnv.FloodFill(X+DX,Y-DY);
  1227. end;
  1228. Function FractionAngle(F,T : Integer): Double;
  1229. begin
  1230. Result:=(2*Pi*(F/T))
  1231. end;
  1232. begin
  1233. F:=TFreeTypeFont.Create;
  1234. With F do
  1235. begin
  1236. Name:='arial';
  1237. FontIndex:=0;
  1238. Size:=12;
  1239. FPColor:=colred;
  1240. AntiAliased:=False;
  1241. Resolution:=96;
  1242. end;
  1243. // Writeln('Creating image');
  1244. Cnv:=TFPImageCanvas.Create(Img);
  1245. // Writeln('Getting width and height');
  1246. W:=Img.Width;
  1247. H:=Img.Height;
  1248. // Writeln('Transparant');
  1249. cnv.Brush.Style:=bsSolid;
  1250. cnv.Brush.FPColor:=colTransparent;
  1251. cnv.Pen.FPColor:=colWhite;
  1252. Cnv.Rectangle(0,0,W,H);
  1253. // Writeln('Setting font');
  1254. Cnv.Font:=F;
  1255. // Writeln('Getting textwidth ');
  1256. FH:=CNV.GetTextHeight('A');
  1257. If FH=0 then
  1258. FH:=14; // 3 * 14;
  1259. Inc(FH,3);
  1260. R.Top:=FH*4;
  1261. R.Left:=0;
  1262. R.Bottom:=H;
  1263. CR:=H-(FH*4);
  1264. If W>CR then
  1265. R.Right:=CR
  1266. else
  1267. R.Right:=W;
  1268. Ra:=CR div 2;
  1269. // Writeln('Setting pen color');
  1270. Cnv.Pen.FPColor:=colBlack;
  1271. // Writeln('Palette size : ',Img.Palette.Count);
  1272. // Writeln('Setting brush style');
  1273. cnv.brush.FPColor:=colRed;
  1274. // cnv.pen.width:=1;
  1275. // Writeln('Drawing ellipse');
  1276. Cnv.Ellipse(R);
  1277. // Writeln('Setting text');
  1278. // Writeln('Palette size : ',Img.Palette.Count);
  1279. cnv.font.FPColor:=colred;
  1280. Inc(FH,4);
  1281. FR:=Failed/Total;
  1282. SR:=Skipped/Total;
  1283. PR:=1-(FR+SR);
  1284. Cnv.Textout(1,FH,Format('%d Failed (%3.1f%%)',[Failed,Fr*100]));
  1285. // Writeln('Palette size : ',Img.Palette.Count);
  1286. cnv.font.FPColor:=colYellow;
  1287. Cnv.Textout(1,FH*2,Format('%d Skipped (%3.1f%%)',[Skipped,SR*100]));
  1288. A1:=(Pi*2*(failed/total));
  1289. A2:=A1+(Pi*2*(Skipped/Total));
  1290. AddPie(Ra,R.Top+Ra,Ra,A1,A2,ColYellow);
  1291. cnv.font.FPColor:=colGreen;
  1292. // Writeln('Palette size : ',Img.Palette.Count);
  1293. A1:=A2;
  1294. A2:=A1+(Pi*2*((Total-(Skipped+Failed))/Total));
  1295. Cnv.Textout(1,FH*3,Format('%d Passed (%3.1f%%',[Total-Skipped-Failed,PR*100]));
  1296. AddPie(Ra,R.Top+Ra,Ra,A1,A2,ColGreen);
  1297. // Writeln('Palette size : ',Img.Palette.Count);
  1298. // Writeln('All done');
  1299. end;
  1300. end.