paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-01 22:19:39 +01:00
Code Issues Packages Projects Releases Wiki Activity

further work on the lazarus test suite database

Browse Source 
git-svn-id: trunk@16094 -
This commit is contained in:
vincents 2008-08-17 20:30:16 +00:00
parent 574d6f28d9
commit edf06c79a8
10 changed files with 239 additions and 170 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
test/runtests.lpr
View File

@ -73,7 +73,6 @@ var
begin
inherited ExtendXmlDocument(Doc);
env := Doc.CreateElement('Environment');
AddElement('Date', {$I %DATE%});
AddElement('CPU', {$I %FPCTARGETCPU%});
AddElement('OS', {$I %FPCTARGETOS%});
AddElement('FPCVersion', {$I %FPCVERSION%});

1
test/testglobals.pas
View File

@ -39,6 +39,7 @@ begin
end;
initialization
GetTestRegistry.TestName := 'All tests';
BugsTestSuite := TTestSuite.Create('Bugs');
GetTestRegistry.AddTest(BugsTestSuite);

4
test/testlpi.pas
View File

@ -23,7 +23,7 @@ unit TestLpi;
interface
uses
Classes, SysUtils, fpcunit, testregistry, process, FileUtil,
Classes, SysUtils, strutils, fpcunit, testregistry, process, FileUtil,
TestGlobals;
type
@ -124,7 +124,7 @@ end;
class function TLpkTest.CreateSuiteFromFile(const AName,
APath: string): TTestSuite;
begin
Result := TTestSuite.Create(AName);
Result := TTestSuite.Create(AnsiReplaceStr(AName, DirectorySeparator, '/'));
Result.AddTest(Create(APath, 'TestCompile'));
end;

40
test/testresult-db/createdb.sql
View File

@ -3,8 +3,8 @@
-- http://www.phpmyadmin.net
--
-- Host: localhost
-- Generatie Tijd: 08 Apr 2008 om 23:16
-- Server versie: 5.0.22
-- Generatie Tijd: 16 Aug 2008 om 14:19
-- Server versie: 5.0.45
-- PHP Versie: 5.1.6
SET SQL_MODE="NO_AUTO_VALUE_ON_ZERO";
@ -19,12 +19,13 @@ SET SQL_MODE="NO_AUTO_VALUE_ON_ZERO";
-- Tabel structuur voor tabel `TESTCPU`
--
DROP TABLE IF EXISTS `TESTCPU`;
CREATE TABLE IF NOT EXISTS `TESTCPU` (
`TC_ID` int(11) NOT NULL auto_increment,
`TC_NAME` varchar(10) default NULL,
PRIMARY KEY (`TC_ID`),
UNIQUE KEY `TC_INAME` (`TC_NAME`)
) ENGINE=MyISAM DEFAULT CHARSET=latin1 AUTO_INCREMENT=8 ;
) ENGINE=MyISAM DEFAULT CHARSET=latin1 AUTO_INCREMENT=8 ;
--
-- Gegevens worden uitgevoerd voor tabel `TESTCPU`
@ -45,13 +46,14 @@ INSERT INTO `TESTCPU` (`TC_ID`, `TC_NAME`) VALUES
-- Tabel structuur voor tabel `TESTFPCVERSION`
--
DROP TABLE IF EXISTS `TESTFPCVERSION`;
CREATE TABLE IF NOT EXISTS `TESTFPCVERSION` (
`TFV_ID` int(11) NOT NULL auto_increment,
`TFV_VERSION` varchar(10) default NULL,
`TFV_RELEASEDATE` timestamp NOT NULL default CURRENT_TIMESTAMP on update CURRENT_TIMESTAMP,
PRIMARY KEY (`TFV_ID`),
UNIQUE KEY `TFV_INAME` (`TFV_VERSION`)
) ENGINE=MyISAM DEFAULT CHARSET=latin1 AUTO_INCREMENT=5 ;
) ENGINE=MyISAM DEFAULT CHARSET=latin1 AUTO_INCREMENT=6 ;
--
-- Gegevens worden uitgevoerd voor tabel `TESTFPCVERSION`
@ -61,7 +63,8 @@ INSERT INTO `TESTFPCVERSION` (`TFV_ID`, `TFV_VERSION`, `TFV_RELEASEDATE`) VALUES
(1, '2.2.0', '2008-04-08 23:13:10'),
(2, '2.2.1', '2008-04-08 23:13:10'),
(3, '2.2.2', '2008-04-08 23:14:27'),
(4, '2.3.1', '2008-04-08 23:14:27');
(4, '2.3.1', '2008-04-08 23:14:27'),
(0, 'All', '2008-04-09 23:42:58');
-- --------------------------------------------------------
@ -69,13 +72,14 @@ INSERT INTO `TESTFPCVERSION` (`TFV_ID`, `TFV_VERSION`, `TFV_RELEASEDATE`) VALUES
-- Tabel structuur voor tabel `TESTLAZVERSION`
--
DROP TABLE IF EXISTS `TESTLAZVERSION`;
CREATE TABLE IF NOT EXISTS `TESTLAZVERSION` (
`TLV_ID` int(11) NOT NULL auto_increment,
`TLV_VERSION` varchar(10) default NULL,
`TLV_RELEASEDATE` timestamp NOT NULL default CURRENT_TIMESTAMP on update CURRENT_TIMESTAMP,
PRIMARY KEY (`TLV_ID`),
UNIQUE KEY `TLV_INAME` (`TLV_VERSION`)
) ENGINE=MyISAM DEFAULT CHARSET=latin1 AUTO_INCREMENT=5 ;
) ENGINE=MyISAM DEFAULT CHARSET=latin1 AUTO_INCREMENT=6 ;
--
-- Gegevens worden uitgevoerd voor tabel `TESTLAZVERSION`
@ -85,7 +89,7 @@ INSERT INTO `TESTLAZVERSION` (`TLV_ID`, `TLV_VERSION`, `TLV_RELEASEDATE`) VALUES
(1, '0.9.24', '2008-04-08 20:25:22'),
(2, '0.9.24.1', '2008-04-08 23:08:02'),
(3, '0.9.25', '2008-04-08 23:08:34'),
(4, '0.9.26', '2008-04-08 23:08:34');
(0, 'All', '2008-04-09 23:36:38');
-- --------------------------------------------------------
@ -93,12 +97,13 @@ INSERT INTO `TESTLAZVERSION` (`TLV_ID`, `TLV_VERSION`, `TLV_RELEASEDATE`) VALUES
-- Tabel structuur voor tabel `TESTOS`
--
DROP TABLE IF EXISTS `TESTOS`;
CREATE TABLE IF NOT EXISTS `TESTOS` (
`TO_ID` int(11) NOT NULL auto_increment,
`TO_NAME` varchar(10) default NULL,
PRIMARY KEY (`TO_ID`),
UNIQUE KEY `TR_INAME` (`TO_NAME`)
) ENGINE=MyISAM DEFAULT CHARSET=latin1 AUTO_INCREMENT=16 ;
) ENGINE=MyISAM DEFAULT CHARSET=latin1 AUTO_INCREMENT=16 ;
--
-- Gegevens worden uitgevoerd voor tabel `TESTOS`
@ -127,6 +132,7 @@ INSERT INTO `TESTOS` (`TO_ID`, `TO_NAME`) VALUES
-- Tabel structuur voor tabel `TESTRESULTS`
--
DROP TABLE IF EXISTS `TESTRESULTS`;
CREATE TABLE IF NOT EXISTS `TESTRESULTS` (
`TR_ID` int(11) NOT NULL auto_increment,
`TR_TESTRUN_FK` int(11) NOT NULL,
@ -151,6 +157,7 @@ CREATE TABLE IF NOT EXISTS `TESTRESULTS` (
-- Tabel structuur voor tabel `TESTRUN`
--
DROP TABLE IF EXISTS `TESTRUN`;
CREATE TABLE IF NOT EXISTS `TESTRUN` (
`TU_ID` int(11) NOT NULL auto_increment,
`TU_DATE` timestamp NOT NULL default CURRENT_TIMESTAMP on update CURRENT_TIMESTAMP,
@ -159,6 +166,13 @@ CREATE TABLE IF NOT EXISTS `TESTRUN` (
`TU_WS_FK` int(11) NOT NULL,
`TU_FPC_VERSION_FK` int(11) NOT NULL,
`TU_LAZ_VERSION_FK` int(11) NOT NULL,
`TU_TESTCOUNT` int(11) NOT NULL,
`TU_ERRORCOUNT` int(11) NOT NULL,
`TU_FAILURECOUNT` int(11) NOT NULL,
`TU_IGNORECOUNT` int(11) NOT NULL,
`TU_SUBMITTER` varchar(40) NOT NULL,
`TU_MACHINE` varchar(40) NOT NULL,
`TU_COMMENT` varchar(80) NOT NULL,
PRIMARY KEY (`TU_ID`),
UNIQUE KEY `TU_UNIQUE` (`TU_DATE`,`TU_CPU_FK`,`TU_OS_FK`,`TU_WS_FK`,`TU_FPC_VERSION_FK`,`TU_LAZ_VERSION_FK`),
KEY `TU_IDATE` (`TU_DATE`)
@ -175,9 +189,10 @@ CREATE TABLE IF NOT EXISTS `TESTRUN` (
-- Tabel structuur voor tabel `TESTS`
--
DROP TABLE IF EXISTS `TESTS`;
CREATE TABLE IF NOT EXISTS `TESTS` (
`T_ID` int(11) NOT NULL auto_increment,
`T_NAME` varchar(80) NOT NULL default '',
`T_NAME` varchar(255) NOT NULL default '',
`T_FULLNAME` varchar(255) NOT NULL default '',
`T_CPU` varchar(20) default NULL,
`T_OS` varchar(30) default NULL,
@ -211,12 +226,13 @@ CREATE TABLE IF NOT EXISTS `TESTS` (
-- Tabel structuur voor tabel `TESTWIDGETSET`
--
DROP TABLE IF EXISTS `TESTWIDGETSET`;
CREATE TABLE IF NOT EXISTS `TESTWIDGETSET` (
`TW_ID` int(11) NOT NULL auto_increment,
`TW_NAME` varchar(10) default NULL,
PRIMARY KEY (`TW_ID`),
UNIQUE KEY `TW_INAME` (`TW_NAME`)
) ENGINE=MyISAM DEFAULT CHARSET=latin1 AUTO_INCREMENT=9 ;
) ENGINE=MyISAM DEFAULT CHARSET=latin1 AUTO_INCREMENT=10 ;
--
-- Gegevens worden uitgevoerd voor tabel `TESTWIDGETSET`
@ -228,4 +244,6 @@ INSERT INTO `TESTWIDGETSET` (`TW_ID`, `TW_NAME`) VALUES
(3, 'win32'),
(4, 'gtk'),
(5, 'gtk2'),
(6, 'qt');
(6, 'qt'),
(0, 'All');

51
test/testresult-db/dbtests.pp
View File

@ -23,8 +23,9 @@ Function GetCPUID(Name : String) : Integer;
Function GetCategoryID(Name : String) : Integer;
Function GetFPCVersionID(Name : String) : Integer;
Function GetLAZVersionID(Name : String) : Integer;
Function GetRunID(OSID, CPUID, FPCVERSIONID, LazVersionID : Integer; Date : TDateTime) : Integer;
Function AddRun(OSID, CPUID, FPCVERSIONID, LazVersionID : Integer; Date : TDateTime) : Integer;
Function GetWidgetSetID(Name : String) : Integer;
Function GetRunID(OSID, CPUID, FPCVERSIONID, LazVersionID,WidgetSetID : Integer; Date : TDateTime) : Integer;
Function AddRun(OSID, CPUID, FPCVERSIONID, LazVersionID, WidgetSetID : Integer; Date : TDateTime) : Integer;
Function AddTest(Name : String; AddSource : Boolean) : Integer;
Function UpdateTest(ID : Integer; Info : TConfig; Source : String) : Boolean;
Function AddTestResult(TestID,RunID,TestRes : Integer;
@ -43,7 +44,7 @@ Type
Function ConnectToDatabase(DatabaseName,Host,User,Password : String) : Boolean;
Procedure DisconnectDatabase;
Function RunQuery (Qry : String; Var res : TQueryResult) : Boolean ;
Function RunQuery (Qry : String; out res : TQueryResult) : Boolean ;
Procedure FreeQueryResult (Res : TQueryResult);
Function GetResultField (Res : TQueryResult; Id : Integer) : String;
Function IDQuery(Qry : String) : Integer;
@ -104,7 +105,7 @@ begin
mysql_close(@Connection);
end;
Function RunQuery (Qry : String; Var res : TQueryResult) : Boolean ;
Function RunQuery (Qry : String; out res : TQueryResult) : Boolean ;
begin
Verbose(V_DEBUG,'Running query:'+Qry);
@ -228,8 +229,15 @@ begin
Result:=IDQuery(Format(SFromName,[Name]));
end;
function GetWidgetSetID(Name: String): Integer;
Const
SFromName = 'SELECT TW_ID FROM TESTWIDGETSET WHERE (TW_NAME="%s")';
function GetRunID(OSID, CPUID, FPCVERSIONID, LazVersionID: Integer;
begin
Result:=IDQuery(Format(SFromName,[Name]));
end;
function GetRunID(OSID, CPUID, FPCVERSIONID, LazVersionID, WidgetSetID: Integer;
Date: TDateTime): Integer;
Const
SFromIDS = 'SELECT TU_ID FROM TESTRUN WHERE '+
@ -237,25 +245,26 @@ Const
' AND (TU_CPU_FK=%d) '+
' AND (TU_FPC_VERSION_FK=%d) '+
' AND (TU_LAZ_VERSION_FK=%d) '+
' AND (TU_WS_FK=%d) '+
' AND (TU_DATE="%s")';
begin
Result:=IDQuery(Format(SFromIDS,[OSID,CPUID,FPCVERSIONID,LazVersionID,SQLDate(Date)]));
Result:=IDQuery(Format(SFromIDS,[OSID,CPUID,FPCVERSIONID,LazVersionID,WidgetSetID,SQLDate(Date)]));
end;
Function AddRun(OSID, CPUID, FPCVERSIONID, LazVersionID : Integer; Date : TDateTime) : Integer;
Function AddRun(OSID, CPUID, FPCVERSIONID, LazVersionID, WidgetSetID: Integer; Date : TDateTime) : Integer;
Const
SInsertRun = 'INSERT INTO TESTRUN '+
'(TU_OS_FK,TU_CPU_FK,TU_FPC_VERSION_FK,TU_LAZ_VERSION_FK,TU_DATE)'+
'(TU_OS_FK,TU_CPU_FK,TU_FPC_VERSION_FK,TU_LAZ_VERSION_FK,TU_WS_FK,TU_DATE)'+
' VALUES '+
'(%d,%d,%d,%d,"%s")';
'(%d,%d,%d,%d,%d,"%s")';
Var
Res : TQueryResult;
begin
If RunQuery(Format(SInsertRun,[OSID,CPUID,FPCVERSIONID,LazVersionID,SQLDate(Date)]),Res) then
If RunQuery(Format(SInsertRun,[OSID,CPUID,FPCVERSIONID,LazVersionID,WidgetSetID,SQLDate(Date)]),Res) then
Result:=mysql_insert_id(@connection)
else
Result:=-1;
@ -341,6 +350,23 @@ begin
close(t);
end;
function GetLazarusTestConfig(var r : TConfig) : Boolean;
var
Path : string;
ClassName : string;
MethodName : string;
slashpos : integer;
FileName : string;
s : string;
t : text;
begin
Verbose(V_Debug,'GetLazarusTestConfig');
Result := False;
FillChar(r,sizeof(r),0);
r.Note:= 'unittest';
Result := True;
end;
Function AddTest(Name : String; AddSource : Boolean) : Integer;
Const
@ -355,7 +381,8 @@ begin
Result:=-1;
If (FileExists(TestSrcDir+RelSrcDir+Name) and
GetConfig(TestSrcDir+RelSrcDir+Name,Info)) or
GetUnitTestConfig(Name,Info) then
GetUnitTestConfig(Name,Info) or
GetLazarusTestConfig(Info) then
begin
If RunQuery(Format(SInsertTest,[Name]),Res) then
begin
@ -417,7 +444,7 @@ Function AddTestResult(TestID,RunID,TestRes : Integer;
Log : String) : Integer;
Const
SInsertRes='Insert into TESTRESULTS '+
SInsertRes : string ='Insert into TESTRESULTS '+
'(TR_TEST_FK,TR_TESTRUN_FK,TR_OK,TR_SKIP,TR_RESULT,TR_LOG) '+
' VALUES '+
'(%d,%d,"%s","%s",%d,"%s") ';

4
test/testresult-db/importtestresults.lpi
View File

@ -36,6 +36,10 @@
<Version Value="5"/>
<PathDelim Value="\"/>
<CodeGeneration>
<Checks>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
</Checks>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>

147
test/testresult-db/importtestresults.pp
View File

@ -21,7 +21,7 @@ program importtestresults;
uses
sysutils,teststr,testu,tresults,dbtests,
dom, XMLRead;
dom, XMLRead, dateutils;
Var
@ -109,6 +109,7 @@ Var
TestCPU,
TestFPCVersion,
TestLazVersion,
TestWidgetSet,
DatabaseName,
HostName,
UserName,
@ -277,7 +278,9 @@ Var
TestOSID : Integer;
TestFPCVersionID : Integer;
TestLazVersionID : Integer;
TestWidgetSetID : Integer;
TestRunID : Integer;
TestCount, ErrorCount, FailureCount, IgnoreCount: integer;
Procedure GetIDs;
var
@ -294,6 +297,18 @@ var
Verbose(V_Debug,format('Environment: retrieved %s=%s', [Name, Result]));
end;
function GetDate: TDateTime;
var
Node: TDomNode;
begin
Result := 0;
Node := Doc.FirstChild.FindNode('DateTimeRan') as TDomElement;
if assigned(Node) then
Result := ScanDateTime('YYYY-MM-DD hh:nn:ss', Node.TextContent)
else
Verbose(V_Debug,'No DateTimeRan node');
end;
begin
EnvNode := Doc.FirstChild.FindNode('Environment') as TDomElement;
if not Assigned(EnvNode) then
@ -316,14 +331,21 @@ begin
TestLazVersion := GetEnvValue('LazVersion');
TestLazVersionID := GetLazVersionID(TestLazVersion);
If TestLazVersionID=-1 then
Verbose(V_Error,'NO ID for lazarus version "'+TestLazVersion+'" found.');
TestWidgetSet := GetEnvValue('WidgetSet');
TestWidgetSetID := GetWidgetSetID(TestWidgetSet);
If TestWidgetSetID=-1 then
Verbose(V_Error,'NO ID for fpc version "'+TestLazVersion+'" found.');
TestDate := GetDate;
If (Round(TestDate)=0) then
Testdate:=Now;
TestRunID:=GetRunID(TestOSID,TestCPUID,TestFPCVersionID,TestLazVersionID, TestDate);
TestRunID:=GetRunID(TestOSID,TestCPUID,TestFPCVersionID,TestLazVersionID, TestWidgetSetID, TestDate);
If (TestRunID=-1) then
begin
TestRunID:=AddRun(TestOSID,TestCPUID,TestFPCVersionID,TestLazVersionID,TestDate);
TestRunID:=AddRun(TestOSID,TestCPUID,TestFPCVersionID,TestLazVersionID,TestWidgetSetID,TestDate);
If TestRUnID=-1 then
Verbose(V_Error,'Could not insert new testrun record!');
end
@ -331,6 +353,25 @@ begin
CleanTestRun(TestRunID);
end;
procedure GetCounts;
Function GetIntValue(name: string): integer;
var
Node: TDomNode;
begin
Result := -2;
Node := Doc.FirstChild.FindNode(name);
if not assigned(Node) then
Verbose(V_Error,'No element for '+Name);
Result := StrToIntDef(Node.TextContent,-1);
Verbose(V_Debug,format('Environment: retrieved %s=%d', [Name, Result]));
end;
begin
TestCount := GetIntValue('NumberOfRunTests');
ErrorCount := GetIntValue('NumberOfErrors');
FailureCount := GetIntValue('NumberOfFailures');
IgnoreCount := GetIntValue('NumberOfIgnoredTests');
end;
Function GetLog(FN : String) : String;
begin
@ -374,22 +415,22 @@ begin
begin
Verbose(V_NORMAL,'Analysing result for test '+Line);
Inc(StatusCount[TS]);
If Not ExpectRun[TS] then
begin
ID:=RequireTestID(Line);
If (ID<>-1) then
begin
If Not (TestOK[TS] or TestSkipped[TS]) then
begin
TestLog:=GetExecuteLog(Line);
if pos(failed_to_compile,TestLog)=1 then
TestLog:=GetLog(Line);
end
else
TestLog:='';
AddTestResult(ID,TestRunID,Ord(TS),TestOK[TS],TestSkipped[TS],TestLog);
end;
end
// If Not ExpectRun[TS] then
//begin
//ID:=RequireTestID(Line);
//If (ID<>-1) then
//begin
//If Not (TestOK[TS] or TestSkipped[TS]) then
//begin
//TestLog:=GetExecuteLog(Line);
//if pos(failed_to_compile,TestLog)=1 then
//TestLog:=GetLog(Line);
//end
//else
//TestLog:='';
//AddTestResult(ID,TestRunID,Ord(TS),TestOK[TS],TestSkipped[TS],TestLog);
//end;
//end
end
else
Inc(UnknownLines);
@ -397,6 +438,67 @@ begin
close(logfile);
end;
procedure ProcessTestListing;
procedure ProcessNodes(AParentNode: TDomNode; APath: string); forward;
procedure ProcessTestSuite(ATestSuiteElement: TDOMElement; APath: string);
var
Name: string;
begin
Name := ATestSuiteElement.GetAttribute('Name');
Verbose(V_NORMAL,'Analysing result for testsuite '+Name + ' at '+ APath);
ProcessNodes(ATestSuiteElement, APath + '|' + Name);
end;
procedure ProcessTest(ATestElement: TDOMElement; APath: string);
var
Name, FullName: string;
TestResult: string;
TS: TTestStatus;
ID: LongInt;
i: Integer;
begin
Name := ATestElement.GetAttribute('Name');
TestResult := ATestElement.GetAttribute('Result');
Verbose(V_NORMAL,'Analysing result for test '+Name);
for i := 0 to ATestElement.Attributes.Length-1 do
Verbose(V_NORMAL,ATestElement.Attributes[i].NodeName+ '=' + ATestElement.Attributes[i].NodeValue);
FullName := APath + '|' + Name;
ID := RequireTestID(FullName);
TS:=GetTestStatus(TestResult);
Verbose(V_Debug,'Test result: '+TestResult+' TestStatus: '+IntToStr(ord(TS)));
AddTestResult(ID,TestRunID,Ord(TS),TestOK[TS],TestSkipped[TS],'No log yet');
end;
procedure ProcessNodes(AParentNode: TDomNode; APath: string);
var
Node: TDomNode;
Element: TDomElement absolute Node;
begin
Node := AParentNode.FirstChild;
while assigned(Node) do
begin
if node is TDOMElement then
begin
if Element.TagName='TestSuite' then
ProcessTestSuite(Element, APath)
else if Element.TagName='Test' then
ProcessTest(Element, APath);
end;
Node := Node.NextSibling;
end;
end;
var
ListingNode: TDomNode;
begin
ListingNode := Doc.FirstChild.FindNode('TestListing');
if assigned(ListingNode) then
ProcessNodes(ListingNode, '');
end;
procedure ProcessResultsFile(FN: String);
begin
@ -406,6 +508,8 @@ begin
ReadXMLFile(Doc, FN);
GetIDs;
GetCounts;
ProcessTestListing;
Doc.Free;
Verbose(V_Debug,'End ProcessResultsFile');
end;
@ -413,7 +517,6 @@ end;
procedure UpdateTestRun;
var
i : TTestStatus;
qry : string;
res : TQueryResult;
@ -421,7 +524,9 @@ procedure UpdateTestRun;
qry:='UPDATE TESTRUN SET ';
//for i:=low(TTestStatus) to high(TTestStatus) do
//qry:=qry+format('%s=%d, ',[SQLField[i],StatusCount[i]]);
qry:=qry+format('TU_SUBMITTER="%s", TU_MACHINE="%s", TU_COMMENT="%s", TU_DATE="%s"',
qry:=qry+format('TU_TESTCOUNT=%d, TU_ERRORCOUNT=%d, TU_FAILURECOUNT=%d, TU_IGNORECOUNT=%d,',
[TestCount, ErrorCount, FailureCount, IgnoreCount]);
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]);
RunQuery(Qry,res)

18
test/testresult-db/teststr.pp
View File

@ -20,21 +20,9 @@ unit teststr;
interface
const
failed_to_compile = 'Failed to compile ';
success_compilation_failed = 'Success, compilation failed ';
failed_compilation_successful = 'Failed, compilation successful ';
successfully_compiled = 'Successfully compiled ';
failed_to_run = 'Failed to run ';
successfully_run = 'Successfully run ';
skipping_graph_test = 'Skipping test because it uses graph ';
skipping_interactive_test = 'Skipping test because it is interactive ';
skipping_known_bug = 'Skipping test because it is a known bug ';
skipping_compiler_version_too_low = 'Skipping test because compiler version too low ';
skipping_compiler_version_too_high = 'Skipping test because compiler version too high ';
skipping_other_cpu = 'Skipping test because for other cpu ';
skipping_other_target = 'Skipping test because for other target ';
skipping_run_unit = 'Skipping test run because it is a unit ';
skipping_run_test = 'Skipping run test ';
failed = 'Failed';
success = 'OK';
skipped = 'Ignored';
known_problem = ' known problem: ';
line_separation = '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>';

129
test/testresult-db/tresults.pp
View File

@ -27,126 +27,53 @@ uses
Type
TTestStatus = (
stFailedToCompile,
stSuccessCompilationFailed,
stFailedCompilationsuccessful,
stSuccessfullyCompiled,
stFailedToRun,
stKnownRunProblem,
stSuccessFullyRun,
stSkippingGraphTest,
stSkippingInteractiveTest,
stSkippingKnownBug,
stSkippingCompilerVersionTooLow,
stSkippingCompilerVersionTooHigh,
stSkippingOtherCpu,
stSkippingOtherTarget,
stskippingRunUnit,
stskippingRunTest
stOK,
stFailed,
stIgnored
);
Const
FirstStatus = stFailedToCompile;
LastStatus = stskippingRunTest;
FirstStatus = low(TTestStatus);
LastStatus = high(TTestStatus);
TestOK : Array[TTestStatus] of Boolean = (
False, // stFailedToCompile,
True, // stSuccessCompilationFailed,
False, // stFailedCompilationsuccessful,
True, // stSuccessfullyCompiled,
False, // stFailedToRun,
True, // stKnownRunProblem,
True, // stSuccessFullyRun,
False, // stSkippingGraphTest,
False, // stSkippingInteractiveTest,
False, // stSkippingKnownBug,
False, // stSkippingCompilerVersionTooLow,
False, // stSkippingCompilerVersionTooHigh,
False, // stSkippingOtherCpu,
False, // stSkippingOtherTarget,
False, // stskippingRunUnit,
False // stskippingRunTest
True, // stOK
False, // stFailed
False // stIgnored
);
TestSkipped : Array[TTestStatus] of Boolean = (
False, // stFailedToCompile,
False, // stSuccessCompilationFailed,
False, // stFailedCompilationsuccessful,
False, // stSuccessfullyCompiled,
False, // stFailedToRun,
False, // stKnownRunProblem,
False, // stSuccessFullyRun,
True, // stSkippingGraphTest,
True, // stSkippingInteractiveTest,
True, // stSkippingKnownBug,
True, // stSkippingCompilerVersionTooLow,
True, // stSkippingCompilerVersionTooHigh,
True, // stSkippingOtherCpu,
True, // stSkippingOtherTarget,
True, // stskippingRunUnit,
True // stskippingRunTest
False, // stOK
False, // stFailed
True // stIgnored
);
ExpectRun : Array[TTestStatus] of Boolean = (
False, // stFailedToCompile,
False, // stSuccessCompilationFailed,
False, // stFailedCompilationsuccessful,
True , // stSuccessfullyCompiled,
False, // stFailedToRun,
False, // stKnownRunProblem,
False, // stSuccessFullyRun,
False, // stSkippingGraphTest,
False, // stSkippingInteractiveTest,
False, // stSkippingKnownBug,
False, // stSkippingCompilerVersionTooLow,
False, // stSkippingCompilerVersionTooHigh,
False, // stSkippingOtherCpu,
False, // stSkippingOtherTarget,
False, // stskippingRunUnit,
False // stskippingRunTest
);
StatusText : Array[TTestStatus] of String = (
failed_to_compile,
success_compilation_failed,
failed_compilation_successful ,
successfully_compiled ,
failed_to_run ,
known_problem ,
successfully_run ,
skipping_graph_test ,
skipping_interactive_test ,
skipping_known_bug ,
skipping_compiler_version_too_low,
skipping_compiler_version_too_high,
skipping_other_cpu ,
skipping_other_target ,
skipping_run_unit ,
skipping_run_test
success,
failed,
skipped
);
SQLField : Array[TTestStatus] of String = (
'TU_FAILEDTOCOMPILE',
'TU_SUCCESSFULLYFAILED',
'TU_FAILEDTOFAIL',
'TU_SUCCESFULLYCOMPILED',
'TU_FAILEDTORUN',
'TU_KNOWNPROBLEM',
'TU_SUCCESSFULLYRUN',
'TU_SKIPPEDGRAPHTEST',
'TU_SKIPPEDINTERACTIVETEST',
'TU_KNOWNBUG',
'TU_COMPILERVERIONTOOLOW',
'TU_COMPILERVERIONTOOHIGH',
'TU_OTHERCPU',
'TU_OTHERTARGET',
'TU_UNIT',
'TU_SKIPPINGRUNTEST'
'TU_OK',
'TU_FAILED',
'TU_SKIPPED'
);
function GetTestStatus(AStatusText: string): TTestStatus;
implementation
function GetTestStatus(AStatusText: string): TTestStatus;
var
TS: TTestStatus;
begin
for TS := FirstStatus to LastStatus do
if StatusText[TS]=AStatusText then
exit(TS);
end;
end.

14
test/testresult-db/utests.pp
View File

@ -452,10 +452,9 @@ Procedure TTestSuite.ShowRunOverview;
Const
SOverview = 'SELECT TU_ID as ID,TU_DATE as Date,TC_NAME as CPU,TO_NAME as OS,'+
'TFV_VERSION as Version,COUNT(TR_ID) as Count,'+
'(TU_SUCCESFULLYCOMPILED+TU_SUCCESSFULLYRUN) AS OK,'+
'(TU_FAILEDTOCOMPILE+TU_FAILEDTORUN+TU_FAILEDTOFAIL) as Failed,'+
'(TU_SUCCESFULLYCOMPILED+TU_SUCCESSFULLYRUN+'+
'TU_FAILEDTOCOMPILE+TU_FAILEDTORUN+TU_FAILEDTOFAIL) as Total,'+
'(TU_TESTCOUNT - TU_FAILURECOUNT - TU_ERRORCOUNT) AS OK,'+
'(TU_FAILURECOUNT + TU_ERRORCOUNT) as Failed,'+
'TU_TESTCOUNT as Total,'+
'TU_SUBMITTER as Submitter, TU_MACHINE as Machine, TU_COMMENT as Comment '+
'FROM TESTRESULTS,TESTRUN,TESTCPU,TESTOS,TESTFPCVERSION '+
'WHERE '+
@ -543,7 +542,7 @@ Function TTestSuite.GetVersionName(ID : String) : String;
begin
if (ID<>'') then
Result:=GetSingleton('SELECT TFV_VERSION FROM TESTFPCVERSION WHERE TV_ID='+ID);
Result:=GetSingleton('SELECT TFV_VERSION FROM TESTFPCVERSION WHERE TFV_ID='+ID);
end;
Function TTestSuite.ShowRunData : Boolean;
@ -551,11 +550,12 @@ Function TTestSuite.ShowRunData : Boolean;
Const
SGetRunData = 'SELECT TU_ID,TU_DATE,TC_NAME,TO_NAME,' +
'TU_SUBMITTER,TU_MACHINE,TU_COMMENT,TFV_VERSION '+
' FROM TESTRUN,TESTCPU,TESTOS,TESTFPCVERSION '+
' FROM TESTRUN,TESTCPU,TESTOS,TESTFPCVERSION,TESTLAZVERSION '+
'WHERE '+
' (TC_ID=TU_CPU_FK) AND '+
' (TO_ID=TU_OS_FK) AND '+
' (TV_ID=TU_VERSION_FK) AND '+
' (TFV_ID=TU_FPC_VERSION_FK) AND '+
' (TLV_ID=TU_LAZ_VERSION_FK) AND '+
' (TU_ID=%s)';