mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-28 12:19:27 +02:00
* Move to postgresql
git-svn-id: trunk@28359 -
This commit is contained in:
michael
parent
a61c775d29
commit
32f74d23f1
@ -533,6 +533,7 @@ begin
|
||||
begin
|
||||
readln(logfile,line);
|
||||
fullline:=line;
|
||||
ts:=stFailedToCompile;
|
||||
If analyse(line,TS) then
|
||||
begin
|
||||
Verbose(V_NORMAL,'Analysing result for test '+Line);
|
||||
@ -599,7 +600,6 @@ procedure UpdateTestRun;
|
||||
var
|
||||
i : TTestStatus;
|
||||
qry : string;
|
||||
res : TQueryResult;
|
||||
|
||||
begin
|
||||
qry:='UPDATE TESTRUN SET ';
|
||||
@ -620,8 +620,7 @@ procedure UpdateTestRun;
|
||||
|
||||
qry:=qry+format('TU_SUBMITTER="%s", TU_MACHINE="%s", TU_COMMENT="%s", TU_DATE="%s"',[Submitter,Machine,Comment,SqlDate(TestDate)]);
|
||||
qry:=qry+' WHERE TU_ID='+format('%d',[TestRunID]);
|
||||
if RunQuery(Qry,res) then
|
||||
FreeQueryResult(Res);
|
||||
ExecuteQuery(Qry,False);
|
||||
end;
|
||||
|
||||
function GetTestConfigId : Integer;
|
||||
@ -646,7 +645,6 @@ var
|
||||
qry : string;
|
||||
firstRunID, lastRunID,PrevRunID : Integer;
|
||||
RunCount : Integer;
|
||||
res : TQueryResult;
|
||||
AddCount : boolean;
|
||||
|
||||
begin
|
||||
@ -659,9 +657,7 @@ begin
|
||||
Verbose(V_Warning,format('FirstRunID changed from %d to %d',[FirstRunID,TestRunID]));
|
||||
qry:=format('UPDATE TESTCONFIG SET TCONF_FIRST_RUN_FK=%d WHERE TCONF_ID=%d',
|
||||
[TestRunID,ConfigID]);
|
||||
if RunQuery(qry,res) then
|
||||
FreeQueryResult(res)
|
||||
else
|
||||
if Not ExecuteQuery(qry,False) then
|
||||
Verbose(V_Warning,'Update of LastRunID failed');
|
||||
end;
|
||||
qry:=format('SELECT TCONF_LAST_RUN_FK FROM TESTCONFIG WHERE TCONF_ID=%d',[ConfigID]);
|
||||
@ -670,9 +666,7 @@ begin
|
||||
begin
|
||||
qry:=format('UPDATE TESTCONFIG SET TCONF_LAST_RUN_FK=%d WHERE TCONF_ID=%d',
|
||||
[TestRunID,ConfigID]);
|
||||
if RunQuery(qry,res) then
|
||||
FreeQueryResult(res)
|
||||
else
|
||||
if not ExecuteQuery(qry,False) then
|
||||
Verbose(V_Warning,'Update of LastRunID failed');
|
||||
end
|
||||
else
|
||||
@ -681,14 +675,12 @@ begin
|
||||
PrevRunID:=IDQuery(qry);
|
||||
if TestRunID<>PrevRunID then
|
||||
begin
|
||||
qry:=format('UPDATE TESTCONFIG SET TCONF_NEW_RUN_FK=%d WHERE TCONF_ID=%d',
|
||||
[TestRunID,ConfigID]);
|
||||
if RunQuery(qry,res) then
|
||||
FreeQueryResult(res)
|
||||
else
|
||||
Verbose(V_Warning,'Update of LastRunID failed');
|
||||
AddTestHistoryEntry(TestRunID,PrevRunID);
|
||||
AddCount:=true;
|
||||
qry:=format('UPDATE TESTCONFIG SET TCONF_NEW_RUN_FK=%d WHERE TCONF_ID=%d',
|
||||
[TestRunID,ConfigID]);
|
||||
if not ExecuteQuery(qry,False) then
|
||||
Verbose(V_Warning,'Update of LastRunID failed');
|
||||
AddTestHistoryEntry(TestRunID,PrevRunID);
|
||||
AddCount:=true;
|
||||
end
|
||||
else
|
||||
Verbose(V_Warning,'TestRunID is equal to last!');
|
||||
@ -700,9 +692,7 @@ begin
|
||||
Inc(RunCount);
|
||||
qry:=format('UPDATE TESTCONFIG SET TCONF_COUNT_RUNS=%d WHERE TCONF_ID=%d',
|
||||
[RunCount,ConfigID]);
|
||||
if RunQuery(qry,res) then
|
||||
FreeQueryResult(res)
|
||||
else
|
||||
if not ExecuteQuery(qry,False) then
|
||||
Verbose(V_Warning,'Update of TU_COUNT_RUNS failed');
|
||||
end;
|
||||
UpdateTestConfigID:=true;
|
||||
@ -717,31 +707,23 @@ begin
|
||||
'TCONF_CPU_FK,TCONF_OS_FK,TCONF_VERSION_FK,TCONF_CATEGORY_FK,'+
|
||||
'TCONF_SUBMITTER,TCONF_MACHINE,TCONF_COMMENT,'+
|
||||
'TCONF_NEW_DATE,TCONF_FIRST_DATE,TCONF_LAST_DATE) ';
|
||||
qry:=qry+format(' VALUES(%d,%d,%d,%d,%d,%d,%d,"%s","%s","%s","%s","%s","%s") ',
|
||||
[TestRunID, TestRunID, TestRunID, TestCPUID,
|
||||
TestOSID, TestVersionID, TestCategoryID,
|
||||
Submitter, Machine, Comment,
|
||||
SqlDate(TestDate), SqlDate(TestDate), SqlDate(TestDate)]);
|
||||
qry:=qry+format(' VALUES(%d,%d,%d,%d,%d,%d,%d,"%s","%s","%s","%s","%s","%s") ',
|
||||
[TestRunID, TestRunID, TestRunID, TestCPUID,
|
||||
TestOSID, TestVersionID, TestCategoryID,
|
||||
Submitter, Machine, Comment,
|
||||
SqlDate(TestDate), SqlDate(TestDate), SqlDate(TestDate)]);
|
||||
qry:=qry+' RETURNING TCONF_ID';
|
||||
Result:=InsertQuery(qry);
|
||||
AddTestHistoryEntry(TestRunID,0);
|
||||
end;
|
||||
|
||||
procedure UpdateTestConfig;
|
||||
|
||||
var
|
||||
qry : string;
|
||||
res : TQueryResult;
|
||||
begin
|
||||
qry:='SHOW TABLES LIKE ''TESTCONFIG''';
|
||||
if not RunQuery(Qry,Res) then
|
||||
exit;
|
||||
{ Row_Count is zero if table does not exist }
|
||||
if Res^.Row_Count=0 then exit;
|
||||
FreeQueryResult(Res);
|
||||
if GetTestPreviousRunHistoryID(TestRunID) <> -1 then
|
||||
begin
|
||||
Verbose(V_DEBUG,format('TestRun %d already in TestHistory table',[TestRunID]));
|
||||
exit;
|
||||
Verbose(V_DEBUG,format('TestRun %d already in TestHistory table',[TestRunID]));
|
||||
exit;
|
||||
end;
|
||||
|
||||
if GetTestConfigID >= 0 then
|
||||
|
||||
@ -6,7 +6,7 @@ unit dbtests;
|
||||
Interface
|
||||
|
||||
Uses
|
||||
mysql55dyn, testu;
|
||||
sqldb, testu;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
High-level access
|
||||
@ -34,21 +34,19 @@ function AddTestHistoryEntry(TestRunID,TestPreviousID : Integer) : boolean;
|
||||
Low-level DB access.
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
|
||||
Type
|
||||
TQueryResult = PMYSQL_RES;
|
||||
|
||||
Function ConnectToDatabase(DatabaseName,Host,User,Password,Port : String) : Boolean;
|
||||
Procedure DisconnectDatabase;
|
||||
Function InsertQuery(const Query : string) : Integer;
|
||||
Function RunQuery (Qry : String; Var res : TQueryResult) : Boolean ;
|
||||
Procedure FreeQueryResult (Res : TQueryResult);
|
||||
Function GetResultField (Res : TQueryResult; Id : Integer) : String;
|
||||
Function ExecuteQuery (Qry : String; Silent : Boolean) : Boolean ;
|
||||
Function OpenQuery (Qry : String; Out Res : TSQLQuery; Silent : Boolean) : Boolean ;
|
||||
Procedure FreeQueryResult (Var Res : TSQLQuery);
|
||||
Function GetResultField (Res : TSQLQuery; Id : Integer) : String;
|
||||
Function IDQuery(Qry : String) : Integer;
|
||||
Function StringQuery(Qry : String) : String;
|
||||
Function EscapeSQL( S : String) : String;
|
||||
Function SQLDate(D : TDateTime) : String;
|
||||
|
||||
|
||||
var
|
||||
RelSrcDir,
|
||||
TestSrcDir : string;
|
||||
@ -56,132 +54,145 @@ var
|
||||
Implementation
|
||||
|
||||
Uses
|
||||
SysUtils;
|
||||
SysUtils, pqconnection;
|
||||
|
||||
Var
|
||||
Connection : TPQConnection;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
Low-level DB access.
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
|
||||
Var
|
||||
Connection : PMYSQL;
|
||||
|
||||
|
||||
Function ConnectToDatabase(DatabaseName,Host,User,Password,Port : String) : Boolean;
|
||||
|
||||
Var
|
||||
S : String;
|
||||
PortNb : longint;
|
||||
Error : word;
|
||||
begin
|
||||
Result:=False;
|
||||
Verbose(V_DEBUG,'Connection params : '+DatabaseName+' '+Host+' '+User+' '+Password+' '+Port);
|
||||
if Port<>'' then
|
||||
begin
|
||||
Val(Port,PortNb,Error);
|
||||
if Error<>0 then
|
||||
PortNb:=0;
|
||||
end
|
||||
else
|
||||
PortNB:=0;
|
||||
Connection:=mysql_init(Nil);
|
||||
Result:=mysql_real_connect(Connection,PChar(Host),PChar(User),PChar(Password),Nil,PortNb,Nil,CLIENT_MULTI_RESULTS)<>Nil;
|
||||
If Not Result then
|
||||
begin
|
||||
S:=Strpas(mysql_error(connection));
|
||||
Verbose(V_ERROR,'Failed to connect to database : '+S);
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result:=Mysql_select_db(Connection,Pchar(DatabaseName))>=0;
|
||||
If Not result then
|
||||
Connection:=TPQConnection.Create(Nil);
|
||||
try
|
||||
Connection.Hostname:=Host;
|
||||
Connection.DatabaseName:=DatabaseName;
|
||||
Connection.Username:=User;
|
||||
Connection.Password:=Password;
|
||||
Connection.Connected:=true;
|
||||
if (Port<>'') then
|
||||
Connection.Params.Values['Port']:=Port;
|
||||
except
|
||||
On E : Exception do
|
||||
begin
|
||||
S:=StrPas(mysql_error(connection));
|
||||
DisconnectDatabase;
|
||||
Verbose(V_Error,'Failed to select database : '+S);
|
||||
Verbose(V_ERROR,'Failed to connect to database : '+E.Message);
|
||||
FreeAndNil(Connection);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure DisconnectDatabase;
|
||||
|
||||
begin
|
||||
mysql_close(Connection);
|
||||
FreeAndNil(Connection);
|
||||
end;
|
||||
|
||||
Function RunQuery (Qry : String; Var res : TQueryResult) : Boolean ;
|
||||
Function CreateQuery(Const ASQL : String) : TSQLQuery;
|
||||
|
||||
begin
|
||||
Result:=TSQLQuery.Create(Connection);
|
||||
Result.Database:=Connection;
|
||||
Result.Transaction:=Connection.Transaction;
|
||||
Result.SQL.Text:=ASQL;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Function ExecuteQuery (Qry : String; Silent : Boolean) : Boolean ;
|
||||
|
||||
begin
|
||||
Verbose(V_DEBUG,'Executing query:'+Qry);
|
||||
Result:=False;
|
||||
try
|
||||
With CreateQuery(Qry) do
|
||||
try
|
||||
ExecSQL;
|
||||
Result:=True;
|
||||
(Transaction as TSQLTransaction).Commit;
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
except
|
||||
On E : exception do
|
||||
begin
|
||||
Connection.Transaction.RollBack;
|
||||
if not Silent then
|
||||
Verbose(V_WARNING,'Query : '+Qry+'Failed : '+E.Message);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Function OpenQuery (Qry : String; Out res : TSQLQuery; Silent : Boolean) : Boolean ;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
Verbose(V_DEBUG,'Running query:'+Qry);
|
||||
Result:=mysql_query(Connection,PChar(qry))=0;
|
||||
If Not Result then
|
||||
Verbose(V_WARNING,'Query : '+Qry+'Failed : '+Strpas(mysql_error(connection)))
|
||||
else
|
||||
Res:=Mysql_store_result(connection);
|
||||
Res:=CreateQuery(Qry);
|
||||
try
|
||||
Res.Open;
|
||||
Result:=True;
|
||||
except
|
||||
On E : exception do
|
||||
begin
|
||||
FreeAndNil(Res);
|
||||
Connection.Transaction.RollBack;
|
||||
if not Silent then
|
||||
Verbose(V_WARNING,'Query : '+Qry+'Failed : '+E.Message);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ No warning if it fails }
|
||||
Function RunSilentQuery (Qry : String; Var res : TQueryResult) : Boolean ;
|
||||
Function GetResultField (Res : TSQLQuery; Id : Integer) : String;
|
||||
|
||||
|
||||
begin
|
||||
Verbose(V_DEBUG,'Running silent query:'+Qry);
|
||||
Result:=mysql_query(Connection,PChar(qry))=0;
|
||||
If Not Result then
|
||||
Verbose(V_DEBUG,'Silent query : '+Qry+'Failed : '+Strpas(mysql_error(connection)))
|
||||
else
|
||||
Res:=Mysql_store_result(connection);
|
||||
end;
|
||||
|
||||
|
||||
Function GetResultField (Res : TQueryResult; Id : Integer) : String;
|
||||
|
||||
Var
|
||||
Row : PPchar;
|
||||
|
||||
begin
|
||||
if Res=Nil then
|
||||
If (Res=Nil) or (ID>=Res.Fields.Count) then
|
||||
Result:=''
|
||||
else
|
||||
begin
|
||||
Row:=mysql_fetch_row(Res);
|
||||
If (Row=Nil) or (Row[ID]=Nil) then
|
||||
Result:=''
|
||||
else
|
||||
Result:=strpas(Row[ID]);
|
||||
end;
|
||||
Result:=Res.Fields[ID].AsString;
|
||||
Verbose(V_DEBUG,'Field value '+Result);
|
||||
end;
|
||||
|
||||
Procedure FreeQueryResult (Res : TQueryResult);
|
||||
Procedure FreeQueryResult(var Res : TSQLQuery);
|
||||
|
||||
begin
|
||||
mysql_free_result(Res);
|
||||
if Assigned(Res) and Assigned(Res.Transaction) then
|
||||
(Res.Transaction as TSQLTransaction).Commit;
|
||||
FreeAndNil(Res);
|
||||
end;
|
||||
|
||||
Function IDQuery(Qry : String) : Integer;
|
||||
|
||||
Var
|
||||
Res : TQueryResult;
|
||||
Res : TSQLQuery;
|
||||
|
||||
begin
|
||||
Result:=-1;
|
||||
If RunQuery(Qry,Res) then
|
||||
begin
|
||||
Result:=StrToIntDef(GetResultField(Res,0),-1);
|
||||
FreeQueryResult(Res);
|
||||
If OpenQuery(Qry,Res,False) then
|
||||
try
|
||||
Result:=StrToIntDef(GetResultField(Res,0),-1);
|
||||
finally
|
||||
FreeQueryResult(Res);
|
||||
end;
|
||||
end;
|
||||
|
||||
Function StringQuery(Qry : String) : String;
|
||||
|
||||
Var
|
||||
Res : TQueryResult;
|
||||
Res : TSQLQuery;
|
||||
|
||||
begin
|
||||
Result:='';
|
||||
If RunQuery(Qry,Res) then
|
||||
begin
|
||||
Result:=GetResultField(Res,0);
|
||||
FreeQueryResult(Res);
|
||||
If OpenQuery(Qry,Res,False) then
|
||||
try
|
||||
Result:=GetResultField(Res,0);
|
||||
finally
|
||||
FreeQueryResult(Res);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -265,17 +276,9 @@ begin
|
||||
end;
|
||||
|
||||
Function InsertQuery(const Query : string) : Integer;
|
||||
Var
|
||||
Res : TQueryResult;
|
||||
|
||||
begin
|
||||
If RunQuery(Query,Res) then
|
||||
begin
|
||||
Result:=mysql_insert_id(connection);
|
||||
FreeQueryResult(Res);
|
||||
end
|
||||
else
|
||||
Result:=-1;
|
||||
Result:=IDQuery(Query);
|
||||
end;
|
||||
|
||||
Function AddRun(OSID, CPUID, VERSIONID, CATEGORYID : Integer; Date : TDateTime) : Integer;
|
||||
@ -284,12 +287,12 @@ Const
|
||||
SInsertRun = 'INSERT INTO TESTRUN '+
|
||||
'(TU_OS_FK,TU_CPU_FK,TU_VERSION_FK,TU_CATEGORY_FK,TU_DATE)'+
|
||||
' VALUES '+
|
||||
'(%d,%d,%d,%d,"%s")';
|
||||
'(%d,%d,%d,%d,"%s") RETURNING TU_ID';
|
||||
var
|
||||
Qry : string;
|
||||
begin
|
||||
qry:=Format(SInsertRun,[OSID,CPUID,VERSIONID,CATEGORYID,SQLDate(Date)]);
|
||||
Result:=InsertQuery(Qry);
|
||||
Result:=IDQuery(Qry);
|
||||
end;
|
||||
|
||||
function posr(c : Char; const s : AnsiString) : integer;
|
||||
@ -380,7 +383,6 @@ Const
|
||||
|
||||
Var
|
||||
Info : TConfig;
|
||||
Res : TQueryResult;
|
||||
|
||||
begin
|
||||
Result:=-1;
|
||||
@ -388,9 +390,8 @@ begin
|
||||
GetConfig(TestSrcDir+RelSrcDir+Name,Info)) or
|
||||
GetUnitTestConfig(Name,Info) then
|
||||
begin
|
||||
If RunQuery(Format(SInsertTest,[Name]),Res) then
|
||||
If ExecuteQuery(Format(SInsertTest,[Name]),False) then
|
||||
begin
|
||||
FreeQueryResult(Res);
|
||||
Result:=GetTestID(Name);
|
||||
If Result=-1 then
|
||||
Verbose(V_WARNING,'Could not find newly added test!')
|
||||
@ -424,7 +425,6 @@ Const
|
||||
|
||||
Var
|
||||
Qry : String;
|
||||
Res : TQueryResult;
|
||||
|
||||
begin
|
||||
If Source<>'' then
|
||||
@ -441,8 +441,7 @@ begin
|
||||
Source,
|
||||
ID
|
||||
]);
|
||||
Result:=RunQuery(Qry,res);
|
||||
FreeQueryResult(Res);
|
||||
Result:=ExecuteQuery(Qry,False);
|
||||
end;
|
||||
|
||||
Function AddTestResult(TestID,RunID,TestRes : Integer;
|
||||
@ -453,37 +452,33 @@ Const
|
||||
SInsertRes='Insert into TESTRESULTS '+
|
||||
'(TR_TEST_FK,TR_TESTRUN_FK,TR_OK,TR_SKIP,TR_RESULT) '+
|
||||
' VALUES '+
|
||||
'(%d,%d,"%s","%s",%d) ';
|
||||
'(%d,%d,"%s","%s",%d) RETURNING TR_ID';
|
||||
SSelectId='SELECT TR_ID FROM TESTRESULTS WHERE (TR_TEST_FK=%d) '+
|
||||
' AND (TR_TESTRUN_FK=%d)';
|
||||
SInsertLog='Update TESTRESULTS SET TR_LOG="%s"'+
|
||||
',TR_OK="%s",TR_SKIP="%s",TR_RESULT=%d WHERE (TR_ID=%d)';
|
||||
Var
|
||||
Qry : String;
|
||||
Res : TQueryResult;
|
||||
updateValues : boolean;
|
||||
|
||||
begin
|
||||
updateValues:=false;
|
||||
Result:=-1;
|
||||
Qry:=Format(SInsertRes,
|
||||
[TestID,RunID,B[OK],B[Skipped],TestRes,EscapeSQL(Log)]);
|
||||
If RunSilentQuery(Qry,Res) then
|
||||
Result:=mysql_insert_id(connection)
|
||||
else
|
||||
Result:=IDQuery(Qry);
|
||||
if (Result=-1) then
|
||||
begin
|
||||
Qry:=format(SSelectId,[TestId,RunId]);
|
||||
Result:=IDQuery(Qry);
|
||||
if Result<>-1 then
|
||||
updateValues:=true;
|
||||
Qry:=format(SSelectId,[TestId,RunId]);
|
||||
Result:=IDQuery(Qry);
|
||||
if Result<>-1 then
|
||||
UpdateValues:=true;
|
||||
end;
|
||||
if (Result<>-1) and ((Log<>'') or updateValues) then
|
||||
begin
|
||||
Qry:=format(SInsertLog,[EscapeSQL(Log),B[OK],B[Skipped],TestRes,Result]);
|
||||
if not RunQuery(Qry,Res) then
|
||||
begin
|
||||
Verbose(V_Warning,'Insert Log failed');
|
||||
end;
|
||||
FreeQueryResult(Res);
|
||||
Qry:=Format(SInsertLog,[EscapeSQL(Log),B[OK],B[Skipped],TestRes,Result]);
|
||||
if Not ExecuteQuery(Qry,False) then
|
||||
Verbose(V_Warning,'Insert Log failed');
|
||||
end;
|
||||
{ If test already existed, return false for is_new to avoid double counting }
|
||||
is_new:=not updateValues;
|
||||
@ -504,12 +499,8 @@ Function CleanTestRun(ID : Integer) : Boolean;
|
||||
Const
|
||||
SDeleteRun = 'DELETE FROM TESTRESULTS WHERE TR_TESTRUN_FK=%d';
|
||||
|
||||
Var
|
||||
Res : TQueryResult;
|
||||
|
||||
begin
|
||||
Result:=RunQuery(Format(SDeleteRun,[ID]),Res);
|
||||
FreeQueryResult(Res);
|
||||
Result:=ExecuteQuery(Format(SDeleteRun,[ID]),False);
|
||||
end;
|
||||
|
||||
function GetTestPreviousRunHistoryID(TestRunID : Integer) : Integer;
|
||||
@ -525,21 +516,14 @@ begin
|
||||
end;
|
||||
|
||||
function AddTestHistoryEntry(TestRunID,TestPreviousID : Integer) : boolean;
|
||||
|
||||
var
|
||||
qry : string;
|
||||
res : TQueryResult;
|
||||
begin
|
||||
qry:=format('INSERT INTO TESTRUNHISTORY (TH_ID_FK,TH_PREVIOUS_FK) '+
|
||||
' VALUES (%d,%d)',[TestRunID,TestPreviousID]);
|
||||
If RunQuery(qry,res) then
|
||||
begin
|
||||
FreeQueryResult(res);
|
||||
AddTestHistoryEntry:=true;
|
||||
end
|
||||
else
|
||||
AddTestHistoryEntry:=false;
|
||||
end;
|
||||
|
||||
begin
|
||||
initialisemysql;
|
||||
Qry:=format('INSERT INTO TESTRUNHISTORY (TH_ID_FK,TH_PREVIOUS_FK) '+
|
||||
' VALUES (%d,%d)',[TestRunID,TestPreviousID]);
|
||||
Result:=ExecuteQuery(Qry,False);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -1,137 +1,20 @@
|
||||
<?xml version="1.0"?>
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="3"/>
|
||||
<Version Value="9"/>
|
||||
<General>
|
||||
<ProjectType Value="Program"/>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<LRSInOutputDirectory Value="False"/>
|
||||
</Flags>
|
||||
<MainUnit Value="0"/>
|
||||
<ActiveEditorIndexAtStart Value="1"/>
|
||||
<IconPath Value="./"/>
|
||||
<TargetFileExt Value=""/>
|
||||
<Title Value="testsuite"/>
|
||||
<ActiveWindowIndexAtStart Value="0"/>
|
||||
</General>
|
||||
<JumpHistory Count="12" HistoryIndex="11">
|
||||
<Position1>
|
||||
<Filename Value="dbwhtml.pp"/>
|
||||
<Caret Line="85" Column="3" TopLine="82"/>
|
||||
</Position1>
|
||||
<Position2>
|
||||
<Filename Value="dbwhtml.pp"/>
|
||||
<Caret Line="204" Column="5" TopLine="164"/>
|
||||
</Position2>
|
||||
<Position3>
|
||||
<Filename Value="dbwhtml.pp"/>
|
||||
<Caret Line="205" Column="5" TopLine="165"/>
|
||||
</Position3>
|
||||
<Position4>
|
||||
<Filename Value="dbwhtml.pp"/>
|
||||
<Caret Line="203" Column="25" TopLine="168"/>
|
||||
</Position4>
|
||||
<Position5>
|
||||
<Filename Value="dbwhtml.pp"/>
|
||||
<Caret Line="212" Column="15" TopLine="195"/>
|
||||
</Position5>
|
||||
<Position6>
|
||||
<Filename Value="dbwhtml.pp"/>
|
||||
<Caret Line="70" Column="67" TopLine="52"/>
|
||||
</Position6>
|
||||
<Position7>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="594" Column="5" TopLine="554"/>
|
||||
</Position7>
|
||||
<Position8>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="66" Column="1" TopLine="34"/>
|
||||
</Position8>
|
||||
<Position9>
|
||||
<Filename Value="dbwhtml.pp"/>
|
||||
<Caret Line="396" Column="4" TopLine="361"/>
|
||||
</Position9>
|
||||
<Position10>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="66" Column="14" TopLine="35"/>
|
||||
</Position10>
|
||||
<Position11>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="600" Column="56" TopLine="568"/>
|
||||
</Position11>
|
||||
<Position12>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="31" Column="77" TopLine="14"/>
|
||||
</Position12>
|
||||
</JumpHistory>
|
||||
<Units Count="8">
|
||||
<Unit0>
|
||||
<CursorPos X="19" Y="5"/>
|
||||
<EditorIndex Value="0"/>
|
||||
<Filename Value="testsuite.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<Loaded Value="True"/>
|
||||
<TopLine Value="1"/>
|
||||
<UnitName Value="testsuite"/>
|
||||
<UsageCount Value="56"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<CursorPos X="23" Y="595"/>
|
||||
<EditorIndex Value="1"/>
|
||||
<Filename Value="utests.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<Loaded Value="True"/>
|
||||
<TopLine Value="568"/>
|
||||
<UnitName Value="utests"/>
|
||||
<UsageCount Value="56"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<CursorPos X="6" Y="136"/>
|
||||
<EditorIndex Value="4"/>
|
||||
<Filename Value="/home/michael/fixbranch/rtl/linux/syslinux.pp"/>
|
||||
<Loaded Value="True"/>
|
||||
<TopLine Value="94"/>
|
||||
<UnitName Value="SysLinux"/>
|
||||
<UsageCount Value="28"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<Filename Value="/home/michael/test.sql"/>
|
||||
<SyntaxHighlighter Value="None"/>
|
||||
<TopLine Value="1"/>
|
||||
<UsageCount Value="8"/>
|
||||
</Unit3>
|
||||
<Unit4>
|
||||
<CursorPos X="27" Y="23"/>
|
||||
<EditorIndex Value="3"/>
|
||||
<Filename Value="/home/michael/fixbranch/rtl/unix/linux.pp"/>
|
||||
<Loaded Value="True"/>
|
||||
<TopLine Value="1"/>
|
||||
<UnitName Value="Linux"/>
|
||||
<UsageCount Value="25"/>
|
||||
</Unit4>
|
||||
<Unit5>
|
||||
<CursorPos X="56" Y="251"/>
|
||||
<Filename Value="/home/michael/projects/lazarus/components/editbutton/editbtn.pas"/>
|
||||
<TopLine Value="248"/>
|
||||
<UnitName Value="EditBtn"/>
|
||||
<UsageCount Value="8"/>
|
||||
</Unit5>
|
||||
<Unit6>
|
||||
<CursorPos X="31" Y="8"/>
|
||||
<Filename Value="/home/michael/projects/lazarus/components/editbutton/demo/frmmain.pp"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<ResourceFilename Value="/home/michael/projects/lazarus/components/editbutton/demo/frmmain.lrs"/>
|
||||
<TopLine Value="1"/>
|
||||
<UnitName Value="frmmain"/>
|
||||
<UsageCount Value="20"/>
|
||||
</Unit6>
|
||||
<Unit7>
|
||||
<CursorPos X="27" Y="393"/>
|
||||
<EditorIndex Value="2"/>
|
||||
<Filename Value="dbwhtml.pp"/>
|
||||
<Loaded Value="True"/>
|
||||
<TopLine Value="384"/>
|
||||
<UnitName Value="dbwhtml"/>
|
||||
<UsageCount Value="25"/>
|
||||
</Unit7>
|
||||
</Units>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IgnoreBinaries Value="False"/>
|
||||
@ -144,16 +27,253 @@
|
||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="editbutton"/>
|
||||
<MinVersion Valid="True"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="12">
|
||||
<Unit0>
|
||||
<Filename Value="testsuite.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="testsuite"/>
|
||||
<EditorIndex Value="0"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="1"/>
|
||||
<CursorPos X="29" Y="5"/>
|
||||
<UsageCount Value="72"/>
|
||||
<Loaded Value="True"/>
|
||||
<LoadedDesigner Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="utests.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="utests"/>
|
||||
<IsVisibleTab Value="True"/>
|
||||
<EditorIndex Value="1"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="1003"/>
|
||||
<CursorPos X="59" Y="919"/>
|
||||
<UsageCount Value="72"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="../../../../../fixbranch/rtl/linux/syslinux.pp"/>
|
||||
<UnitName Value="SysLinux"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="94"/>
|
||||
<CursorPos X="6" Y="136"/>
|
||||
<UsageCount Value="26"/>
|
||||
<LoadedDesigner Value="True"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="../../../../../test.sql"/>
|
||||
<TopLine Value="1"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<SyntaxHighlighter Value="None"/>
|
||||
<UsageCount Value="6"/>
|
||||
</Unit3>
|
||||
<Unit4>
|
||||
<Filename Value="../../../../../fixbranch/rtl/unix/linux.pp"/>
|
||||
<UnitName Value="Linux"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="1"/>
|
||||
<CursorPos X="27" Y="23"/>
|
||||
<UsageCount Value="23"/>
|
||||
<LoadedDesigner Value="True"/>
|
||||
</Unit4>
|
||||
<Unit5>
|
||||
<Filename Value="../../../../../projects/lazarus/components/editbutton/editbtn.pas"/>
|
||||
<UnitName Value="EditBtn"/>
|
||||
<TopLine Value="248"/>
|
||||
<CursorPos X="56" Y="251"/>
|
||||
<UsageCount Value="6"/>
|
||||
</Unit5>
|
||||
<Unit6>
|
||||
<Filename Value="../../../../../projects/lazarus/components/editbutton/demo/frmmain.pp"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<UnitName Value="frmmain"/>
|
||||
<TopLine Value="1"/>
|
||||
<CursorPos X="31" Y="8"/>
|
||||
<UsageCount Value="18"/>
|
||||
</Unit6>
|
||||
<Unit7>
|
||||
<Filename Value="dbwhtml.pp"/>
|
||||
<UnitName Value="dbwhtml"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="384"/>
|
||||
<CursorPos X="27" Y="393"/>
|
||||
<UsageCount Value="23"/>
|
||||
<LoadedDesigner Value="True"/>
|
||||
</Unit7>
|
||||
<Unit8>
|
||||
<Filename Value="../tresults.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="tresults"/>
|
||||
<UsageCount Value="36"/>
|
||||
</Unit8>
|
||||
<Unit9>
|
||||
<Filename Value="../../../../build/tag_2_6_4/fpcsrc/packages/fcl-base/src/wformat.pp"/>
|
||||
<UnitName Value="wformat"/>
|
||||
<EditorIndex Value="4"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="17"/>
|
||||
<CursorPos X="15" Y="35"/>
|
||||
<UsageCount Value="18"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit9>
|
||||
<Unit10>
|
||||
<Filename Value="../../../../build/tag_2_6_4/fpcsrc/packages/fcl-web/src/base/webutil.pp"/>
|
||||
<UnitName Value="webutil"/>
|
||||
<EditorIndex Value="3"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="1"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<UsageCount Value="17"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit10>
|
||||
<Unit11>
|
||||
<Filename Value="../../../../build/tag_2_6_4/fpcsrc/packages/fcl-web/src/base/cgiapp.pp"/>
|
||||
<UnitName Value="cgiapp"/>
|
||||
<EditorIndex Value="2"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="34"/>
|
||||
<CursorPos X="1" Y="40"/>
|
||||
<UsageCount Value="17"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit11>
|
||||
</Units>
|
||||
<JumpHistory Count="30" HistoryIndex="29">
|
||||
<Position1>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="574" Column="45" TopLine="549"/>
|
||||
</Position1>
|
||||
<Position2>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="946" Column="27" TopLine="930"/>
|
||||
</Position2>
|
||||
<Position3>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="1103" Column="40" TopLine="1077"/>
|
||||
</Position3>
|
||||
<Position4>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="1467" Column="37" TopLine="1442"/>
|
||||
</Position4>
|
||||
<Position5>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="1468" Column="71" TopLine="1443"/>
|
||||
</Position5>
|
||||
<Position6>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="1469" Column="48" TopLine="1444"/>
|
||||
</Position6>
|
||||
<Position7>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="2531" Column="53" TopLine="2531"/>
|
||||
</Position7>
|
||||
<Position8>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="2554" Column="17" TopLine="2525"/>
|
||||
</Position8>
|
||||
<Position9>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="2533" Column="17" TopLine="2519"/>
|
||||
</Position9>
|
||||
<Position10>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="2544" Column="18" TopLine="2540"/>
|
||||
</Position10>
|
||||
<Position11>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="121" Column="1" TopLine="121"/>
|
||||
</Position11>
|
||||
<Position12>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="326" Column="24" TopLine="301"/>
|
||||
</Position12>
|
||||
<Position13>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="67" Column="1" TopLine="61"/>
|
||||
</Position13>
|
||||
<Position14>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="846" Column="3" TopLine="842"/>
|
||||
</Position14>
|
||||
<Position15>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="1" Column="1" TopLine="1"/>
|
||||
</Position15>
|
||||
<Position16>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="2555" Column="11" TopLine="2530"/>
|
||||
</Position16>
|
||||
<Position17>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="2554" Column="10" TopLine="2530"/>
|
||||
</Position17>
|
||||
<Position18>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="1" Column="1" TopLine="1"/>
|
||||
</Position18>
|
||||
<Position19>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="420" Column="21" TopLine="412"/>
|
||||
</Position19>
|
||||
<Position20>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="1" Column="1" TopLine="1"/>
|
||||
</Position20>
|
||||
<Position21>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="2555" Column="41" TopLine="2532"/>
|
||||
</Position21>
|
||||
<Position22>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="2493" Column="3" TopLine="2478"/>
|
||||
</Position22>
|
||||
<Position23>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="2" Column="1" TopLine="1"/>
|
||||
</Position23>
|
||||
<Position24>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="2534" Column="11" TopLine="2527"/>
|
||||
</Position24>
|
||||
<Position25>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="1" Column="1" TopLine="1"/>
|
||||
</Position25>
|
||||
<Position26>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="304" Column="21" TopLine="300"/>
|
||||
</Position26>
|
||||
<Position27>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="676" Column="1" TopLine="661"/>
|
||||
</Position27>
|
||||
<Position28>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="912" Column="13" TopLine="904"/>
|
||||
</Position28>
|
||||
<Position29>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="1" Column="1" TopLine="1"/>
|
||||
</Position29>
|
||||
<Position30>
|
||||
<Filename Value="utests.pp"/>
|
||||
<Caret Line="919" Column="16" TopLine="889"/>
|
||||
</Position30>
|
||||
</JumpHistory>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<SearchPaths>
|
||||
<OtherUnitFiles Value=".."/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<UseAnsiStrings Value="False"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<EditorMacros Count="0"/>
|
||||
</CONFIG>
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
{$h+}
|
||||
program testsuite;
|
||||
|
||||
uses utests;
|
||||
uses utests, tresults;
|
||||
|
||||
Var
|
||||
App : TTestSuite;
|
||||
|
||||
@ -1,25 +1,33 @@
|
||||
{$mode objfpc}
|
||||
{$h+}
|
||||
|
||||
unit utests;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
cgiapp,
|
||||
sysutils,mysql55conn,sqldb,whtml,dbwhtml,db,
|
||||
tresults,
|
||||
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=';
|
||||
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;
|
||||
@ -56,6 +64,7 @@ Type
|
||||
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) ;
|
||||
@ -366,7 +375,8 @@ begin
|
||||
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'];
|
||||
@ -434,7 +444,7 @@ Function TTestSuite.ConnectToDB : Boolean;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
FDB:=TMySQl55Connection.Create(Self);
|
||||
FDB:=TPQConnection.Create(Self);
|
||||
FDB.HostName:=DefHost;
|
||||
FDB.DatabaseName:=DefDatabase;
|
||||
FDB.UserName:=DefDBUser;
|
||||
@ -548,6 +558,9 @@ begin
|
||||
end;
|
||||
|
||||
Procedure TTestSuite.EmitTitle(ATitle : String);
|
||||
|
||||
Var
|
||||
S : TStrings;
|
||||
begin
|
||||
AddResponseLn('<HTML>');
|
||||
AddResponseLn('<TITLE>'+ATitle+'</TITLE>');
|
||||
@ -892,7 +905,7 @@ end;
|
||||
Procedure TTestSuite.ShowRunOverview;
|
||||
Const
|
||||
SOverview = 'SELECT TU_ID as ID,TU_DATE as Date,TC_NAME as CPU,TO_NAME as OS,'+
|
||||
'TV_VERSION as Version,count(*) as Count,'+
|
||||
'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,'+
|
||||
@ -901,11 +914,13 @@ Const
|
||||
'(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) '+
|
||||
'left join TESTRESULTS on (TR_TESTRUN_FK=TU_ID) '+
|
||||
'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'+
|
||||
'GROUP BY TU_ID '+
|
||||
'ORDER BY TU_ID DESC LIMIT %d';
|
||||
|
||||
|
||||
@ -933,11 +948,9 @@ begin
|
||||
S:=S+' AND (TU_COMMENT LIKE '''+Fcomment+''')';
|
||||
If FCond<>'' then
|
||||
S:=S+' AND ('+FCond+')';
|
||||
If FOnlyFailed then
|
||||
S:=S+' AND (TR_OK="-")';
|
||||
If GetCategoryName(FCategory)<>'DB' then
|
||||
SC:=', CONCAT(TU_SVNCOMPILERREVISION,"/",TU_SVNRTLREVISION,"/", '+
|
||||
'TU_SVNPACKAGESREVISION,"/",TU_SVNTESTSREVISION) as svnrev'
|
||||
SC:=', CONCAT(TU_SVNCOMPILERREVISION,''/'',TU_SVNRTLREVISION,''/'', '+
|
||||
'TU_SVNPACKAGESREVISION,''/'',TU_SVNTESTSREVISION) as svnrev'
|
||||
else
|
||||
SC:='';
|
||||
If (FCategory='') or (GetCategoryName(FCategory)='All') then
|
||||
@ -1088,8 +1101,8 @@ begin
|
||||
If Result then
|
||||
begin
|
||||
If GetCategoryName(FCategory)<>'DB' then
|
||||
SC:=', CONCAT(TU_SVNCOMPILERREVISION,"/",TU_SVNRTLREVISION,"/", '+
|
||||
'TU_SVNPACKAGESREVISION,"/",TU_SVNTESTSREVISION) as svnrev'
|
||||
SC:=', CONCAT(TU_SVNCOMPILERREVISION,''/'',TU_SVNRTLREVISION,''/'', '+
|
||||
'TU_SVNPACKAGESREVISION,''/'',TU_SVNTESTSREVISION) as svnrev'
|
||||
else
|
||||
SC:='';
|
||||
If GetCategoryName(FCategory)='All' then
|
||||
@ -1397,9 +1410,9 @@ begin
|
||||
+' WHERE (TR_TEST_FK=T_ID) AND (TR_TESTRUN_FK='+FRunID+') ';
|
||||
|
||||
If FOnlyFailed then
|
||||
S:=S+' AND (TR_OK="-")';
|
||||
S:=S+' AND (not TR_OK)';
|
||||
If FNoSkipped then
|
||||
S:=S+' AND (TR_SKIP="-")';
|
||||
S:=S+' AND (not TR_SKIP)';
|
||||
S:=S+' ORDER BY TR_ID ';
|
||||
Qry:=S;
|
||||
If FDebug then
|
||||
@ -1466,6 +1479,33 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TTestSuite.DumpTestInfo(Q : TSQLQuery);
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
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;
|
||||
if (Not Q.fields[i].IsNull) and (FieldName<>'T_NAME') and (FieldName<>'T_SOURCE') then
|
||||
begin
|
||||
if (Q.Fields[i].Datatype=ftBoolean) then
|
||||
DumpLn('Flag ');
|
||||
DumpLn(FieldName);
|
||||
DumpLn(' ');
|
||||
if (Q.Fields[i].DataType=ftBoolean) and Q.Fields[i].AsBoolean then
|
||||
DumpLn(' set')
|
||||
else
|
||||
DumpLn(FieldValue);
|
||||
DumpLn('<BR>');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TTestSuite.ShowOneTest;
|
||||
|
||||
Var
|
||||
@ -1484,8 +1524,7 @@ begin
|
||||
EmitContentType;
|
||||
EmitDocType;
|
||||
if FTestFileID='' then
|
||||
FTestFileID:=GetSingleton('SELECT T_ID FROM TESTS WHERE T_NAME LIKE ''%'+
|
||||
FTestFileName+'%''');
|
||||
FTestFileID:=GetSingleton('SELECT T_ID FROM TESTS WHERE T_NAME LIKE ''%'+FTestFileName+'%''');
|
||||
if FTestFileID<>'' then
|
||||
FTestFileName:=GetTestFileName(FTestFileID);
|
||||
EmitTitle(Title+' : File '+FTestFileName+' Results');
|
||||
@ -1527,26 +1566,7 @@ begin
|
||||
Try
|
||||
Open;
|
||||
Try
|
||||
For i:=0 to FieldCount-1 do
|
||||
begin
|
||||
FieldValue:=Fields[i].AsString;
|
||||
FieldName:=Fields[i].DisplayName;
|
||||
|
||||
if (FieldValue<>'') and (FieldValue<>'-') and
|
||||
(FieldName<>'T_NAME') and (FieldName<>'T_SOURCE') then
|
||||
begin
|
||||
if (FieldValue='+') then
|
||||
DumpLn('Flag ');
|
||||
DumpLn(FieldName);
|
||||
DumpLn(' ');
|
||||
if FieldValue='+' then
|
||||
DumpLn(' set')
|
||||
else
|
||||
DumpLn(FieldValue);
|
||||
DumpLn('<BR>');
|
||||
end;
|
||||
end;
|
||||
|
||||
DumpTestInfo(Q);
|
||||
Finally
|
||||
Close;
|
||||
end;
|
||||
@ -1746,8 +1766,10 @@ end;
|
||||
|
||||
|
||||
Procedure TTestSuite.ShowHistory;
|
||||
|
||||
Const
|
||||
MaxCombo = 50;
|
||||
|
||||
Type
|
||||
StatusLongintArray = Array [TTestStatus] of longint;
|
||||
StatusDateTimeArray = Array [TTestStatus] of TDateTime;
|
||||
@ -1755,6 +1777,7 @@ Type
|
||||
AStatusDTA = Array[1..MaxCombo] of StatusDateTimeArray;
|
||||
PStatusLA = ^AStatusLA;
|
||||
PStatusDTA = ^AStatusDTA;
|
||||
|
||||
Var
|
||||
S,SS,FL,cpu,version,os : String;
|
||||
date : TDateTime;
|
||||
@ -1782,8 +1805,9 @@ Var
|
||||
version_first_date_id, version_last_date_id : PStatusLA;
|
||||
FieldName,FieldValue,
|
||||
LLog,Source : String;
|
||||
Res : Boolean;
|
||||
B,Res : Boolean;
|
||||
ver : known_versions;
|
||||
|
||||
begin
|
||||
Res:=False;
|
||||
os_count:=nil;
|
||||
@ -1855,25 +1879,7 @@ begin
|
||||
Try
|
||||
Open;
|
||||
Try
|
||||
For i:=0 to FieldCount-1 do
|
||||
begin
|
||||
FieldValue:=Fields[i].AsString;
|
||||
FieldName:=Fields[i].DisplayName;
|
||||
if (FieldValue<>'') and (FieldValue<>'-') and
|
||||
(FieldName<>'T_NAME') and (FieldName<>'T_SOURCE') then
|
||||
begin
|
||||
if (FieldValue='+') then
|
||||
DumpLn('Flag ');
|
||||
DumpLn(FieldName);
|
||||
DumpLn(' ');
|
||||
if FieldValue='+' then
|
||||
DumpLn(' set')
|
||||
else
|
||||
DumpLn(FieldValue);
|
||||
DumpLn('<BR>');
|
||||
end;
|
||||
end;
|
||||
|
||||
DumpTestInfo(Q);
|
||||
Finally
|
||||
Close;
|
||||
end;
|
||||
@ -2048,14 +2054,11 @@ begin
|
||||
begin
|
||||
Q.RecNo:=i;
|
||||
inc(total_count);
|
||||
S:=Fields[ok_ind].AsString;
|
||||
|
||||
if S='+' then
|
||||
if Q.Fields[ok_ind].AsBoolean then
|
||||
inc(OK_count)
|
||||
else
|
||||
inc(not_OK_count);
|
||||
S:=Fields[skip_ind].AsString;
|
||||
if S='+' then
|
||||
if Fields[skip_ind].AsBoolean then
|
||||
inc(skip_count)
|
||||
else
|
||||
inc(not_skip_count);
|
||||
@ -2529,35 +2532,26 @@ begin
|
||||
HeaderEnd(2);
|
||||
ParaGraphStart;
|
||||
Q:=CreateDataset('');
|
||||
Q.SQL.Text:='CREATE TEMPORARY TABLE tr1 like TESTRESULTS;';
|
||||
Q.ExecSQL;
|
||||
Q.SQL.Text:='CREATE TEMPORARY TABLE tr2 like TESTRESULTS;';
|
||||
Q.ExecSQL;
|
||||
Q.SQL.Text:='INSERT INTO tr1 SELECT * FROM '+TESTRESULTSTableName(FRunId)+
|
||||
|
||||
' WHERE TR_TESTRUN_FK='+FRunID+';';
|
||||
Q.ExecSQL;
|
||||
Q.SQL.Text:='INSERT INTO tr2 SELECT * FROM '+TESTRESULTSTableName(FCompareRunId)+
|
||||
' WHERE TR_TESTRUN_FK='+FCompareRunID+';';
|
||||
Q.ExecSQL;
|
||||
S:='SELECT T_ID as Id,T_NAME as Filename,tr1.TR_SKIP as Run1_Skipped,'
|
||||
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 '
|
||||
+'WHERE ((tr1.TR_SKIP IS NULL) or (tr2.TR_SKIP IS NULL) or '
|
||||
+' (%s (tr1.TR_Result<>tr2.TR_Result)))'
|
||||
+'and (T_ID=tr2.TR_TEST_FK)';
|
||||
If FNoSkipped then
|
||||
begin
|
||||
Qry:='(((tr1.TR_SKIP="+") and (tr2.TR_OK="-") and (tr2.TR_SKIP="-")) or '
|
||||
+'((tr1.TR_OK="-") and (tr1.TR_SKIP="-") and (tr2.TR_SKIP="+")) or '
|
||||
+'((tr1.TR_SKIP="-") and (tr2.TR_SKIP="-"))) and ';
|
||||
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);
|
||||
@ -2646,25 +2640,25 @@ begin
|
||||
Run2Field := P.Dataset.FindField('OK');
|
||||
if Run2Field = nil then
|
||||
Run2Field := P.Dataset.FindField('Run2_OK');
|
||||
If (not FNoSkipped) and ((Skip1Field.AsString='+')
|
||||
or ((Skip2Field <> nil) and (Skip2Field.AsString = '+'))) then
|
||||
If (not FNoSkipped) and ((Skip1Field.AsBoolean)
|
||||
or ((Skip2Field <> nil) and (Skip2Field.AsBoolean))) then
|
||||
begin
|
||||
Inc(FRunSkipCount);
|
||||
BGColor:='yellow'; // Yellow
|
||||
end
|
||||
else If Run2Field.AsString='+' then
|
||||
else If Run2Field.AsBoolean then
|
||||
begin
|
||||
if Run1Field.AsString='' then
|
||||
BGColor:='#68DFB8'
|
||||
else if Run1Field.ASString<>'+' then
|
||||
else if Run1Field.AsBoolean then
|
||||
BGColor:='#98FB98'; // pale Green
|
||||
end
|
||||
else if Run2Field.AsString='-' then
|
||||
else if Not Run2Field.AsBoolean then
|
||||
begin
|
||||
Inc(FRunFailedCount);
|
||||
if Run1Field.AsString='' then
|
||||
BGColor:='#FF82AB' // Light red
|
||||
else if Run1Field.AsString<>'-' then
|
||||
else if Not Run1Field.AsBoolean then
|
||||
BGColor:='#FF225B';
|
||||
end;
|
||||
end;
|
||||
@ -2971,6 +2965,5 @@ begin
|
||||
else
|
||||
TestsuiteCGIURL:=TestsuiteURLPrefix+'cgi-bin/'+TestsuiteBin;
|
||||
|
||||
SDetailsURL := TestsuiteCGIURL + '?action=1&run1id=%s';
|
||||
ShortDateFormat:='yyyy/mm/dd';
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user