paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-07-24 02:05:55 +02:00
Code Issues Packages Projects Releases Wiki Activity

fpcunit console test runner: allow to pass a test name like suite1.subsuite2.test3 to the suite parameter from Michael VC

Browse Source 
git-svn-id: trunk@15994 -
This commit is contained in:
vincents 2008-08-08 13:20:02 +00:00
parent a1a13ca9cb
commit a9daf44a6d
1 changed files with 33 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -255,6 +255,37 @@ begin
end;
procedure TTestRunner.DoRun;
procedure CheckTestRegistry (test:TTest; ATestName:string);
var s, c : string;
I, p : integer;
begin
if test is TTestSuite then
begin
p := pos ('.', ATestName);
if p > 0 then
begin
s := copy (ATestName, 1, p-1);
c := copy (ATestName, p+1, maxint);
end
else
begin
s := '';
c := ATestName;
end;
if comparetext(c, test.TestName) = 0 then
DoTestRun(test)
else if (CompareText( s, Test.TestName) = 0) or (s = '') then
for I := 0 to TTestSuite(test).Tests.Count - 1 do
CheckTestRegistry (TTest(TTestSuite(test).Tests[I]), c)
end
else // if test is TTestCase then
begin
if comparetext(test.TestName, ATestName) = 0 then
DoTestRun(test);
end;
end;
var
I: integer;
S: string;
@ -286,9 +317,8 @@ begin
for I := 0 to GetTestRegistry.Tests.Count - 1 do
writeln(GetTestRegistry[i].TestName)
else
for I := 0 to GetTestRegistry.Tests.Count - 1 do
if GetTestRegistry[i].TestName = S then
DoTestRun(GetTestRegistry[i]);
for I := 0 to GetTestRegistry.Tests.count-1 do
CheckTestRegistry (GetTestregistry[I], S);
end;
Terminate;
end;