12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077 |
- {$mode objfpc}
- {$h+}
- unit utests;
- interface
- uses
- cgiapp,
- sysutils,
- pqconnection,
- sqldb,whtml,dbwhtml,db,
- tresults,webutil,
- Classes,ftFont,fpimage,fpimgcanv,fpWritePng,fpcanvas;
- const
- TestsuiteURLPrefix='http://www.freepascal.org/testsuite/';
- TestsuiteBin='testsuite.cgi';
- ViewURL='http://svn.freepascal.org/cgi-bin/viewvc.cgi/';
- ViewRevURL='http://svn.freepascal.org/cgi-bin/viewvc.cgi?view=revision&revision=';
- TestsSubDir='/tests/';
- DataBaseSubDir='/packages/fcl-db/tests/';
- var
- TestsuiteCGIURL : string;
- Type
- { TTestSuite }
- TTestSuite = Class(TCgiApplication)
- Private
- FHTMLWriter : THtmlWriter;
- FComboBoxProducer : TComboBoxProducer;
- FDB : TSQLConnection;
- FTrans : TSQLTransaction;
- FRunID,
- FCompareRunID,
- FPreviousRunID,
- FNextRunID,
- FPrevious2RunID,
- FNext2RunID,
- FTestFileID,
- FTestFileName,
- FVersion,
- FVersionBranch,
- FCond,
- FSubmitter,
- FMachine,
- FComment,
- FCPU,
- FCategory,
- FOS : String;
- FViewVCURL : String;
- FDate : TDateTime;
- FDebug,
- FListAll,
- FNoSkipped,
- FOnlyFailed : Boolean;
- FRunSkipCount,
- FRunFailedCount,
- FRunCount : Integer;
- FAction,
- FLimit : Integer;
- FTestLastDays : Integer;
- FNeedEnd : boolean;
- procedure DumpTestInfo(Q: TSQLQuery);
- Procedure GetOverviewRowAttr(Sender : TObject; Var BGColor : String;
- Var Align : THTMLAlign; Var VAlign : THTMLValign;
- Var CustomAttr : String) ;
- Procedure GetRunRowAttr(Sender : TObject; Var BGColor : String;
- Var Align : THTMLAlign; Var VAlign : THTMLValign;
- Var CustomAttr : String) ;
- Procedure FormatFailedOverview(Sender : TObject; Var CellData : String);
- Procedure FormatTestRunOverview(Sender : TObject; Var CellData : String);
- Procedure FormatFileDetails(Sender: TObject; var CellData: String);
- Procedure FormatFileIDDetails(Sender: TObject; var CellData: String);
- Procedure FormatTestResult(Sender: TObject; var CellData: String);
- Procedure FormatSVN(Sender: TObject; var CellData: String);
- Procedure FormatSVNData(var CellData: String);
- Function FormatDetailURL(const RunIdStr, CellData : String) : string;
- Procedure DoDrawPie(Img : TFPCustomImage; Skipped,Failed,Total : Integer);
- Public
- Function CreateDataset(Qry : String) : TSQLQuery;
- Function CreateTableProducer(DS : TDataset) :TTableProducer;
- Procedure DefaultTableFromQuery(Qry,ALink : String; IncludeRecordCount : Boolean);
- Procedure ComboBoxFromQuery(Const ComboName,Qry : String);
- Procedure ComboBoxFromQuery(Const ComboName,Qry,Value : String);
- Function GetSingleTon(Const Qry : String) : String;
- Function GetOSName(ID : String) : String;
- Function GetOSID(AName : String) : String;
- Function GetCPUName(ID : String) : String;
- Function GetCPUID(AName : String) : String;
- Function GetVersionName(ID : String) : String;
- Function GetCategoryName(ID : String) : String;
- Function GetTestFileName(ID : String) : String;
- Function GetPreviousRunID(RunID : String) : String;
- Function GetNextRunID(RunID : String) : String;
- Function GetFailCount(RunID : longint) : string;
- Function InitCGIVars : Integer;
- Procedure DoRun; override;
- Procedure EmitDocType;
- Procedure EmitOverviewForm;
- Procedure EmitHistoryForm;
- Procedure ShowRunResults;
- Procedure ShowRunComparison;
- Procedure ShowOneTest;
- Procedure ShowHistory;
- Function ConnectToDB : Boolean;
- procedure DisconnectFromDB;
- Procedure EmitTitle(ATitle : String);
- Procedure EmitEnd;
- Procedure ShowRunOverview;
- Procedure CreateRunPie;
- Function ShowRunData : Boolean;
- Procedure LDump(Const St : String);
- Procedure LDumpLn(Const St : String);
- end;
- implementation
- uses
- wformat,
- dateutils;
- Const
- {$i utests.cfg}
- { if utests.cfg is missed, create one with the following contents:
- DefDatabase = 'TESTSUITE';
- DefHost = '';
- DefDBUser = ''; // fill this in when compiling.
- DefPassword = ''; // fill this in, too.
- }
- Const
- OldTestResultsTableName = 'OLDTESTRESULTS';
- NewTestResultsTableName = 'TESTRESULTS';
- LastOldTestRun = 91178;
- MaxLimit = 1000;
- const
- faction_show_overview = 0;
- faction_show_run_results = 1;
- faction_show_run_pie = 2;
- faction_show_one_test = 3;
- faction_show_history = 4;
- faction_compare_with_previous = 5;
- faction_compare_with_next = 6;
- faction_compare2_with_previous = 7;
- faction_compare2_with_next = 8;
- faction_compare_both_with_previous = 9;
- faction_compare_both_with_next = 10;
- Function TestResultsTableName(const RunId : String) : string;
- var
- RunIDVal : qword;
- Error : word;
- begin
- system.val (RunId,RunIdVal,error);
- if (error<>0) then
- result:='ErrorTable'
- else if (RunIdVal <= LastOldTestRun) then
- result:=OldTestResultsTableName
- else
- result:=NewTestResultsTableName;
- end;
- Var
- SDetailsURL : string;
- type
- known_versions = (
- ver_unknown,
- ver_1_0_10,
- ver_2_0_0,
- ver_2_0_1,
- ver_2_0_2,
- ver_2_0_3,
- ver_2_0_4,
- ver_2_0_5,
- ver_2_1_2,
- ver_2_1_4,
- ver_2_2_0,
- ver_2_2_1,
- ver_2_2_2,
- ver_2_2_3,
- ver_2_2_4,
- ver_2_2_5,
- ver_2_3_1,
- ver_2_4_0,
- ver_2_4_1,
- ver_2_4_2,
- ver_2_4_3,
- ver_2_4_4,
- ver_2_4_5,
- ver_2_5_1,
- ver_2_6_0,
- ver_2_6_1,
- ver_2_6_2,
- ver_2_6_3,
- ver_2_6_4,
- ver_2_6_5,
- ver_2_7_1,
- ver_3_0_0,
- ver_3_0_1,
- ver_3_0_2,
- ver_3_0_3,
- ver_3_0_4,
- ver_3_0_5,
- ver_3_1_1,
- ver_3_2_0,
- ver_3_2_1,
- ver_3_3_1);
- const
- ver_trunk = high (known_versions);
- const
- ver_string : array[known_versions] of string =
- (
- 'unknown',
- '1.0.10',
- '2.0.0',
- '2.0.1',
- '2.0.2',
- '2.0.3',
- '2.0.4',
- '2.0.5',
- '2.1.2',
- '2.1.4',
- '2.2.0',
- '2.2.1',
- '2.2.2',
- '2.2.3',
- '2.2.4',
- '2.2.5',
- '2.3.1',
- '2.4.0',
- '2.4.1',
- '2.4.2',
- '2.4.3',
- '2.4.4',
- '2.4.5',
- '2.5.1',
- '2.6.0',
- '2.6.1',
- '2.6.2',
- '2.6.3',
- '2.6.4',
- '2.6.5',
- '2.7.1',
- '3.0.0',
- '3.0.1',
- '3.0.2',
- '3.0.3',
- '3.0.4',
- '3.0.5',
- '3.1.1',
- '3.2.0',
- '3.2.1',
- '3.3.1'
- );
- ver_branch : array [known_versions] of string =
- (
- '',
- '',
- 'tags/release_2_0_0',
- 'branches/fixes_2_0',
- 'tags/release_2_0_2',
- 'branches/fixes_2_0',
- 'tags/release_2_0_4',
- 'branches/fixes_2_0',
- 'tags/release_2_1_2',
- 'tags/release_2_1_4',
- 'tags/release_2_2_0',
- 'branches/fixes_2_2',
- 'tags/release_2_2_2',
- 'branches/fixes_2_2',
- 'tags/release_2_2_4',
- 'branches/fixes_2_2',
- 'tags/release_2_4_0',
- 'tags/release_2_4_0',
- 'tags/release_2_4_2',
- 'tags/release_2_4_2',
- 'tags/release_2_4_4',
- 'tags/release_2_4_4',
- 'branches/fixes_2_4',
- 'tags/release_2_6_0',
- 'tags/release_2_6_0',
- 'tags/release_2_6_2',
- 'tags/release_2_6_2',
- 'tags/release_2_6_4',
- 'tags/release_2_6_4',
- 'branches/fixes_2_6',
- 'branches/release_3_0_0',
- 'branches/release_3_0_0',
- 'branches/release_3_0_2',
- 'branches/release_3_0_2',
- 'branches/release_3_0_4',
- 'branches/release_3_0_4',
- 'branches/fixes_3_0',
- 'branches/fixes_3_2',
- 'branches/fixes_3_2',
- 'branches/fixes_3_2',
- 'trunk'
- );
- Procedure TTestSuite.DoRun;
- begin
- Try
- Try
- Case InitCGIVars of
- faction_show_overview : EmitOverviewForm;
- faction_show_run_results :
- if Length(FCompareRunID) = 0 then
- ShowRunResults
- else
- ShowRunComparison;
- faction_show_run_pie : CreateRunPie;
- faction_show_one_test : ShowOneTest;
- faction_show_history : ShowHistory;
- faction_compare_with_previous :
- begin
- FCompareRunID:=FRunID;
- FRunID:=FPreviousRunID;
- ShowRunComparison;
- end;
- faction_compare_with_next :
- begin
- FCompareRunID:=FNextRunID;
- ShowRunComparison;
- end;
- faction_compare2_with_previous :
- begin
- FRunID:=FPrevious2RunID;
- ShowRunComparison;
- end;
- faction_compare2_with_next :
- begin
- FRunID:=FCompareRunID;
- FCompareRunID:=FNext2RunID;
- ShowRunComparison;
- end;
- faction_compare_both_with_previous :
- begin
- FRunID:=FPreviousRunID;
- FCompareRunID:=FPrevious2RunID;
- ShowRunComparison;
- end;
- faction_compare_both_with_next :
- begin
- FRunID:=FNextRunID;
- FCompareRunID:=FNext2RunID;
- ShowRunComparison;
- end;
- {$ifdef TEST}
- 98 :
- begin
- ///EmitOverviewForm;
- system.Writeln(stdout,'<PRE>');
- system.Writeln(stdout,'paramstr(0) is ',paramstr(0));
- system.FreeMem(pointer($ffffffff));
- system.Writeln(stdout,'</PRE>');
- system.Flush(stdout);
- end;
- 99 :
- begin
- EmitOverviewForm;
- system.Writeln(stdout,'<PRE>');
- system.Dump_stack(stdout,get_frame);
- system.Writeln(stdout,'</PRE>');
- system.Flush(stdout);
- end;
- {$endif TEST}
- end;
- finally
- EmitEnd;
- DisConnectFromDB;
- end;
- Finally
- Terminate;
- end;
- end;
- Function TTestSuite.InitCGIVars : Integer;
- Var
- S : String;
- begin
- FHtmlWriter:=THTMLWriter.Create(Response);
- FComboBoxProducer:=TComboBoxProducer.Create(Self);
- DateSeparator:='/';
- Result:=0;
- S:=RequestVariables['action'];
- if Length(S) = 0 then
- S:=RequestVariables['TESTACTION'];
- if S='View_history' then
- FAction:=faction_show_history
- else if S='Show/Compare' then
- FAction:=faction_show_run_results
- else if S='Compare_to_previous' then
- FAction:=faction_compare_with_previous
- else if S='Compare_to_next' then
- FAction:=faction_compare_with_next
- else if S='Compare_right_to_previous' then
- FAction:=faction_compare2_with_previous
- else if S='Compare_right_to_next' then
- FAction:=faction_compare2_with_next
- else if S='Compare_both_to_previous' then
- FAction:=faction_compare_both_with_previous
- else if S='Compare_both_to_next' then
- FAction:=faction_compare_both_with_next
- else
- FAction:=StrToIntDef(S,0);
- S:=RequestVariables['limit'];
- if Length(S) = 0 then
- S:=RequestVariables['TESTLIMIT'];
- FLimit:=StrToIntDef(S,50);
- if FLimit > MaxLimit then
- FLimit:=MaxLimit;
- FVersion:=RequestVariables['version'];
- if Length(FVersion) = 0 then
- FVersion:=RequestVariables['TESTVERSION'];
- TestsuiteCGIURL:=Self.ScriptName;
- SDetailsURL := TestsuiteCGIURL + '?action=1&run1id=%s';
- FOS:=RequestVariables['os'];
- if Length(FOS) = 0 then
- FOS:=RequestVariables['TESTOS'];
- FCPU:=RequestVariables['cpu'];
- if Length(FCPU) = 0 then
- FCPU:=RequestVariables['TESTCPU'];
- FCategory:=RequestVariables['category'];
- if Length(FCategory) = 0 then
- FCategory:=RequestVariables['TESTCATEGORY'];
- FCond:=RequestVariables['cond'];
- if Length(FCond) = 0 then
- FCond:=RequestVariables['TESTCOND'];
- FComment:=RequestVariables['comment'];
- if Length(FComment) = 0 then
- FComment:=RequestVariables['TESTCOMMENT'];
- FSubmitter:=RequestVariables['submitter'];
- if Length(FSubmitter) = 0 then
- FSubmitter:=RequestVariables['TESTSUBMITTER'];
- FMachine:=RequestVariables['machine'];
- if Length(FMachine) = 0 then
- FMachine:=RequestVariables['TESTMACHINE'];
- FRunID:=RequestVariables['run1id'];
- if Length(FRunID) = 0 then
- FRunID:=RequestVariables['TESTRUN'];
- S:=RequestVariables['lastdays'];
- if Length(S) = 0 then
- S:=RequestVariables['TESTLASTDAYS'];
- FTestLastDays:=StrToIntDef(S,31);
- S:=RequestVariables['date'];
- if Length(S) = 0 then
- S:=RequestVariables['TESTDATE'];
- if Length(S) > 0 then
- try
- FDate:=StrToDate(S);
- except
- FDate:=0;
- end;
- S:=RequestVariables['failedonly'];
- if Length(S) = 0 then
- S:=RequestVariables['TESTFAILEDONLY'];
- FOnlyFailed:=(S='1');
- S:=RequestVariables['noskipped'];
- if Length(S) = 0 then
- S:=RequestVariables['TESTNOSKIPPED'];
- FNoSkipped:=(S='1');
- FCompareRunID:=RequestVariables['run2id'];
- FPreviousRunID:=RequestVariables['previousrunid'];
- FNextRunID:=RequestVariables['nextrunid'];
- FPrevious2RunID:=RequestVariables['previous2runid'];
- FNext2RunID:=RequestVariables['next2runid'];
- FTestFileID:=RequestVariables['testfileid'];
- FTestFileName:=RequestVariables['testfilename'];
- FRunCount:=StrToIntDef(RequestVariables['PIETOTAL'],0);
- FRunSkipCount:=StrToIntDef(RequestVariables['PIESKIPPED'],0);
- FRunFailedCount:=StrToIntDef(RequestVariables['PIEFAILED'],0);
- S:=RequestVariables['DEBUGCGI'];
- FDebug:=(S='1');
- S:=RequestVariables['listall'];
- FListAll:=(S='1');
- Result:=FAction;
- end;
- Function TTestSuite.ConnectToDB : Boolean;
- begin
- Result:=False;
- FDB:=TPQConnection.Create(Self);
- FDB.HostName:=DefHost;
- FDB.DatabaseName:=DefDatabase;
- FDB.UserName:=DefDBUser;
- FDB.Password:=DefPassword;
- FTrans := TSQLTransaction.Create(nil);
- FTrans.DataBase := FDB;
- FDB.Transaction := FTrans;
- FDB.Connected:=True;
- Result:=True;
- { All is not the first anymore, we need to put it by default explicity }
- if Length(FOS) = 0 then
- FOS:=GetOSID('All');
- { All is not the first anymore, we need to put it by default explicity }
- if Length(FCPU) = 0 then
- FCPU:=GetCPUID('All');
- end;
- procedure TTestsuite.LDump(Const St : String);
- var
- S : String;
- ShortS : ShortString;
- i,p : longint;
- begin
- i:=length(St);
- p:=1;
- while (i>255) do
- begin
- ShortS:=copy(St,p,255);
- inc(p,255);
- dec(i,255);
- FHTMLWriter.Dump(ShortS);
- end;
- ShortS:=Copy(St,p,255);
- FHTMLWriter.Dump(ShortS);
- end;
- procedure TTestsuite.LDumpLn(Const St : String);
- begin
- LDump(St);
- LDump(LineFeed);
- end;
- procedure TTestSuite.DisconnectFromDB;
- begin
- If Assigned(FDB) then
- begin
- if (FDB.Connected) then
- FDB.Connected:=False;
- FreeAndNil(FDB);
- FreeAndNil(FTrans);
- end;
- end;
- Procedure TTestSuite.ComboBoxFromQuery(Const ComboName,Qry: String);
- begin
- ComboBoxFromQuery(ComboName,Qry,'')
- end;
- Procedure TTestSuite.ComboBoxFromQuery(Const ComboName,Qry,Value : String);
- Var
- Q : TSQLQuery;
- begin
- Q:=TSQLQuery.Create(Self);
- try
- Q.Database:=FDB;
- Q.Transaction:=FTrans;
- Q.SQL.Text:=Qry;
- Q.Open;
- FComboboxProducer.Dataset:=Q;
- FComboBoxProducer.ValueField:=Q.Fields[0].FieldName;
- FComboBoxProducer.DataField:=Q.Fields[1].FieldName;
- FComboBoxProducer.Value:=Value;
- FComboBoxProducer.InputName:=ComboName;
- FComboBoxProducer.CreateComboBox(Response);
- Finally
- Q.Free;
- end;
- end;
- Function TTestSuite.GetSingleton(Const Qry : String) : String;
- Var
- Q : TSQLQuery;
- begin
- Result:='';
- if FDEbug then
- begin
- system.Writeln('Query=',Qry);
- system.flush(output);
- end;
- Q:=TSQLQuery.Create(Self);
- try
- Q.Database:=FDB;
- Q.Transaction:=FTrans;
- Q.SQL.Text:=Qry;
- Q.Open;
- Try
- if FDebug and (Q.FieldCount<>1) then
- begin
- system.Writeln('GetSingleton number of fields is not 1, but ',
- Q.FieldCount);
- system.flush(output);
- end;
- If Not (Q.EOF and Q.BOF) then
- Result:=Q.Fields[0].AsString;
- Finally
- Q.Close;
- end;
- finally
- Q.Free;
- end;
- end;
- Procedure TTestSuite.EmitTitle(ATitle : String);
- Var
- S : TStrings;
- begin
- AddResponseLn('<HTML>');
- AddResponseLn('<TITLE>'+ATitle+'</TITLE>');
- AddResponseLn('<BODY>');
- FNeedEnd:=true;
- end;
- Procedure TTestSuite.EmitDocType;
- begin
- AddResponseLn('<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" '+
- '"http://www.w3.org/TR/html4/loose.dtd">');
- end;
- Procedure TTestSuite.EmitOverviewForm;
- begin
- ConnectToDB;
- ContentType:='text/html';
- EmitContentType;
- EmitDocType;
- EmitTitle(Title);
- With FHTMLWriter do
- begin
- HeaderStart(1);
- DumpLn('View Test suite results');
- HeaderEnd(1);
- DumpLn('Please specify search criteria:');
- FormStart(TestsuiteCGIURL,'');
- if FDebug then
- EmitHiddenVar('DEBUGCGI', '1');
- TableStart(2,true);
- RowStart;
- CellStart;
- DumpLn('Operating system:');
- CellNext;
- ComboBoxFromQuery('os','SELECT TO_ID,TO_NAME FROM TESTOS ORDER BY TO_NAME',FOS);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Processor:');
- CellNext;
- ComboBoxFromQuery('cpu','SELECT TC_ID,TC_NAME FROM TESTCPU ORDER BY TC_NAME',FCPU);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Version');
- CellNext;
- ComboBoxFromQuery('version','SELECT TV_ID,TV_VERSION FROM TESTVERSION ORDER BY TV_VERSION DESC',FVERSION);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Date');
- CellNext;
- If (FDate=0) then
- EmitInput('date','')
- else
- EmitInput('date',DateToStr(FDate));
- CellEnd;
- //if FDebug then
- begin
- RowNext;
- CellStart;
- DumpLn('Submitter');
- CellNext;
- If (FSubmitter='') then
- EmitInput('submitter','')
- else
- EmitInput('submitter',FSubmitter);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Machine');
- CellNext;
- If (FMachine='') then
- EmitInput('machine','')
- else
- EmitInput('machine',FMachine);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Comment');
- CellNext;
- If (FComment='') then
- EmitInput('comment','')
- else
- EmitInput('comment',FComment);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Cond');
- CellNext;
- If (FCond='') then
- EmitInput('cond','')
- else
- EmitInput('cond',FCond);
- CellEnd;
- end;
- RowNext;
- CellStart;
- DumpLn('Category');
- CellNext;
- ComboBoxFromQuery('Category','SELECT TCAT_ID,TCAT_NAME FROM TESTCATEGORY ORDER BY TCAT_NAME',FCategory);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Only failed tests');
- CellNext;
- EmitCheckBox('failedonly','1',FonlyFailed);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Hide skipped tests');
- CellNext;
- EmitCheckBox('noskipped','1',FNoSkipped);
- CellEnd;
- RowEnd;
- TableEnd;
- ParaGraphStart;
- EmitSubmitButton('','Search');
- EmitSubmitButton('action','View history');
- EmitResetButton('','Reset form');
- FormEnd;
- end;
- ShowRunOverview;
- end;
- Procedure TTestSuite.EmitHistoryForm;
- begin
- ConnectToDB;
- ContentType:='text/html';
- EmitContentType;
- EmitDocType;
- EmitTitle(Title);
- With FHTMLWriter do
- begin
- HeaderStart(1);
- DumpLn('View Test suite results');
- HeaderEnd(1);
- DumpLn('Please specify search criteria:');
- FormStart(TestsuiteCGIURL,'');
- if FDebug then
- EmitHiddenVar('DEBUGCGI', '1');
- EmitHiddenVar('action',IntToStr(faction_show_history));
- TableStart(2,true);
- RowStart;
- CellStart;
- DumpLn('File:');
- CellNext;
- EmitInput('testfilename',FTestfilename);
- CellEnd;
- RowNext;
- (* CellStart;
- DumpLn('FileID:');
- CellNext;
- EmitInput('testfileid',FTestfileid);
- CellEnd;
- RowNext; *)
- CellStart;
- DumpLn('Operating system:');
- CellNext;
- ComboBoxFromQuery('os','SELECT TO_ID,TO_NAME FROM TESTOS ORDER BY TO_NAME',FOS);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Processor:');
- CellNext;
- ComboBoxFromQuery('cpu','SELECT TC_ID,TC_NAME FROM TESTCPU ORDER BY TC_NAME',FCPU);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Version');
- CellNext;
- ComboBoxFromQuery('version','SELECT TV_ID,TV_VERSION FROM TESTVERSION ORDER BY TV_VERSION DESC',FVERSION);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Date');
- CellNext;
- If (FDate=0) then
- EmitInput('date','')
- else
- EmitInput('date',DateToStr(FDate));
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Submitter');
- CellNext;
- If (FSubmitter='') then
- EmitInput('submitter','')
- else
- EmitInput('submitter',FSubmitter);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Machine');
- CellNext;
- If (FMachine='') then
- EmitInput('machine','')
- else
- EmitInput('machine',FMachine);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Comment');
- CellNext;
- If (FComment='') then
- EmitInput('comment','')
- else
- EmitInput('comment',FComment);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Limit');
- CellNext;
- EmitInput('limit',IntToStr(FLimit));
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Cond');
- CellNext;
- If (FCond='') then
- EmitInput('cond','')
- else
- EmitInput('cond',FCond);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Category');
- CellNext;
- ComboBoxFromQuery('Category','SELECT TCAT_ID,TCAT_NAME FROM TESTCATEGORY ORDER BY TCAT_NAME',FCategory);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Only failed tests');
- CellNext;
- EmitCheckBox('failedonly','1',FonlyFailed);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Hide skipped tests');
- CellNext;
- EmitCheckBox('noskipped','1',FNoSkipped);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('List all tests');
- CellNext;
- EmitCheckBox('listall','1',FListAll);
- CellEnd;
- RowEnd;
- TableEnd;
- ParaGraphStart;
- if FDebug then
- EmitHiddenVar('DEBUGCGI', '1');
- EmitSubmitButton('','Search');
- EmitResetButton('','Reset form');
- FormEnd;
- end;
- end;
- procedure TTestSuite.EmitEnd;
- begin
- if not FNeedEnd then
- exit;
- AddResponseLn('</BODY>');
- AddResponseLn('</HTML>');
- end;
- procedure TTestSuite.GetOverviewRowAttr(Sender: TObject; var BGColor: String;
- var Align: THTMLAlign; var VAlign: THTMLValign; var CustomAttr: String);
- begin
- If ((Sender as TTAbleProducer).CurrentRow mod 2=0) then
- BGColor:='#EEEEEE'
- end;
- Function TTestSuite.CreateDataset(Qry : String) : TSQLQuery;
- begin
- Result:=TSQLQuery.Create(Self);
- With Result do
- begin
- Database:=FDB;
- Transaction := FTrans;
- SQL.Text:=Qry;
- end;
- end;
- Function TTestSuite.CreateTableProducer(DS : TDataset) :TTableProducer;
- begin
- Result:=TTableProducer.Create(Self);
- Result.Dataset:=DS;
- end;
- Procedure TTestSuite.DefaultTableFromQuery(Qry,Alink : String; IncludeRecordCount : Boolean);
- Var
- Q : TSQLQuery;
- begin
- If FDebug then
- Writeln('Query : '+Qry);
- Q:=CreateDataset(Qry);
- With Q do
- try
- Open;
- Try
- With CreateTableProducer(Q) do
- Try
- Border:=True;
- If (Alink<>'') then
- begin
- CreateColumns(Nil);
- If TableColumns.Count>0 then
- (TableColumns.Items[0] as TTableColumn).ActionURL:=ALink;
- end;
- CreateTable(Response);
- Finally
- Free;
- end;
- If IncludeRecordCount then
- FHTMLWriter.DumpLn(Format('<p>Record count: %d </p>',[Q.RecordCount]));
- Finally
- Close;
- end;
- finally
- Free;
- end;
- end;
- Procedure TTestSuite.ShowRunOverview;
- Const
- SOverview = 'SELECT TU_ID as ID,TU_DATE as Date,TC_NAME as CPU,TO_NAME as OS,'+
- 'TV_VERSION as Version,(select count(*) from testresults where (TR_TESTRUN_FK=TU_ID)) as Count,'+
- 'TU_SVNCOMPILERREVISION as SvnCompRev,'+
- 'TU_SVNRTLREVISION as SvnRTLRev,'+
- 'TU_SVNPACKAGESREVISION as SvnPackRev,TU_SVNTESTSREVISION as SvnTestsRev,'+
- '(TU_SUCCESSFULLYFAILED+TU_SUCCESFULLYCOMPILED+TU_SUCCESSFULLYRUN) AS OK,'+
- '(TU_FAILEDTOCOMPILE+TU_FAILEDTORUN+TU_FAILEDTOFAIL) as Failed,'+
- '(TU_SUCCESSFULLYFAILED+TU_SUCCESFULLYCOMPILED+TU_SUCCESSFULLYRUN+'+
- 'TU_FAILEDTOCOMPILE+TU_FAILEDTORUN+TU_FAILEDTOFAIL) as Total,'+
- 'TU_SUBMITTER as Submitter, TU_MACHINE as Machine, TU_COMMENT as Comment %s '+
- 'FROM '+
- ' TESTRUN '+
- ' left join TESTCPU on (TC_ID=TU_CPU_FK) '+
- ' left join TESTOS on (TO_ID=TU_OS_FK) '+
- ' left join TESTVERSION on (TV_ID=TU_VERSION_FK) '+
- ' left join TESTCATEGORY on (TCAT_ID=TU_CATEGORY_FK) '+
- '%s'+
- 'ORDER BY TU_ID DESC LIMIT %d';
- Var
- SC,S,A,Qry : String;
- Q : TSQLQuery;
- begin
- S:='';
- If (FCPU<>'') and (GetCPUName(FCPU)<>'All') then
- S:=S+' AND (TU_CPU_FK='+FCPU+')';
- If (FCategory<>'') and (GetCategoryName(FCategory)<>'All') then
- S:=S+' AND (TU_CATEGORY_FK='+FCategory+')';
- If (FVersion<>'') and (GetVersionName(FVersion)<>'All') then
- S:=S+' AND (TU_VERSION_FK='+FVERSION+')';
- if (FOS<>'') and (GetOSName(FOS)<>'All') then
- S:=S+' AND (TU_OS_FK='+FOS+')';
- If (Round(FDate)<>0) then
- S:=S+' AND (to_char(TU_DATE, ''YYYY-MM-DD'') LIKE '''+FormatDateTime('YYYY-MM-DD',FDate)+'%'')';
- If FSubmitter<>'' then
- S:=S+' AND (TU_SUBMITTER='''+FSubmitter+''')';
- If FMachine<>'' then
- S:=S+' AND (TU_MACHINE='''+FMachine+''')';
- If FComment<>'' then
- S:=S+' AND (TU_COMMENT LIKE '''+Fcomment+''')';
- If FCond<>'' then
- S:=S+' AND ('+FCond+')';
- If GetCategoryName(FCategory)<>'DB' then
- SC:=', CONCAT(TU_SVNCOMPILERREVISION,''/'',TU_SVNRTLREVISION,''/'', '+
- 'TU_SVNPACKAGESREVISION,''/'',TU_SVNTESTSREVISION) as svnrev'
- else
- SC:='';
- If (FCategory='') or (GetCategoryName(FCategory)='All') then
- SC:=SC+', TCAT_NAME as Cat';
- A:=SDetailsURL;
- If FOnlyFailed then
- A:=A+'&failedonly=1';
- If FNoSkipped then
- A:=A+'&noskipped=1';
-
- if S <> '' then
- begin
- Delete(S, 1, 4);
- S:='WHERE '+ S + ' ';
- end;
- Qry:=Format(SOverview,[SC,S,FLimit]);
- If FDebug then
- Writeln('Query : '+Qry);
- Q:=CreateDataset(Qry);
- With Q do
- try
- Open;
- Try
- With CreateTableProducer(Q) do
- Try
- Border:=True;
- OnGetRowAttributes:=@GetOverViewRowAttr;
- CreateColumns(Nil);
- TableColumns.ColumnByName('ID').ActionURL:=A;
- TableColumns.ColumnByNAme('Failed').OnGetCellContents:=@FormatFailedOverview;
- TableColumns.ColumnByNAme('svnrev').OnGetCellContents:=@FormatSVN;
- CreateTable(Response);
- Finally
- Free;
- end;
- FHTMLWriter.DumpLn(Format('<p>Record count: %d</p>',[Q.RecordCount]));
- Finally
- Close;
- end;
- finally
- Free;
- end;
- end;
- Function TTestSuite.GetOSName(ID : String) : String;
- begin
- if (ID<>'') then
- Result:=GetSingleTon('SELECT TO_NAME FROM TESTOS WHERE TO_ID='+ID)
- else
- Result:='';
- end;
- Function TTestSuite.GetOSID(AName : String) : String;
- begin
- if (AName<>'') then
- Result:=GetSingleTon('SELECT TO_ID FROM TESTOS WHERE TO_NAME='''+Aname+'''')
- else
- Result:='';
- end;
- Function TTestSuite.GetTestFileName(ID : String) : String;
- begin
- if (ID<>'') then
- Result:=GetSingleTon('SELECT T_NAME FROM TESTS WHERE T_ID='+ID)
- else
- Result:='';
- end;
- Function TTestsuite.GetFailCount(RunID : longint) : string;
- begin
- if RunID<>0 then
- Result:=GetSingleTon('SELECT (TU_FAILEDTOCOMPILE + TU_FAILEDTOFAIL + TU_FAILEDTORUN) FROM TESTRUN WHERE TU_ID='+IntToStr(RunID))
- else
- Result:='';
- end;
- Function TTestSuite.GetCPUName(ID : String) : String;
- begin
- if (ID<>'') then
- Result:=GetSingleTon('SELECT TC_NAME FROM TESTCPU WHERE TC_ID='+ID)
- else
- Result:='';
- end;
- Function TTestSuite.GetCPUID(AName : String) : String;
- begin
- if (AName<>'') then
- Result:=GetSingleTon('SELECT TC_ID FROM TESTCPU WHERE TC_NAME='''+AName+'''')
- else
- Result:='';
- end;
- Function TTestSuite.GetVersionName(ID : String) : String;
- begin
- if (ID<>'') then
- Result:=GetSingleton('SELECT TV_VERSION FROM TESTVERSION WHERE TV_ID='+ID)
- else
- Result:='';
- end;
- Function TTestSuite.GetCategoryName(ID : String) : String;
- begin
- if (ID<>'') then
- Result:=GetSingleton('SELECT TCAT_NAME FROM TESTCATEGORY WHERE TCAT_ID='+ID)
- else
- Result:='';
- end;
- Function TTestSuite.GetPreviousRunID(RunID : String) : String;
- begin
- if (RunID<>'') then
- Result:=GetSingleton('SELECT TH_PREVIOUS_FK FROM TESTRUNHISTORY WHERE TH_ID_FK='+RunID)
- else
- Result:='';
- end;
- Function TTestSuite.GetNextRunID(RunID : String) : String;
- begin
- if (RunID<>'') then
- Result:=GetSingleton('SELECT TH_ID_FK FROM TESTRUNHISTORY WHERE TH_PREVIOUS_FK='+RunID)
- else
- Result:='';
- end;
- Function TTestSuite.ShowRunData : Boolean;
- Const
- SGetRunData = 'SELECT TU_ID,TU_DATE,TC_NAME,TO_NAME,' +
- 'TU_SUBMITTER,TU_MACHINE,TU_COMMENT,TV_VERSION,'+
- 'TU_CATEGORY_FK,TU_SVNCOMPILERREVISION,TU_SVNRTLREVISION,'+
- 'TU_COMPILERDATE,'+
- 'TU_SVNPACKAGESREVISION,TU_SVNTESTSREVISION,'+
- '(TU_SUCCESSFULLYFAILED+TU_SUCCESFULLYCOMPILED+TU_SUCCESSFULLYRUN) AS OK,'+
- '(TU_FAILEDTOCOMPILE+TU_FAILEDTORUN+TU_FAILEDTOFAIL) as Failed,'+
- '(TU_SUCCESSFULLYFAILED+TU_SUCCESFULLYCOMPILED+TU_SUCCESSFULLYRUN+'+
- 'TU_FAILEDTOCOMPILE+TU_FAILEDTORUN+TU_FAILEDTOFAIL) as Total'+
- ' %s FROM TESTRUN,TESTCPU,TESTOS,TESTVERSION '+
- 'WHERE '+
- ' (TC_ID=TU_CPU_FK) AND '+
- ' (TO_ID=TU_OS_FK) AND '+
- ' (TV_ID=TU_VERSION_FK) AND '+
- ' (TU_ID=%s)';
- Var
- Q1,Q2 : TSQLQuery;
- F : TField;
- SC : string;
- Date1, Date2: TDateTime;
- AddNewPar : boolean;
- CompilerDate1, CompilerDate2: TDateTime;
- begin
- Result:=(FRunID<>'');
- If Result then
- begin
- If GetCategoryName(FCategory)<>'DB' then
- SC:=', CONCAT(TU_SVNCOMPILERREVISION,''/'',TU_SVNRTLREVISION,''/'', '+
- 'TU_SVNPACKAGESREVISION,''/'',TU_SVNTESTSREVISION) as svnrev'
- else
- SC:='';
- If GetCategoryName(FCategory)='All' then
- SC:=SC+', TCAT_NAME as Cat';
- Q1:=CreateDataset(Format(SGetRunData,[SC,FRunID]));
- if Length(FCompareRunID) > 0 then
- Q2:=CreateDataset(Format(SGetRunData,[SC,FCompareRunID]))
- else
- Q2:=nil;
- Try
- Q1.Open;
- if Q2 <> nil then
- Q2.Open;
- Result:=Not (Q1.EOF and Q1.BOF);
- If Result then
- With FHTMLWriter do
- begin
- FormStart(TestsuiteCGIURL,'get');
- TableStart(3,true);
- RowStart;
- CellStart;
- DumpLn('Run ID:');
- CellNext;
- EmitInput('run1id',FRunID);
- CellNext;
- EmitInput('run2id',FCompareRunID);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Operating system:');
- CellNext;
- DumpLn(Q1.FieldByName('TO_NAME').AsString);
- CellNext;
- if Q2 <> nil then
- DumpLn(Q2.FieldByName('TO_NAME').AsString);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Processor:');
- CellNext;
- DumpLn(Q1.FieldByName('TC_NAME').AsString);
- CellNext;
- if Q2 <> nil then
- DumpLn(Q2.FieldByName('TC_NAME').AsString);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Version:');
- CellNext;
- DumpLn(Q1.FieldByNAme('TV_VERSION').AsString);
- CellNext;
- if Q2 <> nil then
- DumpLn(Q2.FieldByNAme('TV_VERSION').AsString);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Fails/OK/Total:');
- CellNext;
- Dump(Q1.FieldByName('Failed').AsString);
- Dump('/'+Q1.FieldByName('OK').AsString);
- DumpLn('/'+Q1.FieldByName('Total').AsString);
- CellNext;
- if Q2 <> nil then
- begin
- Dump(Q2.FieldByName('Failed').AsString);
- Dump('/'+Q2.FieldByName('Ok').AsString);
- DumpLn('/'+Q2.FieldByName('Total').AsString);
- end;
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Comment:');
- CellNext;
- DumpLn(Q1.FieldByName('TU_COMMENT').AsString);
- CellNext;
- if Q2 <> nil then
- DumpLn(Q2.FieldByName('TU_COMMENT').AsString);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Machine:');
- CellNext;
- DumpLn(Q1.FieldByName('TU_MACHINE').AsString);
- CellNext;
- if Q2 <> nil then
- DumpLn(Q2.FieldByName('TU_MACHINE').AsString);
- CellEnd;
- if GetCategoryName(FCategory)<>'All' then
- begin
- RowNext;
- CellStart;
- DumpLn('Category:');
- CellNext;
- DumpLn(GetCategoryName(Q1.FieldByName('TU_CATEGORY_FK').AsString));
- CellNext;
- if Q2 <> nil then
- DumpLn(GetCategoryName(Q2.FieldByName('TU_CATEGORY_FK').AsString));
- CellEnd;
- end;
- If GetCategoryName(FCategory)<>'DB' then
- begin
- RowNext;
- CellStart;
- DumpLn('SVN Revisions:');
- CellNext;
- SC:=Q1.FieldByName('svnrev').AsString;
- if (SC<>'') then
- FormatSVNData(SC);
- LDumpLn(SC);
- CellNext;
- if Q2 <> nil then
- begin
- SC:=Q2.FieldByName('svnrev').AsString;
- FormatSVNData(SC);
- LDumpLn(SC);
- end;
- CellEnd;
- end;
- RowNext;
- CellStart;
- DumpLn('Submitter:');
- CellNext;
- DumpLn(Q1.FieldByName('TU_SUBMITTER').AsString);
- CellNext;
- if Q2 <> nil then
- DumpLn(Q2.FieldByName('TU_SUBMITTER').AsString);
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Date:');
- CellNext;
- F := Q1.FieldByName('TU_DATE');
- Date1 := F.AsDateTime;
- DumpLn(F.AsString);
- F := Q1.FieldByName('TU_COMPILERDATE');
- Try
- CompilerDate1 := F.AsDateTime;
- if not SameDate(Date1,CompilerDate1) then
- DumpLn(' <> '+F.AsString);
- Except
- { Not a valid date, do nothing }
- end;
- CellNext;
- if Q2 <> nil then
- begin
- F := Q2.FieldByName('TU_DATE');
- Date2 := F.AsDateTime;
- DumpLn(F.AsString);
- F := Q2.FieldByName('TU_COMPILERDATE');
- Try
- CompilerDate2 := F.AsDateTime;
- if not SameDate(Date2,CompilerDate2) then
- DumpLn(' <> '+F.AsString);
- Except
- { Not a valid date, do nothing }
- end;
- end;
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Previous run:');
- CellNext;
- FPreviousRunID:=GetPreviousRunID(FRunID);
- if FPreviousRunID<>'' then
- EmitHiddenVar('previousrunid',FPreviousRunID);
- DumpLn(FPreviousRunID);
- CellNext;
- if (FCompareRunID<>'') then
- begin
- FPrevious2RunID:=GetPreviousRunID(FCompareRunID);
- DumpLn(FPrevious2RunID);
- if FPrevious2RunID <> '' then
- EmitHiddenVar('previous2runid',FPrevious2RunID);
- end;
- CellEnd;
- RowNext;
- CellStart;
- DumpLn('Next run:');
- CellNext;
- FNextRunID:=GetNextRunID(FRunID);
- if FNextRunID<>'' then
- EmitHiddenVar('nextrunid',FNextRunID);
- DumpLn(FNextRunID);
- CellNext;
- if (FCompareRunID<>'') then
- begin
- FNext2RunID:=GetNextRunID(FCompareRunID);
- DumpLn(FNext2RunID);
- if FNext2RunID <> '' then
- EmitHiddenVar('next2runid',FNext2RunID);
- end;
- CellEnd;
- RowEnd;
- TableEnd;
- ParagraphStart;
- if FDebug then
- EmitHiddenVar('DEBUGCGI', '1');
- EmitCheckBox('noskipped','1',FNoSkipped);
- DumpLn(' Hide skipped tests');
- ParagraphEnd;
- ParagraphStart;
- EmitCheckBox('failedonly','1',FonlyFailed);
- DumpLn(' Hide successful tests');
- ParagraphEnd;
- ParaGraphStart;
- AddNewPar:=false;
- if FPreviousRunID<>'' then
- begin
- EmitSubmitButton('action','Compare_to_previous');
- AddNewPar:=true;
- end;
- if (FNextRunID<>'') and (FNextRunID <> FCompareRunID) then
- begin
- EmitSubmitButton('action','Compare_to_next');
- AddNewPar:=true;
- end;
- if (FPrevious2RunID<>'') and (FPrevious2RunID <> FRunID) then
- begin
- EmitSubmitButton('action','Compare_right_to_previous');
- AddNewPar:=true;
- end;
- if FNext2RunID<>'' then
- begin
- EmitSubmitButton('action','Compare_right_to_next');
- AddNewPar:=true;
- end;
- if AddNewPar then
- begin
- ParagraphEnd;
- ParaGraphStart;
- end;
-
- if (FPrevious2RunID<>'') and (FPreviousRunId<>'') then
- begin
- EmitSubmitButton('action','Compare_both_to_previous');
- AddNewPar:=true;
- end;
- if (FNext2RunID<>'') and (FNextRunId<>'') then
- begin
- EmitSubmitButton('action','Compare_both_to_next');
- AddNewPar:=true;
- end;
- if AddNewPar then
- begin
- ParagraphEnd;
- ParaGraphStart;
- end;
- EmitSubmitButton('action','Show/Compare');
- if FTestFileID<>'' then
- EmitSubmitButton('action','View_history');
- EmitResetButton('','Reset form');
- ParagraphEnd;
- FormEnd;
- { give warning if dates reversed }
- if (Q2 <> nil) and (Date1 > Date2) then
- begin
- ParagraphStart;
- DumpLn('Warning: testruns are not compared in chronological order.');
- ParagraphEnd;
- end;
- end;
- Finally
- Q1.Close;
- Q1.Free;
- if Q2 <> nil then
- begin
- Q2.Close;
- Q2.Free;
- end;
- end;
- end;
- end;
- Procedure TTestSuite.ShowRunResults;
- Var
- S : String;
- Qry : String;
- Q : TSQLQuery;
- FL : String;
- begin
- ConnectToDB;
- ContentType:='text/html';
- EmitContentType;
- EmitDocType;
- EmitTitle(Title+' : Search Results');
- With FHTMLWriter do
- begin
- HeaderStart(1);
- DumpLn('Test suite results for run '+FRunID);
- HeaderEnd(1);
- HeaderStart(2);
- DumpLn('Test run data : ');
- HeaderEnd(2);
- If ShowRunData then
- begin
- HeaderStart(2);
- DumpLn('Detailed test run results:');
- FL:='';
- If FOnlyFailed or FNoSkipped then
- begin
- FL:='';
- If FOnlyFailed then
- FL:='successful';
- if FNoSkipped then
- begin
- If (FL<>'') then
- FL:=FL+' and ';
- FL:=FL+'skipped';
- end;
- DumpLn(' ('+FL+' tests are hidden)');
- end;
- HeaderEnd(2);
- S:='SELECT T_ID as Id,T_NAME as Filename,TR_SKIP as Skipped'
- +',TR_OK as OK,TR_RESULT as Result'
- +' FROM '+TESTRESULTSTableName(FRunID)+',TESTS'
- +' WHERE (TR_TEST_FK=T_ID) AND (TR_TESTRUN_FK='+FRunID+') ';
- If FOnlyFailed then
- S:=S+' AND (not TR_OK)';
- If FNoSkipped then
- S:=S+' AND (not TR_SKIP)';
- S:=S+' ORDER BY TR_ID ';
- Qry:=S;
- If FDebug then
- begin
- ParaGraphStart;
- Dumpln('Query : '+Qry);
- ParaGraphEnd;
- end;
- FRunCount:=0;
- FRunSkipCount:=0;
- FRunFailedCount:=0;
- Q:=CreateDataset(Qry);
- With Q do
- try
- Open;
- while not EOF do
- Next;
- RecNo:=1;
- DumpLn(Format('<p>Record count: %d </p>',[Q.RecordCount]));
- Try
- With CreateTableProducer(Q) do
- Try
- Border:=True;
- FL:='Id,Filename';
- If Not FNoSkipped then
- FL:=FL+',Skipped';
- If Not FOnlyFailed then
- FL:=FL+',OK';
- FL:=FL+',Result';
- CreateColumns(FL);
- OnGetRowAttributes:=@GetRunRowAttr;
- TableColumns.ColumnByNAme('Id').OnGetCellContents:=
- @FormatFileIDDetails;
- TableColumns.ColumnByNAme('Filename').OnGetCellContents:=
- @FormatFileDetails;
- TableColumns.ColumnByNAme('Result').OnGetCellContents:=
- @FormatTestResult;
- //(TableColumns.Items[0] as TTableColumn).ActionURL:=ALink;
- CreateTable(Response);
- Finally
- Free;
- end;
- Finally
- Close;
- end;
- finally
- Free;
- end;
- If Not (FRunCount=0) and not (FNoSkipped or FOnlyFailed) then
- begin
- ParaGraphStart;
- TagStart('IMG',Format('Src="'+TestsuiteCGIURL+
- '?action=2&pietotal=%d&piefailed=%d&pieskipped=%d"'+
- ' ALT="total=%d, failed=%d, skipped=%d"',
- [FRunCount,FRunFailedCount,FRunSkipCount,
- FRunCount,FRunFailedCount,FRunSkipCount
- ]));
- end;
- end
- else
- DumpLn('No data for test run with ID: '+FRunID);
- end;
- end;
- Procedure TTestSuite.DumpTestInfo(Q : TSQLQuery);
- Var
- I : Integer;
- field_displayed : boolean;
- FieldValue,FieldName : String;
- begin
- With FHTMLWriter do
- For i:=0 to Q.FieldCount-1 do
- begin
- FieldValue:=Q.Fields[i].AsString;
- FieldName:=Q.Fields[i].DisplayName;
- field_displayed:=false;
- if (Not Q.fields[i].IsNull) and (FieldName<>'t_name') and (FieldName<>'t_source') then
- begin
- if (Q.Fields[i].Datatype=ftBoolean) then
- begin
- if Q.Fields[i].AsBoolean then
- begin
- DumpLn('Flag ');
- DumpLn(FieldName);
- DumpLn(' set');
- field_displayed:=true;
- end;
- end
- else if FieldValue<>'' then
- begin
- DumpLn(FieldName);
- DumpLn(' ');
- DumpLn(FieldValue);
- field_displayed:=true;
- end;
- if field_displayed then
- DumpLn('<BR>');
- end;
- end;
- end;
- Procedure TTestSuite.ShowOneTest;
- Var
- S,S2 : String;
- Qry : String;
- Base, Category : string;
- Q : TSQLQuery;
- i : longint;
- FieldName,FieldValue,
- LLog,Source : String;
- Res : Boolean;
- ver : known_versions;
- begin
- ConnectToDB;
- ContentType:='text/html';
- EmitContentType;
- EmitDocType;
- if FTestFileID='' then
- FTestFileID:=GetSingleton('SELECT T_ID FROM TESTS WHERE T_NAME LIKE ''%'+FTestFileName+'%''');
- if FTestFileID<>'' then
- FTestFileName:=GetTestFileName(FTestFileID);
- EmitTitle(Title+' : File '+FTestFileName+' Results');
- With FHTMLWriter do
- begin
- HeaderStart(1);
- DumpLn('Test suite results for test file '+FTestFileName);
- HeaderEnd(1);
- HeaderStart(2);
- DumpLn('Test run data : ');
- HeaderEnd(2);
- if FRunID<>'' then
- begin
- Res:=ShowRunData;
- Res:=true;
- end
- else
- begin
- // This is useless as it is now
- // It should be integrated into a form probably PM
- DumpLn('Only failed tests');
- EmitCheckBox('failedonly','1',FonlyFailed);
- DumpLn('Hide skipped tests');
- EmitCheckBox('noskipped','1',FNoSkipped);
- Res:=true;
- end;
- If Res then
- begin
- HeaderStart(2);
- DumpLn('Test file "'+FTestFileName+'" information:');
- HeaderEnd(2);
- ParaGraphStart;
- if FTestFileID<>'' then
- S:='SELECT * FROM TESTS WHERE T_ID='+FTestFileID
- else
- S:='SELECT * FROM TESTS WHERE T_NAME='+FTestFileName;
- Q:=CreateDataSet(S);
- With Q do
- Try
- Open;
- Try
- DumpTestInfo(Q);
- Finally
- Close;
- end;
- Finally
- Free;
- end;
- ParaGraphEnd;
- HeaderStart(2);
- DumpLn('Detailed test run results:');
- HeaderEnd(2);
- S:='SELECT TR_ID,TR_TESTRUN_FK AS RUN,TR_TEST_FK,TR_OK, TR_SKIP,TR_RESULT '
- //S:='SELECT * '
- +' FROM '+TESTRESULTSTableName(FRunID)
- +' WHERE (TR_TEST_FK='+FTestFileID+')';
- If FOnlyFailed then
- S:=S+' AND (TR_OK="-")';
- if Fcomparerunid<>'' then
- begin
- if TESTRESULTSTableName(FRunID)<>TESTRESULTSTableName(FCompareRunID) then
- begin
- S2:='SELECT TR_ID,TR_TESTRUN_FK AS RUN,TR_TEST_FK,TR_OK, TR_SKIP,TR_RESULT '
- +' FROM '+TESTRESULTSTableName(FCompareRunID)
- +' WHERE (TR_TEST_FK='+FTestFileID+')';
- If FOnlyFailed then
- S2:=S2+' AND (TR_OK="-")';
- S:=S+' AND (TR_TESTRUN_FK='+Frunid+') UNION '+
- S2+' AND (TR_TESTRUN_FK='+Fcomparerunid+')'
- end
- else
- S:=S+' AND ((TR_TESTRUN_FK='+Frunid+') OR '+
- '(TR_TESTRUN_FK='+Fcomparerunid+'))'
- end
- else if Frunid<>'' then
- S:=S+' AND (TR_TESTRUN_FK='+Frunid+')'
- else
- S:=S+' ORDER BY TR_TESTRUN_FK DESC LIMIT '+IntToStr(FLimit);
- Qry:=S;
- If FDebug then
- begin
- ParaGraphStart;
- Dumpln('Query : '+Qry);
- ParaGraphEnd;
- end;
- FRunCount:=0;
- FRunSkipCount:=0;
- FRunFailedCount:=0;
- Q:=CreateDataset(Qry);
- With Q do
- try
- Open;
- Try
- With CreateTableProducer(Q) do
- Try
- Border:=True;
- //FL:='TR_ID,TR_TESTRUN_FK,T_NAME,T_CPU,T_VERSION';
- CreateColumns(Nil);
- TableColumns.Delete(TableColumns.ColumnByName('TR_TEST_FK').Index);
- TableColumns.ColumnByNAme('RUN').OnGetCellContents:=
- @FormatTestRunOverview;
- //OnGetRowAttributes:=@GetRunRowAttr;
- TableColumns.ColumnByNAme('TR_RESULT').OnGetCellContents:=
- @FormatTestResult;
- //(TableColumns.Items[0] as TTableColumn).ActionURL:=ALink;
- CreateTable(Response);
- Finally
- Free;
- end;
- ParaGraphStart;
- DumpLn(Format('Record count: %d',[Q.RecordCount]));
- ParaGraphEnd;
- Finally
- Close;
- end;
- finally
- Free;
- end;
- //If FDebug then
- Category:='1';
- if FRunId<>'' then
- begin
- Category:=getsingleton('select TU_CATEGORY_FK from TESTRUN where TU_ID='+FRunId);
- FVersionBranch:=GetVersionName(getsingleton('select TU_VERSION_FK from TESTRUN where TU_ID='+fRunId));
- LLog:='';
- Try
- LLog:=getsingleton('select TR_LOG from TESTRESULTS where (TR_TEST_FK='+ftestfileid
- +') and (TR_TESTRUN_FK='+frunid+')');
- if LLog<>'' then
- begin
- HeaderStart(2);
- DumpLn('Log of '+FRunId+':');
- HeaderEnd(2);
- PreformatStart;
- system.Write(LLog);
- system.flush(output);
- PreformatEnd;
- end;
- Finally
- if LLog='' then
- begin
- HeaderStart(2);
- DumpLn('No log of '+FRunId+'.');
- HeaderEnd(2);
- end;
- end;
- end;
- if FCompareRunId<>'' then
- begin
- LLog:='';
- Try
- LLog:=getsingleton('select TR_LOG from TESTRESULTS where (TR_TEST_FK='+ftestfileid
- +') and (TR_TESTRUN_FK='+fcomparerunid+')');
- if LLog<>'' then
- begin
- HeaderStart(2);
- DumpLn('Log of '+FCompareRunId+':');
- HeaderEnd(2);
- PreformatStart;
- system.Write(LLog);
- system.flush(output);
- PreformatEnd;
- end;
- Finally
- if LLog='' then
- begin
- HeaderStart(2);
- DumpLn('No log of '+FCompareRunId+'.');
- HeaderEnd(2);
- end;
- end;
- end;
- if FDebug then
- DumpLn('After Log.');
- Source:='';
- Try
- Source:=getsingleton('select T_SOURCE from TESTS where T_ID='+ftestfileid);
- if Source<>'' then
- begin
- HeaderStart(2);
- DumpLn('Source:');
- HeaderEnd(2);
- PreformatStart;
- system.Write(Source);
- system.flush(output);
- PreformatEnd;
- end;
- Finally
- Base:='trunk';
- if FVersionBranch<>'' then
- begin
- // Test all but last version, which is assumed to be trunk
- for ver:=low(known_versions) to pred(high(known_versions)) do
- if VER_String[ver]=FVersionBranch then
- begin
- base:=ver_branch[ver];
- break;
- end;
- end;
- FViewVCURL:=ViewURL+Base;
- if Category='1' then
- FViewVCUrl:=FViewVCURL+TestsSubDir
- else
- begin
- FViewVCUrl:=FViewVCURL+DataBaseSubDir;
- // This assumes that type TAnyType is
- // defined in anytype.pas source PM
- if pos('/',FTestFileName)>0 then
- FTestfilename:=lowercase(copy(FTestFilename,2,pos('/',FTestFilename)-2)+'.pas');
- end;
- if Source='' then
- begin
- HeaderStart(3);
- DumpLn('<P>No Source in TestSuite DataBase.</P>');
- DumpLn('Link to SVN view of '+
- '<A HREF="'+FViewVCURL+FTestFileName+'?view=markup'+
- '" TARGET="fpc_source"> '+FTestFileName+'</A> source. ');
- HeaderEnd(3);
- end
- else
- begin
- HeaderStart(3);
- DumpLn('Link to SVN view of '+
- '<A HREF="'+FViewVCURL+FTestFileName+'?view=markup'+
- '" TARGET="fpc_source"> '+FTestFileName+'</A> source. ');
- HeaderEnd(3);
- end;
- end;
- if FDebug then
- DumpLn('After Source.');
- end
- else
- DumpLn(Format('No data for test file with ID: %s',[FTestFileID]));
- end;
- end;
- Procedure TTestSuite.ShowHistory;
- Const
- { We already have 53 versions }
- MaxCombo = 100;
- Type
- StatusLongintArray = Array [TTestStatus] of longint;
- StatusDateTimeArray = Array [TTestStatus] of TDateTime;
- AStatusLA = Array[1..MaxCombo] of StatusLongintArray;
- AStatusDTA = Array[1..MaxCombo] of StatusDateTimeArray;
- PStatusLA = ^AStatusLA;
- PStatusDTA = ^AStatusDTA;
- Var
- S,SS,FL,cpu,version,os : String;
- date : TDateTime;
- Qry : String;
- Base, Category : string;
- Q : TSQLQuery;
- i,run_id,os_id,version_id,cpu_id : longint;
- run_ind,os_ind,version_ind,cpu_ind,
- ok_ind,skip_ind,result_ind,date_ind : longint;
- os_size, cpu_size, version_size : longint;
- os_last, cpu_last, version_last : longint;
- error : word;
- OK_count, not_OK_count,resi,
- total_count, skip_count, not_skip_count : longint;
- TS : TTestStatus;
- result_count : StatusLongintArray;
- os_count,cpu_count,version_count: PStatusLA;
- first_date, last_date : array[TTestStatus] of TDateTime;
- first_date_id, last_date_id : array[TTestStatus] of longint;
- os_first_date, os_last_date,
- cpu_first_date, cpu_last_date,
- version_first_date, version_last_date : PStatusDTA;
- os_first_date_id, os_last_date_id,
- cpu_first_date_id, cpu_last_date_id,
- version_first_date_id, version_last_date_id : PStatusLA;
- FieldName,FieldValue,
- LLog,Source : String;
- B,Res : Boolean;
- ver : known_versions;
- begin
- Res:=False;
- os_count:=nil;
- cpu_count:=nil;
- version_count:=nil;
- ConnectToDB;
- ContentType:='text/html';
- EmitContentType;
- EmitDocType;
- if (FTestFileID='') and (FTestFileName<>'') then
- begin
- FTestFileID:=GetSingleton('SELECT T_ID FROM TESTS WHERE T_NAME LIKE ''%'+
- FTestFileName+'%''');
- end;
- if FTestFileID<>'' then
- FTestFileName:=GetTestFileName(FTestFileID);
- if FTestFileName<>'' then
- EmitTitle(Title+' : File '+FTestFileName+' Results')
- else
- EmitTitle(Title+' : History overview');
- With FHTMLWriter do
- begin
- if FTestFileName<>'' then
- begin
- HeaderStart(1);
- DumpLn('Test suite results for test file '+FTestFileName);
- HeaderEnd(1);
- HeaderStart(2);
- DumpLn('Test run data : ');
- HeaderEnd(2);
- end;
- if FRunID<>'' then
- begin
- Res:=ShowRunData;
- Res:=true;
- end
- else
- begin
- // This is useless as it is now
- // It should be integrated into a form probably PM
- //DumpLn('Only failed tests');
- //EmitCheckBox('failedonly','1',FonlyFailed);
- //DumpLn('Hide skipped tests');
- //EmitCheckBox('noskipped','1',FNoSkipped);
- Res:=true;
- EmitHistoryForm;
- if FTestFileID = '' then
- with FHTMLWriter do begin
- HeaderStart(2);
- if Trim(FTestFileName) <> '' then
- DumpLn(Format('Error: No test files matching "%s" found.', [FTestFileName]))
- else
- DumpLn('Error: Please specify a test file.');
- HeaderEnd(2);
- Res:=False;
- end;
- end;
- If Res then
- begin
- if (FTestFileName<>'') then
- begin
- HeaderStart(2);
- DumpLn('Test file "'+FTestFileName+'" information:');
- HeaderEnd(2);
- ParaGraphStart;
- S:='SELECT * FROM TESTS WHERE T_ID='+FTestFileID;
- Q:=CreateDataSet(S);
- With Q do
- Try
- Open;
- Try
- DumpTestInfo(Q);
- Finally
- Close;
- end;
- Finally
- Free;
- end;
- ParaGraphEnd;
- HeaderStart(2);
- DumpLn('Detailed test run results:');
- end;
- HeaderEnd(2);
- ParaGraphStart;
- SS:='SELECT TR_ID,TR_TESTRUN_FK AS Run,TR_TEST_FK,TR_OK AS OK'
- +', TR_SKIP As Skip,TR_RESULT As Result'
- //S:='SELECT * '
- +',TC_NAME AS CPU, TV_VERSION AS Version, TO_NAME AS OS'
- +',TU_ID,TU_DATE AS Date,TU_SUBMITTER AS Submitter'
- +',(TU_FAILEDTOCOMPILE + TU_FAILEDTOFAIL + TU_FAILEDTORUN) AS Fails'
- +',TU_MACHINE AS Machine,TU_COMMENT AS Comment'
- +',TU_COMPILERDATE As CompDate'
- +',TU_SVNTESTSREVISION AS Tests_rev'
- +',TU_SVNRTLREVISION AS RTL_rev'
- +',TU_SVNCOMPILERREVISION AS Compiler_rev'
- +',TU_SVNPACKAGESREVISION AS Packages_rev'
- +',TO_ID,TC_ID,TV_ID'
- +' FROM TESTRUN '
- +' LEFT JOIN TESTRESULTS ON (TR_TESTRUN_FK=TU_ID)'
- +' LEFT JOIN TESTOS ON (TU_OS_FK=TO_ID)'
- +' LEFT JOIN TESTCPU ON (TU_CPU_FK=TC_ID)'
- +' LEFT JOIN TESTVERSION ON (TU_VERSION_FK=TV_ID)';
- S:='';
- if FTestFileID<>'' then
- S:=S+' AND (TR_TEST_FK='+FTestFileID+')';
- if FRunID<>'' then
- S:=S+' AND (TR_TESTRUN_FK='+FRunID+')';
- If FOnlyFailed then
- S:=S+' AND (NOT TR_OK)';
- If FNoSkipped then
- S:=S+' AND (NOT TR_SKIP)';
- If FCond<>'' then
- S:=S+' AND ('+FCond+')';
- If (FCPU<>'') and (GetCPUName(FCPU)<>'All') then
- begin
- S:=S+' AND (TU_CPU_FK='+FCPU+')';
- cpu_size:=0;
- end
- else
- begin
- cpu_last:=StrToInt(GetSingleton('SELECT MAX(TC_ID) FROM TESTCPU'));
- cpu_size:=Sizeof(StatusLongintArray)*(1+cpu_last);
- cpu_count:=GetMem(cpu_size);
- FillChar(cpu_count^,cpu_size,#0);
- cpu_first_date_id:=GetMem(cpu_size);
- FillChar(cpu_first_date_id^,cpu_size,#0);
- cpu_last_date_id:=GetMem(cpu_size);
- FillChar(cpu_last_date_id^,cpu_size,#0);
- cpu_first_date:=GetMem(cpu_last*SizeOf(StatusDateTimeArray));
- FillChar(cpu_first_date^,cpu_last*Sizeof(StatusDateTimeArray),#0);
- cpu_last_date:=GetMem(cpu_last*SizeOf(StatusDateTimeArray));
- FillChar(cpu_last_date^,cpu_last*Sizeof(StatusDateTimeArray),#0);
- end;
- If (FVersion<>'') and (GetVersionName(FVersion)<>'All') then
- begin
- S:=S+' AND (TU_VERSION_FK='+FVERSION+')';
- version_size:=0;
- end
- else
- begin
- version_last:=StrToInt(GetSingleton('SELECT MAX(TV_ID) FROM TESTVERSION'));
- version_size:=Sizeof(StatusLongintArray)*(1+version_last);
- version_count:=GetMem(version_size);
- FillChar(version_count^,version_size,#0);
- version_first_date_id:=GetMem(version_size);
- FillChar(version_first_date_id^,version_size,#0);
- version_last_date_id:=GetMem(version_size);
- FillChar(version_last_date_id^,version_size,#0);
- version_first_date:=GetMem(version_last*SizeOf(StatusDateTimeArray));
- FillChar(version_first_date^,version_last*Sizeof(StatusDateTimeArray),#0);
- version_last_date:=GetMem(version_last*SizeOf(StatusDateTimeArray));
- FillChar(version_last_date^,version_last*Sizeof(StatusDateTimeArray),#0);
- end;
- if (FOS<>'') and (GetOSName(FOS)<>'All') then
- begin
- S:=S+' AND (TU_OS_FK='+FOS+')';
- os_size:=0;
- end
- else
- begin
- os_last:=StrToInt(GetSingleton('SELECT MAX(TO_ID) FROM TESTOS'));
- os_size:=Sizeof(StatusLongintArray)*(1+os_last);
- os_count:=GetMem(os_size);
- FillChar(os_count^,os_size,#0);
- os_first_date_id:=GetMem(os_size);
- FillChar(os_first_date_id^,os_size,#0);
- os_last_date_id:=GetMem(os_size);
- FillChar(os_last_date_id^,os_size,#0);
- os_first_date:=GetMem(os_last*SizeOf(StatusDateTimeArray));
- FillChar(os_first_date^,os_last*Sizeof(StatusDateTimeArray),#0);
- os_last_date:=GetMem(os_last*SizeOf(StatusDateTimeArray));
- FillChar(os_last_date^,os_last*Sizeof(StatusDateTimeArray),#0);
- end;
- If FSubmitter<>'' then
- S:=S+' AND (TU_SUBMITTER='''+FSubmitter+''')';
- If FMachine<>'' then
- S:=S+' AND (TU_MACHINE='''+FMachine+''')';
- If FComment<>'' then
- S:=S+' AND (TU_COMMENT LIKE '''+FComment+''')';
- if FDATE<>0 then
- S:=S+' AND (TU_DATE >= '''+FormatDateTime('YYYY-MM-DD',FDate)+''')';
- if S <> '' then
- begin
- Delete(S, 1, 4);
- S:=SS + ' WHERE '+ S;
- end
- else
- S:=SS;
- S:=S+' ORDER BY TU_ID DESC';
- if FDATE=0 then
- S:=S+' LIMIT '+IntToStr(FLimit)
- else
- S:=S+' LIMIT '+IntToStr(MaxLimit);
- Qry:=S;
- If FDebug then
- begin
- Writeln(system.stdout,'Query : '+Qry);
- system.Flush(system.stdout);
- end;
- FRunCount:=0;
- FRunSkipCount:=0;
- FRunFailedCount:=0;
- Q:=CreateDataset(Qry);
- With Q do
- try
- Open;
- while not EOF do
- Next;
- DumpLn(Format('<p>Record count: %d </p>',[Q.RecordCount]));
- if RecordCount>0 then
- RecNo:=1;
- Try
- { if FDebug then
- begin
- Writeln(stdout,'FieldKind=',Fields[0].FieldKind);
- Writeln(stdout,'DataType=',Fields[0].DataType);
- system.flush(stdout);
- end; }
- total_count:=0;
- OK_count:=0;
- not_OK_count:=0;
- skip_count:=0;
- not_skip_count:=0;
- fillchar(Result_Count,Sizeof(Result_count),#0);
- ok_ind:=FieldByName('OK').Index;
- skip_ind:=FieldBYName('SKIP').Index;
- result_ind:=FieldByName('Result').Index;
- cpu_ind:=FieldByName('TC_ID').Index;
- os_ind:=FieldByName('TO_ID').Index;
- version_ind:=FieldByName('TV_ID').Index;
- date_ind:=FieldByName('Date').Index;
- run_ind:=FieldByName('TU_ID').Index;
- For i:=1 to Q.RecordCount do
- begin
- Q.RecNo:=i;
- inc(total_count);
- if Q.Fields[ok_ind].AsBoolean then
- inc(OK_count)
- else
- inc(not_OK_count);
- if Fields[skip_ind].AsBoolean then
- inc(skip_count)
- else
- inc(not_skip_count);
- S:=Fields[result_ind].AsString;
- cpu:=Fields[cpu_ind].ASString;
- version:=Fields[version_ind].AsString;
- os:=Fields[os_ind].AsString;
- date:=Fields[date_ind].ASDateTime;
- os_id:=Fields[os_ind].AsLongint;
- cpu_id:=Fields[cpu_ind].AsLongint;
- version_id:=Fields[version_ind].AsLongint;
- system.val(S,resi,error);
- run_id:=Fields[run_ind].ASLongint;
- if (error=0) and (Resi>=longint(FirstStatus)) and
- (Resi<=longint(LastStatus)) then
- begin
- TS:=TTestStatus(Resi);
- if Result_count[TS]=0 then
- begin
- first_date[TS]:=date;
- last_date[TS]:=date;
- first_date_id[TS]:=run_id;
- last_date_id[TS]:=run_id;
- end
- else
- begin
- if (date>last_date[TS]) then
- begin
- last_date[TS]:=date;
- last_date_id[TS]:=run_id;
- end;
- if date<first_date[TS] then
- begin
- first_date[TS]:=date;
- first_date_id[TS]:=run_id;
- end;
- end;
- inc(Result_count[TS]);
- if assigned(cpu_count) and (cpu_id<=cpu_last) then
- begin
- if cpu_count^[cpu_id,TS]=0 then
- begin
- cpu_first_date^[cpu_id,TS]:=date;
- cpu_last_date^[cpu_id,TS]:=date;
- cpu_first_date_id^[cpu_id,TS]:=run_id;
- cpu_last_date_id^[cpu_id,TS]:=run_id;
- end
- else
- begin
- if (date>cpu_last_date^[cpu_id,TS]) then
- begin
- cpu_last_date^[cpu_id,TS]:=date;
- cpu_last_date_id^[cpu_id,TS]:=run_id;
- end;
- if date<cpu_first_date^[cpu_id,TS] then
- begin
- cpu_first_date^[cpu_id,TS]:=date;
- cpu_first_date_id^[cpu_id,TS]:=run_id;
- end;
- end;
- inc(cpu_count^[cpu_id,TS]);
- end;
- if assigned(os_count) and (os_id<=os_last) then
- begin
- if os_count^[os_id,TS]=0 then
- begin
- os_first_date^[os_id,TS]:=date;
- os_last_date^[os_id,TS]:=date;
- os_first_date_id^[os_id,TS]:=run_id;
- os_last_date_id^[os_id,TS]:=run_id;
- end
- else
- begin
- if (date>os_last_date^[os_id,TS]) then
- begin
- os_last_date^[os_id,TS]:=date;
- os_last_date_id^[os_id,TS]:=run_id;
- end;
- if date<os_first_date^[os_id,TS] then
- begin
- os_first_date^[os_id,TS]:=date;
- os_first_date_id^[os_id,TS]:=run_id;
- end;
- end;
- inc(os_count^[os_id,TS]);
- end;
- if assigned(version_count) and (version_id<=version_last) then
- begin
- if version_count^[version_id,TS]=0 then
- begin
- version_first_date^[version_id,TS]:=date;
- version_last_date^[version_id,TS]:=date;
- version_first_date_id^[version_id,TS]:=run_id;
- version_last_date_id^[version_id,TS]:=run_id;
- end
- else
- begin
- if (date>version_last_date^[version_id,TS]) then
- begin
- version_last_date^[version_id,TS]:=date;
- version_last_date_id^[version_id,TS]:=run_id;
- end;
- if date<version_first_date^[version_id,TS] then
- begin
- version_first_date^[version_id,TS]:=date;
- version_first_date_id^[version_id,TS]:=run_id;
- end;
- end;
- inc(version_count^[version_id,TS]);
- end;
- end
- else if Fdebug then
- writeln(stdout,'Error for Result, S=',S);
- end;
- DumpLn(Format('<p>Total = %d </p>',[total_count]));
- if Total_count > 0 then
- DumpLn(Format('<p>OK=%d Percentage= %3.2f </p>',[OK_count,OK_count*100/total_count]));
- if Skip_count > 0 then
- DumpLn(Format('<p>Skipped=%d Percentage= %3.2f </p>',[Skip_count,Skip_count*100/total_count]));
- if total_count>0 then
- begin
- TableStart(5,True);
- RowStart;
- CellStart;
- DumpLn('Result type');
- CellNext;
- DumpLn('Cat.');
- CellNext;
- DumpLn('Count');
- CellNext;
- DumpLn('Percentage');
- CellNext;
- DumpLn('First date');
- CellNext;
- DumpLn('Last Date');
- CellEnd;
- end;
- For TS:=FirstStatus to LastStatus do
- if Result_count[TS]>0 then
- begin
- RowNext;
- CellStart;
- DumpLn(StatusText[TS]);
- CellNext;
- CellNext;
- DumpLn(Format('%d',[Result_count[TS]]));
- CellNext;
- DumpLn(Format('%3.1f',[Result_count[TS]*100/total_count]));
- CellNext;
- DumpLn(FormatDetailURL(IntToStr(first_date_id[TS]),
- DateTimeToStr(first_date[TS])));
- DumpLn(' '+GetFailCount(first_date_id[TS]));
- CellNext;
- DumpLn(FormatDetailURL(IntToStr(last_date_id[TS]),
- DateTimeToStr(last_date[TS])));
- DumpLn(' '+GetFailCount(last_date_id[TS]));
- CellEnd;
- if assigned(cpu_count) then
- begin
- for i:=1 to cpu_last do
- if cpu_count^[i,TS]>0 then
- begin
- RowNext;
- CellStart;
- CellNext;
- DumpLn(GetSingleton('SELECT TC_NAME FROM TESTCPU WHERE TC_ID='+IntToStr(i)));
- CellNext;
- DumpLn(Format('%d',[cpu_count^[i,TS]]));
- CellNext;
- DumpLn(Format('%3.1f',[cpu_count^[i,TS]*100/result_count[TS]]));
- CellNext;
- DumpLn(FormatDetailURL(IntToStr(cpu_first_date_id^[i,TS]),
- DateTimeToStr(cpu_first_date^[i,TS])));
- DumpLn(' '+GetFailCount(cpu_first_date_id^[i,TS]));
- CellNext;
- DumpLn(FormatDetailURL(IntToStr(cpu_last_date_id^[i,TS]),
- DateTimeToStr(cpu_last_date^[i,TS])));
- DumpLn(' '+GetFailCount(cpu_last_date_id^[i,TS]));
- CellEnd;
- end;
- end;
- if assigned(os_count) then
- begin
- for i:=1 to os_last do
- if os_count^[i,TS]>0 then
- begin
- RowNext;
- CellStart;
- CellNext;
- DumpLn(GetSingleton('SELECT TO_NAME FROM TESTOS WHERE TO_ID='+IntToStr(i)));
- CellNext;
- DumpLn(Format('%d',[os_count^[i,TS]]));
- CellNext;
- DumpLn(Format('%3.1f',[os_count^[i,TS]*100/result_count[TS]]));
- CellNext;
- DumpLn(FormatDetailURL(IntToStr(os_first_date_id^[i,TS]),
- DateTimeToStr(os_first_date^[i,TS])));
- DumpLn(' '+GetFailCount(os_first_date_id^[i,TS]));
- CellNext;
- DumpLn(FormatDetailURL(IntToStr(os_last_date_id^[i,TS]),
- DateTimeToStr(os_last_date^[i,TS])));
- DumpLn(' '+GetFailCount(os_last_date_id^[i,TS]));
- CellEnd;
- end;
- end;
- if assigned(version_count) then
- begin
- for i:=1 to version_last do
- if version_count^[i,TS]>0 then
- begin
- RowNext;
- CellStart;
- CellNext;
- DumpLn(GetSingleton('SELECT TV_VERSION FROM TESTVERSION WHERE TV_ID='+IntToStr(i)));
- CellNext;
- DumpLn(Format('%d',[version_count^[i,TS]]));
- CellNext;
- DumpLn(Format('%3.1f',[version_count^[i,TS]*100/result_count[TS]]));
- CellNext;
- DumpLn(FormatDetailURL(IntToStr(version_first_date_id^[i,TS]),
- DateTimeToStr(version_first_date^[i,TS])));
- DumpLn(' '+GetFailCount(version_first_date_id^[i,TS]));
- CellNext;
- DumpLn(FormatDetailURL(IntToStr(version_last_date_id^[i,TS]),
- DateTimeToStr(version_last_date^[i,TS])));
- DumpLn(' '+GetFailCount(version_last_date_id^[i,TS]));
- CellEnd;
- end;
- end;
- end;
- if total_count>0 then
- begin
- TableEnd;
- RecNo:=1;
- end;
- If FDebug or FListAll then
- begin
- With CreateTableProducer(Q) do
- Try
- Border:=True;
- FL:='RUN,Date,OK,SKIP,Result';
- if FSubmitter='' then
- FL:=FL+',Submitter';
- if FMachine='' then
- FL:=FL+',Machine';
- if Fcomment='' then
- FL:=FL+',Comment';
- if (FOS='') or (GetOSName(FOS)='All') then
- FL:=FL+',OS';
- if (FCPU='') or (GetCPUName(FCPU)='All') then
- FL:=FL+',CPU';
- if (FVersion='') or (GetVersionName(FVersion)='All') then
- FL:=FL+',Version';
- FL:=FL+',Fails,CompDate';
- FL:=FL+',Tests_rev,RTL_rev,Compiler_rev,Packages_rev';
- CreateColumns(FL);
- //TableColumns.Delete(TableColumns.ColumnByName('TR_TEST_FK').Index);
- TableColumns.ColumnByNAme('RUN').OnGetCellContents:=
- @FormatTestRunOverview;
- //OnGetRowAttributes:=@GetRunRowAttr;
- TableColumns.ColumnByNAme('Result').OnGetCellContents:=
- @FormatTestResult;
- //(TableColumns.Items[0] as TTableColumn).ActionURL:=ALink;
- CreateTable(Response);
- Finally
- Free;
- end;
- end;
- Finally
- Close;
- end;
- finally
- Free;
- end;
- //If FDebug then
- Category:='1';
- if FRunId<>'' then
- begin
- Category:=getsingleton('select TU_CATEGORY_FK from TESTRUN where TU_ID='+FRunId);
- FVersionBranch:=GetVersionName(getsingleton('select TU_VERSION_FK from TESTRUN where TU_ID='+fRunId));
- LLog:='';
- Try
- LLog:=getsingleton('select TR_LOG from TESTRESULTS where (TR_TEST_FK='+ftestfileid
- +') and (TR_TESTRUN_FK='+frunid+')');
- if LLog<>'' then
- begin
- HeaderStart(2);
- DumpLn('LLog of '+FRunId+':');
- HeaderEnd(2);
- PreformatStart;
- system.Write(LLog);
- system.flush(output);
- PreformatEnd;
- end;
- Finally
- if LLog='' then
- begin
- HeaderStart(2);
- DumpLn('No log of '+FRunId+'.');
- HeaderEnd(2);
- end;
- end;
- end;
- if FCompareRunId<>'' then
- begin
- LLog:='';
- Try
- LLog:=getsingleton('select TR_LOG from TESTRESULTS where (TR_TEST_FK='+ftestfileid
- +') and (TR_TESTRUN_FK='+fcomparerunid+')');
- if LLog<>'' then
- begin
- HeaderStart(2);
- DumpLn('Log of '+FCompareRunId+':');
- HeaderEnd(2);
- PreformatStart;
- system.Write(LLog);
- system.flush(output);
- PreformatEnd;
- end;
- Finally
- if LLog='' then
- begin
- HeaderStart(2);
- DumpLn('No log of '+FCompareRunId+'.');
- HeaderEnd(2);
- end;
- end;
- end;
- if FDebug then
- DumpLn('After log.');
- Source:='';
- Try
- if ftestfileid <> '' then
- begin
- Source:=getsingleton('select T_SOURCE from TESTS where T_ID='+ftestfileid);
- if Source<>'' then
- begin
- HeaderStart(2);
- DumpLn('Source:');
- HeaderEnd(2);
- PreformatStart;
- system.Write(Source);
- system.flush(output);
- PreformatEnd;
- end;
- end;
- Finally
- Base:='trunk';
- if FVersionBranch<>'' then
- begin
- // Test all but last version, which is assumed to be trunk
- for ver:=low(known_versions) to pred(high(known_versions)) do
- if ver_string[ver]=FVersionBranch then
- begin
- base:=ver_branch[ver];
- break;
- end;
- end;
- FViewVCURL:=ViewURL+Base;
- if Category='1' then
- FViewVCUrl:=FViewVCURL+TestsSubDir
- else
- begin
- FViewVCUrl:=FViewVCURL+DataBaseSubDir;
- // This assumes that type TAnyType is
- // defined in anytype.pas source PM
- if pos('/',FTestFileName)>0 then
- FTestfilename:=lowercase(copy(FTestFilename,2,pos('/',FTestFilename)-2)+'.pas');
- end;
- if Source='' then
- begin
- HeaderStart(3);
- DumpLn('<P>No Source in TestSuite DataBase.</P>');
- DumpLn('Link to SVN view of '+
- '<A HREF="'+FViewVCURL+FTestFileName+'?view=markup'+
- '" TARGET="fpc_source"> '+FTestFileName+'</A> source. ');
- HeaderEnd(3);
- end
- else
- begin
- HeaderStart(3);
- DumpLn('Link to SVN view of '+
- '<A HREF="'+FViewVCURL+FTestFileName+'?view=markup'+
- '" TARGET="fpc_source"> '+FTestFileName+'</A> source. ');
- HeaderEnd(3);
- end;
- end;
- if FDebug then
- DumpLn('After Source.');
- end;
- end;
- if assigned(os_count) then
- begin
- FreeMem(os_count);
- FreeMem(os_first_date);
- FreeMem(os_first_date_id);
- FreeMem(os_last_date);
- FreeMem(os_last_date_id);
- end;
- if assigned(cpu_count) then
- begin
- FreeMem(cpu_count);
- FreeMem(cpu_first_date);
- FreeMem(cpu_first_date_id);
- FreeMem(cpu_last_date);
- FreeMem(cpu_last_date_id);
- end;
- if assigned(version_count) then
- begin
- FreeMem(version_count);
- FreeMem(version_first_date);
- FreeMem(version_first_date_id);
- FreeMem(version_last_date);
- FreeMem(version_last_date_id);
- end;
- end;
- Procedure TTestSuite.ShowRunComparison;
- Var
- S : String;
- Qry : String;
- Q : TSQLQuery;
- FL : String;
- begin
- ConnectToDB;
- ContentType:='text/html';
- EmitContentType;
- EmitDocType;
- EmitTitle(Title+' : Compare 2 runs');
- With FHTMLWriter do
- begin
- HeaderStart(1);
- DumpLn('Test suite results for run '+FRunID+' vs. '+FCompareRunID);
- HeaderEnd(1);
- HeaderStart(2);
- DumpLn('Test run data: ');
- HeaderEnd(2);
- If ShowRunData then
- begin
- HeaderStart(2);
- DumpLn('Detailed test run results:');
- FL:='';
- If FOnlyFailed or FNoSkipped then
- begin
- FL:='';
- If FOnlyFailed then
- FL:='successful';
- if FNoSkipped then
- begin
- If (FL<>'') then
- FL:=FL+' and ';
- FL:=FL+'skipped';
- end;
- DumpLn(' ('+FL+' tests are hidden)');
- end;
- HeaderEnd(2);
- ParaGraphStart;
- Q:=CreateDataset('');
- S:='with tr1 as (SELECT * FROM '+TESTRESULTSTableName(FRunId)+ ' WHERE TR_TESTRUN_FK='+FRunID+'), '+
- ' tr2 as (SELECT * FROM '+TESTRESULTSTableName(FCompareRunId)+' WHERE TR_TESTRUN_FK='+FCompareRunID+')'+
- ' SELECT T_ID as id,T_NAME as Filename,tr1.TR_SKIP as Run1_Skipped,'
- +'tr2.TR_SKIP as Run2_Skipped,tr1.TR_OK as Run1_OK,'
- +'tr2.TR_OK as Run2_OK, tr1.TR_Result as Run1_Result,'
- +'tr2.TR_RESULT as Run2_Result '
- +'FROM TESTS, tr2 LEFT JOIN tr1 USING (TR_TEST_FK) '
- +'WHERE ((tr1.TR_SKIP IS NULL) or (tr2.TR_SKIP IS NULL) or '
- +' (%s (tr1.TR_Result<>tr2.TR_Result)))'
- +'and (T_ID=tr2.TR_TEST_FK)';
- If FNoSkipped then
- begin
- Qry:='(((tr1.TR_SKIP) and (not tr2.TR_OK) and (not tr2.TR_SKIP)) or '
- +'((not tr1.TR_OK) and (not tr1.TR_SKIP) and (tr2.TR_SKIP)) or '
- +'((not tr1.TR_SKIP) and (not tr2.TR_SKIP))) and ';
- end
- else
- Qry:='';
- Qry:=Format(S,[Qry]);
- // DumpLn(Qry);
- If FDebug then
- begin
- system.WriteLn('Query: '+Qry);
- system.Flush(stdout);
- end;
- FRunCount:=0;
- FRunSkipCount:=0;
- FRunFailedCount:=0;
- Q.SQL.Text:=Qry;
- With Q do
- try
- Open;
- Try
- With CreateTableProducer(Q) do
- Try
- Border:=True;
- FL:='Id,Filename,Run1_OK,Run2_OK';
- If Not FNoSkipped then
- FL:=FL+',Run1_Skipped,Run2_Skipped';
- FL:=FL+',Run1_Result,Run2_Result';
- CreateColumns(FL);
- OnGetRowAttributes:=@GetRunRowAttr;
- TableColumns.ColumnByNAme('Id').OnGetCellContents:=
- @FormatFileIDDetails;
- TableColumns.ColumnByNAme('Run1_Result').OnGetCellContents:=
- @FormatTestResult;
- TableColumns.ColumnByNAme('Run2_Result').OnGetCellContents:=
- @FormatTestResult;
- TableColumns.ColumnByNAme('Filename').OnGetCellContents:=
- @FormatFileDetails;
- //(TableColumns.Items[0] as TTableColumn).ActionURL:=ALink;
- CreateTable(Response);
- Finally
- Free;
- end;
- DumpLn(format('<p>Record count: %d</P>',[Q.RecordCount]));
- Finally
- Close;
- end;
- finally
- Free;
- end;
- If Not (FRunCount=0) and not (FNoSkipped or FOnlyFailed) then
- begin
- ParaGraphStart;
- TagStart('IMG',Format('Src="'+TestsuiteCGIURL+
- '?action=2&pietotal=%d&piefailed=%d&pieskipped=%d"'+
- ' ALT="total=%d, failed=%d, skipped=%d"',
- [FRunCount,FRunFailedCount,FRunSkipCount,
- FRunCount,FRunFailedCount,FRunSkipCount
- ]));
- end;
- end
- else
- DumpLn('No data for test run with ID: '+FRunID);
- end;
- end;
- procedure TTestSuite.GetRunRowAttr(Sender: TObject; var BGColor: String;
- var Align: THTMLAlign; var VAlign: THTMLValign; var CustomAttr: String);
- Var
- P : TTableProducer;
- Skip1Field, Skip2Field, Run1Field, Run2Field : TField;
- begin
- P:=(Sender as TTAbleProducer);
- Inc(FRunCount);
- If (FOnlyFailed and FNoSkipped) then
- begin
- If (P.CurrentRow Mod 2)=0 then
- BGColor:='#EEEEEE'
- end
- else
- begin
- Skip1Field := P.Dataset.FindField('Skipped');
- if Skip1Field = nil then
- begin
- Skip1Field := P.Dataset.FindField('Run1_Skipped');
- Skip2Field := P.Dataset.FindField('Run2_Skipped');
- end
- else
- Skip2Field := nil;
- Run1Field := P.Dataset.FindField('OK');
- if Run1Field = nil then
- Run1Field := P.Dataset.FindField('Run1_OK');
- Run2Field := P.Dataset.FindField('OK');
- if Run2Field = nil then
- Run2Field := P.Dataset.FindField('Run2_OK');
- If (not FNoSkipped) and ((Skip1Field.AsBoolean)
- or ((Skip2Field <> nil) and (Skip2Field.AsBoolean))) then
- begin
- Inc(FRunSkipCount);
- BGColor:='yellow'; // Yellow
- end
- else If Run2Field.AsBoolean then
- begin
- if Run1Field.AsString='' then
- BGColor:='#68DFB8'
- else if Run1Field.AsBoolean then
- BGColor:='#98FB98'; // pale Green
- end
- else if Not Run2Field.AsBoolean then
- begin
- Inc(FRunFailedCount);
- if Run1Field.AsString='' then
- BGColor:='#FF82AB' // Light red
- else if Not Run1Field.AsBoolean then
- BGColor:='#FF225B';
- end;
- end;
- end;
- procedure TTestSuite.FormatFailedOverview(Sender: TObject; var CellData: String);
- Var
- S: String;
- P : TTableProducer;
- begin
- P:=(Sender as TTableProducer);
- S:=Format(SDetailsURL,[P.DataSet.FieldByName('ID').AsString]);
- S:=S+'&failedonly=1&noskipped=1';
- CellData:=Format('<A HREF="%s">%s</A>',[S,CellData]);
- end;
- function TTestSuite.FormatDetailURL(const RunIdStr, CellData : String) : string;
- Var
- S : String;
- begin
- S:=Format(SDetailsURL,[RunIdStr]);
- if FOnlyFailed then
- S:=S+'&failedonly=1';
- if FNoSkipped then
- S:=S+'&noskipped=1';
- FormatDetailURL:=Format('<A HREF="%s">%s</A>',[S,CellData]);
- end;
- procedure TTestSuite.FormatTestRunOverview(Sender: TObject; var CellData: String);
- Var
- S: String;
- P : TTableProducer;
- begin
- P:=(Sender as TTableProducer);
- S:=Format(SDetailsURL,[P.DataSet.FieldByName('RUN').AsString]);
- if FOnlyFailed then
- S:=S+'&failedonly=1';
- if FNoSkipped then
- S:=S+'&noskipped=1';
- CellData:=Format('<A HREF="%s">%s</A>',[S,CellData]);
- end;
- procedure TTestSuite.FormatSVN(Sender: TObject; var CellData: String);
- begin
- FormatSVNData(CellData);
- end;
- procedure TTestSuite.FormatSVNData(var CellData: String);
- Var
- S, Rev, SubStr, Remaining : String;
- P : TTableProducer;
- pos_colon, pos_sep : longint;
- begin
- pos_sep:=pos('/', CellData);
- if pos_sep=0 then
- begin
- pos_colon:=pos(':',CellData);
- S:=ViewRevURL+copy(CellData,pos_colon+1,length(CellData));
- CellData:=Format('<A HREF="%s" target="_blank">%s</A>',[S,CellData]);
- end
- else
- begin
- SubStr:=Copy(CellData,1,pos_sep-1);
- Remaining:=Copy(CellData,pos_sep+1,length(CellData));
- CellData:='';
- while SubStr<>'' do
- begin
- pos_colon:=pos(':',SubStr);
- Rev:=copy(SubStr,pos_colon+1,length(SubStr));
- { Remove suffix like M for modified...}
- while (length(Rev)>0) and (not (Rev[length(Rev)] in ['0'..'9'])) do
- Rev:=Copy(Rev,1,length(Rev)-1);
- S:=ViewRevURL+Rev;
- CellData:=CellData+Format('<A HREF="%s" target="_blank">%s</A>',[S,SubStr]);
- if Remaining='' then
- SubStr:=''
- else
- begin
- pos_sep:=pos('/',Remaining);
- if pos_sep=0 then
- pos_sep:=length(Remaining)+1;
- CellData:=CellData+':';
- SubStr:=Copy(Remaining,1,pos_sep-1);
- Remaining:=Copy(Remaining,pos_sep+1,length(Remaining));
- end;
- end;
- end;
- end;
- procedure TTestSuite.FormatFileIDDetails(Sender: TObject; var CellData: String);
- Var
- S: String;
- P : TTableProducer;
- begin
- P:=(Sender as TTableProducer);
- if FVersion<>'' then
- S:=Format(TestSuiteCGIURL + '?action=%d&version=%s&testfileid=%s',
- [faction_show_history,FVersion,P.DataSet.FieldByName('Id').AsString])
- else
- S:=Format(TestSuiteCGIURL + '?action=%d&testfileid=%s',
- [faction_show_history,P.DataSet.FieldByName('Id').AsString]);
- CellData:=Format('<A HREF="%s">%s</A>',[S,CellData]);
- end;
- procedure TTestSuite.FormatFileDetails(Sender: TObject; var CellData: String);
- Var
- S: String;
- P : TTableProducer;
- begin
- P:=(Sender as TTableProducer);
- if FCompareRunID<>'' then
- S:=Format(TestSuiteCGIURL + '?action=%d&run1id=%s&run2id=%s&testfileid=%s',
- [faction_show_one_test,FRunID,FCompareRunID,P.DataSet.FieldByName('Id').AsString])
- else
- S:=Format(TestSuiteCGIURL + '?action=%d&run1id=%s&testfileid=%s',
- [faction_show_one_test,FRunID,P.DataSet.FieldByName('Id').AsString]);
- CellData:=Format('<A HREF="%s">%s</A>',[S,CellData]);
- end;
- procedure TTestSuite.FormatTestResult(Sender: TObject; var CellData: String);
- Var
- Res : longint;
- Error:word;
- TS : TTestStatus;
- begin
- Val(CellData,Res,Error);
- if (Error=0) and (Res>=longint(FirstStatus)) and
- (Res<=longint(LastStatus)) then
- begin
- TS:=TTestStatus(Res);
- CellData:=StatusText[TS];
- end;
- end;
- Procedure TTestSuite.CreateRunPie;
- Var
- I : TFPMemoryImage;
- M : TMemoryStream;
- begin
- ftFont.InitEngine;
- FontMgr.SearchPath:='/usr/lib/X11/fonts/truetype';
- I:=TFPMemoryImage.Create(320,320);
- try
- If FRunCount=0 Then
- Raise Exception.Create('Invalid parameters passed to script: No total count');
- DoDrawPie(I,FRunSkipCount,FRunFailedCount,FRunCount);
- M:=TMemoryStream.Create;
- Try
- With TFPWriterPNG.Create do
- try
- UseAlpha:=True;
- ImageWrite(M,I);
- Finally
- Free;
- end;
- ContentType:='image/png';
- //EmitDocType;
- EmitContentType;
- M.Position:=0;
- Response.CopyFrom(M,M.Size);
- Finally
- M.Free;
- end;
- Finally
- I.Free;
- end;
- end;
- Procedure TTestSuite.DoDrawPie(Img : TFPCustomImage; Skipped,Failed,Total : Integer);
- Var
- Cnv : TFPImageCanvas;
- W,H,FH,CR,ra : Integer;
- A1,A2,FR,SR,PR : Double;
- R : TRect;
- F : TFreeTypeFont;
- Procedure AddPie(X,Y,R : Integer; AStart,AStop : Double; Col : TFPColor);
- Var
- DX,Dy : Integer;
- begin
- DX:=Round(R*Cos(A1));
- DY:=Round(R*Sin(A1));
- Cnv.Line(X,Y,X+DX,Y-DY);
- DX:=Round(Ra*Cos(A2));
- DY:=Round(Ra*Sin(A2));
- Cnv.Line(X,Y,X+DX,Y-Dy);
- DX:=Round(R/2*Cos((A1+A2)/2));
- DY:=Round(R/2*Sin((A1+A2)/2));
- Cnv.Brush.FpColor:=Col;
- Cnv.FloodFill(X+DX,Y-DY);
- end;
- Function FractionAngle(F,T : Integer): Double;
- begin
- Result:=(2*Pi*(F/T))
- end;
- begin
- F:=TFreeTypeFont.Create;
- With F do
- begin
- Name:='arial';
- FontIndex:=0;
- Size:=12;
- FPColor:=colred;
- AntiAliased:=False;
- Resolution:=96;
- end;
- if FDebug then
- Writeln(stdout,'Creating image');
- Cnv:=TFPImageCanvas.Create(Img);
- if FDebug then
- Writeln(stdout,'CNV=0x',hexstr(ptruint(cnv),16));
- if FDebug then
- Writeln(stdout,'Getting width and height');
- W:=Img.Width;
- H:=Img.Height;
- if FDebug then
- begin
- Writeln(stdout,'width=',W,' height=',H);
- //system.flush(stdout);
- end;
- // Writeln('Transparant');
- cnv.Brush.Style:=bsSolid;
- cnv.Brush.FPColor:=colTransparent;
- cnv.Pen.FPColor:=colWhite;
- Cnv.Rectangle(0,0,W,H);
- if FDEbug then
- Writeln(stdout,'Setting font');
- Cnv.Font:=F;
- if FDebug then
- Writeln(stdout,'Getting textwidth ');
- FH:=CNV.GetTextHeight('A');
- If FH=0 then
- FH:=14; // 3 * 14;
- if FDebug then
- writeln(stdout,'FH=',FH);
- Inc(FH,3);
- R.Top:=FH*4;
- R.Left:=0;
- R.Bottom:=H;
- CR:=H-(FH*4);
- If W>CR then
- R.Right:=CR
- else
- R.Right:=W;
- Ra:=CR div 2;
- if FDEbug then
- begin
- Writeln(stdout,'Setting pen color');
- system.flush(stdout);
- end;
- Cnv.Pen.FPColor:=colBlack;
- if FDebug then
- begin
- Writeln(stdout,'Palette size : ',Img.Palette.Count);
- Writeln(stdout,'Setting brush style');
- system.flush(stdout);
- end;
- cnv.brush.FPColor:=colRed;
- // cnv.pen.width:=1;
- // Writeln('Drawing ellipse');
- Cnv.Ellipse(R);
- if FDebug then
- begin
- Writeln(stdout,'Setting text');
- system.flush(stdout);
- end;
- Cnv.Textout(1,FH*2,Format('%d Skipped (%3.1f%%)',[Skipped,SR*100]));
- A1:=(Pi*2*(failed/total));
- A2:=A1+(Pi*2*(Skipped/Total));
- AddPie(Ra,R.Top+Ra,Ra,A1,A2,ColYellow);
- cnv.font.FPColor:=colGreen;
- // Writeln('Palette size : ',Img.Palette.Count);
- A1:=A2;
- A2:=A1+(Pi*2*((Total-(Skipped+Failed))/Total));
- Cnv.Textout(1,FH*3,Format('%d Passed (%3.1f%%',[Total-Skipped-Failed,PR*100]));
- AddPie(Ra,R.Top+Ra,Ra,A1,A2,ColGreen);
- // Writeln('Palette size : ',Img.Palette.Count);
- // Writeln('All done');
- end;
- begin
- if paramstr(0)<>'' then
- TestsuiteCGIURL:=TestsuiteURLPrefix+'cgi-bin/'+extractfilename(paramstr(0))
- else
- TestsuiteCGIURL:=TestsuiteURLPrefix+'cgi-bin/'+TestsuiteBin;
- ShortDateFormat:='yyyy/mm/dd';
- end.
|