mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 21:51:42 +02:00
658 lines
17 KiB
ObjectPascal
658 lines
17 KiB
ObjectPascal
unit tshtml;
|
|
|
|
{$mode ObjFPC}
|
|
{$h+}
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, wformat, dbwhtml, whtml, sqldb, tsdb, tsconsts, tssql, tsutils, tstypes;
|
|
|
|
var
|
|
TestsuiteCGIURL : string;
|
|
|
|
Type
|
|
|
|
{ TTestSuiteHTMLWriter }
|
|
|
|
TTestSuiteHTMLWriter = class(THTMLWriter)
|
|
Private
|
|
FNeedEnd : Boolean;
|
|
FSQL : TTestSQL;
|
|
FComboBoxProducer:TComboBoxProducer;
|
|
FVars : TQueryData;
|
|
Public
|
|
constructor create(aStream : TStream; aSQL: TTestSQL; aVars : TQueryData); reintroduce;
|
|
destructor destroy; override;
|
|
// Create HTML from SQL
|
|
Procedure ComboBoxFromQuery(Const ComboName,Qry : String);
|
|
Procedure ComboBoxFromQuery(Const ComboName,Qry,Value : String);
|
|
Procedure ComboBoxFromQuery(Const ComboName,Qry : String; Value : integer);
|
|
function CreateTableProducer(DS: TSQLQuery): TTableProducer;
|
|
procedure DefaultTableFromQuery(Qry, ALink: String; IncludeRecordCount: Boolean);
|
|
// Formatting things
|
|
function FormatDetailURL(const RunIdStr, CellData: String): string;
|
|
procedure FormatFailedOverview(Sender: TObject; var CellData: String);
|
|
procedure FormatTestRunOverview(Sender: TObject; var CellData: String);
|
|
procedure FormatSVN(Sender: TObject; var CellData: String);
|
|
procedure FormatSVNData(var CellData: String);
|
|
procedure FormatFileDetails(Sender: TObject; var CellData: String);
|
|
procedure FormatFileIDDetails(Sender: TObject; var CellData: String);
|
|
procedure FormatTestResult(Sender: TObject; var CellData: String);
|
|
// reate Html
|
|
procedure EmitHiddenVar(const Name: String; aValue: Int64); overload;
|
|
procedure EmitDocType;
|
|
procedure EmitTitle(ATitle: String);
|
|
procedure EmitPieImage(aOKCount, aFailedCount, aSkipCount: integer);
|
|
procedure EmitHistoryForm(aTitle: String);
|
|
procedure EmitOverviewForm(aTitle: string);
|
|
procedure DumpTestInfo(aInfo: TTestInfo);
|
|
procedure EmitEnd;
|
|
// In 3.2.2 the htmlwriter uses shortstring for Dumpln.
|
|
// LDump cuts string into 255 char pieces and writes them one by one
|
|
Procedure LDump(Const St : String);
|
|
Procedure LDumpLn(Const St : String);
|
|
procedure HandleVerbose(lvl: TVerboseLevel; const aMsg: String);
|
|
end;
|
|
|
|
implementation
|
|
|
|
{ TTestSuiteHTMLWriter }
|
|
|
|
constructor TTestSuiteHTMLWriter.create(aStream: TStream; aSQL: TTestSQL; aVars: TQueryData);
|
|
begin
|
|
Inherited Create(aStream);
|
|
FSQL:=ASQL;
|
|
FComboBoxProducer:=TComboBoxProducer.Create(Nil);
|
|
FVars:=aVars;
|
|
end;
|
|
|
|
destructor TTestSuiteHTMLWriter.destroy;
|
|
begin
|
|
FreeAndNil(FComboBoxProducer);
|
|
inherited destroy;
|
|
end;
|
|
|
|
procedure TTestSuiteHTMLWriter.ComboBoxFromQuery(const ComboName, Qry: String);
|
|
|
|
begin
|
|
ComboBoxFromQuery(ComboName,Qry,'')
|
|
end;
|
|
|
|
procedure TTestSuiteHTMLWriter.ComboBoxFromQuery(const ComboName, Qry, Value: String);
|
|
|
|
Var
|
|
Q : TSQLQuery;
|
|
|
|
begin
|
|
Q:=FSQL.CreateQuery(Qry);
|
|
try
|
|
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(Stream);
|
|
Finally
|
|
Q.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TTestSuiteHTMLWriter.ComboBoxFromQuery(const ComboName, Qry: String; Value: integer);
|
|
begin
|
|
ComboBoxFromQuery(ComboName,Qry,IntToStr(Value))
|
|
end;
|
|
|
|
procedure TTestSuiteHTMLWriter.FormatFailedOverview(Sender: TObject; var CellData: String);
|
|
|
|
Var
|
|
S: String;
|
|
P : TTableProducer;
|
|
|
|
begin
|
|
P:=(Sender as TTableProducer);
|
|
S:=Format(SDetailsURL,[P.DataSet.FieldByName('ID').AsString]);
|
|
S:=S+'&failedonly=1&noskipped=1';
|
|
CellData:=Format('<A HREF="%s">%s</A>',[S,CellData]);
|
|
end;
|
|
|
|
|
|
function TTestSuiteHTMLWriter.FormatDetailURL(const RunIdStr, CellData : String) : string;
|
|
Var
|
|
S : String;
|
|
begin
|
|
S:=Format(SDetailsURL,[RunIdStr]);
|
|
if FVars.OnlyFailed then
|
|
S:=S+'&failedonly=1';
|
|
if FVars.NoSkipped then
|
|
S:=S+'&noskipped=1';
|
|
Result:=Format('<A HREF="%s">%s</A>',[S,CellData]);
|
|
end;
|
|
|
|
procedure TTestSuiteHTMLWriter.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 FVars.OnlyFailed then
|
|
S:=S+'&failedonly=1';
|
|
if FVars.NoSkipped then
|
|
S:=S+'&noskipped=1';
|
|
CellData:=Format('<A HREF="%s">%s</A>',[S,CellData]);
|
|
end;
|
|
|
|
|
|
procedure TTestSuiteHTMLWriter.FormatSVN(Sender: TObject; var CellData: String);
|
|
begin
|
|
FormatSVNData(CellData);
|
|
end;
|
|
|
|
procedure TTestSuiteHTMLWriter.FormatSVNData(var CellData: String);
|
|
Var
|
|
S, Rev, SubStr, Remaining : String;
|
|
pos_colon, pos_sep : longint;
|
|
begin
|
|
if CellData='' then
|
|
exit;
|
|
pos_sep:=pos('/', CellData);
|
|
if pos_sep=0 then
|
|
begin
|
|
pos_colon:=pos(':',CellData);
|
|
S:=ViewGitHashURL+copy(CellData,pos_colon+1,length(CellData));
|
|
CellData:=Format('<A HREF="%s" target="_blank">%s</A>',[S,CellData]);
|
|
end
|
|
else
|
|
begin
|
|
SubStr:=Copy(CellData,1,pos_sep-1);
|
|
Remaining:=Copy(CellData,pos_sep+1,length(CellData));
|
|
CellData:='';
|
|
while SubStr<>'' do
|
|
begin
|
|
pos_colon:=pos(':',SubStr);
|
|
Rev:=copy(SubStr,pos_colon+1,length(SubStr));
|
|
{ Remove suffix like M for modified...}
|
|
while (length(Rev)>0) and (not (Rev[length(Rev)] in ['0'..'9','a'..'f','A'..'F'])) do
|
|
Rev:=Copy(Rev,1,length(Rev)-1);
|
|
S:=ViewGitHashURL+Rev;
|
|
CellData:=CellData+Format('<A HREF="%s" target="_blank">%s</A>',[S,SubStr]);
|
|
if Remaining='' then
|
|
SubStr:=''
|
|
else
|
|
begin
|
|
pos_sep:=pos('/',Remaining);
|
|
if pos_sep=0 then
|
|
pos_sep:=length(Remaining)+1;
|
|
CellData:=CellData+':';
|
|
SubStr:=Copy(Remaining,1,pos_sep-1);
|
|
Remaining:=Copy(Remaining,pos_sep+1,length(Remaining));
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TTestSuiteHTMLWriter.EmitHiddenVar(const Name: String; aValue: Int64);
|
|
begin
|
|
if (aValue<>-1) then
|
|
EmitHiddenVar(Name,IntToStr(aValue));
|
|
end;
|
|
|
|
|
|
procedure TTestSuiteHTMLWriter.FormatFileIDDetails(Sender: TObject; var CellData: String);
|
|
|
|
Var
|
|
S: String;
|
|
P : TTableProducer;
|
|
|
|
begin
|
|
P:=(Sender as TTableProducer);
|
|
if FVars.VersionID<>-1 then
|
|
S:=Format(TestSuiteCGIURL + '?action=%d&version=%d&testfileid=%d',
|
|
[faction_show_history,FVars.VersionID,P.DataSet.FieldByName('Id').AsInteger])
|
|
else
|
|
S:=Format(TestSuiteCGIURL + '?action=%d&testfileid=%s',
|
|
[faction_show_history,P.DataSet.FieldByName('Id').AsString]);
|
|
CellData:=Format('<A HREF="%s">%s</A>',[S,CellData]);
|
|
end;
|
|
|
|
|
|
procedure TTestSuiteHTMLWriter.FormatFileDetails(Sender: TObject; var CellData: String);
|
|
|
|
Var
|
|
S: String;
|
|
P : TTableProducer;
|
|
|
|
begin
|
|
P:=(Sender as TTableProducer);
|
|
if FVars.CompareRunID<>-1 then
|
|
S:=Format(TestSuiteCGIURL + '?action=%d&run1id=%d&run2id=%d&testfileid=%s',
|
|
[faction_show_one_test,FVars.RunID,FVars.CompareRunID,P.DataSet.FieldByName('Id').AsString])
|
|
else
|
|
S:=Format(TestSuiteCGIURL + '?action=%d&run1id=%d&testfileid=%s',
|
|
[faction_show_one_test,FVars.RunID,P.DataSet.FieldByName('Id').AsString]);
|
|
CellData:=Format('<A HREF="%s">%s</A>',[S,CellData]);
|
|
end;
|
|
|
|
procedure TTestSuiteHTMLWriter.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 TTestSuiteHTMLWriter.EmitTitle(ATitle: String);
|
|
|
|
begin
|
|
if FNeedEnd then
|
|
exit;
|
|
DumpLn('<HTML>');
|
|
DumpLn('<HEAD>');
|
|
DumpLn('<TITLE>'+ATitle+'</TITLE>');
|
|
Dumpln('<STYLE>');
|
|
Dumpln('.logNormal { color: green; }');
|
|
Dumpln('.logAbort { color: red; }');
|
|
Dumpln('.logError { color: red; }');
|
|
Dumpln('.logWarning { color: orange; }');
|
|
Dumpln('.logSQL { color: darkblue; font-size: small; }');
|
|
Dumpln('.logDebug { color: darkblue; font-size: small; }');
|
|
Dumpln('</STYLE>');
|
|
DumpLn('</HEAD>');
|
|
|
|
DumpLn('<BODY>');
|
|
FNeedEnd:=true;
|
|
end;
|
|
|
|
procedure TTestSuiteHTMLWriter.EmitDocType;
|
|
begin
|
|
if FNeedEnd then
|
|
exit;
|
|
DumpLn('<!DOCTYPE html>');
|
|
end;
|
|
|
|
function TTestSuiteHTMLWriter.CreateTableProducer(DS: TSQLQuery): TTableProducer;
|
|
|
|
begin
|
|
Result:=TTableProducer.Create(Nil);
|
|
Result.Dataset:=DS;
|
|
end;
|
|
|
|
procedure TTestSuiteHTMLWriter.DefaultTableFromQuery(Qry, ALink: String; IncludeRecordCount: Boolean);
|
|
|
|
Var
|
|
Q : TSQLQuery;
|
|
lTable : TTableProducer;
|
|
|
|
begin
|
|
If FVars.Debug then
|
|
Writeln('Query : '+Qry);
|
|
lTable:=Nil;
|
|
Q:=FSQL.CreateQuery(Qry);
|
|
try
|
|
Q.Open;
|
|
lTable:=CreateTableProducer(Q);
|
|
lTable.Border:=True;
|
|
If (Alink<>'') then
|
|
begin
|
|
lTable.CreateColumns(Nil);
|
|
If lTable.TableColumns.Count>0 then
|
|
(lTable.TableColumns.Items[0] as TTableColumn).ActionURL:=ALink;
|
|
end;
|
|
lTable.CreateTable(Stream);
|
|
If IncludeRecordCount then
|
|
DumpLn(Format('<p>Record count: %d </p>',[Q.RecordCount]));
|
|
finally
|
|
lTable.Free;
|
|
Q.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TTestSuiteHTMLWriter.EmitPieImage(aOKCount,aFailedCount,aSkipCount : integer);
|
|
|
|
const
|
|
sLink = 'Src="%s?action=2&pietotal=%d&piefailed=%d&pieskipped=%d"'+
|
|
' ALT="total=%d, failed=%d, skipped=%d"';
|
|
|
|
begin
|
|
ParaGraphStart;
|
|
TagStart('IMG',Format(SLink,[TestsuiteCGIURL,
|
|
aOKCount,aFailedCount,aSkipCount,
|
|
aOKCount,aFailedCount,aSkipCount
|
|
]));
|
|
end;
|
|
|
|
procedure TTestSuiteHTMLWriter.EmitHistoryForm(aTitle : String);
|
|
|
|
begin
|
|
EmitDocType;
|
|
EmitTitle(aTitle);
|
|
HeaderStart(1);
|
|
DumpLn('View Test suite results');
|
|
HeaderEnd(1);
|
|
DumpLn('Please specify search criteria:');
|
|
FormStart(TestsuiteCGIURL,'');
|
|
if FVars.Debug then
|
|
EmitHiddenVar('DEBUGCGI', '1');
|
|
EmitHiddenVar('action',IntToStr(faction_show_history));
|
|
TableStart(2,true);
|
|
RowStart;
|
|
CellStart;
|
|
DumpLn('File:');
|
|
CellNext;
|
|
EmitInput('testfilename',FVars.Testfilename);
|
|
CellEnd;
|
|
RowNext;
|
|
CellStart;
|
|
DumpLn('Operating system:');
|
|
CellNext;
|
|
ComboBoxFromQuery('os','SELECT TO_ID,TO_NAME FROM TESTOS ORDER BY TO_NAME',IntToStr(FVars.OSID));
|
|
CellEnd;
|
|
RowNext;
|
|
CellStart;
|
|
DumpLn('Processor:');
|
|
CellNext;
|
|
ComboBoxFromQuery('cpu','SELECT TC_ID,TC_NAME FROM TESTCPU ORDER BY TC_NAME',FVars.CPUID);
|
|
CellEnd;
|
|
RowNext;
|
|
CellStart;
|
|
DumpLn('Version');
|
|
CellNext;
|
|
ComboBoxFromQuery('version','SELECT TV_ID,TV_VERSION FROM TESTVERSION ORDER BY TV_VERSION DESC',FVars.VERSIONID);
|
|
CellEnd;
|
|
RowNext;
|
|
CellStart;
|
|
DumpLn('Date');
|
|
CellNext;
|
|
If (FVars.Date=0) then
|
|
EmitInput('date','')
|
|
else
|
|
EmitInput('date',DateToStr(FVars.Date));
|
|
CellEnd;
|
|
RowNext;
|
|
CellStart;
|
|
DumpLn('Submitter');
|
|
CellNext;
|
|
If (FVars.Submitter='') then
|
|
EmitInput('submitter','')
|
|
else
|
|
EmitInput('submitter',FVars.Submitter);
|
|
CellEnd;
|
|
RowNext;
|
|
CellStart;
|
|
DumpLn('Machine');
|
|
CellNext;
|
|
If (FVars.Machine='') then
|
|
EmitInput('machine','')
|
|
else
|
|
EmitInput('machine',FVars.Machine);
|
|
CellEnd;
|
|
RowNext;
|
|
CellStart;
|
|
DumpLn('Config');
|
|
CellNext;
|
|
If (FVars.Config='') then
|
|
EmitInput('config','')
|
|
else
|
|
EmitInput('config',FVars.Config);
|
|
CellEnd;
|
|
RowNext;
|
|
CellStart;
|
|
DumpLn('Limit');
|
|
CellNext;
|
|
EmitInput('limit',IntToStr(FVars.Limit));
|
|
CellEnd;
|
|
RowNext;
|
|
CellStart;
|
|
DumpLn('Cond');
|
|
CellNext;
|
|
If (FVars.Cond='') then
|
|
EmitInput('cond','')
|
|
else
|
|
EmitInput('cond',FVars.Cond);
|
|
CellEnd;
|
|
RowNext;
|
|
CellStart;
|
|
DumpLn('Category');
|
|
CellNext;
|
|
ComboBoxFromQuery('Category','SELECT TA_ID,TA_NAME FROM TESTCATEGORY ORDER BY TA_NAME',FVars.CategoryID);
|
|
CellEnd;
|
|
RowNext;
|
|
CellStart;
|
|
DumpLn('Only failed tests');
|
|
CellNext;
|
|
EmitCheckBox('failedonly','1',FVars.onlyFailed);
|
|
CellEnd;
|
|
RowNext;
|
|
CellStart;
|
|
DumpLn('Hide skipped tests');
|
|
CellNext;
|
|
EmitCheckBox('noskipped','1',FVars.NoSkipped);
|
|
CellEnd;
|
|
RowNext;
|
|
CellStart;
|
|
DumpLn('List all tests');
|
|
CellNext;
|
|
EmitCheckBox('listall','1',FVars.ListAll);
|
|
CellEnd;
|
|
|
|
RowEnd;
|
|
TableEnd;
|
|
ParaGraphStart;
|
|
if FVars.Debug then
|
|
EmitHiddenVar('DEBUGCGI', '1');
|
|
EmitSubmitButton('','Search');
|
|
EmitResetButton('','Reset form');
|
|
FormEnd;
|
|
end;
|
|
|
|
procedure TTestSuiteHTMLWriter.EmitOverviewForm(aTitle : string);
|
|
|
|
begin
|
|
EmitDocType;
|
|
EmitTitle(aTitle);
|
|
HeaderStart(1);
|
|
DumpLn('View Test suite results');
|
|
HeaderEnd(1);
|
|
DumpLn('Please specify search criteria:');
|
|
FormStart(TestsuiteCGIURL,'');
|
|
if FVars.Debug 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',FVars.OSID);
|
|
CellEnd;
|
|
RowNext;
|
|
CellStart;
|
|
DumpLn('Processor:');
|
|
CellNext;
|
|
ComboBoxFromQuery('cpu','SELECT TC_ID,TC_NAME FROM TESTCPU ORDER BY TC_NAME',FVars.CPUID);
|
|
CellEnd;
|
|
RowNext;
|
|
CellStart;
|
|
DumpLn('Version');
|
|
CellNext;
|
|
ComboBoxFromQuery('version','SELECT TV_ID,TV_VERSION FROM TESTVERSION ORDER BY TV_VERSION DESC',FVars.VERSIONID);
|
|
CellEnd;
|
|
RowNext;
|
|
CellStart;
|
|
DumpLn('Date');
|
|
CellNext;
|
|
If (FVars.Date=0) then
|
|
EmitInput('date','')
|
|
else
|
|
EmitInput('date',DateToStr(FVars.Date));
|
|
CellEnd;
|
|
//if FDebug then
|
|
begin
|
|
RowNext;
|
|
CellStart;
|
|
DumpLn('Submitter');
|
|
CellNext;
|
|
If (FVars.Submitter='') then
|
|
EmitInput('submitter','')
|
|
else
|
|
EmitInput('submitter',FVars.Submitter);
|
|
CellEnd;
|
|
RowNext;
|
|
CellStart;
|
|
DumpLn('Machine');
|
|
CellNext;
|
|
If (FVars.Machine='') then
|
|
EmitInput('machine','')
|
|
else
|
|
EmitInput('machine',FVars.Machine);
|
|
CellEnd;
|
|
RowNext;
|
|
CellStart;
|
|
DumpLn('Config');
|
|
CellNext;
|
|
If (FVars.Config='') then
|
|
EmitInput('config','')
|
|
else
|
|
EmitInput('config',FVars.Config);
|
|
CellEnd;
|
|
|
|
RowNext;
|
|
CellStart;
|
|
DumpLn('Cond');
|
|
CellNext;
|
|
If (FVars.Cond='') then
|
|
EmitInput('cond','')
|
|
else
|
|
EmitInput('cond',FVars.Cond);
|
|
CellEnd;
|
|
end;
|
|
RowNext;
|
|
CellStart;
|
|
DumpLn('Category');
|
|
CellNext;
|
|
ComboBoxFromQuery('Category','SELECT TA_ID,TA_NAME FROM TESTCATEGORY ORDER BY TA_NAME',IntToStr(FVars.CategoryID));
|
|
CellEnd;
|
|
RowNext;
|
|
CellStart;
|
|
DumpLn('Only failed tests');
|
|
CellNext;
|
|
EmitCheckBox('failedonly','1',FVars.onlyFailed);
|
|
CellEnd;
|
|
RowNext;
|
|
CellStart;
|
|
DumpLn('Hide skipped tests');
|
|
CellNext;
|
|
EmitCheckBox('noskipped','1',FVars.NoSkipped);
|
|
CellEnd;
|
|
RowEnd;
|
|
TableEnd;
|
|
ParaGraphStart;
|
|
EmitSubmitButton('','Search');
|
|
EmitSubmitButton('action','View history');
|
|
EmitResetButton('','Reset form');
|
|
FormEnd;
|
|
end;
|
|
|
|
procedure TTestSuiteHTMLWriter.DumpTestInfo(aInfo: TTestInfo);
|
|
|
|
Procedure MaybeField(const aName,aValue : string);
|
|
begin
|
|
if aValue='' then exit;
|
|
DumpLn(aName+':');
|
|
DumpLn(' ');
|
|
DumpLn(aValue);
|
|
DumpLn('<BR>');
|
|
end;
|
|
|
|
Procedure MaybeField(const aName : string; aValue : Boolean);
|
|
begin
|
|
if not aValue then exit;
|
|
DumpLn('Flag ');
|
|
DumpLn('"'+aName+'" :');
|
|
DumpLn(' set');
|
|
DumpLn('<BR>');
|
|
end;
|
|
|
|
Procedure MaybeField(const aName : string; aValue : Integer);
|
|
begin
|
|
if aValue<=0 then exit;
|
|
MaybeField(aName,IntToStr(aValue));
|
|
end;
|
|
|
|
begin
|
|
With aInfo do
|
|
begin
|
|
MaybeField('CPU',CPU);
|
|
MaybeField('OS',OS);
|
|
MaybeField('Version',Version);
|
|
if addDate<>0 then
|
|
MaybeField('Add date',FormatDateTime('yyy-mm-dd',addDate));
|
|
MaybeField('Version',Version);
|
|
MaybeField('Graph',Graph);
|
|
MaybeField('Interactive',Interactive);
|
|
MaybeField('Result',Result);
|
|
MaybeField('Fail',Fail);
|
|
MaybeField('Recompile',Recompile);
|
|
MaybeField('NoRun',NoRun);
|
|
MaybeField('NeedLibrary',NoRun);
|
|
MaybeField('KnownRunError',KnownRunError);
|
|
MaybeField('Note',Note);
|
|
MaybeField('Description',Description);
|
|
MaybeField('Opts',opts);
|
|
end;
|
|
end;
|
|
|
|
procedure TTestSuiteHTMLWriter.EmitEnd;
|
|
|
|
begin
|
|
if not FNeedEnd then
|
|
exit;
|
|
DumpLn('</BODY>');
|
|
DumpLn('</HTML>');
|
|
end;
|
|
|
|
procedure TTestSuiteHTMLWriter.HandleVerbose(lvl: TVerboseLevel; const aMsg: String);
|
|
|
|
Const
|
|
StyleNames : Array[TVerboseLevel] of string
|
|
= ('Abort','Error','Warning','Normal','Debug','SQL');
|
|
begin
|
|
LDumpln(Format('<span class="log%s" >%s</span><br>',[StyleNames[lvl],aMsg]));
|
|
end;
|
|
|
|
procedure TTestsuiteHTMLWriter.LDump(Const St : String);
|
|
|
|
var
|
|
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);
|
|
Dump(ShortS);
|
|
end;
|
|
ShortS:=Copy(St,p,255);
|
|
Dump(ShortS);
|
|
end;
|
|
|
|
procedure TTestsuiteHTMLWriter.LDumpLn(Const St : String);
|
|
begin
|
|
LDump(St);
|
|
LDump(LineFeed);
|
|
end;
|
|
|
|
end.
|
|
|