paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 01:48:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

lazarus tests: console test runner stores test environment data in the test results

Browse Source 
git-svn-id: trunk@16057 -
This commit is contained in:
vincents 2008-08-14 13:22:03 +00:00
parent 42e0b8c301
commit 64c7eb142a
5 changed files with 40 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpcunit/console/consoletestrunner.pas
View File

@ -56,7 +56,7 @@ type
procedure AppendLongOpts; virtual;
procedure WriteCustomHelp; virtual;
procedure ParseOptions; virtual;
procedure ExtendXmlDocument(Doc: TXMLDocument);
procedure ExtendXmlDocument(Doc: TXMLDocument); virtual;
function GetResultsWriter: TCustomResultsWriter; virtual;
public
constructor Create(AOwner: TComponent); override;

2
components/sqldb/registersqldb.pas
View File

@ -100,7 +100,7 @@ Resourcestring
function TSQLFirebirdFileNamePropertyEditor.GetFilter: String;
begin
Result := sFireBirdDatabases+' (*.fb)|*.fb;*.fdb';
Result := sFireBirdDatabases+' (*.fb;*.fdb)|*.fb;*.fdb';
Result := Result + '|' + sInterbaseDatabases +' (*.gdb)|*.gdb;*.GDB';
Result:= Result+ '|'+ inherited GetFilter;
end;

12
test/runtests.lpi
View File

@ -17,7 +17,7 @@
<RunParams>
<local>
<FormatVersion Value="1"/>
<CommandLineParams Value="-a --file=results.xml"/>
<CommandLineParams Value="-s bugs.2068 --file=results.xml"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
@ -47,14 +47,14 @@
<UnitName Value="TestLpi"/>
</Unit1>
<Unit2>
<Filename Value="..\components\fpcunit\console\fpcunitproject1.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="FPCUnitProject1"/>
</Unit2>
<Unit3>
<Filename Value="bugtestcase.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="BugTestCase"/>
</Unit2>
<Unit3>
<Filename Value="testglobals.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="testglobals"/>
</Unit3>
</Units>
</ProjectOptions>

29
test/runtests.lpr
View File

@ -22,7 +22,9 @@ program runtests;
uses
Classes, consoletestrunner,
testglobals, testunits;
testglobals, testunits, dom,
{Unit needed to set the LCL version and widget set name}
LCLVersion, InterfaceBase, Interfaces;
type
@ -33,6 +35,8 @@ type
procedure AppendLongOpts; override;
procedure ParseOptions; override;
procedure WriteCustomHelp; override;
procedure ExtendXmlDocument(Doc: TXMLDocument); override;
end;
{ TLazTestRunner }
@ -55,6 +59,29 @@ begin
writeln(' --compiler=<ppcxxx> use ppcxxx to build test projects');
end;
procedure TLazTestRunner.ExtendXmlDocument(Doc: TXMLDocument);
var
env: TDOMElement;
procedure AddElement(const name, value: string);
var
n: TDOMElement;
begin
n := Doc.CreateElement(name);
n.AppendChild(Doc.CreateTextNode(value));
env.AppendChild(n);
end;
begin
inherited ExtendXmlDocument(Doc);
env := Doc.CreateElement('Environment');
AddElement('Date', {$I %DATE%});
AddElement('CPU', {$I %FPCTARGETCPU%});
AddElement('OS', {$I %FPCTARGETOS%});
AddElement('FPCVersion', {$I %FPCVERSION%});
AddElement('LCLVersion', lcl_version);
AddElement('WidgetSet', LCLPlatformDirNames[WidgetSet.LCLPlatform]);
Doc.FirstChild.AppendChild(env);
end;
var
App: TLazTestRunner;

8
test/runtestsgui.lpi
View File

@ -23,16 +23,16 @@
</RunParams>
<RequiredPackages Count="4">
<Item1>
<PackageName Value="CodeTools"/>
<PackageName Value="LCL"/>
</Item1>
<Item2>
<PackageName Value="FCL"/>
<PackageName Value="FPCUnitTestRunner"/>
</Item2>
<Item3>
<PackageName Value="FPCUnitTestRunner"/>
<PackageName Value="FCL"/>
</Item3>
<Item4>
<PackageName Value="LCL"/>
<PackageName Value="CodeTools"/>
</Item4>
</RequiredPackages>
<Units Count="7">