1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402 |
- {$mode objfpc}
- {$h+}
- unit utests;
- interface
- uses cgiapp,sysutils,mysql41conn,sqldb,whtml,dbwhtml,db,
- tresults,
- Classes,ftFont,fpimage,fpimgcanv,fpWritePng,fpcanvas;
- {$ifndef TEST}
- const
- CGI = 'testsuite.cgi';
- {$else TEST}
- const
- CGI = 'testsuite-new.cgi';
- {$endif TEST}
- Type
- TTestSuite = Class(TCgiApplication)
- Private
- FHTMLWriter : THtmlWriter;
- FComboBoxProducer : TComboBoxProducer;
- FDB : TSQLConnection;
- FTrans : TSQLTransaction;
- FRunID,
- FCompareRunID,
- FTestFileID,
- FTestFileName,
- FVersion,
- FCPU,
- FOS : String;
- FDate : TDateTime;
- FDebug,
- FNoSkipped,
- FOnlyFailed : Boolean;
- FRunSkipCount,
- FRunFailedCount,
- FRunCount : Integer;
- FAction,
- FLimit : Integer;
- FTestLastDays : Integer;
- 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 FormatTestResult(Sender: TObject; var CellData: 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 GetCPUName(ID : String) : String;
- Function GetVersionName(ID : String) : String;
- Function GetTestFileName(ID : String) : String;
- Function InitCGIVars : Integer;
- Procedure DoRun; override;
- Procedure EmitOverviewForm;
- Procedure ShowRunResults;
- Procedure ShowRunComparison;
- Procedure ShowOneTest;
- Function ConnectToDB : Boolean;
- procedure DisconnectFromDB;
- Procedure EmitTitle(ATitle : String);
- Procedure EmitEnd;
- Procedure ShowRunOverview;
- Procedure CreateRunPie;
- Function ShowRunData : Boolean;
- end;
- implementation
- 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
- SDetailsURL = CGI + '?action=1&run1id=%s';
- Procedure TTestSuite.DoRun;
- begin
- Try
- Try
- Case InitCGIVars of
- 0 : EmitOverviewForm;
- 1 :
- if Length(FCompareRunID) = 0 then
- ShowRunResults
- else
- ShowRunComparison;
- 2 : CreateRunPie;
- 3 : ShowOneTest;
- {$ifdef TEST}
- 98 :
- begin
- EmitOverviewForm;
- Writeln(stdout,'<PRE>');
- FreeMem(pointer($ffffffff));
- Writeln(stdout,'</PRE>');
- end;
- 99 :
- begin
- EmitOverviewForm;
- Writeln(stdout,'<PRE>');
- Dump_stack(stdout,get_frame);
- Writeln(stdout,'</PRE>');
- 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'];
- FAction:=StrToIntDef(S,0);
- S:=RequestVariables['limit'];
- if Length(S) = 0 then
- S:=RequestVariables['TESTLIMIT'];
- FLimit:=StrToIntDef(S,50);
- FVersion:=RequestVariables['version'];
- if Length(FVersion) = 0 then
- FVersion:=RequestVariables['TESTVERSION'];
- FOS:=RequestVariables['os'];
- if Length(FOS) = 0 then
- FOS:=RequestVariables['TESTOS'];
- FCPU:=RequestVariables['cpu'];
- if Length(FCPU) = 0 then
- FCPU:=RequestVariables['TESTCPU'];
- 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'];
- 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');
- Result:=FAction;
- end;
- Function TTestSuite.ConnectToDB : Boolean;
- begin
- Result:=False;
- FDB:=TMySQL41Connection.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;
- 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);
- begin
- AddResponseLn('<HTML>');
- AddResponseLn('<TITLE>'+ATitle+'</TITLE>');
- AddResponseLn('<BODY>');
- end;
- Procedure TTestSuite.EmitOverviewForm;
- begin
- ConnectToDB;
- ContentType:='text/html';
- EmitContentType;
- EmitTitle(Title);
- With FHTMLWriter do
- begin
- HeaderStart(1);
- Write('View Test suite results');
- HeaderEnd(1);
- Write('Please specify search criteria:');
- ParagraphStart;
- FormStart(CGI,'');
- TableStart(2,true);
- RowStart;
- CellStart;
- Write('Operating system:');
- CellNext;
- ComboBoxFromQuery('os','SELECT TO_ID,TO_NAME FROM TESTOS ORDER BY TO_NAME',FOS);
- CellEnd;
- RowNext;
- CellStart;
- Write('Processor:');
- CellNext;
- ComboBoxFromQuery('cpu','SELECT TC_ID,TC_NAME FROM TESTCPU ORDER BY TC_NAME',FCPU);
- CellEnd;
- RowNext;
- CellStart;
- Write('Version');
- CellNext;
- ComboBoxFromQuery('version','SELECT TV_ID,TV_VERSION FROM TESTVERSION ORDER BY TV_VERSION DESC',FVERSION);
- CellEnd;
- RowNext;
- CellStart;
- Write('Date');
- CellNext;
- If (FDate=0) then
- EmitInput('date','')
- else
- EmitInput('date',DateToStr(FDate));
- CellEnd;
- RowNext;
- CellStart;
- Write('Only failed tests');
- CellNext;
- EmitCheckBox('failedonly','1',FonlyFailed);
- CellEnd;
- RowNext;
- CellStart;
- Write('Hide skipped tests');
- CellNext;
- EmitCheckBox('noskipped','1',FNoSkipped);
- CellEnd;
- RowEnd;
- TableEnd;
- ParaGraphStart;
- EmitSubmitButton('','Search');
- EmitResetButton('','Reset form');
- FormEnd;
- end;
- ShowRunOverview;
- end;
- procedure TTestSuite.EmitEnd;
- begin
- 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,COUNT(TR_ID) as Count,'+
- '(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 '+
- 'FROM TESTRESULTS,TESTRUN,TESTCPU,TESTOS,TESTVERSION '+
- 'WHERE '+
- '(TC_ID=TU_CPU_FK) AND '+
- '(TO_ID=TU_OS_FK) AND '+
- '(TV_ID=TU_VERSION_FK) AND '+
- '(TR_TESTRUN_FK=TU_ID) '+
- '%s '+
- 'GROUP BY TU_ID '+
- 'ORDER BY TU_ID DESC LIMIT %d';
- Var
- S,A,Qry : String;
- Q : TSQLQuery;
- begin
- S:='';
- If (FCPU<>'') and (GetCPUName(FCPU)<>'All') then
- S:=S+' AND (TU_CPU_FK='+FCPU+')';
- 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 (TU_DATE="'+FormatDateTime('YYYY/MM/DD',FDate)+'")';
- If FOnlyFailed then
- S:=S+' AND (TR_OK="-")';
- A:=SDetailsURL;
- If FOnlyFailed then
- A:=A+'&failedonly=1';
- If FNoSkipped then
- A:=A+'&noskipped=1';
- Qry:=Format(SOverview,[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;
- 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);
- end;
- Function TTestSuite.GetTestFileName(ID : String) : String;
- begin
- if (ID<>'') then
- Result:=GetSingleTon('SELECT T_NAME FROM TESTS WHERE T_ID='+ID);
- end;
- Function TTestSuite.GetCPUName(ID : String) : String;
- begin
- if (ID<>'') then
- Result:=GetSingleTon('SELECT TC_NAME FROM TESTCPU WHERE TC_ID='+ID);
- end;
- Function TTestSuite.GetVersionName(ID : String) : String;
- begin
- if (ID<>'') then
- Result:=GetSingleton('SELECT TV_VERSION FROM TESTVERSION WHERE TV_ID='+ID);
- end;
- Function TTestSuite.ShowRunData : Boolean;
- Const
- SGetRunData = 'SELECT TU_ID,TU_DATE,TC_NAME,TO_NAME,' +
- 'TU_SUBMITTER,TU_MACHINE,TU_COMMENT,TV_VERSION '+
- ' 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;
- Date1, Date2: TDateTime;
- begin
- Result:=(FRunID<>'');
- If Result then
- begin
- Q1:=CreateDataset(Format(SGetRunData,[FRunID]));
- if Length(FCompareRunID) > 0 then
- Q2:=CreateDataset(Format(SGetRunData,[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(CGI,'get');
- EmitHiddenVar('action', '1');
- TableStart(3,true);
- RowStart;
- CellStart;
- Write('Run ID:');
- CellNext;
- EmitInput('run1id',FRunID);
- CellNext;
- EmitInput('run2id',FCompareRunID);
- CellEnd;
- RowNext;
- CellStart;
- Write('Operating system:');
- CellNext;
- Write(Q1.FieldByName('TO_NAME').AsString);
- CellNext;
- if Q2 <> nil then
- Write(Q2.FieldByName('TO_NAME').AsString);
- CellEnd;
- RowNext;
- CellStart;
- Write('Processor:');
- CellNext;
- Write(Q1.FieldByName('TC_NAME').AsString);
- CellNext;
- if Q2 <> nil then
- Write(Q2.FieldByName('TC_NAME').AsString);
- CellEnd;
- RowNext;
- CellStart;
- Write('Version:');
- CellNext;
- Write(Q1.FieldByNAme('TV_VERSION').AsString);
- CellNext;
- if Q2 <> nil then
- Write(Q2.FieldByNAme('TV_VERSION').AsString);
- CellEnd;
- RowNext;
- CellStart;
- Write('Comment:');
- CellNext;
- Write(Q1.FieldByName('TU_COMMENT').AsString);
- CellNext;
- if Q2 <> nil then
- Write(Q2.FieldByName('TU_COMMENT').AsString);
- CellEnd;
- RowNext;
- CellStart;
- Write('Machine:');
- CellNext;
- Write(Q1.FieldByName('TU_MACHINE').AsString);
- CellNext;
- if Q2 <> nil then
- Write(Q2.FieldByName('TU_MACHINE').AsString);
- CellEnd;
- RowNext;
- CellStart;
- Write('Submitter:');
- CellNext;
- Write(Q1.FieldByName('TU_SUBMITTER').AsString);
- CellNext;
- if Q2 <> nil then
- Write(Q2.FieldByName('TU_SUBMITTER').AsString);
- CellEnd;
- RowNext;
- CellStart;
- Write('Date:');
- CellNext;
- F := Q1.FieldByName('TU_DATE');
- Date1 := F.AsDateTime;
- Write(F.AsString);
- CellNext;
- if Q2 <> nil then
- begin
- F := Q2.FieldByName('TU_DATE');
- Date2 := F.AsDateTime;
- Write(F.AsString);
- end;
- CellEnd;
- RowEnd;
- TableEnd;
- ParagraphStart;
- EmitCheckBox('noskipped','1',FNoSkipped);
- Write(' Hide skipped tests');
- ParagraphEnd;
- ParagraphStart;
- EmitCheckBox('failedonly','1',FonlyFailed);
- Write(' Hide successful tests');
- ParagraphEnd;
- ParaGraphStart;
- EmitSubmitButton('','Show/Compare');
- EmitResetButton('','Reset form');
- ParagraphEnd;
- FormEnd;
- { give warning if dates reversed }
- if (Q2 <> nil) and (Date1 > Date2) then
- begin
- ParagraphStart;
- Write('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;
- EmitTitle(Title+' : Search Results');
- With FHTMLWriter do
- begin
- HeaderStart(1);
- Write('Test suite results for run '+FRunID);
- HeaderEnd(1);
- HeaderStart(2);
- Write('Test run data : ');
- HeaderEnd(2);
- If ShowRunData then
- begin
- HeaderStart(2);
- Write('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;
- Write(' ('+FL+' tests are hidden)');
- end;
- HeaderEnd(2);
- ParaGraphStart;
- S:='SELECT T_ID as Id,T_NAME as Filename,TR_SKIP as Skipped'
- +',TR_OK as OK,TR_RESULT as Result'
- +' FROM TESTRESULTS,TESTS'
- +' WHERE (TR_TEST_FK=T_ID) AND (TR_TESTRUN_FK='+FRunID+') ';
-
- If FOnlyFailed then
- S:=S+' AND (TR_OK="-")';
- If FNoSkipped then
- S:=S+' AND (TR_SKIP="-")';
- S:=S+' ORDER BY TR_ID ';
- Qry:=S;
- If FDebug then
- begin
- Writeln('Query : '+Qry);
- Flush(stdout);
- end;
- FRunCount:=0;
- FRunSkipCount:=0;
- FRunFailedCount:=0;
- Q:=CreateDataset(Qry);
- With Q do
- try
- Open;
- 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('Filename').OnGetCellContents:=
- @FormatFileDetails;
- TableColumns.ColumnByNAme('Result').OnGetCellContents:=
- @FormatTestResult;
- //(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="'+CGI+'?action=2&pietotal=%d&piefailed=%d&pieskipped=%d"',[FRunCount,FRunFailedCount,FRunSkipCount]));
- end;
- end
- else
- Write('No data for test run with ID: '+FRunID);
- end;
- end;
- Procedure TTestSuite.ShowOneTest;
- Var
- S : String;
- Qry : String;
- Q : TSQLQuery;
- i : longint;
- FieldName,FieldValue,
- Log,Comment,Source : String;
- Res : Boolean;
- begin
- ConnectToDB;
- ContentType:='text/html';
- EmitContentType;
- 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);
- Write('Test suite results for test file '+FTestFileName);
- HeaderEnd(1);
- HeaderStart(2);
- Write('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
- Write('Only failed tests');
- EmitCheckBox('failedonly','1',FonlyFailed);
- Write('Hide skipped tests');
- EmitCheckBox('noskipped','1',FNoSkipped);
- Res:=true;
- end;
- If Res then
- begin
- HeaderStart(2);
- Write('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
- For i:=0 to FieldCount-1 do
- begin
- FieldValue:=Fields[i].AsString;
- FieldName:=Fields[i].DisplayName;
-
- if (FieldValue<>'') and (FieldValue<>'-') and
- (FieldName<>'T_NAME') and (FieldName<>'T_SOURCE') then
- begin
- if (FieldValue='+') then
- Write('Flag ');
- Write(FieldName);
- Write(' ');
- if FieldValue='+' then
- Write(' set')
- else
- Write(FieldValue);
- DumpLn('<BR>');
- end;
- end;
-
- Finally
- Close;
- end;
- Finally
- Free;
- end;
- ParaGraphEnd;
- HeaderStart(2);
- Write('Detailed test run results:');
- HeaderEnd(2);
- ParaGraphStart;
- S:='SELECT TR_ID,TR_TESTRUN_FK,TR_TEST_FK,TR_OK, TR_SKIP,TR_RESULT '
- //S:='SELECT * '
- +' FROM TESTRESULTS '
- +' WHERE (TR_TEST_FK='+FTestFileID+')';
- If FOnlyFailed then
- S:=S+' AND (TR_OK="-")';
- if Fcomparerunid<>'' then
- S:=S+' AND ((TR_TESTRUN_FK='+Frunid+') OR '+
- '(TR_TESTRUN_FK='+Fcomparerunid+'))'
- 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
- Writeln('Query : '+Qry);
- Flush(stdout);
- 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.ColumnByNAme('TR_TESTRUN_FK').OnGetCellContents:=
- @FormatTestRunOverview;
- //OnGetRowAttributes:=@GetRunRowAttr;
- TableColumns.ColumnByNAme('TR_RESULT').OnGetCellContents:=
- @FormatTestResult;
- //(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 FDebug then
- if FRunId<>'' then
- begin
- log:='';
- Try
- log:=getsingleton('select TR_LOG from TESTRESULTS where (TR_TEST_FK='+ftestfileid
- +') and (TR_TESTRUN_FK='+frunid+')');
- if Log<>'' then
- begin
- HeaderStart(2);
- Write('Log of '+FRunId+':');
- HeaderEnd(2);
- PreformatStart;
- system.Write(Log);
- system.flush(output);
- PreformatEnd;
- end;
- Finally
- if Log='' then
- begin
- HeaderStart(2);
- Write('No log of '+FRunId+'.');
- HeaderEnd(2);
- end;
- end;
- end;
- if FCompareRunId<>'' then
- begin
- log:='';
- Try
- log:=getsingleton('select TR_LOG from TESTRESULTS where (TR_TEST_FK='+ftestfileid
- +') and (TR_TESTRUN_FK='+fcomparerunid+')');
- if Log<>'' then
- begin
- HeaderStart(2);
- Write('Log of '+FCompareRunId+':');
- HeaderEnd(2);
- PreformatStart;
- system.Write(Log);
- system.flush(output);
- PreformatEnd;
- end;
- Finally
- if Log='' then
- begin
- HeaderStart(2);
- Write('No log of '+FCompareRunId+'.');
- HeaderEnd(2);
- end;
- end;
- end;
- if FDebug then
- Write('After Log.');
- Source:='';
- Try
- Source:=getsingleton('select T_SOURCE from TESTS where T_ID='+ftestfileid);
- if Source<>'' then
- begin
- HeaderStart(2);
- Write('Source:');
- HeaderEnd(2);
- PreformatStart;
- system.Write(Source);
- system.flush(output);
- PreformatEnd;
- end;
- Finally
- if Source='' then
- begin
- HeaderStart(3);
- DumpLn('<P>No Source in TestSuite DataBase.</P>');
- DumpLn('Link to SVN view of '+
- '<A HREF="http://www.freepascal.org'+
- '/cgi-bin/viewcvs.cgi/trunk/tests/'+
- FTestFileName+'?view=markup'+
- '" TARGET="_blank"> '+FTestFileName+'</A> source. ');
- HeaderEnd(3);
- end
- else
- begin
- HeaderStart(3);
- DumpLn('Link to SVN view of '+
- '<A HREF="http://www.freepascal.org'+
- '/cgi-bin/viewcvs.cgi/trunk/tests/'+
- FTestFileName+'?view=markup'+
- '" TARGET="_blank"> '+FTestFileName+'</A> source. ');
- HeaderEnd(3);
- end;
- end;
- if FDebug then
- Write('After Source.');
- end
- else
- Write(Format('No data for test file with ID: %s',[FTestFileID]));
-
- end;
- end;
- Procedure TTestSuite.ShowRunComparison;
- Var
- S : String;
- Qry : String;
- Q : TSQLQuery;
- FL : String;
- begin
- ConnectToDB;
- ContentType:='text/html';
- EmitContentType;
- EmitTitle(Title+' : Compare 2 runs');
- With FHTMLWriter do
- begin
- HeaderStart(1);
- Write('Test suite results for run '+FRunID+' vs. '+FCompareRunID);
- HeaderEnd(1);
- HeaderStart(2);
- Write('Test run data: ');
- HeaderEnd(2);
- If ShowRunData then
- begin
- HeaderStart(2);
- Write('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;
- Write(' ('+FL+' tests are hidden)');
- end;
- HeaderEnd(2);
- ParaGraphStart;
- Q:=CreateDataset('');
- Q.SQL.Text:='CREATE TEMPORARY TABLE tr1 like TESTRESULTS;';
- Q.ExecSQL;
- Q.SQL.Text:='CREATE TEMPORARY TABLE tr2 like TESTRESULTS;';
- Q.ExecSQL;
- Q.SQL.Text:='INSERT INTO tr1 SELECT * FROM TESTRESULTS '+
- 'WHERE TR_TESTRUN_FK='+FRunID+';';
- Q.ExecSQL;
- Q.SQL.Text:='INSERT INTO tr2 SELECT * FROM TESTRESULTS '+
- 'WHERE TR_TESTRUN_FK='+FCompareRunID+';';
- Q.ExecSQL;
- S:='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 (tr2.TR_OK="-") and (tr2.TR_SKIP="-")) or '
- +'((tr1.TR_OK="-") and (tr1.TR_SKIP="-") and (tr2.TR_SKIP="+")) or '
- +'((tr1.TR_SKIP="-") and (tr2.TR_SKIP="-"))) and ';
- end
- else
- Qry:='';
- Qry:=Format(S,[Qry]);
- If FDebug then
- begin
- Writeln('Query: '+Qry);
- 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:='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('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;
- Writeln('<p>Record count: ',Q.RecordCount,'</p>');
- Finally
- Close;
- end;
- finally
- Free;
- end;
- If Not (FRunCount=0) and not (FNoSkipped or FOnlyFailed) then
- begin
- ParaGraphStart;
- TagStart('IMG',Format('Src="'+CGI+'?action=2&pietotal=%d&piefailed=%d&pieskipped=%d"',[FRunCount,FRunFailedCount,FRunSkipCount]));
- end;
- end
- else
- Write('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.AsString='+')
- or ((Skip2Field <> nil) and (Skip2Field.AsString = '+'))) then
- begin
- Inc(FRunSkipCount);
- BGColor:='yellow'; // Yellow
- end
- else If Run2Field.AsString='+' then
- begin
- if Run1Field.AsString='' then
- BGColor:='#68DFB8'
- else if Run1Field.ASString<>'+' then
- BGColor:='#98FB98'; // pale Green
- end
- else if Run2Field.AsString='-' then
- begin
- Inc(FRunFailedCount);
- if Run1Field.AsString='' then
- BGColor:='#FF82AB' // Light red
- else if Run1Field.AsString<>'-' 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;
- procedure TTestSuite.FormatTestRunOverview(Sender: TObject; var CellData: String);
- Var
- S: String;
- P : TTableProducer;
- begin
- P:=(Sender as TTableProducer);
- S:=Format(SDetailsURL,[P.DataSet.FieldByName('TR_TESTRUN_FK').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.FormatFileDetails(Sender: TObject; var CellData: String);
- Var
- S: String;
- P : TTableProducer;
- begin
- P:=(Sender as TTableProducer);
- if FCompareRunID<>'' then
- S:=Format(CGI + '?action=3&run1id=%s&run2id=%s&testfileid=%s',
- [FRunID,FCompareRunID,P.DataSet.FieldByName('Id').AsString])
- else
- S:=Format(CGI + '?action=3&run1id=%s&testfileid=%s',
- [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;
- P : TTableProducer;
- begin
- P:=(Sender as TTableProducer);
- 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';
- 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;
- // Writeln('Creating image');
- Cnv:=TFPImageCanvas.Create(Img);
- // Writeln('Getting width and height');
- W:=Img.Width;
- H:=Img.Height;
- // Writeln('Transparant');
- cnv.Brush.Style:=bsSolid;
- cnv.Brush.FPColor:=colTransparent;
- cnv.Pen.FPColor:=colWhite;
- Cnv.Rectangle(0,0,W,H);
- // Writeln('Setting font');
- Cnv.Font:=F;
- // Writeln('Getting textwidth ');
- FH:=CNV.GetTextHeight('A');
- If FH=0 then
- FH:=14; // 3 * 14;
- 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;
- // Writeln('Setting pen color');
- Cnv.Pen.FPColor:=colBlack;
- // Writeln('Palette size : ',Img.Palette.Count);
- // Writeln('Setting brush style');
- cnv.brush.FPColor:=colRed;
- // cnv.pen.width:=1;
- // Writeln('Drawing ellipse');
- Cnv.Ellipse(R);
- // Writeln('Setting text');
- // Writeln('Palette size : ',Img.Palette.Count);
- cnv.font.FPColor:=colred;
- Inc(FH,4);
- FR:=Failed/Total;
- SR:=Skipped/Total;
- PR:=1-(FR+SR);
- Cnv.Textout(1,FH,Format('%d Failed (%3.1f%%)',[Failed,Fr*100]));
- // Writeln('Palette size : ',Img.Palette.Count);
- cnv.font.FPColor:=colYellow;
- 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;
- end.
|