[fpc-pascal] Re: new FPCUnit feature - Register nested tests

[Graeme Geldenhuys]

I attached the unit I defined the two functions in. Please note, this
is not a patch, it is just to show the implementation of the functions
(for review).  If it will make the 2.2 release, I will create a patch
(and be able to delete my own unit).

Graeme.



On 5/21/07, Graeme Geldenhuys <[EMAIL PROTECTED]> wrote:

Hi,

Would this feature make the 2.2 release if I submit a patch? I need to
know for my own projects.  It is only two new functions. It allows you
to register tests and automatically builds the TestSuite structure for
you... Before you had to manually create the TestSuite's.

--
Graeme Geldenhuys

General error, hit any user to continue.

{
  Helper functions to fake the DUnit methods. This well prevent more
  IFDEF statements.
  
  NOTE:
    This unit is meant for FPCUnit only!!!  DUnit already supports these
    features.
}
unit tiFPCUnitUtils;

{$I tiDefines.inc}

interface
uses
  fpcunit
  ,TestRegistry
  ,Classes
  ;


procedure RegisterTest(ASuitePath: String; ATestClass: TTestCaseClass); overload;

implementation


procedure RegisterTestInSuite(rootSuite: TTestSuite; APath: string; ATestClass: TTestCaseClass);
var
  i: Integer;
  targetSuite: TTestSuite;
  currentTest: TTest;
  suiteName: String;
  pathRemainder: String;
  dotPos: Integer;
  Tests: TFPList;
begin
  if APath = '' then
  begin
    // end recursion
    rootSuite.AddTestSuiteFromClass(ATestClass);
  end
  else
  begin
    // Split the path on the dot (.)
    dotPos := Pos('.', APath);
    if (dotPos <= 0) then dotPos := Pos('\', APath);
    if (dotPos <= 0) then dotPos := Pos('/', APath);
    if (dotPos > 0) then
    begin
      suiteName := Copy(APath, 1, dotPos - 1);
      pathRemainder := Copy(APath, dotPos + 1, length(APath) - dotPos);
    end
    else
    begin
      suiteName := APath;
      pathRemainder := '';
    end;
    Tests := rootSuite.Tests;

    // Check to see if the path already exists
    targetSuite := nil;
    Tests := rootSuite.Tests;
    for i := 0 to Tests.Count -1 do
    begin
      currentTest := TTest(Tests[i]);
      if currentTest is TTestSuite then
      begin
        if (currentTest.TestName = suiteName) then
        begin
          targetSuite := TTestSuite(currentTest);
          break;
        end;
      end;
    end;

    if not Assigned(targetSuite) then
    begin
      targetSuite := TTestSuite.Create(suiteName);
      rootSuite.AddTest(targetSuite);
    end;

    RegisterTestInSuite(targetSuite, pathRemainder, ATestClass);
  end;
end;

procedure RegisterTest(ASuitePath: String; ATestClass: TTestCaseClass);
begin
  RegisterTestInSuite(GetTestRegistry, ASuitePath, ATestClass);
end;


initialization
  GetTestRegistry.TestName := 'tiOPF2 Unit Tests';

end.


_______________________________________________
fpc-pascal maillist  -  fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal