utests.pp 91 KB

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