{$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; 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); 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; {$ifdef TEST} 98 : begin ///EmitOverviewForm; system.Writeln(stdout,'
');
            system.Writeln(stdout,'paramstr(0) is ',paramstr(0));
            system.FreeMem(pointer($ffffffff));
            system.Writeln(stdout,'
'); system.Flush(stdout); end; 99 : begin EmitOverviewForm; system.Writeln(stdout,'
');
            system.Dump_stack(stdout,get_frame);
            system.Writeln(stdout,'
'); 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 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(''); AddResponseLn(''+ATitle+''); AddResponseLn(''); FNeedEnd:=true; end; Procedure TTestSuite.EmitDocType; begin AddResponseLn(''); 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(''); AddResponseLn(''); 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('

Record count: %d

',[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('

Record count: %d

',[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; 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('

Record count: %d

',[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('
'); 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('

No Source in TestSuite DataBase.

'); DumpLn('Link to SVN view of '+ ' '+FTestFileName+' source. '); HeaderEnd(3); end else begin HeaderStart(3); DumpLn('Link to SVN view of '+ ' '+FTestFileName+' 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 TESTRESULTS ' +' LEFT JOIN TESTRUN 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 TR_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('

Record count: %d

',[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 datecpu_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 dateos_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 dateversion_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 dateTotal = %d

',[total_count])); if Total_count > 0 then DumpLn(Format('

OK=%d Percentage= %3.2f

',[OK_count,OK_count*100/total_count])); if Skip_count > 0 then DumpLn(Format('

Skipped=%d Percentage= %3.2f

',[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('

No Source in TestSuite DataBase.

'); DumpLn('Link to SVN view of '+ ' '+FTestFileName+' source. '); HeaderEnd(3); end else begin HeaderStart(3); DumpLn('Link to SVN view of '+ ' '+FTestFileName+' 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('

Record count: %d

',[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('%s',[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('%s',[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('%s',[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('%s',[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('%s',[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('%s',[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('%s',[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.