utests.pp 80 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704
  1. {$mode objfpc}
  2. {$h+}
  3. unit utests;
  4. interface
  5. {$ifdef FPC}
  6. {$ifdef VER2_4}
  7. {$define USE_FPCGI}
  8. {$endif VER2_4}
  9. {$ifdef VER2_5}
  10. {$define USE_FPCGI}
  11. {$endif VER2_5}
  12. {$endif FPC}
  13. {$undef USE_FPCGI}
  14. uses
  15. {$ifdef USE_FPCGI}
  16. fpcgi,
  17. {$else not USE_FPCGI}
  18. cgiapp,
  19. {$endif not USE_FPCGI}
  20. sysutils,mysql55conn,sqldb,whtml,dbwhtml,db,
  21. tresults,
  22. Classes,ftFont,fpimage,fpimgcanv,fpWritePng,fpcanvas;
  23. const
  24. TestsuiteURLPrefix='http://www.freepascal.org/testsuite/';
  25. TestsuiteBin='testsuite.cgi';
  26. ViewURL='http://svn.freepascal.org/cgi-bin/viewvc.cgi/';
  27. TestsSubDir='/tests/';
  28. DataBaseSubDir='/packages/fcl-db/tests/';
  29. var
  30. TestsuiteCGIURL : string;
  31. Type
  32. TTestSuite = Class(TCgiApplication)
  33. Private
  34. FHTMLWriter : THtmlWriter;
  35. FComboBoxProducer : TComboBoxProducer;
  36. FDB : TSQLConnection;
  37. FTrans : TSQLTransaction;
  38. FRunID,
  39. FCompareRunID,
  40. FTestFileID,
  41. FTestFileName,
  42. FVersion,
  43. FVersionBranch,
  44. FCond,
  45. FSubmitter,
  46. FMachine,
  47. FComment,
  48. FCPU,
  49. FCategory,
  50. FOS : String;
  51. FViewVCURL : String;
  52. FDate : TDateTime;
  53. FDebug,
  54. FListAll,
  55. FNoSkipped,
  56. FOnlyFailed : Boolean;
  57. FRunSkipCount,
  58. FRunFailedCount,
  59. FRunCount : Integer;
  60. FAction,
  61. FLimit : Integer;
  62. FTestLastDays : Integer;
  63. FNeedEnd : boolean;
  64. Procedure GetOverviewRowAttr(Sender : TObject; Var BGColor : String;
  65. Var Align : THTMLAlign; Var VAlign : THTMLValign;
  66. Var CustomAttr : String) ;
  67. Procedure GetRunRowAttr(Sender : TObject; Var BGColor : String;
  68. Var Align : THTMLAlign; Var VAlign : THTMLValign;
  69. Var CustomAttr : String) ;
  70. Procedure FormatFailedOverview(Sender : TObject; Var CellData : String);
  71. Procedure FormatTestRunOverview(Sender : TObject; Var CellData : String);
  72. Procedure FormatFileDetails(Sender: TObject; var CellData: String);
  73. Procedure FormatFileIDDetails(Sender: TObject; var CellData: String);
  74. Procedure FormatTestResult(Sender: TObject; var CellData: String);
  75. Function FormatDetailURL(const RunIdStr, CellData : String) : string;
  76. Procedure DoDrawPie(Img : TFPCustomImage; Skipped,Failed,Total : Integer);
  77. Public
  78. Function CreateDataset(Qry : String) : TSQLQuery;
  79. Function CreateTableProducer(DS : TDataset) :TTableProducer;
  80. Procedure DefaultTableFromQuery(Qry,ALink : String; IncludeRecordCount : Boolean);
  81. Procedure ComboBoxFromQuery(Const ComboName,Qry : String);
  82. Procedure ComboBoxFromQuery(Const ComboName,Qry,Value : String);
  83. Function GetSingleTon(Const Qry : String) : String;
  84. Function GetOSName(ID : String) : String;
  85. Function GetCPUName(ID : String) : String;
  86. Function GetVersionName(ID : String) : String;
  87. Function GetCategoryName(ID : String) : String;
  88. Function GetTestFileName(ID : String) : String;
  89. Function GetFailCount(RunID : longint) : string;
  90. Function InitCGIVars : Integer;
  91. Procedure DoRun; override;
  92. Procedure EmitOverviewForm;
  93. Procedure EmitHistoryForm;
  94. Procedure ShowRunResults;
  95. Procedure ShowRunComparison;
  96. Procedure ShowOneTest;
  97. Procedure ShowHistory;
  98. Function ConnectToDB : Boolean;
  99. procedure DisconnectFromDB;
  100. Procedure EmitTitle(ATitle : String);
  101. Procedure EmitEnd;
  102. Procedure ShowRunOverview;
  103. Procedure CreateRunPie;
  104. Function ShowRunData : Boolean;
  105. end;
  106. implementation
  107. Const
  108. {$i utests.cfg}
  109. { if utests.cfg is missed, create one with the following contents:
  110. DefDatabase = 'TESTSUITE';
  111. DefHost = '';
  112. DefDBUser = ''; // fill this in when compiling.
  113. DefPassword = ''; // fill this in, too.
  114. }
  115. Const
  116. OldTestResultsTableName = 'OLDTESTRESULTS';
  117. NewTestResultsTableName = 'TESTRESULTS';
  118. LastOldTestRun = 91178;
  119. MaxLimit = 1000;
  120. Function TestResultsTableName(const RunId : String) : string;
  121. var
  122. RunIDVal : qword;
  123. Error : word;
  124. begin
  125. system.val (RunId,RunIdVal,error);
  126. if (error<>0) then
  127. result:='ErrorTable'
  128. else if (RunIdVal <= LastOldTestRun) then
  129. result:=OldTestResultsTableName
  130. else
  131. result:=NewTestResultsTableName;
  132. end;
  133. Var
  134. SDetailsURL : string;
  135. type
  136. known_versions = (
  137. ver_unknown,
  138. ver_1_0_10,
  139. ver_2_0_0,
  140. ver_2_0_1,
  141. ver_2_0_2,
  142. ver_2_0_3,
  143. ver_2_0_4,
  144. ver_2_0_5,
  145. ver_2_1_2,
  146. ver_2_1_4,
  147. ver_2_2_0,
  148. ver_2_2_1,
  149. ver_2_2_2,
  150. ver_2_2_3,
  151. ver_2_2_4,
  152. ver_2_2_5,
  153. ver_2_3_1,
  154. ver_2_4_0,
  155. ver_2_4_1,
  156. ver_2_4_2,
  157. ver_2_4_3,
  158. ver_2_4_4,
  159. ver_2_4_5,
  160. ver_2_5_1,
  161. ver_2_7_1);
  162. const
  163. ver_trunk = high (known_versions);
  164. const
  165. ver_string : array[known_versions] of string =
  166. (
  167. 'unknown',
  168. '1.0.10',
  169. '2.0.0',
  170. '2.0.1',
  171. '2.0.2',
  172. '2.0.3',
  173. '2.0.4',
  174. '2.0.5',
  175. '2.1.2',
  176. '2.1.4',
  177. '2.2.0',
  178. '2.2.1',
  179. '2.2.2',
  180. '2.2.3',
  181. '2.2.4',
  182. '2.2.5',
  183. '2.3.1',
  184. '2.4.0',
  185. '2.4.1',
  186. '2.4.2',
  187. '2.4.3',
  188. '2.4.4',
  189. '2.4.5',
  190. '2.5.1',
  191. '2.7.1'
  192. );
  193. ver_branch : array [known_versions] of string =
  194. (
  195. '',
  196. '',
  197. 'tags/release_2_0_0',
  198. 'branches/fixes_2_0',
  199. 'tags/release_2_0_2',
  200. 'branches/fixes_2_0',
  201. 'tags/release_2_0_4',
  202. 'branches/fixes_2_0',
  203. 'tags/release_2_1_2',
  204. 'tags/release_2_1_4',
  205. 'tags/release_2_2_0',
  206. 'branches/fixes_2_2',
  207. 'tags/release_2_2_2',
  208. 'branches/fixes_2_2',
  209. 'tags/release_2_2_4',
  210. 'branches/fixes_2_2',
  211. 'tags/release_2_4_0',
  212. 'tags/release_2_4_0',
  213. 'tags/release_2_4_2',
  214. 'tags/release_2_4_2',
  215. 'tags/release_2_4_4',
  216. 'tags/release_2_4_4',
  217. 'branches/fixes_2_4',
  218. 'branches/fixes_2_6',
  219. 'trunk'
  220. );
  221. Procedure TTestSuite.DoRun;
  222. begin
  223. Try
  224. Try
  225. Case InitCGIVars of
  226. 0 : EmitOverviewForm;
  227. 1 :
  228. if Length(FCompareRunID) = 0 then
  229. ShowRunResults
  230. else
  231. ShowRunComparison;
  232. 2 : CreateRunPie;
  233. 3 : ShowOneTest;
  234. 4 : ShowHistory;
  235. {$ifdef TEST}
  236. 98 :
  237. begin
  238. ///EmitOverviewForm;
  239. system.Writeln(stdout,'<PRE>');
  240. system.Writeln(stdout,'paramstr(0) is ',paramstr(0));
  241. system.FreeMem(pointer($ffffffff));
  242. system.Writeln(stdout,'</PRE>');
  243. system.Flush(stdout);
  244. end;
  245. 99 :
  246. begin
  247. EmitOverviewForm;
  248. system.Writeln(stdout,'<PRE>');
  249. system.Dump_stack(stdout,get_frame);
  250. system.Writeln(stdout,'</PRE>');
  251. system.Flush(stdout);
  252. end;
  253. {$endif TEST}
  254. end;
  255. finally
  256. EmitEnd;
  257. DisConnectFromDB;
  258. end;
  259. Finally
  260. Terminate;
  261. end;
  262. end;
  263. Function TTestSuite.InitCGIVars : Integer;
  264. Var
  265. S : String;
  266. begin
  267. FHtmlWriter:=THTMLWriter.Create(Response);
  268. FComboBoxProducer:=TComboBoxProducer.Create(Self);
  269. DateSeparator:='/';
  270. Result:=0;
  271. S:=RequestVariables['action'];
  272. if Length(S) = 0 then
  273. S:=RequestVariables['TESTACTION'];
  274. if S='View history' then
  275. FAction:=4
  276. else
  277. FAction:=StrToIntDef(S,0);
  278. S:=RequestVariables['limit'];
  279. if Length(S) = 0 then
  280. S:=RequestVariables['TESTLIMIT'];
  281. FLimit:=StrToIntDef(S,50);
  282. if FLimit > MaxLimit then
  283. FLimit:=MaxLimit;
  284. FVersion:=RequestVariables['version'];
  285. if Length(FVersion) = 0 then
  286. FVersion:=RequestVariables['TESTVERSION'];
  287. FOS:=RequestVariables['os'];
  288. if Length(FOS) = 0 then
  289. FOS:=RequestVariables['TESTOS'];
  290. FCPU:=RequestVariables['cpu'];
  291. if Length(FCPU) = 0 then
  292. FCPU:=RequestVariables['TESTCPU'];
  293. FCategory:=RequestVariables['category'];
  294. if Length(FCategory) = 0 then
  295. FCategory:=RequestVariables['TESTCATEGORY'];
  296. FCond:=RequestVariables['cond'];
  297. if Length(FCond) = 0 then
  298. FCond:=RequestVariables['TESTCOND'];
  299. FComment:=RequestVariables['comment'];
  300. if Length(FComment) = 0 then
  301. FComment:=RequestVariables['TESTCOMMENT'];
  302. FSubmitter:=RequestVariables['submitter'];
  303. if Length(FSubmitter) = 0 then
  304. FSubmitter:=RequestVariables['TESTSUBMITTER'];
  305. FMachine:=RequestVariables['machine'];
  306. if Length(FMachine) = 0 then
  307. FMachine:=RequestVariables['TESTMACHINE'];
  308. FRunID:=RequestVariables['run1id'];
  309. if Length(FRunID) = 0 then
  310. FRunID:=RequestVariables['TESTRUN'];
  311. S:=RequestVariables['lastdays'];
  312. if Length(S) = 0 then
  313. S:=RequestVariables['TESTLASTDAYS'];
  314. FTestLastDays:=StrToIntDef(S,31);
  315. S:=RequestVariables['date'];
  316. if Length(S) = 0 then
  317. S:=RequestVariables['TESTDATE'];
  318. if Length(S) > 0 then
  319. try
  320. FDate:=StrToDate(S);
  321. except
  322. FDate:=0;
  323. end;
  324. S:=RequestVariables['failedonly'];
  325. if Length(S) = 0 then
  326. S:=RequestVariables['TESTFAILEDONLY'];
  327. FOnlyFailed:=(S='1');
  328. S:=RequestVariables['noskipped'];
  329. if Length(S) = 0 then
  330. S:=RequestVariables['TESTNOSKIPPED'];
  331. FNoSkipped:=(S='1');
  332. FCompareRunID:=RequestVariables['run2id'];
  333. FTestFileID:=RequestVariables['testfileid'];
  334. FTestFileName:=RequestVariables['testfilename'];
  335. FRunCount:=StrToIntDef(RequestVariables['PIETOTAL'],0);
  336. FRunSkipCount:=StrToIntDef(RequestVariables['PIESKIPPED'],0);
  337. FRunFailedCount:=StrToIntDef(RequestVariables['PIEFAILED'],0);
  338. S:=RequestVariables['DEBUGCGI'];
  339. FDebug:=(S='1');
  340. S:=RequestVariables['listall'];
  341. FListAll:=(S='1');
  342. Result:=FAction;
  343. end;
  344. Function TTestSuite.ConnectToDB : Boolean;
  345. begin
  346. Result:=False;
  347. FDB:=TMySQl55Connection.Create(Self);
  348. FDB.HostName:=DefHost;
  349. FDB.DatabaseName:=DefDatabase;
  350. FDB.UserName:=DefDBUser;
  351. FDB.Password:=DefPassword;
  352. FTrans := TSQLTransaction.Create(nil);
  353. FTrans.DataBase := FDB;
  354. FDB.Transaction := FTrans;
  355. FDB.Connected:=True;
  356. Result:=True;
  357. end;
  358. procedure TTestSuite.DisconnectFromDB;
  359. begin
  360. If Assigned(FDB) then
  361. begin
  362. if (FDB.Connected) then
  363. FDB.Connected:=False;
  364. FreeAndNil(FDB);
  365. FreeAndNil(FTrans);
  366. end;
  367. end;
  368. Procedure TTestSuite.ComboBoxFromQuery(Const ComboName,Qry: String);
  369. begin
  370. ComboBoxFromQuery(ComboName,Qry,'')
  371. end;
  372. Procedure TTestSuite.ComboBoxFromQuery(Const ComboName,Qry,Value : String);
  373. Var
  374. Q : TSQLQuery;
  375. begin
  376. Q:=TSQLQuery.Create(Self);
  377. try
  378. Q.Database:=FDB;
  379. Q.Transaction:=FTrans;
  380. Q.SQL.Text:=Qry;
  381. Q.Open;
  382. FComboboxProducer.Dataset:=Q;
  383. FComboBoxProducer.ValueField:=Q.Fields[0].FieldName;
  384. FComboBoxProducer.DataField:=Q.Fields[1].FieldName;
  385. FComboBoxProducer.Value:=Value;
  386. FComboBoxProducer.InputName:=ComboName;
  387. FComboBoxProducer.CreateComboBox(Response);
  388. Finally
  389. Q.Free;
  390. end;
  391. end;
  392. Function TTestSuite.GetSingleton(Const Qry : String) : String;
  393. Var
  394. Q : TSQLQuery;
  395. begin
  396. Result:='';
  397. if FDEbug then
  398. begin
  399. system.Writeln('Query=',Qry);
  400. system.flush(output);
  401. end;
  402. Q:=TSQLQuery.Create(Self);
  403. try
  404. Q.Database:=FDB;
  405. Q.Transaction:=FTrans;
  406. Q.SQL.Text:=Qry;
  407. Q.Open;
  408. Try
  409. if FDebug and (Q.FieldCount<>1) then
  410. begin
  411. system.Writeln('GetSingleton number of fields is not 1, but ',
  412. Q.FieldCount);
  413. system.flush(output);
  414. end;
  415. If Not (Q.EOF and Q.BOF) then
  416. Result:=Q.Fields[0].AsString;
  417. Finally
  418. Q.Close;
  419. end;
  420. finally
  421. Q.Free;
  422. end;
  423. end;
  424. Procedure TTestSuite.EmitTitle(ATitle : String);
  425. begin
  426. AddResponseLn('<HTML>');
  427. AddResponseLn('<TITLE>'+ATitle+'</TITLE>');
  428. AddResponseLn('<BODY>');
  429. FNeedEnd:=true;
  430. end;
  431. Procedure TTestSuite.EmitOverviewForm;
  432. begin
  433. ConnectToDB;
  434. ContentType:='text/html';
  435. EmitContentType;
  436. EmitTitle(Title);
  437. With FHTMLWriter do
  438. begin
  439. HeaderStart(1);
  440. Write('View Test suite results');
  441. HeaderEnd(1);
  442. Write('Please specify search criteria:');
  443. ParagraphStart;
  444. FormStart(TestsuiteCGIURL,'');
  445. if FDebug then
  446. EmitHiddenVar('DEBUGCGI', '1');
  447. TableStart(2,true);
  448. RowStart;
  449. CellStart;
  450. Write('Operating system:');
  451. CellNext;
  452. ComboBoxFromQuery('os','SELECT TO_ID,TO_NAME FROM TESTOS ORDER BY TO_NAME',FOS);
  453. CellEnd;
  454. RowNext;
  455. CellStart;
  456. Write('Processor:');
  457. CellNext;
  458. ComboBoxFromQuery('cpu','SELECT TC_ID,TC_NAME FROM TESTCPU ORDER BY TC_NAME',FCPU);
  459. CellEnd;
  460. RowNext;
  461. CellStart;
  462. Write('Version');
  463. CellNext;
  464. ComboBoxFromQuery('version','SELECT TV_ID,TV_VERSION FROM TESTVERSION ORDER BY TV_VERSION DESC',FVERSION);
  465. CellEnd;
  466. RowNext;
  467. CellStart;
  468. Write('Date');
  469. CellNext;
  470. If (FDate=0) then
  471. EmitInput('date','')
  472. else
  473. EmitInput('date',DateToStr(FDate));
  474. CellEnd;
  475. //if FDebug then
  476. begin
  477. RowNext;
  478. CellStart;
  479. Write('Submitter');
  480. CellNext;
  481. If (FSubmitter='') then
  482. EmitInput('submitter','')
  483. else
  484. EmitInput('submitter',FSubmitter);
  485. CellEnd;
  486. RowNext;
  487. CellStart;
  488. Write('Machine');
  489. CellNext;
  490. If (FMachine='') then
  491. EmitInput('machine','')
  492. else
  493. EmitInput('machine',FMachine);
  494. CellEnd;
  495. RowNext;
  496. CellStart;
  497. Write('Comment');
  498. CellNext;
  499. If (FComment='') then
  500. EmitInput('comment','')
  501. else
  502. EmitInput('comment',FComment);
  503. CellEnd;
  504. RowNext;
  505. CellStart;
  506. Write('Cond');
  507. CellNext;
  508. If (FCond='') then
  509. EmitInput('cond','')
  510. else
  511. EmitInput('cond',FCond);
  512. CellEnd;
  513. end;
  514. RowNext;
  515. CellStart;
  516. Write('Category');
  517. CellNext;
  518. ComboBoxFromQuery('Category','SELECT TCAT_ID,TCAT_NAME FROM TESTCATEGORY ORDER BY TCAT_NAME',FCategory);
  519. CellEnd;
  520. RowNext;
  521. CellStart;
  522. Write('Only failed tests');
  523. CellNext;
  524. EmitCheckBox('failedonly','1',FonlyFailed);
  525. CellEnd;
  526. RowNext;
  527. CellStart;
  528. Write('Hide skipped tests');
  529. CellNext;
  530. EmitCheckBox('noskipped','1',FNoSkipped);
  531. CellEnd;
  532. RowEnd;
  533. TableEnd;
  534. ParaGraphStart;
  535. EmitSubmitButton('','Search');
  536. EmitSubmitButton('action','View history');
  537. EmitResetButton('','Reset form');
  538. FormEnd;
  539. end;
  540. ShowRunOverview;
  541. end;
  542. Procedure TTestSuite.EmitHistoryForm;
  543. begin
  544. ConnectToDB;
  545. ContentType:='text/html';
  546. EmitContentType;
  547. EmitTitle(Title);
  548. With FHTMLWriter do
  549. begin
  550. HeaderStart(1);
  551. Write('View Test suite results');
  552. HeaderEnd(1);
  553. Write('Please specify search criteria:');
  554. ParagraphStart;
  555. FormStart(TestsuiteCGIURL,'');
  556. if FDebug then
  557. EmitHiddenVar('DEBUGCGI', '1');
  558. EmitHiddenVar('action','4');
  559. TableStart(2,true);
  560. RowStart;
  561. CellStart;
  562. Write('File:');
  563. CellNext;
  564. EmitInput('testfilename',FTestfilename);
  565. CellEnd;
  566. RowNext;
  567. (* CellStart;
  568. Write('FileID:');
  569. CellNext;
  570. EmitInput('testfileid',FTestfileid);
  571. CellEnd;
  572. RowNext; *)
  573. CellStart;
  574. Write('Operating system:');
  575. CellNext;
  576. ComboBoxFromQuery('os','SELECT TO_ID,TO_NAME FROM TESTOS ORDER BY TO_NAME',FOS);
  577. CellEnd;
  578. RowNext;
  579. CellStart;
  580. Write('Processor:');
  581. CellNext;
  582. ComboBoxFromQuery('cpu','SELECT TC_ID,TC_NAME FROM TESTCPU ORDER BY TC_NAME',FCPU);
  583. CellEnd;
  584. RowNext;
  585. CellStart;
  586. Write('Version');
  587. CellNext;
  588. ComboBoxFromQuery('version','SELECT TV_ID,TV_VERSION FROM TESTVERSION ORDER BY TV_VERSION DESC',FVERSION);
  589. CellEnd;
  590. RowNext;
  591. CellStart;
  592. Write('Date');
  593. CellNext;
  594. If (FDate=0) then
  595. EmitInput('date','')
  596. else
  597. EmitInput('date',DateToStr(FDate));
  598. CellEnd;
  599. RowNext;
  600. CellStart;
  601. Write('Submitter');
  602. CellNext;
  603. If (FSubmitter='') then
  604. EmitInput('submitter','')
  605. else
  606. EmitInput('submitter',FSubmitter);
  607. CellEnd;
  608. RowNext;
  609. CellStart;
  610. Write('Machine');
  611. CellNext;
  612. If (FMachine='') then
  613. EmitInput('machine','')
  614. else
  615. EmitInput('machine',FMachine);
  616. CellEnd;
  617. RowNext;
  618. CellStart;
  619. Write('Comment');
  620. CellNext;
  621. If (FComment='') then
  622. EmitInput('comment','')
  623. else
  624. EmitInput('comment',FComment);
  625. CellEnd;
  626. RowNext;
  627. CellStart;
  628. Write('Limit');
  629. CellNext;
  630. EmitInput('limit',IntToStr(FLimit));
  631. CellEnd;
  632. RowNext;
  633. CellStart;
  634. Write('Cond');
  635. CellNext;
  636. If (FCond='') then
  637. EmitInput('cond','')
  638. else
  639. EmitInput('cond',FCond);
  640. CellEnd;
  641. RowNext;
  642. CellStart;
  643. Write('Category');
  644. CellNext;
  645. ComboBoxFromQuery('Category','SELECT TCAT_ID,TCAT_NAME FROM TESTCATEGORY ORDER BY TCAT_NAME',FCategory);
  646. CellEnd;
  647. RowNext;
  648. CellStart;
  649. Write('Only failed tests');
  650. CellNext;
  651. EmitCheckBox('failedonly','1',FonlyFailed);
  652. CellEnd;
  653. RowNext;
  654. CellStart;
  655. Write('Hide skipped tests');
  656. CellNext;
  657. EmitCheckBox('noskipped','1',FNoSkipped);
  658. CellEnd;
  659. RowNext;
  660. CellStart;
  661. Write('List all tests');
  662. CellNext;
  663. EmitCheckBox('listall','1',FListAll);
  664. CellEnd;
  665. RowEnd;
  666. TableEnd;
  667. ParaGraphStart;
  668. EmitSubmitButton('','Search');
  669. EmitResetButton('','Reset form');
  670. FormEnd;
  671. end;
  672. end;
  673. procedure TTestSuite.EmitEnd;
  674. begin
  675. if not FNeedEnd then
  676. exit;
  677. AddResponseLn('</BODY>');
  678. AddResponseLn('</HTML>');
  679. end;
  680. procedure TTestSuite.GetOverviewRowAttr(Sender: TObject; var BGColor: String;
  681. var Align: THTMLAlign; var VAlign: THTMLValign; var CustomAttr: String);
  682. begin
  683. If ((Sender as TTAbleProducer).CurrentRow mod 2=0) then
  684. BGColor:='#EEEEEE'
  685. end;
  686. Function TTestSuite.CreateDataset(Qry : String) : TSQLQuery;
  687. begin
  688. Result:=TSQLQuery.Create(Self);
  689. With Result do
  690. begin
  691. Database:=FDB;
  692. Transaction := FTrans;
  693. SQL.Text:=Qry;
  694. end;
  695. end;
  696. Function TTestSuite.CreateTableProducer(DS : TDataset) :TTableProducer;
  697. begin
  698. Result:=TTableProducer.Create(Self);
  699. Result.Dataset:=DS;
  700. end;
  701. Procedure TTestSuite.DefaultTableFromQuery(Qry,Alink : String; IncludeRecordCount : Boolean);
  702. Var
  703. Q : TSQLQuery;
  704. begin
  705. If FDebug then
  706. Writeln('Query : '+Qry);
  707. Q:=CreateDataset(Qry);
  708. With Q do
  709. try
  710. Open;
  711. Try
  712. With CreateTableProducer(Q) do
  713. Try
  714. Border:=True;
  715. If (Alink<>'') then
  716. begin
  717. CreateColumns(Nil);
  718. If TableColumns.Count>0 then
  719. (TableColumns.Items[0] as TTableColumn).ActionURL:=ALink;
  720. end;
  721. CreateTable(Response);
  722. Finally
  723. Free;
  724. end;
  725. If IncludeRecordCount then
  726. FHTMLWriter.DumpLn(Format('<p>Record count: %d </p>',[Q.RecordCount]));
  727. Finally
  728. Close;
  729. end;
  730. finally
  731. Free;
  732. end;
  733. end;
  734. Procedure TTestSuite.ShowRunOverview;
  735. Const
  736. SOverview = 'SELECT TU_ID as ID,TU_DATE as Date,TC_NAME as CPU,TO_NAME as OS,'+
  737. 'TV_VERSION as Version,count(*) as Count,'+
  738. 'TU_SVNCOMPILERREVISION as SvnCompRev,'+
  739. 'TU_SVNRTLREVISION as SvnRTLRev,'+
  740. 'TU_SVNPACKAGESREVISION as SvnPackRev,TU_SVNTESTSREVISION as SvnTestsRev,'+
  741. '(TU_SUCCESSFULLYFAILED+TU_SUCCESFULLYCOMPILED+TU_SUCCESSFULLYRUN) AS OK,'+
  742. '(TU_FAILEDTOCOMPILE+TU_FAILEDTORUN+TU_FAILEDTOFAIL) as Failed,'+
  743. '(TU_SUCCESSFULLYFAILED+TU_SUCCESFULLYCOMPILED+TU_SUCCESSFULLYRUN+'+
  744. 'TU_FAILEDTOCOMPILE+TU_FAILEDTORUN+TU_FAILEDTOFAIL) as Total,'+
  745. 'TU_SUBMITTER as Submitter, TU_MACHINE as Machine, TU_COMMENT as Comment %s '+
  746. 'FROM TESTRUN left join TESTCPU on (TC_ID=TU_CPU_FK) left join TESTOS on (TO_ID=TU_OS_FK) '+
  747. 'left join TESTVERSION on (TV_ID=TU_VERSION_FK) left join TESTCATEGORY on (TCAT_ID=TU_CATEGORY_FK) '+
  748. 'left join TESTRESULTS on (TR_TESTRUN_FK=TU_ID) '+
  749. '%s'+
  750. 'GROUP BY TU_ID '+
  751. 'ORDER BY TU_ID DESC LIMIT %d';
  752. Var
  753. SC,S,A,Qry : String;
  754. Q : TSQLQuery;
  755. begin
  756. S:='';
  757. If (FCPU<>'') and (GetCPUName(FCPU)<>'All') then
  758. S:=S+' AND (TU_CPU_FK='+FCPU+')';
  759. If (FCategory<>'') and (GetCategoryName(FCategory)<>'All') then
  760. S:=S+' AND (TU_CATEGORY_FK='+FCategory+')';
  761. If (FVersion<>'') and (GetVersionName(FVersion)<>'All') then
  762. S:=S+' AND (TU_VERSION_FK='+FVERSION+')';
  763. if (FOS<>'') and (GetOSName(FOS)<>'All') then
  764. S:=S+' AND (TU_OS_FK='+FOS+')';
  765. If (Round(FDate)<>0) then
  766. S:=S+' AND (TU_DATE LIKE '''+FormatDateTime('YYYY-MM-DD',FDate)+'%'')';
  767. If FSubmitter<>'' then
  768. S:=S+' AND (TU_SUBMITTER='''+FSubmitter+''')';
  769. If FMachine<>'' then
  770. S:=S+' AND (TU_MACHINE='''+FMachine+''')';
  771. If FComment<>'' then
  772. S:=S+' AND (TU_COMMENT LIKE '''+Fcomment+''')';
  773. If FCond<>'' then
  774. S:=S+' AND ('+FCond+')';
  775. If FOnlyFailed then
  776. S:=S+' AND (TR_OK="-")';
  777. If GetCategoryName(FCategory)<>'DB' then
  778. SC:=', CONCAT(TU_SVNCOMPILERREVISION,"/",TU_SVNRTLREVISION,"/", '+
  779. 'TU_SVNPACKAGESREVISION,"/",TU_SVNTESTSREVISION) as svnrev'
  780. else
  781. SC:='';
  782. If (FCategory='') or (GetCategoryName(FCategory)='All') then
  783. SC:=SC+', TCAT_NAME as Cat';
  784. A:=SDetailsURL;
  785. If FOnlyFailed then
  786. A:=A+'&failedonly=1';
  787. If FNoSkipped then
  788. A:=A+'&noskipped=1';
  789. if S <> '' then
  790. begin
  791. Delete(S, 1, 4);
  792. S:='WHERE '+ S + ' ';
  793. end;
  794. Qry:=Format(SOverview,[SC,S,FLimit]);
  795. If FDebug then
  796. Writeln('Query : '+Qry);
  797. Q:=CreateDataset(Qry);
  798. With Q do
  799. try
  800. Open;
  801. Try
  802. With CreateTableProducer(Q) do
  803. Try
  804. Border:=True;
  805. OnGetRowAttributes:=@GetOverViewRowAttr;
  806. CreateColumns(Nil);
  807. TableColumns.ColumnByName('ID').ActionURL:=A;
  808. TableColumns.ColumnByNAme('Failed').OnGetCellContents:=@FormatFailedOverview;
  809. CreateTable(Response);
  810. Finally
  811. Free;
  812. end;
  813. FHTMLWriter.DumpLn(Format('<p>Record count: %d</p>',[Q.RecordCount]));
  814. Finally
  815. Close;
  816. end;
  817. finally
  818. Free;
  819. end;
  820. end;
  821. Function TTestSuite.GetOSName(ID : String) : String;
  822. begin
  823. if (ID<>'') then
  824. Result:=GetSingleTon('SELECT TO_NAME FROM TESTOS WHERE TO_ID='+ID);
  825. end;
  826. Function TTestSuite.GetTestFileName(ID : String) : String;
  827. begin
  828. if (ID<>'') then
  829. Result:=GetSingleTon('SELECT T_NAME FROM TESTS WHERE T_ID='+ID);
  830. end;
  831. Function TTestsuite.GetFailCount(RunID : longint) : string;
  832. begin
  833. if RunID<>0 then
  834. Result:=GetSingleTon('SELECT (TU_FAILEDTOCOMPILE + TU_FAILEDTOFAIL + TU_FAILEDTORUN) FROM TESTRUN WHERE TU_ID='+IntToStr(RunID));
  835. end;
  836. Function TTestSuite.GetCPUName(ID : String) : String;
  837. begin
  838. if (ID<>'') then
  839. Result:=GetSingleTon('SELECT TC_NAME FROM TESTCPU WHERE TC_ID='+ID);
  840. end;
  841. Function TTestSuite.GetVersionName(ID : String) : String;
  842. begin
  843. if (ID<>'') then
  844. Result:=GetSingleton('SELECT TV_VERSION FROM TESTVERSION WHERE TV_ID='+ID);
  845. end;
  846. Function TTestSuite.GetCategoryName(ID : String) : String;
  847. begin
  848. if (ID<>'') then
  849. Result:=GetSingleton('SELECT TCAT_NAME FROM TESTCATEGORY WHERE TCAT_ID='+ID);
  850. end;
  851. Function TTestSuite.ShowRunData : Boolean;
  852. Const
  853. SGetRunData = 'SELECT TU_ID,TU_DATE,TC_NAME,TO_NAME,' +
  854. 'TU_SUBMITTER,TU_MACHINE,TU_COMMENT,TV_VERSION,'+
  855. 'TU_CATEGORY_FK,TU_SVNCOMPILERREVISION,TU_SVNRTLREVISION,'+
  856. 'TU_SVNPACKAGESREVISION,TU_SVNTESTSREVISION,'+
  857. '(TU_SUCCESSFULLYFAILED+TU_SUCCESFULLYCOMPILED+TU_SUCCESSFULLYRUN) AS OK,'+
  858. '(TU_FAILEDTOCOMPILE+TU_FAILEDTORUN+TU_FAILEDTOFAIL) as Failed,'+
  859. '(TU_SUCCESSFULLYFAILED+TU_SUCCESFULLYCOMPILED+TU_SUCCESSFULLYRUN+'+
  860. 'TU_FAILEDTOCOMPILE+TU_FAILEDTORUN+TU_FAILEDTOFAIL) as Total'+
  861. ' %s FROM TESTRUN,TESTCPU,TESTOS,TESTVERSION '+
  862. 'WHERE '+
  863. ' (TC_ID=TU_CPU_FK) AND '+
  864. ' (TO_ID=TU_OS_FK) AND '+
  865. ' (TV_ID=TU_VERSION_FK) AND '+
  866. ' (TU_ID=%s)';
  867. Var
  868. Q1,Q2 : TSQLQuery;
  869. F : TField;
  870. SC : string;
  871. Date1, Date2: TDateTime;
  872. begin
  873. Result:=(FRunID<>'');
  874. If Result then
  875. begin
  876. If GetCategoryName(FCategory)<>'DB' then
  877. SC:=', CONCAT(TU_SVNCOMPILERREVISION,"/",TU_SVNRTLREVISION,"/", '+
  878. 'TU_SVNPACKAGESREVISION,"/",TU_SVNTESTSREVISION) as svnrev'
  879. else
  880. SC:='';
  881. If GetCategoryName(FCategory)='All' then
  882. SC:=SC+', TCAT_NAME as Cat';
  883. Q1:=CreateDataset(Format(SGetRunData,[SC,FRunID]));
  884. if Length(FCompareRunID) > 0 then
  885. Q2:=CreateDataset(Format(SGetRunData,[SC,FCompareRunID]))
  886. else
  887. Q2:=nil;
  888. Try
  889. Q1.Open;
  890. if Q2 <> nil then
  891. Q2.Open;
  892. Result:=Not (Q1.EOF and Q1.BOF);
  893. If Result then
  894. With FHTMLWriter do
  895. begin
  896. FormStart(TestsuiteCGIURL,'get');
  897. EmitHiddenVar('action', '1');
  898. TableStart(3,true);
  899. RowStart;
  900. CellStart;
  901. Write('Run ID:');
  902. CellNext;
  903. EmitInput('run1id',FRunID);
  904. CellNext;
  905. EmitInput('run2id',FCompareRunID);
  906. CellEnd;
  907. RowNext;
  908. CellStart;
  909. Write('Operating system:');
  910. CellNext;
  911. Write(Q1.FieldByName('TO_NAME').AsString);
  912. CellNext;
  913. if Q2 <> nil then
  914. Write(Q2.FieldByName('TO_NAME').AsString);
  915. CellEnd;
  916. RowNext;
  917. CellStart;
  918. Write('Processor:');
  919. CellNext;
  920. Write(Q1.FieldByName('TC_NAME').AsString);
  921. CellNext;
  922. if Q2 <> nil then
  923. Write(Q2.FieldByName('TC_NAME').AsString);
  924. CellEnd;
  925. RowNext;
  926. CellStart;
  927. Write('Version:');
  928. CellNext;
  929. Write(Q1.FieldByNAme('TV_VERSION').AsString);
  930. CellNext;
  931. if Q2 <> nil then
  932. Write(Q2.FieldByNAme('TV_VERSION').AsString);
  933. CellEnd;
  934. RowNext;
  935. CellStart;
  936. Write('Fails/OK/Total:');
  937. CellNext;
  938. Write(Q1.FieldByName('Failed').AsString);
  939. Write('/'+Q1.FieldByName('OK').AsString);
  940. Write('/'+Q1.FieldByName('Total').AsString);
  941. CellNext;
  942. if Q2 <> nil then
  943. begin
  944. Write(Q2.FieldByName('Failed').AsString);
  945. Write('/'+Q2.FieldByName('Ok').AsString);
  946. Write('/'+Q2.FieldByName('Total').AsString);
  947. end;
  948. CellEnd;
  949. RowNext;
  950. CellStart;
  951. Write('Comment:');
  952. CellNext;
  953. Write(Q1.FieldByName('TU_COMMENT').AsString);
  954. CellNext;
  955. if Q2 <> nil then
  956. Write(Q2.FieldByName('TU_COMMENT').AsString);
  957. CellEnd;
  958. RowNext;
  959. CellStart;
  960. Write('Machine:');
  961. CellNext;
  962. Write(Q1.FieldByName('TU_MACHINE').AsString);
  963. CellNext;
  964. if Q2 <> nil then
  965. Write(Q2.FieldByName('TU_MACHINE').AsString);
  966. CellEnd;
  967. if GetCategoryName(FCategory)<>'All' then
  968. begin
  969. RowNext;
  970. CellStart;
  971. Write('Category:');
  972. CellNext;
  973. Write(GetCategoryName(Q1.FieldByName('TU_CATEGORY_FK').AsString));
  974. CellNext;
  975. if Q2 <> nil then
  976. Write(GetCategoryName(Q2.FieldByName('TU_CATEGORY_FK').AsString));
  977. CellEnd;
  978. end;
  979. If GetCategoryName(FCategory)<>'DB' then
  980. begin
  981. RowNext;
  982. CellStart;
  983. Write('SVN Revisions:');
  984. CellNext;
  985. Write(Q1.FieldByName('svnrev').AsString);
  986. CellNext;
  987. if Q2 <> nil then
  988. Write(Q2.FieldByName('svnrev').AsString);
  989. CellEnd;
  990. end;
  991. RowNext;
  992. CellStart;
  993. Write('Submitter:');
  994. CellNext;
  995. Write(Q1.FieldByName('TU_SUBMITTER').AsString);
  996. CellNext;
  997. if Q2 <> nil then
  998. Write(Q2.FieldByName('TU_SUBMITTER').AsString);
  999. CellEnd;
  1000. RowNext;
  1001. CellStart;
  1002. Write('Date:');
  1003. CellNext;
  1004. F := Q1.FieldByName('TU_DATE');
  1005. Date1 := F.AsDateTime;
  1006. Write(F.AsString);
  1007. CellNext;
  1008. if Q2 <> nil then
  1009. begin
  1010. F := Q2.FieldByName('TU_DATE');
  1011. Date2 := F.AsDateTime;
  1012. Write(F.AsString);
  1013. end;
  1014. CellEnd;
  1015. RowEnd;
  1016. TableEnd;
  1017. ParagraphStart;
  1018. EmitCheckBox('noskipped','1',FNoSkipped);
  1019. Write(' Hide skipped tests');
  1020. ParagraphEnd;
  1021. ParagraphStart;
  1022. EmitCheckBox('failedonly','1',FonlyFailed);
  1023. Write(' Hide successful tests');
  1024. ParagraphEnd;
  1025. ParaGraphStart;
  1026. EmitSubmitButton('','Show/Compare');
  1027. EmitResetButton('','Reset form');
  1028. ParagraphEnd;
  1029. FormEnd;
  1030. { give warning if dates reversed }
  1031. if (Q2 <> nil) and (Date1 > Date2) then
  1032. begin
  1033. ParagraphStart;
  1034. Write('Warning: testruns are not compared in chronological order.');
  1035. ParagraphEnd;
  1036. end;
  1037. end;
  1038. Finally
  1039. Q1.Close;
  1040. Q1.Free;
  1041. if Q2 <> nil then
  1042. begin
  1043. Q2.Close;
  1044. Q2.Free;
  1045. end;
  1046. end;
  1047. end;
  1048. end;
  1049. Procedure TTestSuite.ShowRunResults;
  1050. Var
  1051. S : String;
  1052. Qry : String;
  1053. Q : TSQLQuery;
  1054. FL : String;
  1055. begin
  1056. ConnectToDB;
  1057. ContentType:='text/html';
  1058. EmitContentType;
  1059. EmitTitle(Title+' : Search Results');
  1060. With FHTMLWriter do
  1061. begin
  1062. HeaderStart(1);
  1063. Write('Test suite results for run '+FRunID);
  1064. HeaderEnd(1);
  1065. HeaderStart(2);
  1066. Write('Test run data : ');
  1067. HeaderEnd(2);
  1068. If ShowRunData then
  1069. begin
  1070. HeaderStart(2);
  1071. Write('Detailed test run results:');
  1072. FL:='';
  1073. If FOnlyFailed or FNoSkipped then
  1074. begin
  1075. FL:='';
  1076. If FOnlyFailed then
  1077. FL:='successful';
  1078. if FNoSkipped then
  1079. begin
  1080. If (FL<>'') then
  1081. FL:=FL+' and ';
  1082. FL:=FL+'skipped';
  1083. end;
  1084. Write(' ('+FL+' tests are hidden)');
  1085. end;
  1086. HeaderEnd(2);
  1087. ParaGraphStart;
  1088. S:='SELECT T_ID as Id,T_NAME as Filename,TR_SKIP as Skipped'
  1089. +',TR_OK as OK,TR_RESULT as Result'
  1090. +' FROM '+TESTRESULTSTableName(FRunID)+',TESTS'
  1091. +' WHERE (TR_TEST_FK=T_ID) AND (TR_TESTRUN_FK='+FRunID+') ';
  1092. If FOnlyFailed then
  1093. S:=S+' AND (TR_OK="-")';
  1094. If FNoSkipped then
  1095. S:=S+' AND (TR_SKIP="-")';
  1096. S:=S+' ORDER BY TR_ID ';
  1097. Qry:=S;
  1098. If FDebug then
  1099. begin
  1100. Writeln('Query : '+Qry);
  1101. Flush(stdout);
  1102. end;
  1103. FRunCount:=0;
  1104. FRunSkipCount:=0;
  1105. FRunFailedCount:=0;
  1106. Q:=CreateDataset(Qry);
  1107. With Q do
  1108. try
  1109. Open;
  1110. while not EOF do
  1111. Next;
  1112. RecNo:=0;
  1113. DumpLn(Format('<p>Record count: %d </p>',[Q.RecordCount]));
  1114. Try
  1115. With CreateTableProducer(Q) do
  1116. Try
  1117. Border:=True;
  1118. FL:='Id,Filename';
  1119. If Not FNoSkipped then
  1120. FL:=FL+',Skipped';
  1121. If Not FOnlyFailed then
  1122. FL:=FL+',OK';
  1123. FL:=FL+',Result';
  1124. CreateColumns(FL);
  1125. OnGetRowAttributes:=@GetRunRowAttr;
  1126. TableColumns.ColumnByNAme('Id').OnGetCellContents:=
  1127. @FormatFileIDDetails;
  1128. TableColumns.ColumnByNAme('Filename').OnGetCellContents:=
  1129. @FormatFileDetails;
  1130. TableColumns.ColumnByNAme('Result').OnGetCellContents:=
  1131. @FormatTestResult;
  1132. //(TableColumns.Items[0] as TTableColumn).ActionURL:=ALink;
  1133. CreateTable(Response);
  1134. Finally
  1135. Free;
  1136. end;
  1137. Finally
  1138. Close;
  1139. end;
  1140. finally
  1141. Free;
  1142. end;
  1143. If Not (FRunCount=0) and not (FNoSkipped or FOnlyFailed) then
  1144. begin
  1145. ParaGraphStart;
  1146. TagStart('IMG',Format('Src="'+TestsuiteCGIURL+'?action=2&pietotal=%d&piefailed=%d&pieskipped=%d"',[FRunCount,FRunFailedCount,FRunSkipCount]));
  1147. end;
  1148. end
  1149. else
  1150. Write('No data for test run with ID: '+FRunID);
  1151. end;
  1152. end;
  1153. Procedure TTestSuite.ShowOneTest;
  1154. Var
  1155. S,S2 : String;
  1156. Qry : String;
  1157. Base, Category : string;
  1158. Q : TSQLQuery;
  1159. i : longint;
  1160. FieldName,FieldValue,
  1161. LLog,Source : String;
  1162. Res : Boolean;
  1163. ver : known_versions;
  1164. begin
  1165. ConnectToDB;
  1166. ContentType:='text/html';
  1167. EmitContentType;
  1168. if FTestFileID='' then
  1169. FTestFileID:=GetSingleton('SELECT T_ID FROM TESTS WHERE T_NAME LIKE ''%'+
  1170. FTestFileName+'%''');
  1171. if FTestFileID<>'' then
  1172. FTestFileName:=GetTestFileName(FTestFileID);
  1173. EmitTitle(Title+' : File '+FTestFileName+' Results');
  1174. With FHTMLWriter do
  1175. begin
  1176. HeaderStart(1);
  1177. Write('Test suite results for test file '+FTestFileName);
  1178. HeaderEnd(1);
  1179. HeaderStart(2);
  1180. Write('Test run data : ');
  1181. HeaderEnd(2);
  1182. if FRunID<>'' then
  1183. begin
  1184. Res:=ShowRunData;
  1185. Res:=true;
  1186. end
  1187. else
  1188. begin
  1189. // This is useless as it is now
  1190. // It should be integrated into a form probably PM
  1191. Write('Only failed tests');
  1192. EmitCheckBox('failedonly','1',FonlyFailed);
  1193. Write('Hide skipped tests');
  1194. EmitCheckBox('noskipped','1',FNoSkipped);
  1195. Res:=true;
  1196. end;
  1197. If Res then
  1198. begin
  1199. HeaderStart(2);
  1200. Write('Test file "'+FTestFileName+'" information:');
  1201. HeaderEnd(2);
  1202. ParaGraphStart;
  1203. if FTestFileID<>'' then
  1204. S:='SELECT * FROM TESTS WHERE T_ID='+FTestFileID
  1205. else
  1206. S:='SELECT * FROM TESTS WHERE T_NAME='+FTestFileName;
  1207. Q:=CreateDataSet(S);
  1208. With Q do
  1209. Try
  1210. Open;
  1211. Try
  1212. For i:=0 to FieldCount-1 do
  1213. begin
  1214. FieldValue:=Fields[i].AsString;
  1215. FieldName:=Fields[i].DisplayName;
  1216. if (FieldValue<>'') and (FieldValue<>'-') and
  1217. (FieldName<>'T_NAME') and (FieldName<>'T_SOURCE') then
  1218. begin
  1219. if (FieldValue='+') then
  1220. Write('Flag ');
  1221. Write(FieldName);
  1222. Write(' ');
  1223. if FieldValue='+' then
  1224. Write(' set')
  1225. else
  1226. Write(FieldValue);
  1227. DumpLn('<BR>');
  1228. end;
  1229. end;
  1230. Finally
  1231. Close;
  1232. end;
  1233. Finally
  1234. Free;
  1235. end;
  1236. ParaGraphEnd;
  1237. HeaderStart(2);
  1238. Write('Detailed test run results:');
  1239. HeaderEnd(2);
  1240. ParaGraphStart;
  1241. S:='SELECT TR_ID,TR_TESTRUN_FK AS RUN,TR_TEST_FK,TR_OK, TR_SKIP,TR_RESULT '
  1242. //S:='SELECT * '
  1243. +' FROM '+TESTRESULTSTableName(FRunID)
  1244. +' WHERE (TR_TEST_FK='+FTestFileID+')';
  1245. If FOnlyFailed then
  1246. S:=S+' AND (TR_OK="-")';
  1247. if Fcomparerunid<>'' then
  1248. begin
  1249. if TESTRESULTSTableName(FRunID)<>TESTRESULTSTableName(FCompareRunID) then
  1250. begin
  1251. S2:='SELECT TR_ID,TR_TESTRUN_FK AS RUN,TR_TEST_FK,TR_OK, TR_SKIP,TR_RESULT '
  1252. +' FROM '+TESTRESULTSTableName(FCompareRunID)
  1253. +' WHERE (TR_TEST_FK='+FTestFileID+')';
  1254. If FOnlyFailed then
  1255. S2:=S2+' AND (TR_OK="-")';
  1256. S:=S+' AND (TR_TESTRUN_FK='+Frunid+') UNION '+
  1257. S2+' AND (TR_TESTRUN_FK='+Fcomparerunid+')'
  1258. end
  1259. else
  1260. S:=S+' AND ((TR_TESTRUN_FK='+Frunid+') OR '+
  1261. '(TR_TESTRUN_FK='+Fcomparerunid+'))'
  1262. end
  1263. else if Frunid<>'' then
  1264. S:=S+' AND (TR_TESTRUN_FK='+Frunid+')'
  1265. else
  1266. S:=S+' ORDER BY TR_TESTRUN_FK DESC LIMIT '+IntToStr(FLimit);
  1267. Qry:=S;
  1268. If FDebug then
  1269. begin
  1270. Writeln('Query : '+Qry);
  1271. Flush(stdout);
  1272. end;
  1273. FRunCount:=0;
  1274. FRunSkipCount:=0;
  1275. FRunFailedCount:=0;
  1276. Q:=CreateDataset(Qry);
  1277. With Q do
  1278. try
  1279. Open;
  1280. Try
  1281. With CreateTableProducer(Q) do
  1282. Try
  1283. Border:=True;
  1284. //FL:='TR_ID,TR_TESTRUN_FK,T_NAME,T_CPU,T_VERSION';
  1285. CreateColumns(Nil);
  1286. TableColumns.Delete(TableColumns.ColumnByName('TR_TEST_FK').Index);
  1287. TableColumns.ColumnByNAme('RUN').OnGetCellContents:=
  1288. @FormatTestRunOverview;
  1289. //OnGetRowAttributes:=@GetRunRowAttr;
  1290. TableColumns.ColumnByNAme('TR_RESULT').OnGetCellContents:=
  1291. @FormatTestResult;
  1292. //(TableColumns.Items[0] as TTableColumn).ActionURL:=ALink;
  1293. CreateTable(Response);
  1294. Finally
  1295. Free;
  1296. end;
  1297. DumpLn(Format('<p>Record count: %d </p>',[Q.RecordCount]));
  1298. Finally
  1299. Close;
  1300. end;
  1301. finally
  1302. Free;
  1303. end;
  1304. //If FDebug then
  1305. Category:='1';
  1306. if FRunId<>'' then
  1307. begin
  1308. Category:=getsingleton('select TU_CATEGORY_FK from TESTRUN where TU_ID='+FRunId);
  1309. FVersionBranch:=GetVersionName(getsingleton('select TU_VERSION_FK from TESTRUN where TU_ID='+fRunId));
  1310. LLog:='';
  1311. Try
  1312. LLog:=getsingleton('select TR_LOG from TESTRESULTS where (TR_TEST_FK='+ftestfileid
  1313. +') and (TR_TESTRUN_FK='+frunid+')');
  1314. if LLog<>'' then
  1315. begin
  1316. HeaderStart(2);
  1317. Write('Log of '+FRunId+':');
  1318. HeaderEnd(2);
  1319. PreformatStart;
  1320. system.Write(LLog);
  1321. system.flush(output);
  1322. PreformatEnd;
  1323. end;
  1324. Finally
  1325. if LLog='' then
  1326. begin
  1327. HeaderStart(2);
  1328. Write('No log of '+FRunId+'.');
  1329. HeaderEnd(2);
  1330. end;
  1331. end;
  1332. end;
  1333. if FCompareRunId<>'' then
  1334. begin
  1335. LLog:='';
  1336. Try
  1337. LLog:=getsingleton('select TR_LOG from TESTRESULTS where (TR_TEST_FK='+ftestfileid
  1338. +') and (TR_TESTRUN_FK='+fcomparerunid+')');
  1339. if LLog<>'' then
  1340. begin
  1341. HeaderStart(2);
  1342. Write('Log of '+FCompareRunId+':');
  1343. HeaderEnd(2);
  1344. PreformatStart;
  1345. system.Write(LLog);
  1346. system.flush(output);
  1347. PreformatEnd;
  1348. end;
  1349. Finally
  1350. if LLog='' then
  1351. begin
  1352. HeaderStart(2);
  1353. Write('No log of '+FCompareRunId+'.');
  1354. HeaderEnd(2);
  1355. end;
  1356. end;
  1357. end;
  1358. if FDebug then
  1359. Write('After Log.');
  1360. Source:='';
  1361. Try
  1362. Source:=getsingleton('select T_SOURCE from TESTS where T_ID='+ftestfileid);
  1363. if Source<>'' then
  1364. begin
  1365. HeaderStart(2);
  1366. Write('Source:');
  1367. HeaderEnd(2);
  1368. PreformatStart;
  1369. system.Write(Source);
  1370. system.flush(output);
  1371. PreformatEnd;
  1372. end;
  1373. Finally
  1374. Base:='trunk';
  1375. if FVersionBranch<>'' then
  1376. begin
  1377. // Test all but last version, which is assumed to be trunk
  1378. for ver:=low(known_versions) to pred(high(known_versions)) do
  1379. if VER_String[ver]=FVersionBranch then
  1380. begin
  1381. base:=ver_branch[ver];
  1382. break;
  1383. end;
  1384. end;
  1385. FViewVCURL:=ViewURL+Base;
  1386. if Category='1' then
  1387. FViewVCUrl:=FViewVCURL+TestsSubDir
  1388. else
  1389. begin
  1390. FViewVCUrl:=FViewVCURL+DataBaseSubDir;
  1391. // This assumes that type TAnyType is
  1392. // defined in anytype.pas source PM
  1393. if pos('/',FTestFileName)>0 then
  1394. FTestfilename:=lowercase(copy(FTestFilename,2,pos('/',FTestFilename)-2)+'.pas');
  1395. end;
  1396. if Source='' then
  1397. begin
  1398. HeaderStart(3);
  1399. DumpLn('<P>No Source in TestSuite DataBase.</P>');
  1400. DumpLn('Link to SVN view of '+
  1401. '<A HREF="'+FViewVCURL+FTestFileName+'?view=markup'+
  1402. '" TARGET="fpc_source"> '+FTestFileName+'</A> source. ');
  1403. HeaderEnd(3);
  1404. end
  1405. else
  1406. begin
  1407. HeaderStart(3);
  1408. DumpLn('Link to SVN view of '+
  1409. '<A HREF="'+FViewVCURL+FTestFileName+'?view=markup'+
  1410. '" TARGET="fpc_source"> '+FTestFileName+'</A> source. ');
  1411. HeaderEnd(3);
  1412. end;
  1413. end;
  1414. if FDebug then
  1415. Write('After Source.');
  1416. end
  1417. else
  1418. Write(Format('No data for test file with ID: %s',[FTestFileID]));
  1419. end;
  1420. end;
  1421. Procedure TTestSuite.ShowHistory;
  1422. Const
  1423. MaxCombo = 50;
  1424. Type
  1425. StatusLongintArray = Array [TTestStatus] of longint;
  1426. StatusDateTimeArray = Array [TTestStatus] of TDateTime;
  1427. AStatusLA = Array[1..MaxCombo] of StatusLongintArray;
  1428. AStatusDTA = Array[1..MaxCombo] of StatusDateTimeArray;
  1429. PStatusLA = ^AStatusLA;
  1430. PStatusDTA = ^AStatusDTA;
  1431. Var
  1432. S,SS,FL,cpu,version,os : String;
  1433. date : TDateTime;
  1434. Qry : String;
  1435. Base, Category : string;
  1436. Q : TSQLQuery;
  1437. i,run_id,os_id,version_id,cpu_id : longint;
  1438. run_ind,os_ind,version_ind,cpu_ind,
  1439. ok_ind,skip_ind,result_ind,date_ind : longint;
  1440. os_size, cpu_size, version_size : longint;
  1441. os_last, cpu_last, version_last : longint;
  1442. error : word;
  1443. OK_count, not_OK_count,resi,
  1444. total_count, skip_count, not_skip_count : longint;
  1445. TS : TTestStatus;
  1446. result_count : StatusLongintArray;
  1447. os_count,cpu_count,version_count: PStatusLA;
  1448. first_date, last_date : array[TTestStatus] of TDateTime;
  1449. first_date_id, last_date_id : array[TTestStatus] of longint;
  1450. os_first_date, os_last_date,
  1451. cpu_first_date, cpu_last_date,
  1452. version_first_date, version_last_date : PStatusDTA;
  1453. os_first_date_id, os_last_date_id,
  1454. cpu_first_date_id, cpu_last_date_id,
  1455. version_first_date_id, version_last_date_id : PStatusLA;
  1456. FieldName,FieldValue,
  1457. LLog,Source : String;
  1458. Res : Boolean;
  1459. ver : known_versions;
  1460. begin
  1461. Res:=False;
  1462. os_count:=nil;
  1463. cpu_count:=nil;
  1464. version_count:=nil;
  1465. ConnectToDB;
  1466. ContentType:='text/html';
  1467. EmitContentType;
  1468. if (FTestFileID='') and (FTestFileName<>'') then
  1469. begin
  1470. FTestFileID:=GetSingleton('SELECT T_ID FROM TESTS WHERE T_NAME LIKE ''%'+
  1471. FTestFileName+'%''');
  1472. end;
  1473. if FTestFileID<>'' then
  1474. FTestFileName:=GetTestFileName(FTestFileID);
  1475. if FTestFileName<>'' then
  1476. EmitTitle(Title+' : File '+FTestFileName+' Results')
  1477. else
  1478. EmitTitle(Title+' : History overview');
  1479. With FHTMLWriter do
  1480. begin
  1481. if FTestFileName<>'' then
  1482. begin
  1483. HeaderStart(1);
  1484. Write('Test suite results for test file '+FTestFileName);
  1485. HeaderEnd(1);
  1486. HeaderStart(2);
  1487. Write('Test run data : ');
  1488. HeaderEnd(2);
  1489. end;
  1490. if FRunID<>'' then
  1491. begin
  1492. Res:=ShowRunData;
  1493. Res:=true;
  1494. end
  1495. else
  1496. begin
  1497. // This is useless as it is now
  1498. // It should be integrated into a form probably PM
  1499. //Write('Only failed tests');
  1500. //EmitCheckBox('failedonly','1',FonlyFailed);
  1501. //Write('Hide skipped tests');
  1502. //EmitCheckBox('noskipped','1',FNoSkipped);
  1503. Res:=true;
  1504. EmitHistoryForm;
  1505. if FTestFileID = '' then
  1506. with FHTMLWriter do begin
  1507. HeaderStart(2);
  1508. if Trim(FTestFileName) <> '' then
  1509. Write(Format('Error: No test files matching "%s" found.', [FTestFileName]))
  1510. else
  1511. Write('Error: Please specify a test file.');
  1512. HeaderEnd(2);
  1513. Res:=False;
  1514. end;
  1515. end;
  1516. If Res then
  1517. begin
  1518. if (FTestFileName<>'') then
  1519. begin
  1520. HeaderStart(2);
  1521. Write('Test file "'+FTestFileName+'" information:');
  1522. HeaderEnd(2);
  1523. ParaGraphStart;
  1524. S:='SELECT * FROM TESTS WHERE T_ID='+FTestFileID;
  1525. Q:=CreateDataSet(S);
  1526. With Q do
  1527. Try
  1528. Open;
  1529. Try
  1530. For i:=0 to FieldCount-1 do
  1531. begin
  1532. FieldValue:=Fields[i].AsString;
  1533. FieldName:=Fields[i].DisplayName;
  1534. if (FieldValue<>'') and (FieldValue<>'-') and
  1535. (FieldName<>'T_NAME') and (FieldName<>'T_SOURCE') then
  1536. begin
  1537. if (FieldValue='+') then
  1538. Write('Flag ');
  1539. Write(FieldName);
  1540. Write(' ');
  1541. if FieldValue='+' then
  1542. Write(' set')
  1543. else
  1544. Write(FieldValue);
  1545. DumpLn('<BR>');
  1546. end;
  1547. end;
  1548. Finally
  1549. Close;
  1550. end;
  1551. Finally
  1552. Free;
  1553. end;
  1554. ParaGraphEnd;
  1555. HeaderStart(2);
  1556. Write('Detailed test run results:');
  1557. end;
  1558. HeaderEnd(2);
  1559. ParaGraphStart;
  1560. SS:='SELECT TR_ID,TR_TESTRUN_FK AS Run,TR_TEST_FK,TR_OK AS OK'
  1561. +', TR_SKIP As Skip,TR_RESULT As Result'
  1562. //S:='SELECT * '
  1563. +',TC_NAME AS CPU, TV_VERSION AS Version, TO_NAME AS OS'
  1564. +',TU_ID,TU_DATE AS Date,TU_SUBMITTER AS Submitter'
  1565. +',(TU_FAILEDTOCOMPILE + TU_FAILEDTOFAIL + TU_FAILEDTORUN) AS Fails'
  1566. +',TU_MACHINE AS Machine,TU_COMMENT AS Comment'
  1567. +',TU_COMPILERDATE As CompDate'
  1568. +',TU_SVNTESTSREVISION AS Tests_rev'
  1569. +',TU_SVNRTLREVISION AS RTL_rev'
  1570. +',TU_SVNCOMPILERREVISION AS Compiler_rev'
  1571. +',TU_SVNPACKAGESREVISION AS Packages_rev'
  1572. +',TO_ID,TC_ID,TV_ID'
  1573. +' FROM TESTRESULTS '
  1574. +' LEFT JOIN TESTRUN ON (TR_TESTRUN_FK=TU_ID)'
  1575. +' LEFT JOIN TESTOS ON (TU_OS_FK=TO_ID)'
  1576. +' LEFT JOIN TESTCPU ON (TU_CPU_FK=TC_ID)'
  1577. +' LEFT JOIN TESTVERSION ON (TU_VERSION_FK=TV_ID)';
  1578. S:='';
  1579. if FTestFileID<>'' then
  1580. S:=S+' AND (TR_TEST_FK='+FTestFileID+')';
  1581. if FRunID<>'' then
  1582. S:=S+' AND (TR_TESTRUN_FK='+FRunID+')';
  1583. If FOnlyFailed then
  1584. S:=S+' AND (TR_OK="-")';
  1585. If FNoSkipped then
  1586. S:=S+' AND (TR_SKIP="-")';
  1587. If FCond<>'' then
  1588. S:=S+' AND ('+FCond+')';
  1589. If (FCPU<>'') and (GetCPUName(FCPU)<>'All') then
  1590. begin
  1591. S:=S+' AND (TU_CPU_FK='+FCPU+')';
  1592. cpu_size:=0;
  1593. end
  1594. else
  1595. begin
  1596. cpu_last:=StrToInt(GetSingleton('SELECT COUNT(*) FROM TESTCPU'));
  1597. cpu_size:=Sizeof(StatusLongintArray)*(1+cpu_last);
  1598. cpu_count:=GetMem(cpu_size);
  1599. FillChar(cpu_count^,cpu_size,#0);
  1600. cpu_first_date_id:=GetMem(cpu_size);
  1601. FillChar(cpu_first_date_id^,cpu_size,#0);
  1602. cpu_last_date_id:=GetMem(cpu_size);
  1603. FillChar(cpu_last_date_id^,cpu_size,#0);
  1604. cpu_first_date:=GetMem(cpu_last*SizeOf(StatusDateTimeArray));
  1605. FillChar(cpu_first_date^,cpu_last*Sizeof(StatusDateTimeArray),#0);
  1606. cpu_last_date:=GetMem(cpu_last*SizeOf(StatusDateTimeArray));
  1607. FillChar(cpu_last_date^,cpu_last*Sizeof(StatusDateTimeArray),#0);
  1608. end;
  1609. If (FVersion<>'') and (GetVersionName(FVersion)<>'All') then
  1610. begin
  1611. S:=S+' AND (TU_VERSION_FK='+FVERSION+')';
  1612. version_size:=0;
  1613. end
  1614. else
  1615. begin
  1616. version_last:=StrToInt(GetSingleton('SELECT COUNT(*) FROM TESTVERSION'));
  1617. version_size:=Sizeof(StatusLongintArray)*(1+version_last);
  1618. version_count:=GetMem(version_size);
  1619. FillChar(version_count^,version_size,#0);
  1620. version_first_date_id:=GetMem(version_size);
  1621. FillChar(version_first_date_id^,version_size,#0);
  1622. version_last_date_id:=GetMem(version_size);
  1623. FillChar(version_last_date_id^,version_size,#0);
  1624. version_first_date:=GetMem(version_last*SizeOf(StatusDateTimeArray));
  1625. FillChar(version_first_date^,version_last*Sizeof(StatusDateTimeArray),#0);
  1626. version_last_date:=GetMem(version_last*SizeOf(StatusDateTimeArray));
  1627. FillChar(version_last_date^,version_last*Sizeof(StatusDateTimeArray),#0);
  1628. end;
  1629. if (FOS<>'') and (GetOSName(FOS)<>'All') then
  1630. begin
  1631. S:=S+' AND (TU_OS_FK='+FOS+')';
  1632. os_size:=0;
  1633. end
  1634. else
  1635. begin
  1636. os_last:=StrToInt(GetSingleton('SELECT COUNT(*) FROM TESTOS'));
  1637. os_size:=Sizeof(StatusLongintArray)*(1+os_last);
  1638. os_count:=GetMem(os_size);
  1639. FillChar(os_count^,os_size,#0);
  1640. os_first_date_id:=GetMem(os_size);
  1641. FillChar(os_first_date_id^,os_size,#0);
  1642. os_last_date_id:=GetMem(os_size);
  1643. FillChar(os_last_date_id^,os_size,#0);
  1644. os_first_date:=GetMem(os_last*SizeOf(StatusDateTimeArray));
  1645. FillChar(os_first_date^,os_last*Sizeof(StatusDateTimeArray),#0);
  1646. os_last_date:=GetMem(os_last*SizeOf(StatusDateTimeArray));
  1647. FillChar(os_last_date^,os_last*Sizeof(StatusDateTimeArray),#0);
  1648. end;
  1649. If FSubmitter<>'' then
  1650. S:=S+' AND (TU_SUBMITTER='''+FSubmitter+''')';
  1651. If FMachine<>'' then
  1652. S:=S+' AND (TU_MACHINE='''+FMachine+''')';
  1653. If FComment<>'' then
  1654. S:=S+' AND (TU_COMMENT LIKE '''+FComment+''')';
  1655. if FDATE<>0 then
  1656. S:=S+' AND (TU_DATE >= '''+FormatDateTime('YYYY-MM-DD',FDate)+''')';
  1657. if S <> '' then
  1658. begin
  1659. Delete(S, 1, 4);
  1660. S:=SS + ' WHERE '+ S;
  1661. end
  1662. else
  1663. S:=SS;
  1664. S:=S+' ORDER BY TR_ID DESC';
  1665. if FDATE=0 then
  1666. S:=S+' LIMIT '+IntToStr(FLimit)
  1667. else
  1668. S:=S+' LIMIT '+IntToStr(MaxLimit);
  1669. Qry:=S;
  1670. If FDebug then
  1671. begin
  1672. Writeln(system.stdout,'Query : '+Qry);
  1673. system.Flush(system.stdout);
  1674. end;
  1675. FRunCount:=0;
  1676. FRunSkipCount:=0;
  1677. FRunFailedCount:=0;
  1678. Q:=CreateDataset(Qry);
  1679. With Q do
  1680. try
  1681. Open;
  1682. while not EOF do
  1683. Next;
  1684. DumpLn(Format('<p>Record count: %d </p>',[Q.RecordCount]));
  1685. if RecordCount>0 then
  1686. RecNo:=0;
  1687. Try
  1688. { if FDebug then
  1689. begin
  1690. Writeln(stdout,'FieldKind=',Fields[0].FieldKind);
  1691. Writeln(stdout,'DataType=',Fields[0].DataType);
  1692. system.flush(stdout);
  1693. end; }
  1694. total_count:=0;
  1695. OK_count:=0;
  1696. not_OK_count:=0;
  1697. skip_count:=0;
  1698. not_skip_count:=0;
  1699. fillchar(Result_Count,Sizeof(Result_count),#0);
  1700. ok_ind:=FieldByName('OK').Index;
  1701. skip_ind:=FieldBYName('SKIP').Index;
  1702. result_ind:=FieldByName('Result').Index;
  1703. cpu_ind:=FieldByName('TC_ID').Index;
  1704. os_ind:=FieldByName('TO_ID').Index;
  1705. version_ind:=FieldByName('TV_ID').Index;
  1706. date_ind:=FieldByName('Date').Index;
  1707. run_ind:=FieldByName('TU_ID').Index;
  1708. For i:=0 to Q.RecordCount-1 do
  1709. begin
  1710. Q.RecNo:=i;
  1711. inc(total_count);
  1712. S:=Fields[ok_ind].AsString;
  1713. if S='+' then
  1714. inc(OK_count)
  1715. else
  1716. inc(not_OK_count);
  1717. S:=Fields[skip_ind].AsString;
  1718. if S='+' then
  1719. inc(skip_count)
  1720. else
  1721. inc(not_skip_count);
  1722. S:=Fields[result_ind].AsString;
  1723. cpu:=Fields[cpu_ind].ASString;
  1724. version:=Fields[version_ind].AsString;
  1725. os:=Fields[os_ind].AsString;
  1726. date:=Fields[date_ind].ASDateTime;
  1727. os_id:=Fields[os_ind].AsLongint;
  1728. cpu_id:=Fields[cpu_ind].AsLongint;
  1729. version_id:=Fields[version_ind].AsLongint;
  1730. system.val(S,resi,error);
  1731. run_id:=Fields[run_ind].ASLongint;
  1732. if (error=0) and (Resi>=longint(FirstStatus)) and
  1733. (Resi<=longint(LastStatus)) then
  1734. begin
  1735. TS:=TTestStatus(Resi);
  1736. if Result_count[TS]=0 then
  1737. begin
  1738. first_date[TS]:=date;
  1739. last_date[TS]:=date;
  1740. first_date_id[TS]:=run_id;
  1741. last_date_id[TS]:=run_id;
  1742. end
  1743. else
  1744. begin
  1745. if (date>last_date[TS]) then
  1746. begin
  1747. last_date[TS]:=date;
  1748. last_date_id[TS]:=run_id;
  1749. end;
  1750. if date<first_date[TS] then
  1751. begin
  1752. first_date[TS]:=date;
  1753. first_date_id[TS]:=run_id;
  1754. end;
  1755. end;
  1756. inc(Result_count[TS]);
  1757. if assigned(cpu_count) and (cpu_id<=cpu_last) then
  1758. begin
  1759. if cpu_count^[cpu_id,TS]=0 then
  1760. begin
  1761. cpu_first_date^[cpu_id,TS]:=date;
  1762. cpu_last_date^[cpu_id,TS]:=date;
  1763. cpu_first_date_id^[cpu_id,TS]:=run_id;
  1764. cpu_last_date_id^[cpu_id,TS]:=run_id;
  1765. end
  1766. else
  1767. begin
  1768. if (date>cpu_last_date^[cpu_id,TS]) then
  1769. begin
  1770. cpu_last_date^[cpu_id,TS]:=date;
  1771. cpu_last_date_id^[cpu_id,TS]:=run_id;
  1772. end;
  1773. if date<cpu_first_date^[cpu_id,TS] then
  1774. begin
  1775. cpu_first_date^[cpu_id,TS]:=date;
  1776. cpu_first_date_id^[cpu_id,TS]:=run_id;
  1777. end;
  1778. end;
  1779. inc(cpu_count^[cpu_id,TS]);
  1780. end;
  1781. if assigned(os_count) and (os_id<=os_last) then
  1782. begin
  1783. if os_count^[os_id,TS]=0 then
  1784. begin
  1785. os_first_date^[os_id,TS]:=date;
  1786. os_last_date^[os_id,TS]:=date;
  1787. os_first_date_id^[os_id,TS]:=run_id;
  1788. os_last_date_id^[os_id,TS]:=run_id;
  1789. end
  1790. else
  1791. begin
  1792. if (date>os_last_date^[os_id,TS]) then
  1793. begin
  1794. os_last_date^[os_id,TS]:=date;
  1795. os_last_date_id^[os_id,TS]:=run_id;
  1796. end;
  1797. if date<os_first_date^[os_id,TS] then
  1798. begin
  1799. os_first_date^[os_id,TS]:=date;
  1800. os_first_date_id^[os_id,TS]:=run_id;
  1801. end;
  1802. end;
  1803. inc(os_count^[os_id,TS]);
  1804. end;
  1805. if assigned(version_count) and (version_id<=version_last) then
  1806. begin
  1807. if version_count^[version_id,TS]=0 then
  1808. begin
  1809. version_first_date^[version_id,TS]:=date;
  1810. version_last_date^[version_id,TS]:=date;
  1811. version_first_date_id^[version_id,TS]:=run_id;
  1812. version_last_date_id^[version_id,TS]:=run_id;
  1813. end
  1814. else
  1815. begin
  1816. if (date>version_last_date^[version_id,TS]) then
  1817. begin
  1818. version_last_date^[version_id,TS]:=date;
  1819. version_last_date_id^[version_id,TS]:=run_id;
  1820. end;
  1821. if date<version_first_date^[version_id,TS] then
  1822. begin
  1823. version_first_date^[version_id,TS]:=date;
  1824. version_first_date_id^[version_id,TS]:=run_id;
  1825. end;
  1826. end;
  1827. inc(version_count^[version_id,TS]);
  1828. end;
  1829. end
  1830. else if Fdebug then
  1831. writeln(stdout,'Error for Result, S=',S);
  1832. end;
  1833. DumpLn(Format('<p>Total = %d </p>',[total_count]));
  1834. if Total_count > 0 then
  1835. DumpLn(Format('<p>OK=%d Percentage= %3.2f </p>',[OK_count,OK_count*100/total_count]));
  1836. if Skip_count > 0 then
  1837. DumpLn(Format('<p>Skipped=%d Percentage= %3.2f </p>',[Skip_count,Skip_count*100/total_count]));
  1838. if total_count>0 then
  1839. begin
  1840. TableStart(5,True);
  1841. RowStart;
  1842. CellStart;
  1843. Write('Result type');
  1844. CellNext;
  1845. Write('Cat.');
  1846. CellNext;
  1847. Write('Count');
  1848. CellNext;
  1849. Write('Percentage');
  1850. CellNext;
  1851. Write('First date');
  1852. CellNext;
  1853. Write('Last Date');
  1854. CellEnd;
  1855. end;
  1856. For TS:=FirstStatus to LastStatus do
  1857. if Result_count[TS]>0 then
  1858. begin
  1859. RowNext;
  1860. CellStart;
  1861. Write(StatusText[TS]);
  1862. CellNext;
  1863. CellNext;
  1864. Write(Format('%d',[Result_count[TS]]));
  1865. CellNext;
  1866. Write(Format('%3.1f',[Result_count[TS]*100/total_count]));
  1867. CellNext;
  1868. DumpLn(FormatDetailURL(IntToStr(first_date_id[TS]),
  1869. DateTimeToStr(first_date[TS])));
  1870. Write(' '+GetFailCount(first_date_id[TS]));
  1871. CellNext;
  1872. DumpLn(FormatDetailURL(IntToStr(last_date_id[TS]),
  1873. DateTimeToStr(last_date[TS])));
  1874. Write(' '+GetFailCount(last_date_id[TS]));
  1875. CellEnd;
  1876. if assigned(cpu_count) then
  1877. begin
  1878. for i:=1 to cpu_last do
  1879. if cpu_count^[i,TS]>0 then
  1880. begin
  1881. RowNext;
  1882. CellStart;
  1883. CellNext;
  1884. Write(GetSingleton('SELECT TC_NAME FROM TESTCPU WHERE TC_ID='+IntToStr(i)));
  1885. CellNext;
  1886. Write(Format('%d',[cpu_count^[i,TS]]));
  1887. CellNext;
  1888. Write(Format('%3.1f',[cpu_count^[i,TS]*100/result_count[TS]]));
  1889. CellNext;
  1890. DumpLn(FormatDetailURL(IntToStr(cpu_first_date_id^[i,TS]),
  1891. DateTimeToStr(cpu_first_date^[i,TS])));
  1892. Write(' '+GetFailCount(cpu_first_date_id^[i,TS]));
  1893. CellNext;
  1894. DumpLn(FormatDetailURL(IntToStr(cpu_last_date_id^[i,TS]),
  1895. DateTimeToStr(cpu_last_date^[i,TS])));
  1896. Write(' '+GetFailCount(cpu_last_date_id^[i,TS]));
  1897. CellEnd;
  1898. end;
  1899. end;
  1900. if assigned(os_count) then
  1901. begin
  1902. for i:=1 to os_last do
  1903. if os_count^[i,TS]>0 then
  1904. begin
  1905. RowNext;
  1906. CellStart;
  1907. CellNext;
  1908. Write(GetSingleton('SELECT TO_NAME FROM TESTOS WHERE TO_ID='+IntToStr(i)));
  1909. CellNext;
  1910. Write(Format('%d',[os_count^[i,TS]]));
  1911. CellNext;
  1912. Write(Format('%3.1f',[os_count^[i,TS]*100/result_count[TS]]));
  1913. CellNext;
  1914. DumpLn(FormatDetailURL(IntToStr(os_first_date_id^[i,TS]),
  1915. DateTimeToStr(os_first_date^[i,TS])));
  1916. Write(' '+GetFailCount(os_first_date_id^[i,TS]));
  1917. CellNext;
  1918. DumpLn(FormatDetailURL(IntToStr(os_last_date_id^[i,TS]),
  1919. DateTimeToStr(os_last_date^[i,TS])));
  1920. Write(' '+GetFailCount(os_last_date_id^[i,TS]));
  1921. CellEnd;
  1922. end;
  1923. end;
  1924. if assigned(version_count) then
  1925. begin
  1926. for i:=1 to version_last do
  1927. if version_count^[i,TS]>0 then
  1928. begin
  1929. RowNext;
  1930. CellStart;
  1931. CellNext;
  1932. Write(GetSingleton('SELECT TV_VERSION FROM TESTVERSION WHERE TV_ID='+IntToStr(i)));
  1933. CellNext;
  1934. Write(Format('%d',[version_count^[i,TS]]));
  1935. CellNext;
  1936. Write(Format('%3.1f',[version_count^[i,TS]*100/result_count[TS]]));
  1937. CellNext;
  1938. DumpLn(FormatDetailURL(IntToStr(version_first_date_id^[i,TS]),
  1939. DateTimeToStr(version_first_date^[i,TS])));
  1940. Write(' '+GetFailCount(version_first_date_id^[i,TS]));
  1941. CellNext;
  1942. DumpLn(FormatDetailURL(IntToStr(version_last_date_id^[i,TS]),
  1943. DateTimeToStr(version_last_date^[i,TS])));
  1944. Write(' '+GetFailCount(version_last_date_id^[i,TS]));
  1945. CellEnd;
  1946. end;
  1947. end;
  1948. end;
  1949. if total_count>0 then
  1950. begin
  1951. TableEnd;
  1952. RecNo:=0;
  1953. end;
  1954. If FDebug or FListAll then
  1955. begin
  1956. With CreateTableProducer(Q) do
  1957. Try
  1958. Border:=True;
  1959. FL:='RUN,Date,OK,SKIP,Result';
  1960. if FSubmitter='' then
  1961. FL:=FL+',Submitter';
  1962. if FMachine='' then
  1963. FL:=FL+',Machine';
  1964. if Fcomment='' then
  1965. FL:=FL+',Comment';
  1966. if (FOS='') or (GetOSName(FOS)='All') then
  1967. FL:=FL+',OS';
  1968. if (FCPU='') or (GetCPUName(FCPU)='All') then
  1969. FL:=FL+',CPU';
  1970. if (FVersion='') or (GetVersionName(FVersion)='All') then
  1971. FL:=FL+',Version';
  1972. FL:=FL+',Fails,CompDate';
  1973. FL:=FL+',Tests_rev,RTL_rev,Compiler_rev,Packages_rev';
  1974. CreateColumns(FL);
  1975. //TableColumns.Delete(TableColumns.ColumnByName('TR_TEST_FK').Index);
  1976. TableColumns.ColumnByNAme('RUN').OnGetCellContents:=
  1977. @FormatTestRunOverview;
  1978. //OnGetRowAttributes:=@GetRunRowAttr;
  1979. TableColumns.ColumnByNAme('Result').OnGetCellContents:=
  1980. @FormatTestResult;
  1981. //(TableColumns.Items[0] as TTableColumn).ActionURL:=ALink;
  1982. CreateTable(Response);
  1983. Finally
  1984. Free;
  1985. end;
  1986. end;
  1987. Finally
  1988. Close;
  1989. end;
  1990. finally
  1991. Free;
  1992. end;
  1993. //If FDebug then
  1994. Category:='1';
  1995. if FRunId<>'' then
  1996. begin
  1997. Category:=getsingleton('select TU_CATEGORY_FK from TESTRUN where TU_ID='+FRunId);
  1998. FVersionBranch:=GetVersionName(getsingleton('select TU_VERSION_FK from TESTRUN where TU_ID='+fRunId));
  1999. LLog:='';
  2000. Try
  2001. LLog:=getsingleton('select TR_LOG from TESTRESULTS where (TR_TEST_FK='+ftestfileid
  2002. +') and (TR_TESTRUN_FK='+frunid+')');
  2003. if LLog<>'' then
  2004. begin
  2005. HeaderStart(2);
  2006. Write('LLog of '+FRunId+':');
  2007. HeaderEnd(2);
  2008. PreformatStart;
  2009. system.Write(LLog);
  2010. system.flush(output);
  2011. PreformatEnd;
  2012. end;
  2013. Finally
  2014. if LLog='' then
  2015. begin
  2016. HeaderStart(2);
  2017. Write('No log of '+FRunId+'.');
  2018. HeaderEnd(2);
  2019. end;
  2020. end;
  2021. end;
  2022. if FCompareRunId<>'' then
  2023. begin
  2024. LLog:='';
  2025. Try
  2026. LLog:=getsingleton('select TR_LOG from TESTRESULTS where (TR_TEST_FK='+ftestfileid
  2027. +') and (TR_TESTRUN_FK='+fcomparerunid+')');
  2028. if LLog<>'' then
  2029. begin
  2030. HeaderStart(2);
  2031. Write('Log of '+FCompareRunId+':');
  2032. HeaderEnd(2);
  2033. PreformatStart;
  2034. system.Write(LLog);
  2035. system.flush(output);
  2036. PreformatEnd;
  2037. end;
  2038. Finally
  2039. if LLog='' then
  2040. begin
  2041. HeaderStart(2);
  2042. Write('No log of '+FCompareRunId+'.');
  2043. HeaderEnd(2);
  2044. end;
  2045. end;
  2046. end;
  2047. if FDebug then
  2048. Write('After log.');
  2049. Source:='';
  2050. Try
  2051. if ftestfileid <> '' then
  2052. begin
  2053. Source:=getsingleton('select T_SOURCE from TESTS where T_ID='+ftestfileid);
  2054. if Source<>'' then
  2055. begin
  2056. HeaderStart(2);
  2057. Write('Source:');
  2058. HeaderEnd(2);
  2059. PreformatStart;
  2060. system.Write(Source);
  2061. system.flush(output);
  2062. PreformatEnd;
  2063. end;
  2064. end;
  2065. Finally
  2066. Base:='trunk';
  2067. if FVersionBranch<>'' then
  2068. begin
  2069. // Test all but last version, which is assumed to be trunk
  2070. for ver:=low(known_versions) to pred(high(known_versions)) do
  2071. if ver_string[ver]=FVersionBranch then
  2072. begin
  2073. base:=ver_branch[ver];
  2074. break;
  2075. end;
  2076. end;
  2077. FViewVCURL:=ViewURL+Base;
  2078. if Category='1' then
  2079. FViewVCUrl:=FViewVCURL+TestsSubDir
  2080. else
  2081. begin
  2082. FViewVCUrl:=FViewVCURL+DataBaseSubDir;
  2083. // This assumes that type TAnyType is
  2084. // defined in anytype.pas source PM
  2085. if pos('/',FTestFileName)>0 then
  2086. FTestfilename:=lowercase(copy(FTestFilename,2,pos('/',FTestFilename)-2)+'.pas');
  2087. end;
  2088. if Source='' then
  2089. begin
  2090. HeaderStart(3);
  2091. DumpLn('<P>No Source in TestSuite DataBase.</P>');
  2092. DumpLn('Link to SVN view of '+
  2093. '<A HREF="'+FViewVCURL+FTestFileName+'?view=markup'+
  2094. '" TARGET="fpc_source"> '+FTestFileName+'</A> source. ');
  2095. HeaderEnd(3);
  2096. end
  2097. else
  2098. begin
  2099. HeaderStart(3);
  2100. DumpLn('Link to SVN view of '+
  2101. '<A HREF="'+FViewVCURL+FTestFileName+'?view=markup'+
  2102. '" TARGET="fpc_source"> '+FTestFileName+'</A> source. ');
  2103. HeaderEnd(3);
  2104. end;
  2105. end;
  2106. if FDebug then
  2107. Write('After Source.');
  2108. end;
  2109. end;
  2110. if assigned(os_count) then
  2111. begin
  2112. FreeMem(os_count);
  2113. FreeMem(os_first_date);
  2114. FreeMem(os_first_date_id);
  2115. FreeMem(os_last_date);
  2116. FreeMem(os_last_date_id);
  2117. end;
  2118. if assigned(cpu_count) then
  2119. begin
  2120. FreeMem(cpu_count);
  2121. FreeMem(cpu_first_date);
  2122. FreeMem(cpu_first_date_id);
  2123. FreeMem(cpu_last_date);
  2124. FreeMem(cpu_last_date_id);
  2125. end;
  2126. if assigned(version_count) then
  2127. begin
  2128. FreeMem(version_count);
  2129. FreeMem(version_first_date);
  2130. FreeMem(version_first_date_id);
  2131. FreeMem(version_last_date);
  2132. FreeMem(version_last_date_id);
  2133. end;
  2134. end;
  2135. Procedure TTestSuite.ShowRunComparison;
  2136. Var
  2137. S : String;
  2138. Qry : String;
  2139. Q : TSQLQuery;
  2140. FL : String;
  2141. begin
  2142. ConnectToDB;
  2143. ContentType:='text/html';
  2144. EmitContentType;
  2145. EmitTitle(Title+' : Compare 2 runs');
  2146. With FHTMLWriter do
  2147. begin
  2148. HeaderStart(1);
  2149. Write('Test suite results for run '+FRunID+' vs. '+FCompareRunID);
  2150. HeaderEnd(1);
  2151. HeaderStart(2);
  2152. Write('Test run data: ');
  2153. HeaderEnd(2);
  2154. If ShowRunData then
  2155. begin
  2156. HeaderStart(2);
  2157. Write('Detailed test run results:');
  2158. FL:='';
  2159. If FOnlyFailed or FNoSkipped then
  2160. begin
  2161. FL:='';
  2162. If FOnlyFailed then
  2163. FL:='successful';
  2164. if FNoSkipped then
  2165. begin
  2166. If (FL<>'') then
  2167. FL:=FL+' and ';
  2168. FL:=FL+'skipped';
  2169. end;
  2170. Write(' ('+FL+' tests are hidden)');
  2171. end;
  2172. HeaderEnd(2);
  2173. ParaGraphStart;
  2174. Q:=CreateDataset('');
  2175. Q.SQL.Text:='CREATE TEMPORARY TABLE tr1 like TESTRESULTS;';
  2176. Q.ExecSQL;
  2177. Q.SQL.Text:='CREATE TEMPORARY TABLE tr2 like TESTRESULTS;';
  2178. Q.ExecSQL;
  2179. Q.SQL.Text:='INSERT INTO tr1 SELECT * FROM '+TESTRESULTSTableName(FRunId)+
  2180. ' WHERE TR_TESTRUN_FK='+FRunID+';';
  2181. Q.ExecSQL;
  2182. Q.SQL.Text:='INSERT INTO tr2 SELECT * FROM '+TESTRESULTSTableName(FCompareRunId)+
  2183. ' WHERE TR_TESTRUN_FK='+FCompareRunID+';';
  2184. Q.ExecSQL;
  2185. S:='SELECT T_ID as Id,T_NAME as Filename,tr1.TR_SKIP as Run1_Skipped,'
  2186. +'tr2.TR_SKIP as Run2_Skipped,tr1.TR_OK as Run1_OK,'
  2187. +'tr2.TR_OK as Run2_OK, tr1.TR_Result as Run1_Result,'
  2188. +'tr2.TR_RESULT as Run2_Result '
  2189. +'FROM TESTS, tr2 LEFT JOIN tr1 USING (TR_TEST_FK) '
  2190. +'WHERE ((tr1.TR_SKIP IS NULL) or'
  2191. +' (tr2.TR_SKIP IS NULL) or '
  2192. +' (%s (tr1.TR_Result<>tr2.TR_Result)))'
  2193. +'and (T_ID=tr2.TR_TEST_FK)';
  2194. If FNoSkipped then
  2195. begin
  2196. Qry:='(((tr1.TR_SKIP="+") and (tr2.TR_OK="-") and (tr2.TR_SKIP="-")) or '
  2197. +'((tr1.TR_OK="-") and (tr1.TR_SKIP="-") and (tr2.TR_SKIP="+")) or '
  2198. +'((tr1.TR_SKIP="-") and (tr2.TR_SKIP="-"))) and ';
  2199. end
  2200. else
  2201. Qry:='';
  2202. Qry:=Format(S,[Qry]);
  2203. If FDebug then
  2204. begin
  2205. Writeln('Query: '+Qry);
  2206. Flush(stdout);
  2207. end;
  2208. FRunCount:=0;
  2209. FRunSkipCount:=0;
  2210. FRunFailedCount:=0;
  2211. Q.SQL.Text:=Qry;
  2212. With Q do
  2213. try
  2214. Open;
  2215. Try
  2216. With CreateTableProducer(Q) do
  2217. Try
  2218. Border:=True;
  2219. FL:='Filename,Run1_OK,Run2_OK';
  2220. If Not FNoSkipped then
  2221. FL:=FL+',Run1_Skipped,Run2_Skipped';
  2222. FL:=FL+',Run1_Result,Run2_Result';
  2223. CreateColumns(FL);
  2224. OnGetRowAttributes:=@GetRunRowAttr;
  2225. TableColumns.ColumnByNAme('Run1_Result').OnGetCellContents:=
  2226. @FormatTestResult;
  2227. TableColumns.ColumnByNAme('Run2_Result').OnGetCellContents:=
  2228. @FormatTestResult;
  2229. TableColumns.ColumnByNAme('Filename').OnGetCellContents:=
  2230. @FormatFileDetails;
  2231. //(TableColumns.Items[0] as TTableColumn).ActionURL:=ALink;
  2232. CreateTable(Response);
  2233. Finally
  2234. Free;
  2235. end;
  2236. Writeln('<p>Record count: ',Q.RecordCount,'</p>');
  2237. Finally
  2238. Close;
  2239. end;
  2240. finally
  2241. Free;
  2242. end;
  2243. If Not (FRunCount=0) and not (FNoSkipped or FOnlyFailed) then
  2244. begin
  2245. ParaGraphStart;
  2246. TagStart('IMG',Format('Src="'+TestsuiteCGIURL+'?action=2&pietotal=%d&piefailed=%d&pieskipped=%d"',[FRunCount,FRunFailedCount,FRunSkipCount]));
  2247. end;
  2248. end
  2249. else
  2250. Write('No data for test run with ID: '+FRunID);
  2251. end;
  2252. end;
  2253. procedure TTestSuite.GetRunRowAttr(Sender: TObject; var BGColor: String;
  2254. var Align: THTMLAlign; var VAlign: THTMLValign; var CustomAttr: String);
  2255. Var
  2256. P : TTableProducer;
  2257. Skip1Field, Skip2Field, Run1Field, Run2Field : TField;
  2258. begin
  2259. P:=(Sender as TTAbleProducer);
  2260. Inc(FRunCount);
  2261. If (FOnlyFailed and FNoSkipped) then
  2262. begin
  2263. If (P.CurrentRow Mod 2)=0 then
  2264. BGColor:='#EEEEEE'
  2265. end
  2266. else
  2267. begin
  2268. Skip1Field := P.Dataset.FindField('Skipped');
  2269. if Skip1Field = nil then
  2270. begin
  2271. Skip1Field := P.Dataset.FindField('Run1_Skipped');
  2272. Skip2Field := P.Dataset.FindField('Run2_Skipped');
  2273. end
  2274. else
  2275. Skip2Field := nil;
  2276. Run1Field := P.Dataset.FindField('OK');
  2277. if Run1Field = nil then
  2278. Run1Field := P.Dataset.FindField('Run1_OK');
  2279. Run2Field := P.Dataset.FindField('OK');
  2280. if Run2Field = nil then
  2281. Run2Field := P.Dataset.FindField('Run2_OK');
  2282. If (not FNoSkipped) and ((Skip1Field.AsString='+')
  2283. or ((Skip2Field <> nil) and (Skip2Field.AsString = '+'))) then
  2284. begin
  2285. Inc(FRunSkipCount);
  2286. BGColor:='yellow'; // Yellow
  2287. end
  2288. else If Run2Field.AsString='+' then
  2289. begin
  2290. if Run1Field.AsString='' then
  2291. BGColor:='#68DFB8'
  2292. else if Run1Field.ASString<>'+' then
  2293. BGColor:='#98FB98'; // pale Green
  2294. end
  2295. else if Run2Field.AsString='-' then
  2296. begin
  2297. Inc(FRunFailedCount);
  2298. if Run1Field.AsString='' then
  2299. BGColor:='#FF82AB' // Light red
  2300. else if Run1Field.AsString<>'-' then
  2301. BGColor:='#FF225B';
  2302. end;
  2303. end;
  2304. end;
  2305. procedure TTestSuite.FormatFailedOverview(Sender: TObject; var CellData: String);
  2306. Var
  2307. S: String;
  2308. P : TTableProducer;
  2309. begin
  2310. P:=(Sender as TTableProducer);
  2311. S:=Format(SDetailsURL,[P.DataSet.FieldByName('ID').AsString]);
  2312. S:=S+'&failedonly=1&noskipped=1';
  2313. CellData:=Format('<A HREF="%s">%s</A>',[S,CellData]);
  2314. end;
  2315. function TTestSuite.FormatDetailURL(const RunIdStr, CellData : String) : string;
  2316. Var
  2317. S : String;
  2318. begin
  2319. S:=Format(SDetailsURL,[RunIdStr]);
  2320. if FOnlyFailed then
  2321. S:=S+'&failedonly=1';
  2322. if FNoSkipped then
  2323. S:=S+'&noskipped=1';
  2324. FormatDetailURL:=Format('<A HREF="%s">%s</A>',[S,CellData]);
  2325. end;
  2326. procedure TTestSuite.FormatTestRunOverview(Sender: TObject; var CellData: String);
  2327. Var
  2328. S: String;
  2329. P : TTableProducer;
  2330. begin
  2331. P:=(Sender as TTableProducer);
  2332. S:=Format(SDetailsURL,[P.DataSet.FieldByName('RUN').AsString]);
  2333. if FOnlyFailed then
  2334. S:=S+'&failedonly=1';
  2335. if FNoSkipped then
  2336. S:=S+'&noskipped=1';
  2337. CellData:=Format('<A HREF="%s">%s</A>',[S,CellData]);
  2338. end;
  2339. procedure TTestSuite.FormatFileIDDetails(Sender: TObject; var CellData: String);
  2340. Var
  2341. S: String;
  2342. P : TTableProducer;
  2343. begin
  2344. P:=(Sender as TTableProducer);
  2345. if FVersion<>'' then
  2346. S:=Format(TestSuiteCGIURL + '?action=4&version=%s&testfileid=%s',
  2347. [FVersion,P.DataSet.FieldByName('Id').AsString])
  2348. else
  2349. S:=Format(TestSuiteCGIURL + '?action=4&testfileid=%s',
  2350. [P.DataSet.FieldByName('Id').AsString]);
  2351. CellData:=Format('<A HREF="%s">%s</A>',[S,CellData]);
  2352. end;
  2353. procedure TTestSuite.FormatFileDetails(Sender: TObject; var CellData: String);
  2354. Var
  2355. S: String;
  2356. P : TTableProducer;
  2357. begin
  2358. P:=(Sender as TTableProducer);
  2359. if FCompareRunID<>'' then
  2360. S:=Format(TestSuiteCGIURL + '?action=3&run1id=%s&run2id=%s&testfileid=%s',
  2361. [FRunID,FCompareRunID,P.DataSet.FieldByName('Id').AsString])
  2362. else
  2363. S:=Format(TestSuiteCGIURL + '?action=3&run1id=%s&testfileid=%s',
  2364. [FRunID,P.DataSet.FieldByName('Id').AsString]);
  2365. CellData:=Format('<A HREF="%s">%s</A>',[S,CellData]);
  2366. end;
  2367. procedure TTestSuite.FormatTestResult(Sender: TObject; var CellData: String);
  2368. Var
  2369. Res : longint;
  2370. Error:word;
  2371. TS : TTestStatus;
  2372. begin
  2373. Val(CellData,Res,Error);
  2374. if (Error=0) and (Res>=longint(FirstStatus)) and
  2375. (Res<=longint(LastStatus)) then
  2376. begin
  2377. TS:=TTestStatus(Res);
  2378. CellData:=StatusText[TS];
  2379. end;
  2380. end;
  2381. Procedure TTestSuite.CreateRunPie;
  2382. Var
  2383. I : TFPMemoryImage;
  2384. M : TMemoryStream;
  2385. begin
  2386. ftFont.InitEngine;
  2387. FontMgr.SearchPath:='/usr/lib/X11/fonts/truetype';
  2388. I:=TFPMemoryImage.Create(320,320);
  2389. try
  2390. If FRunCount=0 Then
  2391. Raise Exception.Create('Invalid parameters passed to script: No total count');
  2392. DoDrawPie(I,FRunSkipCount,FRunFailedCount,FRunCount);
  2393. M:=TMemoryStream.Create;
  2394. Try
  2395. With TFPWriterPNG.Create do
  2396. try
  2397. UseAlpha:=True;
  2398. ImageWrite(M,I);
  2399. Finally
  2400. Free;
  2401. end;
  2402. ContentType:='image/png';
  2403. EmitContentType;
  2404. M.Position:=0;
  2405. Response.CopyFrom(M,M.Size);
  2406. Finally
  2407. M.Free;
  2408. end;
  2409. Finally
  2410. I.Free;
  2411. end;
  2412. end;
  2413. Procedure TTestSuite.DoDrawPie(Img : TFPCustomImage; Skipped,Failed,Total : Integer);
  2414. Var
  2415. Cnv : TFPImageCanvas;
  2416. W,H,FH,CR,ra : Integer;
  2417. A1,A2,FR,SR,PR : Double;
  2418. R : TRect;
  2419. F : TFreeTypeFont;
  2420. Procedure AddPie(X,Y,R : Integer; AStart,AStop : Double; Col : TFPColor);
  2421. Var
  2422. DX,Dy : Integer;
  2423. begin
  2424. DX:=Round(R*Cos(A1));
  2425. DY:=Round(R*Sin(A1));
  2426. Cnv.Line(X,Y,X+DX,Y-DY);
  2427. DX:=Round(Ra*Cos(A2));
  2428. DY:=Round(Ra*Sin(A2));
  2429. Cnv.Line(X,Y,X+DX,Y-Dy);
  2430. DX:=Round(R/2*Cos((A1+A2)/2));
  2431. DY:=Round(R/2*Sin((A1+A2)/2));
  2432. Cnv.Brush.FpColor:=Col;
  2433. Cnv.FloodFill(X+DX,Y-DY);
  2434. end;
  2435. Function FractionAngle(F,T : Integer): Double;
  2436. begin
  2437. Result:=(2*Pi*(F/T))
  2438. end;
  2439. begin
  2440. F:=TFreeTypeFont.Create;
  2441. With F do
  2442. begin
  2443. Name:='arial';
  2444. FontIndex:=0;
  2445. Size:=12;
  2446. FPColor:=colred;
  2447. AntiAliased:=False;
  2448. Resolution:=96;
  2449. end;
  2450. if FDebug then
  2451. Writeln(stdout,'Creating image');
  2452. Cnv:=TFPImageCanvas.Create(Img);
  2453. if FDebug then
  2454. Writeln(stdout,'CNV=0x',hexstr(ptruint(cnv),16));
  2455. if FDebug then
  2456. Writeln(stdout,'Getting width and height');
  2457. W:=Img.Width;
  2458. H:=Img.Height;
  2459. if FDebug then
  2460. begin
  2461. Writeln(stdout,'width=',W,' height=',H);
  2462. //system.flush(stdout);
  2463. end;
  2464. // Writeln('Transparant');
  2465. cnv.Brush.Style:=bsSolid;
  2466. cnv.Brush.FPColor:=colTransparent;
  2467. cnv.Pen.FPColor:=colWhite;
  2468. Cnv.Rectangle(0,0,W,H);
  2469. if FDEbug then
  2470. Writeln(stdout,'Setting font');
  2471. Cnv.Font:=F;
  2472. if FDebug then
  2473. Writeln(stdout,'Getting textwidth ');
  2474. FH:=CNV.GetTextHeight('A');
  2475. If FH=0 then
  2476. FH:=14; // 3 * 14;
  2477. if FDebug then
  2478. writeln(stdout,'FH=',FH);
  2479. Inc(FH,3);
  2480. R.Top:=FH*4;
  2481. R.Left:=0;
  2482. R.Bottom:=H;
  2483. CR:=H-(FH*4);
  2484. If W>CR then
  2485. R.Right:=CR
  2486. else
  2487. R.Right:=W;
  2488. Ra:=CR div 2;
  2489. if FDEbug then
  2490. begin
  2491. Writeln(stdout,'Setting pen color');
  2492. system.flush(stdout);
  2493. end;
  2494. Cnv.Pen.FPColor:=colBlack;
  2495. if FDebug then
  2496. begin
  2497. Writeln(stdout,'Palette size : ',Img.Palette.Count);
  2498. Writeln(stdout,'Setting brush style');
  2499. system.flush(stdout);
  2500. end;
  2501. cnv.brush.FPColor:=colRed;
  2502. // cnv.pen.width:=1;
  2503. // Writeln('Drawing ellipse');
  2504. Cnv.Ellipse(R);
  2505. if FDebug then
  2506. begin
  2507. Writeln(stdout,'Setting text');
  2508. Writeln(stdout,'Palette size : ',Img.Palette.Count);
  2509. end;
  2510. cnv.font.FPColor:=colred;
  2511. Inc(FH,4);
  2512. FR:=Failed/Total;
  2513. SR:=Skipped/Total;
  2514. PR:=1-(FR+SR);
  2515. Cnv.Textout(1,FH,Format('%d Failed (%3.1f%%)',[Failed,Fr*100]));
  2516. // Writeln('Palette size : ',Img.Palette.Count);
  2517. cnv.font.FPColor:=colYellow;
  2518. Cnv.Textout(1,FH*2,Format('%d Skipped (%3.1f%%)',[Skipped,SR*100]));
  2519. A1:=(Pi*2*(failed/total));
  2520. A2:=A1+(Pi*2*(Skipped/Total));
  2521. AddPie(Ra,R.Top+Ra,Ra,A1,A2,ColYellow);
  2522. cnv.font.FPColor:=colGreen;
  2523. // Writeln('Palette size : ',Img.Palette.Count);
  2524. A1:=A2;
  2525. A2:=A1+(Pi*2*((Total-(Skipped+Failed))/Total));
  2526. Cnv.Textout(1,FH*3,Format('%d Passed (%3.1f%%',[Total-Skipped-Failed,PR*100]));
  2527. AddPie(Ra,R.Top+Ra,Ra,A1,A2,ColGreen);
  2528. // Writeln('Palette size : ',Img.Palette.Count);
  2529. // Writeln('All done');
  2530. end;
  2531. begin
  2532. if paramstr(0)<>'' then
  2533. TestsuiteCGIURL:=TestsuiteURLPrefix+'cgi-bin/'+extractfilename(paramstr(0))
  2534. else
  2535. TestsuiteCGIURL:=TestsuiteURLPrefix+'cgi-bin/'+TestsuiteBin;
  2536. SDetailsURL := TestsuiteCGIURL + '?action=1&run1id=%s';
  2537. end.