DUnitX.TestFixture.pas

{***************************************************************************}
{                                                                           }
{           DUnitX                                                          }
{                                                                           }
{           Copyright (C) 2013 Vincent Parrett                              }
{                                                                           }
{           vincent@finalbuilder.com                                        }
{           http://www.finalbuilder.com                                     }
{                                                                           }
{                                                                           }
{***************************************************************************}
{                                                                           }
{  Licensed under the Apache License, Version 2.0 (the "License");          }
{  you may not use this file except in compliance with the License.         }
{  You may obtain a copy of the License at                                  }
{                                                                           }
{      http://www.apache.org/licenses/LICENSE-2.0                           }
{                                                                           }
{  Unless required by applicable law or agreed to in writing, software      }
{  distributed under the License is distributed on an "AS IS" BASIS,        }
{  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. }
{  See the License for the specific language governing permissions and      }
{  limitations under the License.                                           }
{                                                                           }
{***************************************************************************}

unit DUnitX.TestFixture;

interface

uses
  DUnitX.TestFramework,
  DUnitX.Extensibility,
  DUnitX.InternalInterfaces,
  DUnitX.WeakReference,
  DUnitX.Generics,
  Rtti;

{$I DUnitX.inc}

type
  TDUnitXTestFixture = class(TWeakReferencedObject, ITestFixture, ITestFixtureInfo)
  class var
    FRttiContext  : TRttiContext;
  private
    FTestClass    : TClass;
    FName         : string;
    FNameSpace    : string;
    FDescription  : string;
    FEnabled      : boolean;
    FTests        : ITestList;
    FTestInfos              : IList<ITestInfo>;
    FSetupMethod            : TTestMethod;
    FSetupFixtureMethod     : TTestMethod;
    FTearDownMethod         : TTestMethod;
    FTearDownFixtureMethod  : TTestMethod;
    FFixtureInstance        : TObject;
    FTestInOwnThread        : boolean;
    FSetupFixtureMethodName : string;
    FSetupMethodName        : string;
    FTearDownMethodName     : string;
    FTearDownFixtureMethodName  : string;
    FChildren : ITestFixtureList;
    FTearDownFixtureIsDestructor : boolean;
    FIgnoreMemoryLeaks : Boolean;

    FIgnoreFixtureSetup : boolean;
  protected
    //used by GenerateFixtureFromClass to be tests from TestCaseInfo
    function CreateTestFromTestCase(ACaseInfo : TestCaseInfo; AMethod : TRttiMethod; ATestEnabled : Boolean) : ITest;
    //used by GenerateFixtureFromClass to be tests from a method with out test cases
    function CreateTestFromMethod(AMethod : TRttiMethod; ATestEnabled : Boolean;AIgnored : Boolean;AIgnoredReason: String) : ITest;
    // Check overriding attribute, other wise uses returns fixture value
    function GetIgnoreMemoryLeaksForMethod(AMethod : TRttiMethod) : Boolean;


    function GetEnabled: Boolean;
    procedure SetEnabled(const value: Boolean);


    function GetName: string;
    function GetNameSpace : string;
    function GetFullName : string;
    function GetDescription : string;
    function GetTests: ITestList;
    function ITestFixtureInfo.GetTests = ITestFixtureInfo_GetTests;
    function ITestFixtureInfo_GetTests : IList<ITestInfo>;
    function GetTestClass : TClass;
    function GetSetupMethod : TTestMethod;
    function GetSetupFixtureMethod : TTestMethod;
    function GetTearDownMethod : TTestMethod;
    function GetTearDownFixtureMethod : TTestMethod;
    function GetTestInOwnThread : boolean;
    function GetSetupFixtureMethodName: string;
    function GetSetupMethodName: string;
    function GetTearDownMethodName: string;
    function GetTearDownFixtureMethodName: string;
    function GetFixtureInstance : TObject;
    function GetTestCount : cardinal;
    function GetActiveTestCount : cardinal;

    function GetChildren: ITestFixtureList;
    function GetHasChildren : boolean;
    function GetHasTests : boolean;
    procedure OnMethodExecuted(const AMethod : TTestMethod);

    function AddTest(const AMethod : TTestMethod; const AName : string; const AEnabled : boolean = true;const AIgnored : boolean = false; const AIgnoreReason : string = '') : ITest;
    function AddTestCase(const ACaseName : string; const AName : string; const AMethod : TRttiMethod; const AEnabled : boolean; const AArgs : TValueArray) : ITest;

    function AddChildFixture(const ATestClass : TClass; const AName : string) : ITestFixture;overload;
    function AddChildFixture(const AInstance : TObject; const AName : string) : ITestFixture;overload;

    procedure SetSetupTestMethod(const AMethodName : string; const AMethod : TTestMethod);
    procedure SetSetupFixtureMethod(const AMethodName : string; const AMethod : TTestMethod);
    procedure SetTearDownTestMethod(const AMethodName : string; const AMethod : TTestMethod);
    procedure SetTearDownFixtureMethod(const AMethodName : string; const AMethod : TTestMethod; const AIsDestructor : boolean);
    procedure SetTestInOwnThread(const value: Boolean);
  public
    constructor Create(const AName : string; const AInstance : TObject);overload;
    constructor Create(const AName : string; const AClass : TClass);overload;
    destructor Destroy;override;
    class constructor Create;

  end;

implementation

uses
  TypInfo,
  SysUtils,
  DUnitX.Test,
  DUnitX.Utils,
  Generics.Collections;

{ TDUnitXTestFixture }

constructor TDUnitXTestFixture.Create(const AName : string; const AClass : TClass);
var
  fixtureAttrib   : TestFixtureAttribute;
  IgnoreMemoryLeak: IgnoreMemoryLeaks;
  method : TRttiMethod;
  rType : TRttiType;
  i : integer;
begin
  FTestClass := AClass;
  FTests := TTestList.Create;

  i := LastDelimiter('.',AName);
  if i <> 0 then
  begin
    FNameSpace := Copy(AName,1,i -1);
    FName := Copy(AName,i+1,Length(AName));
  end
  else
  begin
    FName := AName;
    FNameSpace := AName;
  end;

  FEnabled := True;

  FIgnoreMemoryLeaks := False;
  rType := FRttiContext.GetType(FTestClass);
  if rType.TryGetAttributeOfType<IgnoreMemoryLeaks>(IgnoreMemoryLeak) then
    FIgnoreMemoryLeaks := IgnoreMemoryLeak.IgnoreMemoryLeaks;

  fixtureAttrib := nil;
  if rType.TryGetAttributeOfType<TestFixtureAttribute>(fixtureAttrib) then
    FDescription := fixtureAttrib.Description;


  if FFixtureInstance = nil then
  begin
    //it's a dummy namespace fixture, don't bother with the rest.
    if rType.Handle = TypeInfo(TObject) then
    begin
      FFixtureInstance := FTestClass.Create;
      exit;
    end;


    FIgnoreFixtureSetup := false;
    {$IFDEF DELPHI_XE_UP}
    //NOTE: Causes Delphi 2010 to be inconsistent with produced exe. Will sometimes crash with AV when generating fixtures.
    //If there is a parameterless constructor declared then we will use that as the
    //fixture Setup method.
    if rType.TryGetConstructor(method) then
    begin
      FIgnoreFixtureSetup := true;
      FFixtureInstance := method.Invoke(TRttiInstanceType(rtype).MetaclassType, []).AsObject;
    end
    else
    {$ENDIF}
      FFixtureInstance := FTestClass.Create;
  end;

end;

destructor TDUnitXTestFixture.Destroy;
begin
  if FFixtureInstance <> nil then
    FFixtureInstance.Free;

  FTests := nil;
  inherited;
end;




function TDUnitXTestFixture.GetActiveTestCount: cardinal;
begin
  //TODO: Return the active count, currently fudged to be the count.
  Result := GetTestCount;
end;

function TDUnitXTestFixture.GetChildren: ITestFixtureList;
begin
  if FChildren = nil then
    FChildren := TTestFixtureList.Create;
  result := FChildren;
end;

function TDUnitXTestFixture.GetDescription: string;
begin
  result := FDescription;
end;

function TDUnitXTestFixture.GetEnabled: Boolean;
begin
  result := FEnabled;
end;

function TDUnitXTestFixture.GetFixtureInstance: TObject;
begin
  result := FFixtureInstance;
end;

function TDUnitXTestFixture.GetFullName: string;
begin
  if FName <> FNameSpace then
    result := FNameSpace + '.' + FName
  else
    Result := FName;
end;

function TDUnitXTestFixture.GetHasChildren: boolean;
begin
  result := (FChildren <> nil) and (FChildren.Count > 0);
end;


function TDUnitXTestFixture.GetHasTests: boolean;
begin
  result := (FTests <> nil) and (FTests.Count > 0);
end;

function TDUnitXTestFixture.GetIgnoreMemoryLeaksForMethod(
  AMethod: TRttiMethod): Boolean;
var
 IgnoreMemoryLeak: IgnoreMemoryLeaks;
begin
  if AMethod.TryGetAttributeOfType<IgnoreMemoryLeaks>(IgnoreMemoryLeak) then
    result := IgnoreMemoryLeak.IgnoreMemoryLeaks
  else
    result := FIgnoreMemoryLeaks;
end;

function TDUnitXTestFixture.GetName: string;
begin
  result := FName;
end;

function TDUnitXTestFixture.GetNameSpace: string;
begin
  result := FNameSpace;
end;

function TDUnitXTestFixture.GetSetupFixtureMethod: TTestMethod;
begin
  result := FSetupFixtureMethod;
end;

function TDUnitXTestFixture.GetSetupFixtureMethodName: string;
begin
  result := FSetupFixtureMethodName;
end;

function TDUnitXTestFixture.GetSetupMethod: TTestMethod;
begin
  result := FSetupMethod;
end;

function TDUnitXTestFixture.GetSetupMethodName: string;
begin
  result := FSetupMethodName;
end;

function TDUnitXTestFixture.GetTearDownFixtureMethod: TTestMethod;
begin
  result := FTearDownFixtureMethod;
end;

function TDUnitXTestFixture.GetTearDownFixtureMethodName: string;
begin
  result := FTearDownFixtureMethodName;
end;

function TDUnitXTestFixture.GetTearDownMethod: TTestMethod;
begin
  result  := FTearDownMethod;
end;

function TDUnitXTestFixture.GetTearDownMethodName: string;
begin
  result := FTearDownMethodName;
end;

function TDUnitXTestFixture.GetTestClass: TClass;
begin
  result := FTestClass;
end;

function TDUnitXTestFixture.GetTestCount: cardinal;
begin
  Result := FTests.Count;
end;

function TDUnitXTestFixture.GetTestInOwnThread: boolean;
begin
  result := FTestInOwnThread;
end;

function TDUnitXTestFixture.GetTests: ITestList;
begin
  result := FTests;
end;

function TDUnitXTestFixture.ITestFixtureInfo_GetTests: IList<ITestInfo>;
var
  test : ITest;
begin
  //TODO: Need to test that this isn't accessed between updates to FTests.
  if FTestInfos = nil then
  begin
    FTestInfos := TDUnitXList<ITestInfo>.Create;
    for test in FTests do
      FTestInfos.Add(test as ITestInfo);
  end;
  result := FTestInfos;
end;


procedure TDUnitXTestFixture.OnMethodExecuted(const AMethod: TTestMethod);
begin
  if FTearDownFixtureIsDestructor then
  begin
    if TMethod(AMethod).Code = TMethod(FTearDownFixtureMethod).Code then
      FFixtureInstance := nil;
  end;

end;

procedure TDUnitXTestFixture.SetEnabled(const value: Boolean);
begin
  FEnabled := value;
end;

procedure TDUnitXTestFixture.SetSetupFixtureMethod(const AMethodName: string; const AMethod: TTestMethod);
begin
  if not FIgnoreFixtureSetup then
  begin
    FSetupFixtureMethodName := AMethodName;
    FSetupFixtureMethod := AMethod;
  end;
end;

procedure TDUnitXTestFixture.SetSetupTestMethod(const AMethodName: string; const AMethod: TTestMethod);
begin
  FSetupMethodName := AMethodName;
  FSetupMethod := AMethod;
end;

procedure TDUnitXTestFixture.SetTearDownFixtureMethod(const AMethodName: string; const AMethod: TTestMethod; const AIsDestructor : boolean);
begin
  FTearDownFixtureMethodName := AMethodName;
  FTearDownFixtureMethod := AMethod;
  FTearDownFixtureIsDestructor := AIsDestructor;
end;

procedure TDUnitXTestFixture.SetTearDownTestMethod(const AMethodName: string; const AMethod: TTestMethod);
begin
  FTearDownMethodName := AMethodName;
  FTearDownMethod := AMethod;
end;

procedure TDUnitXTestFixture.SetTestInOwnThread(const value: Boolean);
begin
  FTestInOwnThread := value;
end;

function TDUnitXTestFixture.AddChildFixture(const ATestClass: TClass; const AName: string): ITestFixture;
begin
  result := TDUnitXTestFixture.Create(AName,ATestClass);
  if FChildren = nil then
    FChildren := TTestFixtureList.Create;
  FChildren.Add(result);
end;

function TDUnitXTestFixture.AddChildFixture(const AInstance: TObject; const AName: string): ITestFixture;
begin
  result := TDUnitXTestFixture.Create(AName,AInstance);
  if FChildren = nil then
    FChildren := TTestFixtureList.Create;
  FChildren.Add(result);
end;

function TDUnitXTestFixture.AddTest(const AMethod : TTestMethod; const AName : string; const AEnabled : boolean;const AIgnored : boolean; const AIgnoreReason : string): ITest;
begin
  result  := TDUnitXTest.Create(Self, AName, AMethod,AEnabled,AIgnored,AIgnoreReason);
  FTests.Add(Result);
end;

function TDUnitXTestFixture.AddTestCase(const ACaseName, AName: string; const AMethod: TRttiMethod; const AEnabled: boolean; const AArgs: TValueArray): ITest;
begin
  result := TDUnitXTestCase.Create(FFixtureInstance, Self, AName, AMethod.Name, AMethod, AEnabled, AArgs);
  FTests.Add(result);
end;

class constructor TDUnitXTestFixture.Create;
begin
  FRttiContext := TRttiContext.Create;
end;

constructor TDUnitXTestFixture.Create(const AName: string; const AInstance: TObject);
begin
  FFixtureInstance := AInstance;
  Create(AName,AInstance.ClassType);
end;

function TDUnitXTestFixture.CreateTestFromMethod(AMethod: TRttiMethod;
  ATestEnabled, AIgnored: Boolean; AIgnoredReason: String): ITest;
var
  Meth : TMethod;
begin
  meth.Code := AMethod.CodeAddress;
  meth.Data := FFixtureInstance;
  result  := TDUnitXTest.Create(Self, AMethod.Name, TTestMethod(meth),ATestEnabled,AIgnored,AIgnoredReason);
  result.IgnoreMemoryLeaks := GetIgnoreMemoryLeaksForMethod(AMethod);
end;

function TDUnitXTestFixture.CreateTestFromTestCase(ACaseInfo : TestCaseInfo; AMethod : TRttiMethod; ATestEnabled : Boolean) : ITest;
begin
  result := TDUnitXTestCase.Create(FFixtureInstance, Self, ACaseInfo.Name, AMethod.Name, AMethod, ATestEnabled, ACaseInfo.Values);
  result.IgnoreMemoryLeaks := getIgnoreMemoryLeaksForMethod(AMethod);
end;

end.