Use default URL for sources if CategoryId <= 1

tests/utils/testsuite/tscgiapp.pp

@@ -1,1180 +0,0 @@
-unit tscgiapp;
-
-{$mode objfpc}
-{$h+}
-{$WARN 5024 off : Parameter "$1" not used}
-
-interface
-
-uses
-   classes, httpdefs, fphttp, cgiapp, fpcgi, custcgi, inifiles, types,  sysutils,
-   sqldb, whtml, db, dbwhtml,
-   tsgraph, dbtests, tssql, tshistory, tresults, tsconsts, testu, tshtml;
-
-Type
-  { TTestSuite }
-
-  TTestSuite = Class(TCustomHTTPModule)
-  Private
-    FResponse: TResponse;
-    FTitle: String;
-    FVars: TQueryData;
-    FRunData : TTestRunData;
-    FCompareRunData :TTestRunData;
-    FPlatFormID : Integer;
-    FHTMLWriter : TTestSuiteHtmlWriter;
-    FSQL : TTestSQL;
-    FConstructSQL : TTestSuiteSQL;
-    FRunStats : TRunStats;
-    FInfo : TDBInfo;
-    FRequest : TRequest;
-    FContent : TStream;
-    procedure DoDetailURL(aRunID: Int64; aDate: TDateTime; out aURl: String);
-    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) ;
-    function CreateTestSQL: TTestSQL;
-    function GetVersionControlURL: string;
-    procedure ShowAllHistoryData(aQuery: TSQLQuery);
-    procedure ShowLastLog(aRunID: Int64; aTestID, aPlatformID: Integer);
-    procedure ShowSourceFile;
-    procedure WriteTestInfo;
-  Public
-    constructor createnew(aOwner : TComponent; CreateMode: Integer); override;
-    destructor destroy; override;
-    procedure HandleRequest(ARequest: TRequest; AResponse: TResponse); override;
-    Function InitCGIVars : Integer;
-    Procedure DoRun; // override;
-    Procedure ShowRunResults;
-    Procedure ShowRunComparison;
-    Procedure ShowOneTest;
-    Procedure ShowHistory;
-    Function ConnectToDB : Boolean;
-    procedure DisconnectFromDB;
-    Procedure ShowRunOverview;
-    Procedure CreateRunPie;
-    Function  ShowRunData : Boolean;
-    Procedure LDump(Const St : String);
-    Procedure LDumpLn(Const St : String);
-    Property Title : String Read FTitle Write FTitle;
-    Property Request : TRequest Read FRequest;
-    Property Response : TResponse Read FResponse;
-  end;
-
-Procedure HandleTestSuiteRequest(aRequest : TRequest; aResponse : TResponse);
-
-implementation
-
-uses
-  wformat,
-  dateutils;
-
-Procedure HandleTestSuiteRequest(aRequest : TRequest; aResponse : TResponse);
-
-Var
-  Suite : TTestSuite;
-
-begin
-  Suite:=TTestSuite.CreateNew(Nil);
-  try
-    Suite.Title:='Free Pascal Compiler Test Suite Results';
-    Suite.HandleRequest(aRequest,aResponse);
-    aResponse.SendResponse;
-  finally
-    Suite.Free;
-  end;
-
-end;
-
-
-procedure TTestSuite.DoRun;
-
-var
-  lAction : integer;
-
-begin
-//  Terminate;
-  Try
-    ConnectToDB;
-    lAction:=InitCGIVars;
-    if (FVars.RunID>0) and not FSQL.GetRunData(FVars.RunID,FRunData) then
-      FRunData.RunID:=-1;
-    if (FVars.CompareRunID>0) and not FSQL.GetRunData(FVars.CompareRunID,FCompareRunData) then
-      FCompareRunData.RunID:=-1;
-    Case lAction of
-      faction_show_overview :
-        begin
-        FHTMLWriter.EmitOverviewForm(Title);
-        ShowRunOverview;
-        end;
-      faction_show_run_results :
-        if (FVars.CompareRunID<=0) then
-          ShowRunResults
-        else
-          ShowRunComparison;
-      faction_show_run_pie : CreateRunPie;
-      faction_show_one_test : ShowOneTest;
-      faction_show_history : ShowHistory;
-      faction_compare_with_previous :
-        begin
-          FVars.CompareRunID:=FVars.RunID;
-          FVars.RunID:=FVars.PreviousRunID;
-          ShowRunComparison;
-        end;
-      faction_compare_with_next :
-        begin
-          FVars.CompareRunID:=FVars.NextRunID;
-          ShowRunComparison;
-        end;
-      faction_compare2_with_previous :
-        begin
-          FVars.RunID:=FVars.Previous2RunID;
-          ShowRunComparison;
-        end;
-      faction_compare2_with_next :
-        begin
-          FVars.RunID:=FVars.CompareRunID;
-          FVars.CompareRunID:=FVars.Next2RunID;
-          ShowRunComparison;
-        end;
-      faction_compare_both_with_previous :
-        begin
-          FVars.RunID:=FVars.PreviousRunID;
-          FVars.CompareRunID:=FVars.Previous2RunID;
-          ShowRunComparison;
-        end;
-      faction_compare_both_with_next :
-        begin
-          FVars.RunID:=FVars.NextRunID;
-          FVars.CompareRunID:=FVars.Next2RunID;
-          ShowRunComparison;
-        end;
-      end;
-  finally
-    FHTMLWriter.EmitEnd;
-    DisConnectFromDB;
-  end;
-end;
-
-
-function TTestSuite.InitCGIVars: Integer;
-
-var
-  L : TStrings;
-begin
-  TestsuiteCGIURL:=Request.ScriptName;
-  DateSeparator:='/';
-  L:=TStringList.Create;
-  try
-    FVars.InitFromVars(FSQL,Request.QueryFields);
-  finally
-    L.Free;
-  end;
-  Result:=FVars.Action;
-  SDetailsURL := TestsuiteCGIURL + '?action=1&amp;run1id=%s';
-end;
-
-procedure TTestSuite.DoDetailURL(aRunID: Int64; aDate: TDateTime; out aURl: String);
-var
-  lDate : String;
-begin
-  if aDate=0 then
-    lDate:='never'
-  else
-    lDate:=DateToStr(aDate);
-  aURL:=Self.FHTMLWriter.FormatDetailURL(IntToStr(aRunID),lDate);
-end;
-
-function TTestSuite.CreateTestSQL : TTestSQL;
-
-var
-  aIni : TCustomIniFile;
-  lPort : Integer;
-  lHostName,lDatabaseName,lUserName,lPassword : String;
-
-begin
-  Result:=Nil;
-  aIni:=TMemIniFile.Create(DefaultDBConfigFileName);
-  try
-    With aIni do
-      begin
-      lHostName:=ReadString(SSection,KeyHost,'localhost');
-      lDatabaseName:=ReadString(SSection,KeyName,'testsuite');
-      lUserName:=ReadString(SSection,KeyUser,'');
-      lPassword:=ReadString(SSection,KeyPassword,'');
-      lPort:=ReadInteger(SSection,KeyPort,0);
-      end;
-  finally
-    aIni.Free;
-  end;
-  if (lHostName='') or (lDatabaseName='') or (lUserName='') or (lPassword='') then
-    exit;
-  Result:=TTestSQL.create(lDatabaseName,lHostName,lUserName,lPassword,lPort);
-end;
-
-constructor TTestSuite.createnew(aOwner: TComponent; CreateMode: Integer);
-
-begin
-  inherited createNew(aOwner,CreateMode);
-
-  FSQL:=CreateTestSQL;
-  FInfo:=TDBInfo.Create;
-  FVars:=TQueryData.Create;
-  FConstructSQL:=TTestSuiteSQL.create(FVars,FSQL,FInfo);
-  FContent:=TMemoryStream.Create;
-  FHtmlWriter:=TTestSuiteHTMLWriter.Create(FContent,FSQL,FVars);
-  OnVerbose:[email protected];
-end;
-
-destructor TTestSuite.destroy;
-begin
-  OnVerbose:=Nil;
-  FreeAndNil(FContent);
-  FreeAndNil(FConstructSQL);
-  FreeAndNil(FInfo);
-  FreeAndNil(FVars);
-  FreeAndNil(FSQL);
-  inherited destroy;
-end;
-
-procedure TTestSuite.HandleRequest(ARequest: TRequest; AResponse: TResponse{; var AHandled: Boolean});
-
-begin
-  FRequest:=aRequest;
-  FResponse:=aResponse;
-  try
-    DoRun;
-    aResponse.ContentStream:=FContent;
-  finally
-    FRequest:=Nil;
-    FResponse:=Nil;
-  end;
-end;
-
-function TTestSuite.ConnectToDB: Boolean;
-
-begin
-  Result:=False;
-  Result:=FSQL.ConnectToDatabase;
-  if not Result then
-    exit;
-  FInfo.AllCategoryID:=FSQL.GetCategoryID('All');
-  FInfo.AllOSID:=FSQL.GetOSID('All');
-  FInfo.AllCPUID:=FSQL.GetCPUID('All');
-  if FVars.OSID <= 0 then
-    FVars.OSID:=FInfo.AllOSID;
-  if FVars.CPUID<=0 then
-    FVars.CPUID:=FInfo.AllCPUID;
-end;
-
-
-procedure TTestSuite.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);
-      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(FSQL) then
-    begin
-    FSQL.DisconnectDatabase;
-    FreeAndNil(FSQL);
-    end;
-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;
-
-procedure TTestSuite.ShowRunOverview;
-
-var
-  Qry : String;
-  Q : TSQLQuery;
-  A : String;
-  lTable : TTableProducer;
-
-begin
-  A:=SDetailsURL;
-  If FVars.OnlyFailed then
-    A:=A+'&amp;failedonly=1';
-  If FVars.NoSkipped then
-    A:=A+'&amp;noskipped=1';
-  Qry:=FConstructSQL.GetRunOverviewSQL;
-  If FVars.Debug then
-    Writeln('Query : '+Qry);
-  lTable:=Nil;
-  Q:=FSQL.CreateQuery(Qry);
-  try
-    Q.Open;
-    lTable:=FHTMLWriter.CreateTableProducer(Q);
-    lTable.Border:=True;
-    lTable.OnGetRowAttributes:=@GetOverViewRowAttr;
-    lTable.CreateColumns(Nil);
-    With lTable.TableColumns do
-      begin
-      ColumnByName('ID').ActionURL:=A;
-      ColumnByName('Failed').OnGetCellContents:[email protected];
-      ColumnByName('rev').OnGetCellContents:[email protected];
-      ColumnByName('comprev').OnGetCellContents:[email protected];
-      ColumnByName('rtlrev').OnGetCellContents:[email protected];
-      ColumnByName('packrev').OnGetCellContents:[email protected];
-      ColumnByName('testsrev').OnGetCellContents:[email protected];
-      end;
-    lTable.CreateTable(FContent);
-    FHTMLWriter.DumpLn(Format('<p>Record count: %d</p>',[Q.RecordCount]));
-  finally
-    lTable.Free;
-    Q.Free;
-  end;
-end;
-
-function TTestSuite.ShowRunData: Boolean;
-
-  procedure EmitOneRow(RowTitle,FieldLeft,FieldRight : String; is_same : boolean);
-    var
-      FieldColor : string;
-    begin
-      if (FieldRight='') then
-        FieldColor:=''
-      else if is_same then
-        FieldColor:='style="color:green;"'
-      else
-        FieldColor:='style="color:red;"';
-      With FHTMLWriter do
-        begin
-          RowNext;
-          if FieldColor<>'' then
-            begin
-              TagStart('TD',FieldColor);
-            end
-          else 
-            CellStart;
-          LDumpLn(RowTitle);
-          if FieldColor<>'' then
-            begin
-              CellEnd;
-              TagStart('TD',FieldColor);
-            end
-          else 
-            CellNext;
-          LDumpLn(FieldLeft);
-          if FieldColor<>'' then
-            begin
-             CellEnd;
-             TagStart('TD',FieldColor);
-            end
-          else 
-            CellNext;
-          LDumpLn(FieldRight);
-          CellEnd;
-        end;
-    end;
-
-  procedure EmitOneRow(RowTitle,FieldLeft,FieldRight : String);
-    var
-      is_same : boolean;
-    begin
-      is_same:=(FieldLeft=FieldRight);
-      EmitOneRow(RowTitle,FieldLeft,FieldRight,is_same);
-    end;
-
-var
-  aData,aCompData : TTestRunData;
-  AddNewPar : Boolean;
-
-  procedure EmitRow(RowTitle,FieldName : String);
-    var
-      FieldLeft, FieldRight : String;
-    begin
-      FieldLeft:=aData.GetField(FieldName);
-      if aCompData.RunID>0 then
-        FieldRight:=aCompData.GetField(FieldName)
-      else
-        FieldRight:='';
-      EmitOneRow(RowTitle,FieldLeft,FieldRight);
-    end;
-
-  procedure MaybeEmitButton(const aVar,aValue : String; aCondition : boolean);
-
-  begin
-    if not aCondition then exit;
-    FHTMLWriter.EmitSubmitButton(aVar,aValue);
-    AddNewPar:=True;
-  end;
-
-  procedure CheckPar;
-  begin
-    if not AddNewPar then exit;
-    FHTMLWriter.ParagraphEnd;
-    FHTMLWriter.ParaGraphStart;
-  end;
-
-Var
-  isComp : Boolean;
-  FLeft,FRight : string;
-  Date1, Date2 : String;
-  lNextRunID,lNext2RunID : Int64;
-  lPreviousRunID,lPrevious2RunID : Int64;
-  same_date : boolean;
-  CompilerDate1, CompilerDate2 : string;
-
-begin
-  lNextRunID:=-1;
-  lNext2RunID:=-1;
-  lPreviousRunID:=-1;
-  lPrevious2RunID:=-1;
-
-  Result:=(FVars.RunID<>-1);
-  If not Result then
-    exit;
-  if Not FSQL.GetRunData(FVars.RunID,aData) then
-    exit;
-  isComp:=FVars.CompareRunID>0;
-  if isComp and Not FSQL.GetRunData(FVars.CompareRunID,aCompData) then
-    exit;
-  With FHTMLWriter do
-    begin
-    FormStart(TestsuiteCGIURL,'get');
-    TableStart(3,true);
-    RowStart;
-      CellStart;
-        DumpLn('Run ID:');
-      CellNext;
-        EmitInput('run1id',IntToStr(FVars.RunID));
-      CellNext;
-        EmitInput('run2id',IntToStr(FVars.CompareRunID));
-      CellEnd;
-
-    EmitRow('Operating system:','os');
-    EmitRow('Processor:','cpu');
-    EmitRow('Version:','VERSION');
-    if Not IsComp then
-      FRight:=''
-    else
-      begin
-        FRight:=aCompData.GetField('Failed')+
-                '/'+aCompData.GetField('Ok')+
-                '/'+aCompData.GetField('Total');
-      end;
-    EmitOneRow('Fails/OK/Total:',
-         aData.GetField('Failed')+
-         '/'+aData.GetField('Ok')+
-         '/'+aData.GetField('Total'),
-      FRight);
-    EmitRow('Version:','VERSION');
-    EmitRow('Full version:','COMPILERFULLVERSION');
-    EmitRow('Config:','CONFIG');
-    EmitRow('Machine:','TP_MACHINE');
-    if (FVars.CategoryID>0) then
-      EmitRow('Category:','TU_CATEGORY_FK');
-    If (FVars.CategoryID=1) then
-      begin
-        FLeft:=aData.GetField('rev');
-        FormatSVNData(FLeft);
-        if isComp then
-          begin
-            FRight:=aCompData.GetField('rev');
-            FormatSVNData(FRight);
-          end
-        else
-          FRight:='';
-        EmitOneRow('SVN revisions:',FLeft,FRight);
-      end;
-    EmitRow('Submitter:','SUBMITTER');
-    Date1 := aData.GetField('date');
-    if Not IsComp then
-      FRight:=''
-    else
-      begin
-      Date2 := aCompData.GetField('date');
-      FRight:=Date2;
-      end;
-    same_date:=(date1=Date2);
-    EmitOneRow('Date:',Date1,FRight,same_date);
-    CompilerDate1 := aData.GetField('compilerdate');
-    if Not IsComp then
-      FRight:=''
-    else
-      begin
-      CompilerDate2 := aCompData.GetField('compilerdate');
-      FRight:=CompilerDate2;
-      end;
-    same_date:=(CompilerDate1=CompilerDate2);
-    EmitOneRow('CompilerDate:',CompilerDate1,FRight,same_date);
-    lPreviousRunID:=FSQL.GetPreviousRunID(aData.RunID);
-    EmitHiddenVar('previousrunid',lPreviousRunID);
-    FLeft:=IntToStr(lPreviousRunID);
-    if IsComp then
-      begin
-        lPrevious2RunID:=FSQL.GetPreviousRunID(FVars.CompareRunID);
-        FRight:=IntToStr(lPrevious2RunID);
-        EmitHiddenVar('previous2runid',lPrevious2RunID);
-      end
-    else
-      FRight:='';
-    EmitOneRow('Previous run:',FLeft,FRight);
-    lNextRunID:=FSQL.GetNextRunID(FVars.RunID);
-    EmitHiddenVar('nextrunid',lNextRunID);
-    FLeft:=IntToStr(lNextRunID);
-    if IsComp then
-      begin
-        lNext2RunID:=FSQL.GetNextRunID(FVars.CompareRunID);
-        FRight:=IntToStr(lNext2RunID);
-        EmitHiddenVar('next2runid',lNext2RunID);
-      end;
-    EmitOneRow('Next run:',FLeft,FRight);
-    RowEnd;
-    TableEnd;
-    ParagraphStart;
-    if FVars.Debug then
-      EmitHiddenVar('DEBUGCGI', '1');
-    EmitCheckBox('noskipped','1',FVars.NoSkipped);
-    DumpLn(' Hide skipped tests');
-    ParagraphEnd;
-    ParagraphStart;
-    EmitCheckBox('failedonly','1',FVars.onlyFailed);
-    DumpLn(' Hide successful tests');
-    ParagraphEnd;
-    ParaGraphStart;
-    AddNewPar:=false;
-    MaybeEmitButton('action', 'Compare_to_previous', lPreviousRunID<>-1);
-    MaybeEmitButton('action', 'Compare_to_next', (lNextRunID<>-1) and (lNextRunID <> FVars.CompareRunID));
-    MaybeEmitButton('action', 'Compare_right_to_previous', (lPrevious2RunID<>-1) and (lPrevious2RunID <> FVars.RunID));
-    MaybeEmitButton('action', 'Compare_right_to_next',lNext2RunID<>-1);
-    CheckPar;
-    MaybeEmitButton('action', 'Compare_both_to_previous', (lPrevious2RunID<>-1) and (lPreviousRunId<>-1));
-    MaybeEmitButton('action', 'Compare_both_to_next', (lNext2RunID<>-1) and (lNextRunId<>-1));
-    CheckPar;
-    MaybeEmitButton('action','Show/Compare',True);
-    MaybeEmitButton('action','View_history',FVars.TestFileID<>-1);
-    EmitResetButton('','Reset form');
-    ParagraphEnd;
-    FormEnd;
-    { give warning if dates reversed }
-    if IsComp and (aData.Date > aCompData.Date) then
-      begin
-      ParagraphStart;
-      DumpLn('Warning: testruns are not compared in chronological order.');
-      ParagraphEnd;
-      end;
-    end;
-end;
-
-procedure TTestSuite.ShowRunResults;
-
-Var
-  S : String;
-  Qry : String;
-  Q : TSQLQuery;
-  FL : String;
-  lTable : TTableProducer;
-
-begin
-  Response.ContentType:='text/html';
-  //EmitContentType;
-  With FHTMLWriter do
-    begin
-    EmitDocType;
-    EmitTitle(Title+' : Search Results');
-    HeaderStart(1);
-    DumpLn('Test suite results for run '+IntToStr(FVars.RunID));
-    HeaderEnd(1);
-    HeaderStart(2);
-    DumpLn('Test run data : ');
-    HeaderEnd(2);
-    If not ShowRunData then
-      begin
-      DumpLn('No data for test run with ID: '+IntToStr(FVars.RunID));
-      Exit;
-      end;
-    HeaderStart(2);
-    DumpLn('Detailed test run results:');
-    FL:='';
-    If FVars.OnlyFailed or FVars.NoSkipped then
-      begin
-      FL:='';
-      If FVars.OnlyFailed then
-        FL:='successful';
-      if FVars.NoSkipped then
-        begin
-        If (FL<>'') then
-          FL:=FL+' and ';
-        FL:=FL+'skipped';
-        end;
-      DumpLn(' ('+FL+' tests are hidden)');
-      end;
-    HeaderEnd(2);
-    FPlatFormID:=FSQL.GetPlatformID(FVars.RunID);
-    S:=Format(SQLSelectTestResults,[FVars.RunID,FPlatformID]);
-    If FVars.OnlyFailed then
-      S:=S+' AND (not TR_OK)';
-    If FVars.NoSkipped then
-      S:=S+' AND (not TR_SKIP)';
-    S:=S+' ORDER BY TR_ID ';
-    Qry:=S;
-    If FVars.Debug then
-      begin
-      ParaGraphStart;
-      Dumpln('Query : '+Qry);
-      ParaGraphEnd;
-      end;
-    end;
-  Q:=FSQL.CreateQuery(Qry);
-  try
-    Q.PacketRecords:=-1;
-    Q.Open;
-    FHTMLWriter.DumpLn(Format('<p>Record count: %d </p>',[Q.RecordCount]));
-    FL:='Id,Filename';
-    If Not FVars.NoSkipped then
-      FL:=FL+',Skipped';
-    If Not FVars.OnlyFailed then
-      FL:=FL+',OK';
-    FL:=FL+',Result';
-    lTable:=FHTMLWriter.CreateTableProducer(Q);
-    lTable.Border:=True;
-    lTable.CreateColumns(FL);
-    lTable.OnGetRowAttributes:=@GetRunRowAttr;
-    With lTable.TableColumns do
-      begin
-      ColumnByName('Id').OnGetCellContents:[email protected];
-      ColumnByName('Filename').OnGetCellContents:[email protected];
-      ColumnByName('Result').OnGetCellContents:[email protected];
-      end;
-    lTable.CreateTable(FContent); //Response);
-  finally
-    lTable.Free;
-    Q.Free;
-  end;
-  If Not (FRunStats.OKCount=0) and not (FVars.NoSkipped and FVars.OnlyFailed) then
-    FHTMLWriter.EmitPieImage(FRunStats.OKCount,FRunStats.FailedCount,FRunStats.SkipCount);
-end;
-
-procedure TTestSuite.ShowOneTest;
-
-Var
-  Qry : String;
-  Q : TSQLQuery;
-  Res : Boolean;
-  lTable : TTableProducer;
-
-begin
-  Response.ContentType:='text/html';
-//  EmitContentType;
-  With FHTMLWriter do
-    begin
-    EmitDocType;
-    EmitTitle(Title+' : File '+FVars.TestFileName+' Results');
-    HeaderStart(1);
-    DumpLn('Test suite results for test file '+FVars.TestFileName);
-    HeaderEnd(1);
-    HeaderStart(2);
-    DumpLn('Test run data : ');
-    HeaderEnd(2);
-    if FVars.RunID<>-1 then
-      Res:=ShowRunData
-    else
-      Res:=True;
-    If not Res then
-      begin
-      DumpLn(Format('No data for test file with ID: %s',[FVars.TestFileID]));
-      exit;
-      end;
-    WriteTestInfo;
-    Qry:=FConstructSQL.GetSimpleTestResultsSQL;
-    If FVars.Debug then
-    begin
-      ParaGraphStart;
-      Dumpln('Query : '+Qry);
-      ParaGraphEnd;
-    end;
-    FRunStats:=Default(TRunStats);
-    lTable:=nil;
-    Q:=FSQL.CreateQuery(Qry);
-    try
-      Q.Open;
-      lTable:=CreateTableProducer(Q);
-      lTable.Border:=True;
-      lTable.CreateColumns(Nil);
-      With lTable.TableColumns do
-        begin
-        Delete(ColumnByName('TR_TEST_FK').Index);
-        ColumnByName('RUN').OnGetCellContents:=@FormatTestRunOverview;
-        ColumnByName('TR_RESULT').OnGetCellContents:=@FormatTestResult;
-        end;
-      lTable.CreateTable(FContent); // Response);
-      ParaGraphStart;
-      DumpLn(Format('Record count: %d',[Q.RecordCount]));
-      ParaGraphEnd;
-    finally
-      lTable.Free;
-      Q.Free;
-    end;
-    if FVars.RunId<>-1 then
-      ShowLastLog(FVars.RunId,fvars.testfileid,FRunData.PlatformID);
-    if FVars.CompareRunId<>-1 then
-      ShowLastLog(FVars.CompareRunId,fvars.testfileid,FRunData.PlatformID);
-    if FVars.Debug then
-      DumpLn(Format('After Log. Run ID: %d, Testfile ID: %d',[fvars.RunID, fvars.testfileid]));
-    ShowSourceFile;
-    end;
-end;
-
-procedure TTestSuite.ShowLastLog(aRunID : Int64; aTestID,aPlatformID : Integer);
-var
-  LLog : String;
-begin
-  LLog:=FSQL.StringQuery(Format('select TR_LOG from TESTLASTRESULTS left join testresults on (TL_TESTRESULTS_FK=TR_ID) where (TR_TEST_FK=%d) and (TL_PLATFORM_FK=%d)',[aTestID,aPlatformID]));
-  With FHTMLWriter do
-    if LLog<>'' then
-      begin
-      HeaderStart(2);
-      DumpLn(Format('No log of %d:',[aRunId]));
-      HeaderEnd(2);
-      end
-    else
-      begin
-      HeaderStart(2);
-      DumpLn(Format('Log of %d:',[aRunID]));
-      HeaderEnd(2);
-      PreformatStart;
-      system.Write(LLog);
-      system.flush(output);
-      PreformatEnd;
-      end;
-end;
-
-procedure TTestSuite.WriteTestInfo;
-
-var
-  lTestInfo : TTestInfo;
-
-begin
-  With FHTMLWriter do
-    begin
-    HeaderStart(2);
-    DumpLn('Test file "'+FVars.TestFileName+'" information:');
-    HeaderEnd(2);
-    ParaGraphStart;
-    if (FVars.TestFileID<>-1) and FSQL.GetTestInfo(FVars.TestFileID,lTestInfo) then
-      DumpTestInfo(lTestInfo);
-    ParaGraphEnd;
-    HeaderStart(2);
-    DumpLn('Detailed test run results:');
-    HeaderEnd(2);
-    end;
-end;
-
-
-procedure TTestSuite.ShowHistory;
-
-Var
-  Res : Boolean;
-  Qry : String;
-  Q : TSQLQuery;
-  TS : TTestStatus;
-  lHistory : TTestHistoryInfo;
-  lOSMap,lCPUMap,lVersionMap : TIntegerDynArray;
-  lTable : TTableProducer;
-
-begin
-//  Res:=False;
-  Response.ContentType:='text/html';
-  // EmitContentType;
-  lTable:=nil;
-  Q:=Nil;
-  try
-    With FHTMLWriter do
-      begin
-      EmitDocType;
-      if FVars.TestFileName<>'' then
-        EmitTitle(Title+' : File '+FVars.TestFileName+' Results')
-      else
-        EmitTitle(Title+' : History overview');
-      if FVars.TestFileName<>'' then
-        begin
-          HeaderStart(1);
-          DumpLn('Test suite results for test file '+FVars.TestFileName);
-          HeaderEnd(1);
-          HeaderStart(2);
-          DumpLn('Test run data : ');
-          HeaderEnd(2);
-        end;
-      if FVars.RunID<>-1 then
-        Res:=ShowRunData
-      else
-        begin
-        EmitHistoryForm(Title);
-        Res:=(FVars.TestFileID<>-1);
-        if not Res then
-          begin
-          HeaderStart(2);
-          if Trim(FVars.TestFileName) <> '' then
-            DumpLn(Format('Error: No test files matching "%s" found.', [FVars.TestFileName]))
-          else
-            DumpLn('Error: Please specify a test file.');
-          HeaderEnd(2);
-          end;
-        end;
-      If not Res then
-        exit;
-      if (FVars.TestFileName<>'') then
-        WriteTestInfo;
-      ParaGraphStart;
-      If not FInfo.IsAllCPU(FVars.CPUID) then
-        lCPUMap:=FSQL.CreateMap(mtCPU);
-      If not FInfo.IsAllOS(FVars.OSID) then
-        lOSMap:=FSQL.CreateMap(mtOS);
-      if not FInfo.IsAllVersion(fVars.VersionID) then
-        lVersionMap:=FSQL.CreateMap(mtVersion);
-      lHistory:=TTestHistoryInfo.Create(FSQL,lOSMap,lCPUMap,lVersionMap);
-      lHistory.OnGetDetailURL:=@DoDetailURL;
-
-      Qry:=FConstructSQL.GetTestResultsSQL;
-      If FVars.Debug then
-      begin
-        Writeln(system.stdout,'Query : '+Qry);
-        system.Flush(system.stdout);
-      end;
-      FRunStats:=Default(TRunStats);
-      Q:=FSQL.CreateQuery(Qry);
-      Q.PacketRecords:=-1;
-      Q.Open;
-      lHistory.UpdateFromDataset(Q);
-      DumpLn(Format('<p>Total = %d </p>',[lHistory.total_count]));
-      if lHistory.Total_count > 0 then
-        DumpLn(Format('<p>OK=%d Percentage= %3.2f </p>',[lHistory.OK_count,lHistory.OK_count*100/lHistory.total_count]));
-      if lHistory.Skip_count > 0 then
-        DumpLn(Format('<p>Skipped=%d Percentage= %3.2f </p>',[lHistory.Skip_count,lHistory.Skip_count*100/lHistory.total_count]));
-      if lHistory.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 lHistory.Result_count[TS]>0 then
-            begin
-              lHistory.WriteCounts(FHTMLWriter,TS);
-              lHistory.WriteCPUHistory(FHTMLWriter,TS);
-              lHistory.WriteOSHistory(FHTMLWriter,TS);
-              lHIstory.WriteVersionHistory(FHTMLWriter,TS);
-            end;
-        if lHistory.total_count>0 then
-          begin
-            TableEnd;
-          end;
-      end; // FHTMLWriter;
-    If FVars.Debug or FVars.ListAll then
-      ShowAllHistoryData(Q);
-    ShowSourceFile;
-  Finally
-    lTable.Free;
-    Q.Free;
-  end;
-end;
-
-procedure TTestSuite.ShowAllHistoryData(aQuery: TSQLQuery);
-
-var
-  FL : String;
-  lTable : TTableProducer;
-begin
-  aQuery.First;
-  FL:='RUN,Date,OK,SKIP,Result';
-  if FVars.Submitter='' then
-    FL:=FL+',Submitter';
-  if FVars.Machine='' then
-    FL:=FL+',Machine';
-  if FVars.Config='' then
-    FL:=FL+',Config';
-  if (FVars.OSID=-1) or (FVars.OSID=FInfo.AllOSID) then
-    FL:=FL+',OS';
-  if (FVars.CPUID=-1) or (FVars.CPUID=FInfo.AllCPUID) then
-    FL:=FL+',CPU';
-  if (FVars.VersionID=-1) or (FVars.VersionID=FInfo.AllVersionID) then
-    FL:=FL+',Version';
-  FL:=FL+',Fails,CompDate';
-  FL:=FL+',Tests_rev,RTL_rev,Compiler_rev,Packages_rev';
-  lTable:=FHTMLWriter.CreateTableProducer(aQuery);
-  try
-    lTable.Border:=True;
-    lTable.CreateColumns(FL);
-    lTable.TableColumns.ColumnByName('RUN').OnGetCellContents:[email protected];
-    lTable.TableColumns.ColumnByName('Result').OnGetCellContents:[email protected];
-    lTable.CreateTable(FContent); //Response);
-  finally
-    lTable.Free
-  end;
-end;
-
-
-function TTestSuite.GetVersionControlURL : string;
-
-var
-  Base,lURL : String;
-  ver : known_versions;
-  Index : Integer;
-
-begin
-  Base:='trunk';
-  if  FVars.VersionBranch<>'' 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]=FVars.VersionBranch then
-          begin
-            base:=ver_branch[ver];
-            break;
-          end;
-    end;
-  index:=pos('/',Base);
-  if index>0 then
-    Base:=Copy(Base,index+1,length(Base));
-  if Base='trunk' then
-    Base:='main';
-  lURL:=ViewGitHashURL+Base;
-  if FVars.CategoryID=1 then
-    lURL:=lURL+TestsSubDir
-  else
-    begin
-    lURL:=lURL+DataBaseSubDir;
-    // This assumes that type TAnyType is
-    // defined in anytype.pas source PM
-    if pos('/',FVars.TestFileName)>0 then
-      FVars.Testfilename:=lowercase(copy(FVars.TestFilename,2,pos('/',FVars.TestFilename)-2)+'.pas');
-    end;
-  Result:=lURL;
-end;
-
-procedure TTestSuite.ShowSourceFile;
-
-var
-  lFN,lUrl,Source : String;
-
-begin
-  Source:='';
-  lFn:=FVars.TestFileName;
-  if (fvars.testfileid <> -1) then
-    Source:=FSQL.GetTestSource(fvars.testfileid);
-  With FHTMLWriter do
-    begin
-    if Source<>'' then
-      begin
-      HeaderStart(2);
-      DumpLn('Source:');
-      HeaderEnd(2);
-      PreformatStart;
-      Dumpln(Source);
-      PreformatEnd;
-      end;
-    if (Source='') then
-      DumpLn('<P>No Source in TestSuite DataBase.</P>');
-    lURL:=GetVersionControlURL;
-    HeaderStart(3);
-    DumpLn('Link to Git view of '+
-         '<A HREF="'+lURL+lFn+'?view=markup'+
-         '" TARGET="fpc_source"> '+lFN+'</A> source. ');
-    HeaderEnd(3);
-    end;
-end;
-
-procedure TTestSuite.ShowRunComparison;
-
-Var
-  Qry : String;
-  Q : TSQLQuery;
-  FL : String;
-  lTable : TTableProducer;
-
-begin
-  Response.ContentType:='text/html';
-//  EmitContentType;
-  With FHTMLWriter do
-    begin
-    EmitDocType;
-    EmitTitle(Title+' : Compare 2 runs');
-    HeaderStart(1);
-    DumpLn(Format('Test suite results for run %d vs. %d',[FVars.RunID,FVars.CompareRunID]));
-    HeaderEnd(1);
-    HeaderStart(2);
-    DumpLn('Test run data: ');
-    HeaderEnd(2);
-    If Not ShowRunData then
-      begin
-      DumpLn(Format('No data for test run with ID: %d',[FVars.RunID]));
-      exit;
-      end;
-    HeaderStart(2);
-    DumpLn('Detailed test run results:');
-    FL:='';
-    If FVars.OnlyFailed or FVars.NoSkipped then
-      begin
-      FL:='';
-      If FVars.OnlyFailed then
-        FL:='successful';
-      if FVars.NoSkipped then
-        begin
-        If (FL<>'') then
-          FL:=FL+' and ';
-        FL:=FL+'skipped';
-        end;
-      DumpLn(' ('+FL+' tests are hidden)');
-      end;
-    HeaderEnd(2);
-    ParaGraphStart;
-    end;
-  Qry:=FConstructSQL.GetCompareRunSQL;
-  If FVars.Debug then
-    begin
-    system.WriteLn('Query: '+Qry);
-    system.Flush(stdout);
-    end;
-  FRunStats:=Default(TRunStats);
-  Q:=FSQL.CreateQuery(Qry);
-  try
-    Q.Open;
-    FL:='Id,Filename,Run1_OK,Run2_OK';
-    If Not FVars.NoSkipped then
-      FL:=FL+',Run1_Skipped,Run2_Skipped';
-    FL:=FL+',Run1_Result,Run2_Result';
-    lTable:=FHTMLWriter.CreateTableProducer(Q);
-    lTable.Border:=True;
-    lTable.CreateColumns(FL);
-    lTable.OnGetRowAttributes:=@GetRunRowAttr;
-    With lTable.TableColumns do
-      begin
-      ColumnByName('Id').OnGetCellContents:[email protected];
-      ColumnByName('Run1_Result').OnGetCellContents:[email protected];
-      ColumnByName('Run2_Result').OnGetCellContents:[email protected];
-      ColumnByName('Filename').OnGetCellContents:[email protected];
-      end;
-    //(TableColumns.Items[0] as TTableColumn).ActionURL:=ALink;
-    lTable.CreateTable(FContent); // Response);
-    FHTMLWriter.DumpLn(format('<p>Record count: %d</P>',[Q.RecordCount]));
-  finally
-    lTable.Free;
-    Q.Free;
-  end;
-  If Not (FRunStats.OKCount=0) and not (FVars.NoSkipped and FVars.OnlyFailed) then
-    FHTMLWriter.EmitPieImage(FRunStats.OKCount,FRunStats.FailedCount,FRunStats.SkipCount);
-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(FRunStats.OKCount);
-  If (FVars.OnlyFailed and FVars.NoSkipped) 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 FVars.NoSkipped) and ((Skip1Field.AsBoolean)
-        or ((Skip2Field <> nil) and (Skip2Field.AsBoolean))) then
-      begin
-      Inc(FRunStats.SkipCount);
-      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(FRunStats.FailedCount);
-      if Run1Field.AsString='' then
-        BGColor:='#FF82AB'    // Light red
-      else if Not Run1Field.AsBoolean then
-        BGColor:='#FF225B';
-      end;
-    end;
-end;
-
-procedure TTestSuite.CreateRunPie;
-
-Var
-  lGraph : TTestSuiteGraph;
-
-begin
-  lGraph:=TTestSuiteGraph.Create(FVars);
-  try
-    If FVars.RunCount=0 Then
-      Raise Exception.Create('Invalid parameters passed to script: No total count');
-    lGraph.DrawPie(FContent,FVars.RunSkipCount,FVars.RunFailedCount,FVars.RunCount);
-    Response.ContentType:='image/png';
-    FContent.Position:=0;
-  Finally
-    lGraph.Free;
-  end;
-end;
-
-begin
-  ShortDateFormat:='yyyy/mm/dd';
-end.

tests/utils/testsuite/tshttp.pp

@@ -976,7 +976,7 @@ begin
   if Base='trunk' then
     Base:='main';
   lURL:=ViewGitHashURL+Base;
-  if FVars.CategoryID=1 then
+  if FVars.CategoryID<=1 then
     lURL:=lURL+TestsSubDir
   else
     begin