utests.pp 88 KB

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