diff --git a/DUnitX.FixtureResult.pas b/DUnitX.FixtureResult.pas new file mode 100644 index 00000000..02448287 --- /dev/null +++ b/DUnitX.FixtureResult.pas @@ -0,0 +1,296 @@ +unit DUnitX.FixtureResult; + +interface + +uses + classes, + TimeSpan, + DUnitX.Generics, + DUnitX.TestFramework, + DUnitX.InternalInterfaces; + +type + TDUnitXFixtureResult = class(TInterfacedObject,IFixtureResult,IFixtureResultBuilder) + private + FChildren : IList; + FTestResults : IList; + FFixture : ITestFixtureInfo; + + FAllPassed : boolean; + FErrorCount : integer; + FFailureCount : integer; + FPassCount : integer; + FIgnoredCount : integer; + FTotalCount : integer; + + FStartTime : TDateTime; + FFinishTime : TDateTime; + FDuration : TTimeSpan; + + + protected + procedure Reduce; + + + function GetChildCount : Integer; + function GetChildren : IList; + function GetErrorCount : Integer; + function GetErrors : IList; + function GetFailureCount : Integer; + function GetFailures : IList; + function GetFixture : ITestFixtureInfo; + function GetHasFailures : Boolean; + function GetPassCount : Integer; + function GetPasses : IList; + function GetTestResultCount : Integer; + function GetTestResults : IList; + function GetIgnoredCount : Integer; + + function GetStartTime: TDateTime; + function GetFinishTime: TDateTime; + function GetDuration: TTimeSpan; + + procedure AddChild(const AFixtureResult: IFixtureResult); + procedure AddTestResult(const AResult: ITestResult); + procedure RecordTestResult(const AResult : ITestResult); + procedure RollUpResults; + public + constructor Create(const AParentResult : IFixtureResult; const AFixture : ITestFixtureInfo); + end; + +implementation + +uses + DateUtils, + SysUtils; + + + +{ TDUnitXFixtureResult } + +procedure TDUnitXFixtureResult.AddChild(const AFixtureResult: IFixtureResult); +begin + if FChildren = nil then + FChildren := TDUnitXList.Create; + FChildren.Add(AFixtureResult); +end; + +procedure TDUnitXFixtureResult.AddTestResult(const AResult: ITestResult); +begin + if FTestResults = nil then + FTestResults := TDUnitXList.Create; + FTestResults.Add(AResult); + RecordTestResult(AResult); +end; + +constructor TDUnitXFixtureResult.Create(const AParentResult : IFixtureResult;const AFixture: ITestFixtureInfo); +begin + FFixture := AFixture; + FStartTime := Now; + //Don't create collections here.. we'll lazy create; + FChildren := nil; + FTestResults := nil; + + if AParentResult <> nil then + (AParentResult as IFixtureResultBuilder).AddChild(Self); + +end; + + +function TDUnitXFixtureResult.GetChildCount: Integer; +begin + if FChildren <> nil then + result := FChildren.Count + else + result := 0; +end; + +function TDUnitXFixtureResult.GetChildren: IList; +begin + //Don't pass nill back??? + if FChildren = nil then + FChildren := TDUnitXList.Create; + result := FChildren; +end; + +function TDUnitXFixtureResult.GetDuration: TTimeSpan; +begin + result := FDuration; +end; + +function TDUnitXFixtureResult.GetErrorCount: Integer; +begin + result := FErrorCount; +end; + + +function TDUnitXFixtureResult.GetErrors: IList; +var + test : ITestResult; + error : ITestError; +begin + result := TDUnitXList.Create; + if FTestResults = nil then + exit; + + for test in FTestResults do + begin + if Supports(test,ITestError,error) then + result.Add(error); + end; +end; + +function TDUnitXFixtureResult.GetFailureCount: Integer; +begin + result := FFailureCount; +end; + +function TDUnitXFixtureResult.GetFailures: IList; +var + test : ITestResult; +begin + result := TDUnitXList.Create; + if FTestResults = nil then + exit; + + for test in FTestResults do + begin + if test.ResultType = TTestResultType.Failure then + result.Add(test); + end; +end; + +function TDUnitXFixtureResult.GetFinishTime: TDateTime; +begin + result := FFinishTime; +end; + +function TDUnitXFixtureResult.GetFixture: ITestFixtureInfo; +begin + result := FFixture; +end; + +function TDUnitXFixtureResult.GetHasFailures: Boolean; +begin + result := FFailureCount > 0; +end; + +function TDUnitXFixtureResult.GetIgnoredCount: Integer; +begin + result := FIgnoredCount; +end; + +function TDUnitXFixtureResult.GetPassCount: Integer; +begin + result := FPassCount; +end; + +function TDUnitXFixtureResult.GetPasses: IList; +var + test : ITestResult; +begin + result := TDUnitXList.Create; + if FTestResults = nil then + exit; + + for test in FTestResults do + begin + if test.ResultType = TTestResultType.Pass then + result.Add(test); + end; +end; + +function TDUnitXFixtureResult.GetStartTime: TDateTime; +begin + Result := FStartTime; +end; + +function TDUnitXFixtureResult.GetTestResultCount: Integer; +begin + if FTestResults = nil then + Exit(0); + result := FTestResults.Count; +end; + +function TDUnitXFixtureResult.GetTestResults: IList; +begin + if FTestResults = nil then + FTestResults := TDUnitXList.Create; + result := FTestResults; +end; + +function Max(const a, b : TDateTime) : TDateTime; +begin + if a > b then + result := a + else + result := b; +end; + + +procedure TDUnitXFixtureResult.RecordTestResult(const AResult: ITestResult); +begin + Inc(FTotalCount); + case AResult.ResultType of + TTestResultType.Pass : Inc(FPassCount); + TTestResultType.Failure : Inc(FFailureCount); + TTestResultType.Error : Inc(FErrorCount); + TTestResultType.Ignored : Inc(FIgnoredCount); + end; + + if AResult.ResultType <> Pass then + FAllPassed := False; +end; + +procedure TDUnitXFixtureResult.Reduce; +var + fixtureRes : IFixtureResult; +begin + if (FChildren <> nil) and (FChildren.Count > 0) then + begin + //Reduce the children first. + for fixtureRes in FChildren do + fixtureRes.Reduce; + + //if we have no tests and only one child, then we reduce to that child. + if (FChildren.Count = 1) and ((FTestResults = nil) or (FTestResults.Count = 0)) then + begin + fixtureRes := FChildren[0]; + FFixture := fixtureRes.Fixture; + if FTestResults = nil then + FTestResults := TDUnitXList.Create; + FTestResults.AddRange(fixtureRes.TestResults); + FChildren.Clear; + if fixtureRes.ChildCount > 0 then + FChildren.AddRange(fixtureRes.Children) + else + FChildren.Clear; + end; + end; +end; + +procedure TDUnitXFixtureResult.RollUpResults; +var + fixture : IFixtureResult; +begin + if FChildren <> nil then + begin + FFinishTime := FStartTime; + for fixture in FChildren do + begin + (fixture as IFixtureResultBuilder).RollUpResults; + Inc(FErrorCount,fixture.ErrorCount); + Inc(FFailureCount,fixture.FailureCount); + Inc(FIgnoredCount,fixture.IgnoredCount); + Inc(FPassCount,fixture.PassCount); + FAllPassed := FAllPassed and (not fixture.HasFailures); + FFinishTime := Max(FFinishTime,fixture.FinishTime); + end; + end + else + FFinishTime := Now; + FDuration := TTimeSpan.FromMilliseconds(DateUtils.MilliSecondsBetween(FFinishTime,FStartTime)); + +end; + +end. diff --git a/DUnitX.Generics.pas b/DUnitX.Generics.pas index 945662b8..25c536e0 100644 --- a/DUnitX.Generics.pas +++ b/DUnitX.Generics.pas @@ -37,17 +37,34 @@ interface type //Delphi does not have reference counted collection types.. so we created one here. + //This will typically be used where we return IEnumerbable from a function //TODO: need unit tests!!! - IList = interface(IEnumerable) + + IReadOnlyList = interface(IEnumerable) function GetCapacity : integer; - procedure SetCapacity(const value : integer); function GetCount : integer; - procedure SetCount(const value : integer); function GetItem(index : integer) : T; - procedure SetItem(index : integer; value : T); - function GetOnNotify : TCollectionNotifyEvent; procedure SetOnNotify(value : TCollectionNotifyEvent); + function First: T; + function Last: T; + function Contains(const Value: T): Boolean; + function IndexOf(const Value: T): Integer; + function LastIndexOf(const Value: T): Integer; + function BinarySearch(const Item: T; out Index: Integer): Boolean; overload; + function BinarySearch(const Item: T; out Index: Integer; const AComparer: IComparer): Boolean; overload; + property Capacity: Integer read GetCapacity; + property Count: Integer read GetCount; + property Items[Index: Integer]: T read GetItem; default; + property OnNotify: TCollectionNotifyEvent read GetOnNotify write SetOnNotify; + + end; + + IList = interface(IReadOnlyList) + procedure SetCapacity(const value : integer); + procedure SetCount(const value : integer); + procedure SetItem(index : integer; value : T); + function Add(const Value: T): Integer; procedure AddRange(const Values: array of T); overload; @@ -68,21 +85,14 @@ interface procedure Exchange(Index1, Index2: Integer); procedure Move(CurIndex, NewIndex: Integer); - function First: T; - function Last: T; procedure Clear; - function Contains(const Value: T): Boolean; - function IndexOf(const Value: T): Integer; - function LastIndexOf(const Value: T): Integer; procedure Reverse; procedure Sort; overload; procedure Sort(const AComparer: IComparer); overload; - function BinarySearch(const Item: T; out Index: Integer): Boolean; overload; - function BinarySearch(const Item: T; out Index: Integer; const AComparer: IComparer): Boolean; overload; procedure TrimExcess; @@ -104,7 +114,7 @@ TDUnitXEnumerable = class(TInterfacedObject, IEnumerable) function GetNonGenEnumerator: IEnumerator; virtual; abstract; end; - TDUnitXList = class(TDUnitXEnumerable, IList) + TDUnitXList = class(TDUnitXEnumerable, IList,IEnumerable) private FList : TList; protected diff --git a/DUnitX.InternalInterfaces.pas b/DUnitX.InternalInterfaces.pas index 7862b88a..725048cf 100644 --- a/DUnitX.InternalInterfaces.pas +++ b/DUnitX.InternalInterfaces.pas @@ -100,6 +100,8 @@ TTestList = class(TDUnitXList, ITestList) function GetChildren : ITestFixtureList; function GetHasChildren : boolean; function GetNameSpace : string; + function GetHasTests : boolean; + procedure OnMethodExecuted(const AMethod : TTestMethod); property Name : string read GetName; property NameSpace : string read GetNameSpace; @@ -108,6 +110,7 @@ TTestList = class(TDUnitXList, ITestList) property Description : string read GetDescription; property Enabled : boolean read GetEnabled write SetEnabled; property HasChildFixtures : boolean read GetHasChildren; + property HasTests : boolean read GetHasTests; property TestClass : TClass read GetTestClass; property Tests : IEnumerable read GetTests; property SetupMethod : TTestMethod read GetSetupMethod; @@ -139,7 +142,9 @@ TTestFixtureList = class(TDUnitXList, ITestFixtureList) //Used by the TestExecute method. ITestExecuteContext = interface ['{DE4ADB3F-3B5B-4B90-8659-0BFA578977CC}'] - procedure RecordResult(const testResult : ITestResult); + procedure RecordFixture(const fixtureResult : IFixtureResult); + procedure RecordResult(const fixtureResult : IFixtureResult; const testResult : ITestResult); + procedure RollupResults; end; ITestFixtureContext = interface @@ -157,6 +162,16 @@ TTestFixtureList = class(TDUnitXList, ITestFixtureList) end; + IFixtureResultBuilder = interface + ['{2604E655-349D-4379-9796-1C708CAD7307}'] + procedure AddTestResult(const AResult : ITestResult); + procedure AddChild(const AFixtureResult : IFixtureResult); + procedure RollUpResults; + // function Combine(const AFixtureResult : IFixtureResult) : IFixtureResult; + // function AreEqual(const AFixtureResult : IFixtureResult) : boolean; + end; + + implementation diff --git a/DUnitX.IoC.Internal.pas b/DUnitX.IoC.Internal.pas index f6935f08..9f90992e 100644 --- a/DUnitX.IoC.Internal.pas +++ b/DUnitX.IoC.Internal.pas @@ -40,18 +40,7 @@ interface Generics.Collections, DUnitX.IoC; -type - //Makes sure virtual constructors are called correctly. Just using a class reference will not call the overriden constructor! - //See http://stackoverflow.com/questions/791069/how-can-i-create-an-delphi-object-from-a-class-reference-and-ensure-constructor - TClassActivator = class - private - class var - FRttiCtx : TRttiContext; - class constructor Create; - public - class function CreateInstance(const AClass : TClass) : IInterface; - end; @@ -95,33 +84,6 @@ function InterlockedCompareExchangePointer(var Destination: Pointer; Exchange: P end; {$ENDIF} -{ TActivator } -class constructor TClassActivator.Create; -begin - TClassActivator.FRttiCtx := TRttiContext.Create; -end; - -class function TClassActivator.CreateInstance(const AClass : TClass): IInterface; -var - rType : TRttiType; - method: TRttiMethod; -begin - result := nil; - - rType := FRttiCtx.GetType(AClass); - if not (rType is TRttiInstanceType) then - exit; - - for method in TRttiInstanceType(rType).GetMethods do - begin - if method.IsConstructor and (Length(method.GetParameters) = 0) then - begin - Result := method.Invoke(TRttiInstanceType(rtype).MetaclassType, []).AsInterface; - Break; - end; - end; - -end; end. diff --git a/DUnitX.IoC.pas b/DUnitX.IoC.pas index e49dd86e..43916471 100644 --- a/DUnitX.IoC.pas +++ b/DUnitX.IoC.pas @@ -29,14 +29,18 @@ {$I DUnitX.inc} /// -/// A Simple IoC container. This is used internally by DUnitX, not intended -/// for use by tests. Does not do DI. +/// A Simple IoC container. This is used internally by DUnitX +/// DUnitX used the default container, if you need to use this +/// for your tests, create your own container instance. +/// NOTE: Does not do dependency Injection, if you need that then +/// use the Spring for Delphi Framework interface uses Generics.Collections, TypInfo, + Rtti, SysUtils; type @@ -48,6 +52,8 @@ interface TDUnitXIoC = class private + FRaiseIfNotFound : boolean; + FContainerInfo : TDictionary; type TIoCRegistration = class IInterface : PTypeInfo; @@ -57,37 +63,43 @@ TIoCRegistration = class Instance : IInterface; end; - private class var - FDefault : TDUnitXIoC; - - FContainerInfo : TDictionary; - - private class destructor ClassDestroy; - + private + class var FDefault : TDUnitXIoC; + class destructor ClassDestroy; + protected function GetInterfaceKey(const AName: string = ''): string; function InternalResolve(out AInterface: TInterface; const AName: string = ''): TResolveResult; - public constructor Create; destructor Destroy;override; + //Default Container - used internally by DUnitX + class function DefaultContainer : TDUnitXIoC; {$IFDEF DELPHI_XE_UP} //Exe's compiled with D2010 will crash when these are used. //NOTES: The issue is due to the two generics included in the functions. The constaints also seem to be an issue. - procedure RegisterType;overload; - procedure RegisterType(const name : string);overload; - procedure RegisterType(const singleton : boolean);overload; - procedure RegisterType(const singleton : boolean;const name : string);overload; + procedure RegisterType(const name : string = '');overload; + procedure RegisterType(const singleton : boolean;const name : string = '');overload; {$ENDIF} - procedure RegisterType(const delegate : TActivatorDelegate);overload; - procedure RegisterType(const delegate : TActivatorDelegate; const name : string );overload; - procedure RegisterType(const singleton : boolean;const delegate : TActivatorDelegate);overload; - procedure RegisterType(const singleton : boolean;const delegate : TActivatorDelegate; const name : string);overload; + procedure RegisterType(const delegate : TActivatorDelegate; const name : string = '' );overload; + procedure RegisterType(const singleton : boolean;const delegate : TActivatorDelegate; const name : string = '');overload; + + //Register an instance as a signleton. If there is more than one instance that implements the interface + //then use the name parameter + procedure RegisterSingleton(const instance : TInterface; const name : string = ''); //Resolution - function Resolve(const name: string = ''; const AThrowOnFail : boolean = false): TInterface; + function Resolve(const name: string = ''): TInterface; + + //Returns true if we have such a service. + function HasService : boolean; + + //Empty the Container.. usefull for testing only! + procedure Clear; + + property RaiseIfNotFound : boolean read FRaiseIfNotFound write FRaiseIfNotFound; + + - //Default Container - used internally by DUnitX - class function DefaultContainer : TDUnitXIoC; end; EIoCException = class(Exception); @@ -95,35 +107,67 @@ EIoCRegistrationException = class(EIoCException); EIoCResolutionException = class(EIoCException); + //Makes sure virtual constructors are called correctly. Just using a class reference will not call the overriden constructor! + //See http://stackoverflow.com/questions/791069/how-can-i-create-an-delphi-object-from-a-class-reference-and-ensure-constructor + TClassActivator = class + private + class var + FRttiCtx : TRttiContext; + class constructor Create; + public + class function CreateInstance(const AClass : TClass) : IInterface; + end; + + implementation -uses - Rtti, - DUnitX.IoC.Internal; -{$IFDEF DELPHI_XE_UP} +{ TActivator } -procedure TDUnitXIoC.RegisterType(); +class constructor TClassActivator.Create; begin - Self.RegisterType(false,''); + TClassActivator.FRttiCtx := TRttiContext.Create; end; -procedure TDUnitXIoC.RegisterType(const name: string); +class function TClassActivator.CreateInstance(const AClass : TClass): IInterface; var - newName : string; + rType : TRttiType; + method: TRttiMethod; begin - newName := name; + result := nil; - Self.RegisterType(false, newName); + rType := FRttiCtx.GetType(AClass); + if not (rType is TRttiInstanceType) then + exit; + + for method in TRttiInstanceType(rType).GetMethods do + begin + if method.IsConstructor and (Length(method.GetParameters) = 0) then + begin + Result := method.Invoke(TRttiInstanceType(rtype).MetaclassType, []).AsInterface; + Break; + end; + end; + +end; + + + + +function TDUnitXIoC.HasService: boolean; +begin + result := Self.Resolve <> nil; end; -procedure TDUnitXIoC.RegisterType(const singleton: boolean); +{$IFDEF DELPHI_XE_UP} + +procedure TDUnitXIoC.RegisterType(const name: string); var - newSingleton : boolean; + newName : string; begin - newSingleton := singleton; + newName := name; - Self.RegisterType(newSingleton,''); + Self.RegisterType(false, newName); end; procedure TDUnitXIoC.RegisterType(const singleton: boolean; const name: string); @@ -159,30 +203,28 @@ procedure TDUnitXIoC.RegisterType(const singleton: end; {$ENDIF} -procedure TDUnitXIoC.RegisterType(const delegate: TActivatorDelegate); -begin - Self.RegisterType(false, delegate, ''); -end; - procedure TDUnitXIoC.RegisterType(const delegate: TActivatorDelegate; const name: string); begin Self.RegisterType(false, delegate, name); end; -procedure TDUnitXIoC.RegisterType(const singleton: boolean; const delegate: TActivatorDelegate); + +class destructor TDUnitXIoC.ClassDestroy; begin - Self.RegisterType(singleton, delegate, ''); + if FDefault <> nil then + FDefault.Free; end; -class destructor TDUnitXIoC.ClassDestroy; +procedure TDUnitXIoC.Clear; begin - FDefault.Free; + FContainerInfo.Clear; end; constructor TDUnitXIoC.Create; begin FContainerInfo := TDictionary.Create; + FRaiseIfNotFound := false; end; class function TDUnitXIoC.DefaultContainer: TDUnitXIoC; @@ -197,10 +239,14 @@ destructor TDUnitXIoC.Destroy; var o : TObject; begin - for o in FContainerInfo.Values do - o.Free; + if FContainerInfo <> nil then + begin + for o in FContainerInfo.Values do + if o <> nil then + o.Free; - FContainerInfo.Free; + FContainerInfo.Free; + end; inherited; end; @@ -224,7 +270,6 @@ function TDUnitXIoC.InternalResolve(out AInterface: TInterface; cons var key : string; errorMsg : string; - container : TDictionary; registrationObj : TObject; registration : TIoCRegistration; @@ -310,6 +355,30 @@ function TDUnitXIoC.InternalResolve(out AInterface: TInterface; cons end; end; +procedure TDUnitXIoC.RegisterSingleton(const instance: TInterface; const name: string); +var + key : string; + pInfo : PTypeInfo; + rego : TIoCRegistration; + o : TObject; +begin + pInfo := TypeInfo(TInterface); + key := GetInterfaceKey(name); + + if not FContainerInfo.TryGetValue(key,o) then + begin + rego := TIoCRegistration.Create; + rego.IInterface := pInfo; + rego.ActivatorDelegate := nil; + rego.ImplClass := nil; + rego.IsSingleton := true; + rego.Instance := instance; + FContainerInfo.Add(key,rego); + end + else + raise EIoCException.Create(Format('An implementation for type %s with name %s is already registered with IoC',[pInfo.Name, name])); +end; + procedure TDUnitXIoC.RegisterType(const singleton: boolean; const delegate: TActivatorDelegate; const name: string); var key : string; @@ -321,12 +390,7 @@ procedure TDUnitXIoC.RegisterType(const singleton: boolean; const de newName := name; pInfo := TypeInfo(TInterface); - if newName = '' then - key := string(pInfo.Name) - else - key := string(pInfo.Name) + '_' + newName; - key := LowerCase(key); - + key := GetInterfaceKey(name); if not FContainerInfo.TryGetValue(key,o) then begin rego := TIoCRegistration.Create; @@ -340,7 +404,7 @@ procedure TDUnitXIoC.RegisterType(const singleton: boolean; const de raise EIoCException.Create(Format('An implementation for type %s with name %s is already registered with IoC',[pInfo.Name, newName])); end; -function TDUnitXIoC.Resolve(const name: string = ''; const AThrowOnFail : boolean = false): TInterface; +function TDUnitXIoC.Resolve(const name: string = ''): TInterface; var resolveResult: TResolveResult; errorMsg : string; @@ -350,8 +414,8 @@ function TDUnitXIoC.Resolve(const name: string = ''; const AThrowOnF resolveResult := InternalResolve(result, name); //If we don't have a resolution and the caller wants an exception then throw one. - if (result = nil) and (AThrowOnFail) then - begin + if (result = nil) and (FRaiseIfNotFound) then + begin case resolveResult of TResolveResult.Success : ; TResolveResult.InterfaceNotRegistered : errorMsg := Format('No implementation registered for type %s', [pInfo.Name]); diff --git a/DUnitX.Loggers.Console.pas b/DUnitX.Loggers.Console.pas index a38ece9b..e75f9261 100644 --- a/DUnitX.Loggers.Console.pas +++ b/DUnitX.Loggers.Console.pas @@ -66,7 +66,6 @@ TDUnitXConsoleLogger = class(TInterfacedObject, ITestLogger) procedure OnExecuteTest(const threadId : Cardinal; const Test: ITestInfo); procedure OnTestIgnored(const threadId: Cardinal;const AIgnored: ITestResult); - procedure OnTestWarning(const threadId: Cardinal;const AWarning: ITestResult); procedure OnTestError(const threadId: Cardinal; const Error: ITestError); procedure OnTestFailure(const threadId: Cardinal; const Failure: ITestError); procedure OnTestSuccess(const threadId: Cardinal; const Test: ITestResult); @@ -82,7 +81,7 @@ TDUnitXConsoleLogger = class(TInterfacedObject, ITestLogger) procedure OnEndTestFixture(const threadId: Cardinal; const results: IFixtureResult); - procedure OnTestingEnds(const TestResults: ITestResults); + procedure OnTestingEnds(const RunResults: IRunResults); public constructor Create(const quietMode : boolean = false); destructor Destroy;override; @@ -300,7 +299,7 @@ procedure TDUnitXConsoleLogger.OnTeardownTest(const threadId: Cardinal; const Te FConsoleWriter.Outdent(1); end; -procedure TDUnitXConsoleLogger.OnTestingEnds(const TestResults: ITestResults); +procedure TDUnitXConsoleLogger.OnTestingEnds(const RunResults: IRunResults); var testResult: ITestResult; begin @@ -316,35 +315,35 @@ procedure TDUnitXConsoleLogger.OnTestingEnds(const TestResults: ITestResults); end; SetConsoleSummaryColor(); - FConsoleWriter.WriteLn(Format('Tests Run : %d',[TestResults.Count])); + FConsoleWriter.WriteLn(Format('Tests Run : %d',[RunResults.TestCount])); - if TestResults.IgnoredCount > 0 then + if RunResults.IgnoredCount > 0 then SetConsoleWarningColor() else SetConsoleDefaultColor(); - FConsoleWriter.WriteLn(Format('Tests Ignored : %d',[TestResults.IgnoredCount])); + FConsoleWriter.WriteLn(Format('Tests Ignored : %d',[RunResults.IgnoredCount])); - if TestResults.PassCount > 0 then + if RunResults.PassCount > 0 then SetConsolePassColor() else SetConsoleDefaultColor(); - FConsoleWriter.WriteLn(Format('Tests Passed : %d',[TestResults.PassCount])); + FConsoleWriter.WriteLn(Format('Tests Passed : %d',[RunResults.PassCount])); - if TestResults.FailureCount > 0 then + if RunResults.FailureCount > 0 then SetConsoleErrorColor() else SetConsoleDefaultColor(); - FConsoleWriter.WriteLn(Format('Tests Failed : %d',[TestResults.FailureCount])); + FConsoleWriter.WriteLn(Format('Tests Failed : %d',[RunResults.FailureCount])); - if TestResults.ErrorCount > 0 then + if RunResults.ErrorCount > 0 then SetConsoleErrorColor() else SetConsoleDefaultColor(); - FConsoleWriter.WriteLn(Format('Tests Errored : %d',[TestResults.ErrorCount])); + FConsoleWriter.WriteLn(Format('Tests Errored : %d',[RunResults.ErrorCount])); - if TestResults.FailureCount > 0 then + if RunResults.FailureCount > 0 then begin SetConsoleErrorColor(); FConsoleWriter.WriteLn; @@ -352,7 +351,8 @@ procedure TDUnitXConsoleLogger.OnTestingEnds(const TestResults: ITestResults); FConsoleWriter.WriteLn; SetConsoleDefaultColor(); - for testResult in TestResults.GetResults do + + for testResult in RunResults.GetAllTestResults do begin if testResult.ResultType = TTestResultType.Failure then begin @@ -363,11 +363,10 @@ procedure TDUnitXConsoleLogger.OnTestingEnds(const TestResults: ITestResults); FConsoleWriter.WriteLn; end; end; - FConsoleWriter.WriteLn; end; - if TestResults.ErrorCount > 0 then + if RunResults.ErrorCount > 0 then begin SetConsoleErrorColor(); FConsoleWriter.WriteLn; @@ -375,7 +374,7 @@ procedure TDUnitXConsoleLogger.OnTestingEnds(const TestResults: ITestResults); FConsoleWriter.WriteLn; SetConsoleDefaultColor(); - for testResult in TestResults.GetResults do + for testResult in RunResults.GetAllTestResults do begin if testResult.ResultType = TTestResultType.Error then begin @@ -386,7 +385,6 @@ procedure TDUnitXConsoleLogger.OnTestingEnds(const TestResults: ITestResults); FConsoleWriter.WriteLn; end; end; - FConsoleWriter.WriteLn; end; @@ -417,11 +415,6 @@ procedure TDUnitXConsoleLogger.OnTestingStarts(const threadId, testCount, testAc FConsoleWriter.Indent(1); end; -procedure TDUnitXConsoleLogger.OnTestWarning(const threadId: Cardinal; const AWarning: ITestResult); -begin - if FQuietMode then - FConsoleWriter.Write('W'); -end; procedure TDUnitXConsoleLogger.SetConsoleDefaultColor(); begin diff --git a/DUnitX.Loggers.GUI.dfm b/DUnitX.Loggers.GUI.dfm index 9cde14fd..72598b97 100644 --- a/DUnitX.Loggers.GUI.dfm +++ b/DUnitX.Loggers.GUI.dfm @@ -69,7 +69,6 @@ object DUnitXGuiLoggerForm: TDUnitXGuiLoggerForm BevelOuter = bvNone TabOrder = 0 Text = 'Edit1' - ExplicitTop = 90 end end object Panel2: TPanel @@ -103,7 +102,6 @@ object DUnitXGuiLoggerForm: TDUnitXGuiLoggerForm BevelOuter = bvNone ParentColor = True TabOrder = 4 - ExplicitHeight = 264 object TestTree: TTreeView Left = 0 Top = 0 @@ -126,10 +124,6 @@ object DUnitXGuiLoggerForm: TDUnitXGuiLoggerForm 00010A530075006200540065007300740031002E003200280000000000000000 0000002080DB4100000000FFFFFFFF0000000000000000010554006500730074 003200} - ExplicitLeft = 2 - ExplicitTop = 50 - ExplicitWidth = 476 - ExplicitHeight = 146 end end object ActionManager1: TActionManager diff --git a/DUnitX.Loggers.GUI.pas b/DUnitX.Loggers.GUI.pas index b5643712..2758bc56 100644 --- a/DUnitX.Loggers.GUI.pas +++ b/DUnitX.Loggers.GUI.pas @@ -83,9 +83,8 @@ TDUnitXGuiLoggerForm = class(TForm,ITestLogger) procedure OnTestError(const threadId: Cardinal; const Error: ITestError); procedure OnTestFailure(const threadId: Cardinal; const Failure: ITestError); procedure OnTestSuccess(const threadId: Cardinal; const Test: ITestResult); - procedure OnTestWarning(const threadId: Cardinal; const Warning: ITestResult); procedure OnTestIgnored(const threadId: Cardinal; const Ignored: ITestResult); - procedure OnTestingEnds(const TestResults: ITestResults); + procedure OnTestingEnds(const RunResults: IRunResults); procedure OnTestingStarts(const threadId: Cardinal; const testCount: Cardinal; const testActiveCount: Cardinal); procedure WMLoadTests(var message : TMessage); message WM_LOAD_TESTS; @@ -203,7 +202,7 @@ procedure TDUnitXGuiLoggerForm.OnTestIgnored(const threadId: Cardinal; const Ign end; -procedure TDUnitXGuiLoggerForm.OnTestingEnds(const TestResults: ITestResults); +procedure TDUnitXGuiLoggerForm.OnTestingEnds(const RunResults: IRunResults); begin end; @@ -218,17 +217,12 @@ procedure TDUnitXGuiLoggerForm.OnTestSuccess(const threadId: Cardinal; const Tes end; -procedure TDUnitXGuiLoggerForm.OnTestWarning(const threadId: Cardinal; const Warning: ITestResult); -begin - -end; procedure TDUnitXGuiLoggerForm.BuildTree(parentNode : TTreeNode; const fixtureList : ITestFixtureList); var fixture : ITestFixture; test : ITest; fixtureNode : TTreeNode; - testNode : TTreeNode; begin for fixture in fixtureList do begin @@ -237,7 +231,7 @@ procedure TDUnitXGuiLoggerForm.BuildTree(parentNode : TTreeNode; const fixtureLi BuildTree(fixtureNode,fixture.Children); for test in fixture.Tests do begin - testNode := TestTree.Items.AddChild(fixtureNode,test.Name); + TestTree.Items.AddChild(fixtureNode,test.Name); end; end; end; diff --git a/DUnitX.Loggers.Null.pas b/DUnitX.Loggers.Null.pas new file mode 100644 index 00000000..12586882 --- /dev/null +++ b/DUnitX.Loggers.Null.pas @@ -0,0 +1,165 @@ +{***************************************************************************} +{ } +{ 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.Loggers.Null; + +interface + +uses + DUnitX.TestFramework; + +type + /// A Base class for loggers that do not need to use every interface method. + TDUnitXNullLogger = class(TInterfacedObject,ITestLogger) + protected + procedure OnBeginTest(const threadId: Cardinal; const Test: ITestInfo);virtual; + procedure OnEndSetupFixture(const threadId: Cardinal; const fixture: ITestFixtureInfo);virtual; + procedure OnEndSetupTest(const threadId: Cardinal; const Test: ITestInfo);virtual; + procedure OnEndTearDownFixture(const threadId: Cardinal; const fixture: ITestFixtureInfo);virtual; + procedure OnEndTeardownTest(const threadId: Cardinal; const Test: ITestInfo);virtual; + procedure OnEndTest(const threadId: Cardinal; const Test: ITestResult);virtual; + procedure OnEndTestFixture(const threadId: Cardinal; const results: IFixtureResult);virtual; + procedure OnExecuteTest(const threadId: Cardinal; const Test: ITestInfo);virtual; + procedure OnLog(const logType: TLogLevel; const msg: string);virtual; + procedure OnSetupFixture(const threadId: Cardinal; const fixture: ITestFixtureInfo);virtual; + procedure OnSetupTest(const threadId: Cardinal; const Test: ITestInfo);virtual; + procedure OnStartTestFixture(const threadId: Cardinal; const fixture: ITestFixtureInfo);virtual; + procedure OnTearDownFixture(const threadId: Cardinal; const fixture: ITestFixtureInfo);virtual; + procedure OnTeardownTest(const threadId: Cardinal; const Test: ITestInfo);virtual; + procedure OnTestError(const threadId: Cardinal; const Error: ITestError);virtual; + procedure OnTestFailure(const threadId: Cardinal; const Failure: ITestError);virtual; + procedure OnTestIgnored(const threadId: Cardinal; const AIgnored: ITestResult);virtual; + procedure OnTestSuccess(const threadId: Cardinal; const Test: ITestResult);virtual; + procedure OnTestingEnds(const RunResults: IRunResults);virtual; + procedure OnTestingStarts(const threadId: Cardinal; const testCount: Cardinal; const testActiveCount: Cardinal);virtual; + end; + +implementation + +{ TDUnitXNullLogger } + +procedure TDUnitXNullLogger.OnBeginTest(const threadId: Cardinal; const Test: ITestInfo); +begin + +end; + +procedure TDUnitXNullLogger.OnEndSetupFixture(const threadId: Cardinal; const fixture: ITestFixtureInfo); +begin + +end; + +procedure TDUnitXNullLogger.OnEndSetupTest(const threadId: Cardinal; const Test: ITestInfo); +begin + +end; + +procedure TDUnitXNullLogger.OnEndTearDownFixture(const threadId: Cardinal; const fixture: ITestFixtureInfo); +begin + +end; + +procedure TDUnitXNullLogger.OnEndTeardownTest(const threadId: Cardinal; const Test: ITestInfo); +begin + +end; + +procedure TDUnitXNullLogger.OnEndTest(const threadId: Cardinal; const Test: ITestResult); +begin + +end; + +procedure TDUnitXNullLogger.OnEndTestFixture(const threadId: Cardinal; const results: IFixtureResult); +begin + +end; + +procedure TDUnitXNullLogger.OnExecuteTest(const threadId: Cardinal; const Test: ITestInfo); +begin + +end; + +procedure TDUnitXNullLogger.OnLog(const logType: TLogLevel; const msg: string); +begin + +end; + +procedure TDUnitXNullLogger.OnSetupFixture(const threadId: Cardinal; const fixture: ITestFixtureInfo); +begin + +end; + +procedure TDUnitXNullLogger.OnSetupTest(const threadId: Cardinal; const Test: ITestInfo); +begin + +end; + +procedure TDUnitXNullLogger.OnStartTestFixture(const threadId: Cardinal; const fixture: ITestFixtureInfo); +begin + +end; + +procedure TDUnitXNullLogger.OnTearDownFixture(const threadId: Cardinal; const fixture: ITestFixtureInfo); +begin + +end; + +procedure TDUnitXNullLogger.OnTeardownTest(const threadId: Cardinal; const Test: ITestInfo); +begin + +end; + +procedure TDUnitXNullLogger.OnTestError(const threadId: Cardinal; const Error: ITestError); +begin + +end; + +procedure TDUnitXNullLogger.OnTestFailure(const threadId: Cardinal; const Failure: ITestError); +begin + +end; + +procedure TDUnitXNullLogger.OnTestIgnored(const threadId: Cardinal; const AIgnored: ITestResult); +begin + +end; + +procedure TDUnitXNullLogger.OnTestingEnds(const RunResults: IRunResults); +begin + +end; + +procedure TDUnitXNullLogger.OnTestingStarts(const threadId, testCount, testActiveCount: Cardinal); +begin + +end; + +procedure TDUnitXNullLogger.OnTestSuccess(const threadId: Cardinal; const Test: ITestResult); +begin + +end; + + +end. diff --git a/DUnitX.Loggers.Text.pas b/DUnitX.Loggers.Text.pas index f6996e6c..970b942b 100644 --- a/DUnitX.Loggers.Text.pas +++ b/DUnitX.Loggers.Text.pas @@ -56,7 +56,6 @@ TDUnitXTextFileLogger = class(TInterfacedObject, ITestLogger) procedure OnTestSuccess(const threadId: Cardinal; const Test: ITestResult); - procedure OnTestWarning(const threadId: Cardinal; const AWarning: ITestResult); procedure OnTestError(const threadId: Cardinal; const Error: ITestError); procedure OnTestFailure(const threadId: Cardinal; const Failure: ITestError); procedure OnTestIgnored(const threadId: Cardinal; const AIgnored: ITestResult); @@ -74,7 +73,7 @@ TDUnitXTextFileLogger = class(TInterfacedObject, ITestLogger) procedure OnEndTestFixture(const threadId: Cardinal; const results: IFixtureResult); - procedure OnTestingEnds(const TestResult: ITestResults); + procedure OnTestingEnds(const RunResults: IRunResults); public constructor Create(const AFileName: string; const overwrite : boolean = true); end; @@ -180,7 +179,7 @@ procedure TDUnitXTextFileLogger.OnTeardownTest(const threadId: Cardinal; const T end; -procedure TDUnitXTextFileLogger.OnTestingEnds(const TestResult: ITestResults); +procedure TDUnitXTextFileLogger.OnTestingEnds(const RunResults: IRunResults); begin end; @@ -190,9 +189,5 @@ procedure TDUnitXTextFileLogger.OnTestingStarts(const threadId, testCount, testA end; -procedure TDUnitXTextFileLogger.OnTestWarning(const threadId: Cardinal; const AWarning: ITestResult); -begin - -end; end. diff --git a/DUnitX.Loggers.XML.NUnit.pas b/DUnitX.Loggers.XML.NUnit.pas index 1fa4bddf..cfb32ca6 100644 --- a/DUnitX.Loggers.XML.NUnit.pas +++ b/DUnitX.Loggers.XML.NUnit.pas @@ -1,396 +1,307 @@ -{***************************************************************************} -{ } -{ 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.Loggers.XML.NUnit; interface uses + classes, + SysUtils, DUnitX.TestFramework, - classes; + DUnitX.Loggers.Null; -{$I DUnitX.inc} +//TODO : Rework https://github.com/VSoftTechnologies/Delphi-Fluent-XML so it doesn't use msxml and use it here? type - TDUnitXXMLNUnitLogger = class(TInterfacedObject, ITestLogger) + TDUnitXXMLNUnitLogger = class(TDUnitXNullLogger) private FOutputStream : TStream; - - FLogList : TStringList; - FWarningList : TStringList; - - procedure WriteXMLLine(const AXMLLine: string); - procedure WriteInfoAndWarningsXML; - - function HasInfoOrWarnings: Boolean; - + FOwnsStream : boolean; + FIndent : integer; protected - procedure OnTestingStarts(const threadId, testCount, testActiveCount: Cardinal); - - procedure OnStartTestFixture(const threadId: Cardinal; const fixture: ITestFixtureInfo); - - procedure OnSetupFixture(const threadId: Cardinal; const fixture: ITestFixtureInfo); - procedure OnEndSetupFixture(const threadId: Cardinal; const fixture: ITestFixtureInfo); + procedure Indent; + procedure Outdent; + procedure WriteXMLLine(const value : string); - procedure OnBeginTest(const threadId: Cardinal; const Test: ITestInfo); - procedure OnSetupTest(const threadId: Cardinal; const Test: ITestInfo); - procedure OnEndSetupTest(const threadId: Cardinal; const Test: ITestInfo); + procedure OnTestingEnds(const RunResults: IRunResults); override; - procedure OnExecuteTest(const threadId: Cardinal; const Test: ITestInfo); + procedure WriteFixtureResult(const fixtureResult : IFixtureResult); + procedure WriteTestResult(const testResult : ITestResult); - procedure OnTestSuccess(const threadId: Cardinal; const Success: ITestResult); - procedure OnTestWarning(const threadId: Cardinal; const Warning: ITestResult); - procedure OnTestError(const threadId: Cardinal; const Error: ITestError); - procedure OnTestFailure(const threadId: Cardinal; const Failure: ITestError); - procedure OnTestIgnored(const threadId: Cardinal; const Ignored: ITestResult); - procedure OnLog(const logType: TLogLevel; const msg: string); - - procedure OnTeardownTest(const threadId: Cardinal; const Test: ITestInfo); - procedure OnEndTeardownTest(const threadId: Cardinal; const Test: ITestInfo); - - procedure OnEndTest(const threadId: Cardinal; const Test: ITestResult); - - procedure OnTearDownFixture(const threadId: Cardinal; const fixture: ITestFixtureInfo); - procedure OnEndTearDownFixture(const threadId: Cardinal; const fixture: ITestFixtureInfo); - - procedure OnEndTestFixture(const threadId: Cardinal; const results: IFixtureResult); - - procedure OnTestingEnds(const TestResults: ITestResults); public - constructor Create(const AOutputStream : TStream); + constructor Create(const AOutputStream : TStream; const AOwnsStream : boolean = false); destructor Destroy;override; end; TDUnitXXMLNUnitFileLogger = class(TDUnitXXMLNUnitLogger) - private - FXMLFileStream : TFileStream; public constructor Create(const AFilename: string = ''); end; + implementation uses - {$IFDEF MSWINDOWS} - {$if CompilerVersion < 23 } - Forms, - Windows, - {$else} - Vcl.Forms, - WinAPI.Windows, // Delphi XE2 (CompilerVersion 23) added scopes in front of unit names - {$ifend} - {$ENDIF} - DUnitX.Utils.XML, - SysUtils; + TypInfo; -const - NUNIT_LOGGER_CRLF = #13#10; -{ TDUnitXTextFileLogger } +{ TDUnitXXMLNUnitLogger } -procedure TDUnitXXMLNUnitLogger.WriteInfoAndWarningsXML; +constructor TDUnitXXMLNUnitLogger.Create(const AOutputStream: TStream; const AOwnsStream : boolean = false); var - log : string; - warning : string; + preamble: TBytes; begin - if FLogList.Count > 0 then - begin - for log in FLogList do - WriteXMLLine('' + EscapeForXML(log, false) + ''); - end; + FOutputStream := AOutputStream; + FOwnsStream := AOwnsStream; - if FWarningList.Count > 0 then - begin - for warning in FWarningList do - WriteXMLLine('' + EscapeForXML(warning, false) + ''); - end; -end; + Preamble := TEncoding.UTF8.GetPreamble; + FOutputStream.WriteBuffer(preamble[0], Length(preamble)); -constructor TDUnitXXMLNUnitLogger.Create(const AOutputStream: TStream); -begin - //We are given this stream to use as we see fit, would pass in an interface but there is none for streams. - FOutputStream := AOutputStream; - FLogList := TStringList.Create; - FWarningList := TStringList.Create; end; destructor TDUnitXXMLNUnitLogger.Destroy; begin - FOutputStream.Free; - FLogList.Free; - FWarningList.Free; - + if FOwnsStream then + FOutputStream.Free; inherited; end; -function TDUnitXXMLNUnitLogger.HasInfoOrWarnings: Boolean; +procedure TDUnitXXMLNUnitLogger.Indent; begin - Result := (FLogList.Count > 0) or (FWarningList.Count > 0); + Inc(FIndent,1); end; -procedure TDUnitXXMLNUnitLogger.OnBeginTest(const threadId: Cardinal; const Test: ITestInfo); -begin - FLogList.Clear; - FWarningList.Clear; -end; +procedure TDUnitXXMLNUnitLogger.OnTestingEnds(const RunResults: IRunResults); -procedure TDUnitXXMLNUnitLogger.OnEndSetupFixture(const threadId: Cardinal; const fixture: ITestFixtureInfo); -begin - -end; - -procedure TDUnitXXMLNUnitLogger.OnEndSetupTest(const threadId: Cardinal; const Test: ITestInfo); -begin - -end; - -procedure TDUnitXXMLNUnitLogger.OnEndTearDownFixture(const threadId: Cardinal; const fixture: ITestFixtureInfo); -begin - -end; - -procedure TDUnitXXMLNUnitLogger.OnEndTeardownTest(const threadId: Cardinal; const Test: ITestInfo); -begin - -end; - -procedure TDUnitXXMLNUnitLogger.OnEndTest(const threadId: Cardinal; const Test: ITestResult); -begin - -end; - -procedure TDUnitXXMLNUnitLogger.OnEndTestFixture(const threadId: Cardinal; const results: IFixtureResult); +(* +procedure LogFixture(const fixture : IFixtureResult; level : integer); +var + child : IFixtureResult; + sLevel : string; begin - WriteXMLLine(''); - WriteXMLLine(''); -end; + sLevel := StringOfChar(' ', level * 2 ); + System.WriteLn(sLevel + fixture.Fixture.NameSpace + ':' + fixture.Fixture.Name + Format(' [Tests: %d] [Children: %d] [Passed : %d]',[fixture.ResultCount,fixture.ChildCount,fixture.PassCount])); -procedure TDUnitXXMLNUnitLogger.OnExecuteTest(const threadId: Cardinal; const Test: ITestInfo); -begin + Inc(level); + for child in fixture.Children do + begin + LogFixture(child,level); + end; end; +*) -procedure TDUnitXXMLNUnitLogger.OnLog(const logType: TLogLevel; const msg: string); +var + fixtureRes : IFixtureResult; + sExeName : string; + sResult : string; + sTime : string; + sDate : string; begin - FLogList.Add(Format('STATUS: %s: %s', [TLogLevelDesc[logType], msg])); -end; -procedure TDUnitXXMLNUnitLogger.OnSetupFixture(const threadId: Cardinal; const fixture: ITestFixtureInfo); -begin +{ first things first, rollup the namespaces. + So, where parent fixtures have no tests, or only one child fixture, combine into a single fixture. + } + for fixtureRes in RunResults.FixtureResults do + begin + fixtureRes.Reduce; + // LogFixture(fixtureRes,0); + end; -end; -procedure TDUnitXXMLNUnitLogger.OnSetupTest(const threadId: Cardinal; const Test: ITestInfo); -begin + sExeName := ParamStr(0); + FIndent := 0; + sTime := Format('%.3f',[RunResults.Duration.TotalSeconds]); + sDate := FormatDateTime('yyyy-MM-dd',RunResults.StartTime); -end; + WriteXMLLine(Format('', + [sExeName,RunResults.TestCount,RunResults.ErrorCount,RunResults.FailureCount,RunResults.IgnoredCount,RunResults.IgnoredCount,sDate,sTime])); + sExeName := ChangeFileExt(ExtractFileName(sExeName),''); -procedure TDUnitXXMLNUnitLogger.OnStartTestFixture(const threadId: Cardinal; const fixture: ITestFixtureInfo); -var - sType : string; -begin - if fixture.Tests.Count > 0 then - sType := 'TestFixture' + if RunResults.AllPassed then + sResult := 'Success' else - sType := 'Namespace'; - - WriteXMLLine(Format('', [sType,fixture.Name, fixture.TestCount, fixture.TestCount - fixture.ActiveTestCount])); - WriteXMLLine(''); -end; + sResult := 'Failure'; -procedure TDUnitXXMLNUnitLogger.OnTearDownFixture(const threadId: Cardinal; const fixture: ITestFixtureInfo); -begin - -end; + Indent; + //TODO: Populate these properly. + WriteXMLLine(''); + WriteXMLLine(''); + Outdent; -procedure TDUnitXXMLNUnitLogger.OnTeardownTest(const threadId: Cardinal; const Test: ITestInfo); -begin + Indent; + WriteXMLLine(Format('',[sExeName,sResult,BoolToStr(RunResults.AllPassed,true),sTime])); + Indent; + WriteXMLLine(''); -end; + Indent; + for fixtureRes in RunResults.FixtureResults do + WriteFixtureResult(fixtureRes); -procedure TDUnitXXMLNUnitLogger.OnTestError(const threadId: Cardinal; const Error: ITestError); -begin - //TODO: Getting Test, and Fixture from Error is painful for testing. Therefore its painful for setup, and use? - - WriteXMLLine(Format('', - [EscapeForXML(Error.Test.FullName), BoolToStr(Error.Test.Active, True), - Error.TestDuration.TotalMilliseconds / 1000])); + Outdent; + WriteXMLLine(''); + Outdent; + WriteXMLLine(''); + Outdent; + WriteXMLLine(''); - WriteXMLLine(Format('', [EscapeForXML(error.ExceptionClass.ClassName), EscapeForXML(error.ExceptionLocationInfo)])); - WriteXMLLine(Format('%s', [EscapeForXML(error.ExceptionMessage, false)])); - WriteXMLLine(''); - WriteInfoAndWarningsXML; - WriteXMLLine(''); end; -procedure TDUnitXXMLNUnitLogger.OnTestFailure(const threadId: Cardinal; const Failure: ITestError); +procedure TDUnitXXMLNUnitLogger.Outdent; begin - WriteXMLLine(Format('', - [EscapeForXML(Failure.Test.FullName), BoolToStr(Failure.Test.Active, True), - Failure.TestDuration.Milliseconds / 1000])); - WriteXMLLine(Format('', [EscapeForXML(Failure.ExceptionClass.ClassName), EscapeForXML(Failure.ExceptionLocationInfo)])); - WriteXMLLine(Format('%s', [EscapeForXML(Failure.ExceptionMessage, false)])); - WriteXMLLine(''); - WriteInfoAndWarningsXML; - WriteXMLLine(''); + Dec(FIndent,1); end; -procedure TDUnitXXMLNUnitLogger.OnTestIgnored(const threadId: Cardinal; const Ignored: ITestResult); +procedure TDUnitXXMLNUnitLogger.WriteFixtureResult(const fixtureResult: IFixtureResult); var - endTag : string; - fixture: ITestFixtureInfo; + sResult : string; + sTime : string; + sLineEnd : string; + child : IFixtureResult; + testResult : ITestResult; begin - if Ignored.Message <> '' then - endTag := '>' - else - endTag := '/>'; - - fixture := Ignored.Test.Fixture; - - WriteXMLLine(Format(' '' then - begin - WriteXMLLine('' + EscapeForXML(Ignored.Message, false) + ''); - WriteXMLLine(''); + Indent; + try + if not fixtureResult.HasFailures then + sResult := 'Success' + else + sResult := 'Failure'; + sTime := Format('%.3f',[fixtureResult.Duration.TotalSeconds]); + + if fixtureResult.ResultCount > 0 then + begin + //It's a fixture + WriteXMLLine(Format('',[fixtureResult.Fixture.Name, sResult,BoolToStr(not fixtureResult.HasFailures,true),sTime])); + Indent; + WriteXMLLine(''); + for testResult in fixtureResult.TestResults do + begin + WriteTestResult(testResult); + end; + WriteXMLLine(''); + Outdent; + WriteXMLLine(''); + end + else + begin + if fixtureResult.ChildCount = 0 then + sLineEnd := '/'; + //It's a Namespace. + WriteXMLLine(Format('',[fixtureResult.Fixture.FullName, sResult,BoolToStr(not fixtureResult.HasFailures,true),sTime,sLineEnd])); + if fixtureResult.ChildCount > 0 then + begin + WriteXMLLine(''); + for child in fixtureResult.Children do + begin + WriteFixtureResult(child); + end; + WriteXMLLine(''); + WriteXMLLine(''); + end; + end; + finally + Outdent; end; end; -procedure TDUnitXXMLNUnitLogger.OnTestingEnds(const TestResults: ITestResults); +function ResultTypeToString(const value : TTestResultType) : string; begin - WriteXMLLine(''); - WriteXMLLine('' + NUNIT_LOGGER_CRLF + - Format('', [TestResults.Count]) + NUNIT_LOGGER_CRLF + - Format('', [TestResults.FailureCount]) + NUNIT_LOGGER_CRLF + - Format('', [TestResults.ErrorCount]) + NUNIT_LOGGER_CRLF + - Format('', [TestResults.IgnoredCount]) + NUNIT_LOGGER_CRLF + - Format('', [TestResults.SuccessRate]) + NUNIT_LOGGER_CRLF + - Format('', [DateTimeToStr(TestResults.StartTime)]) + NUNIT_LOGGER_CRLF + - Format('', [DateTimeToStr(TestResults.FinishTime)]) + NUNIT_LOGGER_CRLF + - Format('', [TestResults.TestDuration.TotalMilliseconds / 1000]) + NUNIT_LOGGER_CRLF + - '' + NUNIT_LOGGER_CRLF + - ''); - - //TODO: Do we need to write to the console here? + result := GetEnumName(TypeInfo(TTestResultType),Ord(value)); end; -procedure TDUnitXXMLNUnitLogger.OnTestingStarts(const threadId, testCount, testActiveCount: Cardinal); +procedure TDUnitXXMLNUnitLogger.WriteTestResult(const testResult: ITestResult); var - unicodePreamble: TBytes; - dtNow: TDateTime; - sExe : string; + sLineEnd : string; + sResult : string; + sTime : string; begin - //write the byte order mark - unicodePreamble := TEncoding.UTF8.GetPreamble; - - if Length(unicodePreamble) > 0 then - FOutputStream.WriteBuffer(unicodePreamble[0], Length(unicodePreamble)); - - WriteXMLLine(''); - - dtNow := Now; - WriteXMLLine(Format('', - [testCount, - testCount - testActiveCount, - DateToStr(dtNow), - TimeToStr(dtNow)])); - - sExe := ExtractFileName(ParamStr(0)); - - - WriteXMLLine(Format('',[sExe])); - WriteXMLLine(Format('',[ChangeFileExt(sExe,'')])); - - -end; - -procedure TDUnitXXMLNUnitLogger.OnTestSuccess(const threadId: Cardinal; const Success: ITestResult); -var - endTag : string; - fixture: ITestFixtureInfo; -begin - if HasInfoOrWarnings then - endTag := '>' - else - endTag := '/>'; - - fixture := Success.Test.Fixture; - - WriteXMLLine(Format(''); + Indent; + try + sTime := Format('%.3f',[testResult.Duration.TotalSeconds]); + sResult := ResultTypeToString(testResult.ResultType); + if testResult.ResultType = TTestResultType.Pass then + sLineEnd := '/'; + WriteXMLLine(Format('',[testResult.Test.FullName, sResult,BoolToStr(testResult.ResultType = Pass,true),sTime,sLineEnd])); + if testResult.ResultType <> TTestResultType.Pass then + begin + Indent; + case testResult.ResultType of + Failure, Error: + begin + Indent; + WriteXMLLine(''); + Indent; + WriteXMLLine(''); + Indent; + WriteXMLLine(Format('',[testResult.Message])); + Outdent; + WriteXMLLine(''); + Outdent; + Indent; + WriteXMLLine(''); + Indent; + WriteXMLLine(Format('',[testResult.StackTrace])); + Outdent; + WriteXMLLine(''); + Outdent; + WriteXMLLine(''); + Outdent; + end; + Ignored: + begin + Indent; + WriteXMLLine(''); + Indent; + WriteXMLLine(''); + Indent; + WriteXMLLine(Format('',[testResult.Message])); + Outdent; + WriteXMLLine(''); + Outdent; + WriteXMLLine(''); + Outdent; + end; + end; + + + + Outdent; + WriteXMLLine(''); + end; + + finally + Outdent; end; end; -procedure TDUnitXXMLNUnitLogger.OnTestWarning(const threadId: Cardinal; const Warning: ITestResult); -begin - FWarningList.Add(Format('WARNING: %s: %s', [Warning.Test.Name, Warning.Message])); -end; - - -procedure TDUnitXXMLNUnitLogger.WriteXMLLine(const AXMLLine: string); +procedure TDUnitXXMLNUnitLogger.WriteXMLLine(const value: string); var - btUTF8Buffer : TBytes; - sLine: string; + bytes : TBytes; + s : string; begin - sLine := AXMLLine + NUNIT_LOGGER_CRLF; - if FOutputStream <> nil then - begin - btUTF8Buffer := TEncoding.UTF8.GetBytes(sLine); - FOutputStream.WriteBuffer(btUTF8Buffer[0],Length(btUTF8Buffer)); - end - else - WriteLn(AXMLLine); + s := StringOfChar(' ',FIndent) + value + #13#10; + bytes := TEncoding.UTF8.GetBytes(s); + FOutputStream.Write(bytes[0],Length(bytes)); end; -{ TDUnitXXMLNUnitLoggerFile } +{ TDUnitXXMLNUnitFileLogger } -constructor TDUnitXXMLNUnitFileLogger.Create(const AFilename: string = ''); +constructor TDUnitXXMLNUnitFileLogger.Create(const AFilename: string); var - sXmlFilename: string; + sXmlFilename : string; + fileStream : TFileStream; const - DEFAULT_NUNIT_FILE_NAME = 'dunit-report.xml'; + DEFAULT_NUNIT_FILE_NAME = 'dunitx-results.xml'; begin sXmlFilename := AFilename; if sXmlFilename = '' then - sXmlFilename := ExtractFilePath(Application.ExeName) + DEFAULT_NUNIT_FILE_NAME; + sXmlFilename := ExtractFilePath(ParamStr(0)) + DEFAULT_NUNIT_FILE_NAME; - FXMLFileStream := TFileStream.Create(sXmlFilename, fmCreate); + fileStream := TFileStream.Create(sXmlFilename, fmCreate); - //The stream class will take care of cleaning this up for us. - inherited Create(FXMLFileStream); + //base class will destroy the stream; + inherited Create(fileStream,true); end; end. diff --git a/DUnitX.TestResults.pas b/DUnitX.RunResults.pas similarity index 60% rename from DUnitX.TestResults.pas rename to DUnitX.RunResults.pas index b21b8e15..c0bcecaf 100644 --- a/DUnitX.TestResults.pas +++ b/DUnitX.RunResults.pas @@ -24,7 +24,7 @@ { } {***************************************************************************} -unit DUnitX.TestResults; +unit DUnitX.RunResults; interface @@ -40,38 +40,44 @@ interface type - TDUnitXTestResults = class(TInterfacedObject, ITestResults, ITestExecuteContext) + TDUnitXRunResults = class(TInterfacedObject, IRunResults, ITestExecuteContext) private - FResults : IList; FFixtures : IList; FAllPassed : boolean; FErrorCount : integer; FFailureCount : integer; FPassCount : integer; - FWarningCount : integer; FIgnoredCount : integer; + FTotalCount : integer; FStartTime: TDateTime; FFinishTime: TDateTime; FDuration: TTimeSpan; + FFixtureResults : IList; + FAllTestResults : IList; protected + function GetFixtureCount: Integer; function GetAllPassed: Boolean; - function GetCount: Integer; + function GetTestCount: Integer; function GetErrorCount: Integer; function GetFailureCount: Integer; - function GetFixtures: IEnumerable; - function GetResults: IEnumerable; + function GetFixtures: IEnumerable; + function GetFixtureResults: IEnumerable; + function GetAllTestResults : IEnumerable; + function GetPassCount: Integer; - function GetWarningCount: Integer; function GetIgnoredCount: Integer; function GetSuccessRate : integer; function GetStartTime: TDateTime; function GetFinishTime: TDateTime; - function GetTestDuration: TTimeSpan; + function GetDuration: TTimeSpan; //ITestExecuteContext - procedure RecordResult(const testResult: ITestResult); + procedure RecordFixture(const fixtureResult : IFixtureResult); + procedure RecordResult(const fixtureResult : IFixtureResult; const testResult : ITestResult); + //called when all is done. + procedure RollupResults; public constructor Create(const fixtures : IList); destructor Destroy;override; @@ -82,6 +88,7 @@ TDUnitXTestResults = class(TInterfacedObject, ITestResults, ITestExecuteContex implementation uses + DateUtils, {$IFDEF MSWINDOWS} //TODO: Need to to remove Windows by getting a system independant performance counter. {$if CompilerVersion < 23 } @@ -94,106 +101,117 @@ implementation { TDUnitXTestResults } -constructor TDUnitXTestResults.Create(const fixtures : IList); +constructor TDUnitXRunResults.Create(const fixtures : IList); begin - FResults := TDUnitXList.Create; + FFixtureResults := TDUnitXList.Create; + FAllTestResults := TDUnitXList.Create; FFixtures := fixtures; FAllPassed := True; FErrorCount := 0; FPassCount := 0; FFailureCount := 0; - FWarningCount := 0; - FStartTime := Now; FFinishTime := FStartTime; FDuration := TTimeSpan.Zero; end; -destructor TDUnitXTestResults.Destroy; +destructor TDUnitXRunResults.Destroy; begin - FResults := nil; + //not required, but makes debugging easier. FFixtures := nil; + FAllTestResults := nil; inherited; end; -function TDUnitXTestResults.GetAllPassed: Boolean; +function TDUnitXRunResults.GetAllPassed: Boolean; begin result := FAllPassed; end; -function TDUnitXTestResults.GetCount: Integer; +function TDUnitXRunResults.GetAllTestResults: IEnumerable; +begin + result := FAllTestResults; +end; + +function TDUnitXRunResults.GetTestCount: Integer; begin - result := FResults.Count; + result := FTotalCount; end; -function TDUnitXTestResults.GetErrorCount: Integer; +function TDUnitXRunResults.GetErrorCount: Integer; begin result := FErrorCount; end; -function TDUnitXTestResults.GetFailureCount: Integer; +function TDUnitXRunResults.GetFailureCount: Integer; begin result := FFailureCount; end; -function TDUnitXTestResults.GetFinishTime: TDateTime; +function TDUnitXRunResults.GetFinishTime: TDateTime; begin result := FFinishTime; end; -function TDUnitXTestResults.GetFixtures: System.IEnumerable; +function TDUnitXRunResults.GetFixtures: IEnumerable; begin result := FFixtures; end; -function TDUnitXTestResults.GetIgnoredCount: Integer; +function TDUnitXRunResults.GetIgnoredCount: Integer; begin result := FIgnoredCount; end; -function TDUnitXTestResults.GetResults: System.IEnumerable; +function TDUnitXRunResults.GetFixtureCount: Integer; begin - result := FResults; + result := FFixtureResults.Count; end; -function TDUnitXTestResults.GetTestDuration: TTimeSpan; +function TDUnitXRunResults.GetFixtureResults: IEnumerable; +begin + result := FFixtureResults; +end; + +function TDUnitXRunResults.GetDuration: TTimeSpan; begin result := FDuration; end; -function TDUnitXTestResults.GetStartTime: TDateTime; +function TDUnitXRunResults.GetStartTime: TDateTime; begin result := FStartTime; end; -function TDUnitXTestResults.GetPassCount: Integer; +function TDUnitXRunResults.GetPassCount: Integer; begin result := FPassCount; end; -function TDUnitXTestResults.GetSuccessRate: integer; +function TDUnitXRunResults.GetSuccessRate: integer; var successRate : integer; begin - if FResults.Count <> 0 then - successRate := Trunc((FResults.Count - FFailureCount - FErrorCount) / FResults.Count) * 100 + if FTotalCount <> 0 then + successRate := Trunc((FTotalCount - FFailureCount - FErrorCount) / FTotalCount) * 100 else successRate := 100; Result := successRate; end; -function TDUnitXTestResults.GetWarningCount: Integer; + +procedure TDUnitXRunResults.RecordFixture(const fixtureResult: IFixtureResult); begin - result := FWarningCount; + FFixtureResults.Add(fixtureResult); end; -procedure TDUnitXTestResults.RecordResult(const testResult: ITestResult); +procedure TDUnitXRunResults.RecordResult(const fixtureResult : IFixtureResult; const testResult : ITestResult); begin + Inc(FTotalCount); case testResult.ResultType of TTestResultType.Pass : Inc(FPassCount); TTestResultType.Failure : Inc(FFailureCount); - TTestResultType.Warning : Inc(FWarningCount); TTestResultType.Error : Inc(FErrorCount); TTestResultType.Ignored : Inc(FIgnoredCount); end; @@ -201,10 +219,27 @@ procedure TDUnitXTestResults.RecordResult(const testResult: ITestResult); if testResult.ResultType <> Pass then FAllPassed := False; - FResults.Add(testResult); + (fixtureResult as IFixtureResultBuilder).AddTestResult(testResult); + + FAllTestResults.Add(testResult); +end; + +procedure TDUnitXRunResults.RollupResults; +var + fixtureResult : IFixtureResult; + +begin + FFinishTime := Now; + FDuration := TTimeSpan.FromMilliseconds(DateUtils.MilliSecondsBetween(FFinishTime,FStartTime)); + for fixtureResult in FFixtureResults do + (fixtureResult as IFixtureResultBuilder).RollUpResults; + + //Make sure the fixture results are unique. + + end; -function TDUnitXTestResults.ToString: string; +function TDUnitXRunResults.ToString: string; begin result := Format('Test Passed : %d' +#13#10,[FPassCount]); end; diff --git a/DUnitX.Test.pas b/DUnitX.Test.pas index 14fda9f4..309fa3b5 100644 --- a/DUnitX.Test.pas +++ b/DUnitX.Test.pas @@ -53,7 +53,7 @@ TDUnitXTest = class(TWeakReferencedObject, ITest, ITestInfo, ISetTestResult, I protected //ITest function GetName: string; virtual; - function GetFullName : string; + function GetFullName : string;virtual; function GetTestFixture: ITestFixture; function GetTestMethod: TTestMethod; function GetTestStartTime : TDateTime; @@ -145,7 +145,7 @@ function TDUnitXTest.GetEnabled: Boolean; function TDUnitXTest.GetFullName: string; begin - result := FFixture.Data.FullName + '.' + FName; + result := FFixture.Data.FullName + '.' + Self.GetName; end; function TDUnitXTest.GetIgnored: boolean; diff --git a/DUnitX.TestFixture.pas b/DUnitX.TestFixture.pas index 458b25b1..52e67687 100644 --- a/DUnitX.TestFixture.pas +++ b/DUnitX.TestFixture.pas @@ -60,6 +60,7 @@ TDUnitXTestFixture = class(TWeakReferencedObject, ITestFixture, ITestFixtureIn FTearDownMethodName : string; FTearDownFixtureMethodName : string; FChildren : ITestFixtureList; + FTearDownFixtureIsDestructor : boolean; protected //uses RTTI to buid the fixture & tests procedure GenerateFixtureFromClass; @@ -90,6 +91,8 @@ TDUnitXTestFixture = class(TWeakReferencedObject, ITestFixture, ITestFixtureIn function GetChildren: ITestFixtureList; function GetHasChildren : boolean; + function GetHasTests : boolean; + procedure OnMethodExecuted(const AMethod : TTestMethod); public constructor Create(const AName : string; const AClass : TClass); destructor Destroy;override; @@ -182,6 +185,8 @@ procedure TDUnitXTestFixture.GenerateFixtureFromClass; meth : TMethod; newTest : ITest; + ignoreFixtureSetup : boolean; + fixtureAttrib : TestFixtureAttribute; testCases : TArray; testCaseAttrib : TestCaseAttribute; @@ -190,20 +195,46 @@ procedure TDUnitXTestFixture.GenerateFixtureFromClass; begin rType := FRttiContext.GetType(FTestClass); System.Assert(rType <> nil); - FFixtureInstance := FTestClass.Create; + + //it's a dummy namespace fixture, don't bother with the rest. + if rType.Handle = TypeInfo(TObject) then + begin + FFixtureInstance := FTestClass.Create; + exit; + end; //If the fixture class was decorated with [TestFixture] then use it for the description. fixtureAttrib := nil; if rType.TryGetAttributeOfType(fixtureAttrib) then FDescription := fixtureAttrib.Description; + ignoreFixtureSetup := false; + //If there is a parameterless constructor declared then we will use that as the + //fixture Setup method. + if rType.TryGetConstructor(method) then + begin + ignoreFixtureSetup := true; + FFixtureInstance := method.Invoke(TRttiInstanceType(rtype).MetaclassType, []).AsObject; + end + else + FFixtureInstance := FTestClass.Create; - methods := rType.GetMethods; + //important to use declared here.. otherwise we are looking at TObject as well. + methods := rType.GetDeclaredMethods; for method in methods do begin meth.Code := method.CodeAddress; meth.Data := FFixtureInstance; + //if there is a Destructor then we will use it as the fixture + //Teardown method. + if method.IsDestructor and (Length(method.GetParameters) = 0) then + begin + FTearDownFixtureMethod := TTestMethod(meth); + FTearDownFixtureMethodName := method.Name; + FTearDownFixtureIsDestructor := True; + end; + attributes := method.GetAttributes; if Length(attributes) > 0 then begin @@ -215,7 +246,8 @@ procedure TDUnitXTestFixture.GenerateFixtureFromClass; FSetupMethod := TTestMethod(meth); FSetupMethodName := method.Name; end - else if attribute.ClassType = SetupFixtureAttribute then + //If we found a parameterless constructor then that was used. + else if (not ignoreFixtureSetup) and (attribute.ClassType = SetupFixtureAttribute) then begin FSetupFixtureMethod := TTestMethod(meth); FSetupFixtureMethodName := method.Name; @@ -225,7 +257,7 @@ procedure TDUnitXTestFixture.GenerateFixtureFromClass; FTearDownMethod := TTestMethod(meth); FTearDownMethodName := method.Name; end - else if attribute.ClassType = TearDownFixtureAttribute then + else if (not FTearDownFixtureIsDestructor) and (attribute.ClassType = TearDownFixtureAttribute) then begin FTearDownFixtureMethod := TTestMethod(meth); FTearDownFixtureMethodName := method.Name; @@ -241,8 +273,6 @@ procedure TDUnitXTestFixture.GenerateFixtureFromClass; begin testEnabled := TestAttribute(attribute).Enabled; - - if testEnabled and (ignoredAttrib = nil) then //find out if the test fixture has test cases. testCases := method.GetAttributesOfType; @@ -324,6 +354,11 @@ function TDUnitXTestFixture.GetHasChildren: boolean; end; +function TDUnitXTestFixture.GetHasTests: boolean; +begin + result := (FTests <> nil) and (FTests.Count > 0); +end; + function TDUnitXTestFixture.GetName: string; begin result := FName; @@ -409,6 +444,16 @@ function TDUnitXTestFixture.ITestFixtureInfo_GetTests: IList; 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; diff --git a/DUnitX.TestFramework.pas b/DUnitX.TestFramework.pas index 75b55add..763cc4c4 100644 --- a/DUnitX.TestFramework.pas +++ b/DUnitX.TestFramework.pas @@ -202,9 +202,6 @@ Assert = class class procedure Pass(const message : string = ''); class procedure Fail(const message : string = ''; const errorAddrs : pointer = nil); - //TODO: Make more use of warnings. Currently none in use. - class procedure Warn(const message : string = ''; const errorAddrs : pointer = nil); - class procedure AreEqual(const left : string; const right : string; const ignoreCase : boolean; const message : string);overload; class procedure AreEqual(const left : string; const right : string; const message : string = '');overload; class procedure AreEqual(const left, right : Extended; const tolerance : Extended; const message : string = '');overload; @@ -366,22 +363,33 @@ TTestInfoList = class(TDUnitXList, ITestInfoList); ITestFixtureInfoList = interface(IList) ['{DEE229E7-1450-4DC1-BEEA-562461439084}'] end; - + {$M-} TTestFixtureInfoList = class(TDUnitXList, ITestFixtureInfoList); + + {$M+} + IResult = interface + ['{AEA1E458-157B-4B3A-9474-44EDFB3EE7A1}'] + function GetStartTime : TDateTime; + function GetFinishTime : TDateTime; + function GetDuration : TTimeSpan; + + //Timing + property StartTime : TDateTime read GetStartTime; + property FinishTime : TDateTime read GetFinishTime; + property Duration : TTimeSpan read GetDuration; +end; {$M-} - TTestResultType = (Pass,Failure,Warning,Error,Ignored); + TTestResultType = (Pass,Failure,Error,Ignored); {$M+} - ITestResult = interface + ITestResult = interface(IResult) ['{EFD44ABA-4F3E-435C-B8FC-1F8EB4B35A3B}'] function GetTest : ITestInfo; function GetResult : boolean; function GetResultType : TTestResultType; function GetMessage : string; - function GetTestStartTime : TDateTime; - function GetTestEndTime : TDateTime; - function GetTestDuration : TTimeSpan; + function GetStackTrace : string; //Test property Test : ITestInfo read GetTest; @@ -390,15 +398,13 @@ TTestFixtureInfoList = class(TDUnitXList, ITestFixtureInfoLi property Result : boolean read GetResult; property ResultType : TTestResultType read GetResultType; property Message : string read GetMessage; + property StackTrace : string read GetStackTrace; - //Timing - property TestStartTime : TDateTime read GetTestStartTime; - property TestEndTime : TDateTime read GetTestEndTime; - property TestDuration : TTimeSpan read GetTestDuration; end; {$M-} ITestError = interface(ITestResult) + ['{375941C6-CEFD-44E5-9646-30D7915B8A71}'] function GetExceptionClass : ExceptClass; function GetExceptionMessage : string; function GetExceptionLocationInfo : string; @@ -410,11 +416,46 @@ TTestFixtureInfoList = class(TDUnitXList, ITestFixtureInfoLi property ExceptionAddressInfo : string read GetExceptionAddressInfo; end; + IFixtureResult = interface(IResult) + ['{7264579D-495E-4E00-A15D-751E6A65BEF6}'] + function GetErrorCount : integer; + function GetFailureCount : integer; + function GetIgnoredCount : integer; + function GetPassCount : integer; + function GetHasFailures : boolean; + function GetTestResultCount : integer; + function GetChildCount : integer; + + function GetFixture : ITestFixtureInfo; + function GetTestResults : IList; + function GetChildren : IList; + function GetFailures : IList; + function GetErrors : IList; + function GetPasses : IList; + procedure Reduce; + + property HasFailures : Boolean read GetHasFailures; + property FailureCount : integer read GetFailureCount; + property ErrorCount : integer read GetErrorCount; + property IgnoredCount : integer read GetIgnoredCount; + property PassCount : integer read GetPassCount; + property ResultCount : integer read GetTestResultCount; + property ChildCount : integer read GetChildCount; + + property Fixture : ITestFixtureInfo read GetFixture; + property Children : IList read GetChildren; + property TestResults : IList read GetTestResults; + property Failures : IList read GetFailures; + property Errors : IList read GetErrors; + property Pesses : IList read GetPasses; + end; + + (* + IFixtureResult = interface(IEnumerable) ['{2ED7CD6D-AF17-4A56-9ECF-7528A1583B30}'] function GetErrorCount : integer; function GetFailureCount : integer; - function GetWarningCount : integer; function GetSuccessCount : integer; function GetHasFailures : boolean; function GetFixture : ITestFixtureInfo; @@ -422,7 +463,6 @@ TTestFixtureInfoList = class(TDUnitXList, ITestFixtureInfoLi function GetCount : integer; function GetFailures : IEnumerable; - function GetWarnings : IEnumerable; function GetErrors : IEnumerable; function GetSuccesses : IEnumerable; @@ -431,51 +471,52 @@ TTestFixtureInfoList = class(TDUnitXList, ITestFixtureInfoLi property Fixture : ITestFixtureInfo read GetFixture; property HasFailures : Boolean read GetHasFailures; property ErrorCount : integer read GetErrorCount; - property WarningCount : integer read GetWarningCount; property SuccessCount : integer read GetSuccessCount; property ResultCount : integer read GetCount; property Result[index : integer] : ITestResult read GetResult; property Results : IEnumerable read GetResults; property Failures : IEnumerable read GetFailures; - property Warnings : IEnumerable read GetWarnings; property Errors : IEnumerable read GetErrors; property Successes : IEnumerable read GetWarnings; end; + *) + {$M+} - ITestResults = interface + IRunResults = interface(IResult) ['{4A335B76-33E3-48FD-87DF-9462428C60DA}'] - function GetCount : integer; + function GetFixtureCount : integer; + function GetTestCount : integer; function GetAllPassed : boolean; function GetFailureCount : integer; function GetErrorCount : integer; - function GetWarningCount : integer; function GetPassCount : integer; function GetIgnoredCount : integer; function GetSuccessRate : integer; - function GetStartTime: TDateTime; - function GetFinishTime: TDateTime; - function GetTestDuration: TTimeSpan; function GetFixtures : IEnumerable; - function GetResults : IEnumerable; + + function GetFixtureResults : IEnumerable; + + function GetAllTestResults : IEnumerable; function ToString : string; - property Count : integer read GetCount; + property TestCount : integer read GetTestCount; + property FixtureCount : integer read GetFixtureCount; + property FailureCount : integer read GetFailureCount; property ErrorCount : integer read GetErrorCount; property IgnoredCount : integer read GetIgnoredCount; - property WarningCount : integer read GetWarningCount; property PassCount : integer read GetPassCount; - property StartTime : TDateTime read GetStartTime; - property FinishTime: TDateTime read GetFinishTime; - property TestDuration : TTimeSpan read GetTestDuration; - property SuccessRate : integer read GetSuccessRate; + //means all enabled/not ingored tests passed. property AllPassed : boolean read GetAllPassed; + + property Fixtures : IEnumerable read GetFixtures; + property FixtureResults : IEnumerable read GetFixtureResults; end; {$M-} @@ -538,11 +579,6 @@ TTestFixtureInfoList = class(TDUnitXList, ITestFixtureInfoLi /// procedure OnTestFailure(const threadId : Cardinal;const Failure: ITestError); - /// - /// //called when a test results in a warning. - /// - procedure OnTestWarning(const threadId : Cardinal;const AWarning: ITestResult); - /// /// //called when a test is ignored. /// @@ -587,7 +623,7 @@ TTestFixtureInfoList = class(TDUnitXList, ITestFixtureInfoLi /// /// //called after all fixtures have run. /// - procedure OnTestingEnds(const TestResults: ITestResults); + procedure OnTestingEnds(const RunResults: IRunResults); end; TRunnerExitBehavior = (Continue, //The runner will exit normally @@ -608,7 +644,7 @@ TTestFixtureInfoList = class(TDUnitXList, ITestFixtureInfoLi //This is exposed for the GUI Runner cast as ITestFixtureList. function BuildFixtures : IInterface; - function Execute : ITestResults; + function Execute : IRunResults; property ExitBehavior : TRunnerExitBehavior read GetExitBehavior write SetExitBehavior; property UseCommandLineOptions : boolean read GetUseCommandLineOptions write SetUseCommandLineOptions; @@ -648,7 +684,7 @@ TTestFixtureInfoList = class(TDUnitXList, ITestFixtureInfoLi TDUnitX = class public class var - RegisteredFixtures : TDictionary; + RegisteredFixtures : TDictionary; public class constructor Create; class destructor Destroy; @@ -678,7 +714,6 @@ EAbort = class(ETestFrameworkException); ETestFailure = class(EAbort); ETestPass = class(EAbort); - ETestWarning = class(EABort); ENoTestsRegistered = class(ETestFrameworkException); {$IFDEF DELPHI_XE_DOWN} @@ -695,6 +730,9 @@ implementation Math, StrUtils, Types, + {$IFDEF MSWINDOWS} + ActiveX, + {$ENDIF} {$IFDEF SUPPORTS_REGEX} RegularExpressions, {$ENDIF} @@ -1212,13 +1250,6 @@ class procedure Assert.WillRaise(const AMethod : TTestLocalMethod; const excepti Fail('Method did not throw any exceptions.' + GetMsg, ReturnAddress); end; -class procedure Assert.Warn(const message : string; const errorAddrs : pointer); -begin - if errorAddrs = nil then - raise ETestWarning.Create(message) at ReturnAddress - else - raise ETestWarning.Create(message) at errorAddrs; -end; class procedure Assert.WillNotRaise(const AMethod : TTestLocalMethod; const exceptionClass : ExceptClass; const msg : string); function GetMsg : string; @@ -1352,7 +1383,7 @@ class function TDUnitX.CommandLine: ICommandLine; class constructor TDUnitX.Create; begin - RegisteredFixtures := TDictionary.Create; + RegisteredFixtures := TDictionary.Create; end; class function TDUnitX.CreateRunner(const useCommandLineOptions: boolean; const ALogger: ITestLogger): ITestRunner; @@ -1400,11 +1431,8 @@ class procedure TDUnitX.RegisterTestFixture(const AClass: TClass; const AName : end; - - - - if not RegisteredFixtures.ContainsValue(AClass) then - RegisteredFixtures.Add(sName, AClass); + if not RegisteredFixtures.ContainsKey(AClass) then + RegisteredFixtures.Add(AClass,sName ); end; { TestCaseAttribute } @@ -1469,5 +1497,9 @@ constructor RepeatAttribute.Create(const ACount: Cardinal); { IgnoreAttribute } +initialization +{$IFDEF MSWINDOWS} + CoInitialize(nil); +{$ENDIF} end. diff --git a/DUnitX.TestResult.pas b/DUnitX.TestResult.pas index ba40b368..3864d763 100644 --- a/DUnitX.TestResult.pas +++ b/DUnitX.TestResult.pas @@ -44,21 +44,22 @@ TDUnitXTestResult = class(TInterfacedObject, ITestResult) FMessage : string; FResultType : TTestResultType; FTest : IWeakReference; + FStackTrace : string; protected function GetMessage: string; function GetResult: Boolean; function GetResultType: TTestResultType; function GetTest: ITestInfo; - function GetTestStartTime : TDateTime; - function GetTestEndTime : TDateTime; - function GetTestDuration : TTimeSpan; + function GetStartTime : TDateTime; + function GetFinishTime : TDateTime; + function GetDuration : TTimeSpan; + function GetStackTrace : string; public constructor Create(const ATestInfo : ITestInfo; const AType : TTestResultType; const AMessage : string = ''); end; TDUnitXTestError = class(TDUnitXTestResult, ITestError) private - FStackTrace : string; FExceptionClass : ExceptClass; FExceptionMessage : string; FExceptionAddress : Pointer; @@ -88,7 +89,6 @@ implementation constructor TDUnitXTestResult.Create(const ATestInfo : ITestInfo; const AType: TTestResultType; const AMessage: string); begin FTest := TWeakReference.Create(ATestInfo); - FResultType := AType; FMessage := AMessage; end; @@ -116,7 +116,7 @@ function TDUnitXTestResult.GetTest: ITestInfo; result := nil; end; -function TDUnitXTestResult.GetTestDuration: TTimeSpan; +function TDUnitXTestResult.GetDuration: TTimeSpan; begin if FTest.IsAlive then Result := FTest.Data.GetTestDuration @@ -124,7 +124,7 @@ function TDUnitXTestResult.GetTestDuration: TTimeSpan; Result := TTimeSpan.Zero; end; -function TDUnitXTestResult.GetTestEndTime: TDateTime; +function TDUnitXTestResult.GetFinishTime: TDateTime; begin if FTest.IsAlive then Result := FTest.Data.GetTestEndTime @@ -132,7 +132,12 @@ function TDUnitXTestResult.GetTestEndTime: TDateTime; Result := 0; end; -function TDUnitXTestResult.GetTestStartTime: TDateTime; +function TDUnitXTestResult.GetStackTrace: string; +begin + result := FStackTrace; +end; + +function TDUnitXTestResult.GetStartTime: TDateTime; begin if FTest.IsAlive then Result := FTest.Data.GetTestStartTime diff --git a/DUnitX.TestRunner.pas b/DUnitX.TestRunner.pas index 15d1dabe..0eb8ea64 100644 --- a/DUnitX.TestRunner.pas +++ b/DUnitX.TestRunner.pas @@ -34,6 +34,7 @@ interface DUnitX.InternalInterfaces, DUnitX.Generics, DUnitX.WeakReference, + classes, SysUtils, Rtti; @@ -43,19 +44,20 @@ interface type /// Note - we rely on the fact that there will only ever be 1 testrunner /// per thread, if this changes then handling of WriteLn will need to change - TDUnitXTestRunner = class(TWeakReferencedObject, ITestRunner) + TDUnitXTestRunner = class(TInterfacedObject, ITestRunner) private class var FRttiContext : TRttiContext; public class var FActiveRunners : TDictionary; private - FLoggers : TList; + FLoggers : TList; FUseCommandLine : boolean; FUseRTTI : boolean; FExitBehavior : TRunnerExitBehavior; - FFixtureClasses : TDictionary; + FFixtureClasses : TDictionary; FFixtureList : ITestFixtureList; + FLogMessages : TStringList; protected //Logger calls - sequence ordered @@ -76,7 +78,6 @@ TDUnitXTestRunner = class(TWeakReferencedObject, ITestRunner) procedure Loggers_AddSuccess(const threadId : Cardinal; const Test: ITestResult); procedure Loggers_AddError(const threadId : Cardinal; const Error: ITestError); procedure Loggers_AddFailure(const threadId : Cardinal; const Failure: ITestError); - procedure Loggers_AddWarning(const threadId : Cardinal; const AWarning: ITestResult); procedure Loggers_AddIgnored(const threadId : Cardinal; const AIgnored: ITestResult); procedure Loggers_EndTest(const threadId : Cardinal; const Test: ITestResult); @@ -86,22 +87,21 @@ TDUnitXTestRunner = class(TWeakReferencedObject, ITestRunner) procedure Loggers_EndTestFixture(const threadId : Cardinal; const results : IFixtureResult); - procedure Loggers_TestingEnds(const TestResult: ITestResults); + procedure Loggers_TestingEnds(const RunResults: IRunResults); //ITestRunner procedure AddLogger(const value: ITestLogger); - function Execute: ITestResults; + function Execute: IRunResults; - procedure ExecuteFixtures(const context: ITestExecuteContext; const threadId: Cardinal; const fixtures: ITestFixtureList); + procedure ExecuteFixtures(const parentFixtureResult : IFixtureResult; const context: ITestExecuteContext; const threadId: Cardinal; const fixtures: ITestFixtureList); procedure ExecuteSetupFixtureMethod(const threadid: cardinal; const fixture: ITestFixture); function ExecuteTestSetupMethod(const context : ITestExecuteContext; const threadid: cardinal; const fixture: ITestFixture; const test: ITest; out errorResult: ITestResult): boolean; - procedure ExecuteTests(const context : ITestExecuteContext; const threadId: Cardinal; const fixture: ITestFixture); + procedure ExecuteTests(const context : ITestExecuteContext; const threadId: Cardinal; const fixture: ITestFixture; const fixtureResult : IFixtureResult); function ExecuteTest(const context: ITestExecuteContext; const threadId: cardinal; const test: ITest) : ITestResult; function ExecuteSuccessfulResult(const context: ITestExecuteContext; const threadId: cardinal; const test: ITest; const message: string = '') : ITestResult; function ExecuteFailureResult(const context: ITestExecuteContext; const threadId: cardinal; const test: ITest; const exception : Exception) : ITestError; - function ExecuteWarningResult(const context: ITestExecuteContext; const threadId: cardinal; const test: ITest; const exception : Exception) : ITestResult; function ExecuteErrorResult(const context: ITestExecuteContext; const threadId: cardinal; const test: ITest; const exception : Exception) : ITestError; function ExecuteIgnoredResult(const context: ITestExecuteContext; const threadId: cardinal; const test: ITest; const ignoreReason : string) : ITestResult; @@ -109,7 +109,7 @@ TDUnitXTestRunner = class(TWeakReferencedObject, ITestRunner) function ExecuteTestTearDown(const context: ITestExecuteContext; const threadId: Cardinal; const fixture: ITestFixture; const test: ITest; out errorResult: ITestResult) : boolean; procedure ExecuteTearDownFixtureMethod(const context: ITestExecuteContext; const threadId: Cardinal; const fixture: ITestFixture); - procedure RecordResult(const context: ITestExecuteContext; const threadId: cardinal; const testResult: ITestResult); + procedure RecordResult(const context: ITestExecuteContext; const threadId: cardinal; const fixtureResult : IFixtureResult; const testResult: ITestResult); function GetExitBehavior: TRunnerExitBehavior; function GetUseCommandLineOptions: Boolean; @@ -145,13 +145,13 @@ implementation uses DUnitX.TestFixture, - DUnitX.TestResults, + DUnitX.RunResults, DUnitX.TestResult, + DUnitX.FixtureResult, DUnitX.Utils, TypInfo, StrUtils, - Types, - classes; + Types; { TDUnitXTestRunner } @@ -206,15 +206,6 @@ procedure TDUnitXTestRunner.Loggers_AddSuccess(const threadId : Cardinal; const end; end; -procedure TDUnitXTestRunner.Loggers_AddWarning(const threadId : Cardinal; const AWarning: ITestResult); -var - logger : ITestLogger; -begin - for logger in FLoggers do - begin - logger.OnTestWarning(threadId,AWarning); - end; -end; procedure TDUnitXTestRunner.AddStatus(const threadId; const msg: string); begin @@ -225,7 +216,7 @@ function TDUnitXTestRunner.BuildFixtures : IInterface; var fixture : ITestFixture; parentFixture : ITestFixture; - pair : TPair; + pair : TPair; uName : string; namespaces : TStringDynArray; namespace : string; @@ -256,7 +247,7 @@ function TDUnitXTestRunner.BuildFixtures : IInterface; try for pair in FFixtureClasses do begin - uName := pair.Value.UnitName; + uName := pair.Key.UnitName; namespaces := SplitString(uName,'.'); //if the unit name has no namespaces the just add the tests. fixtureNamespace := ''; @@ -297,8 +288,8 @@ function TDUnitXTestRunner.BuildFixtures : IInterface; end; - fixtureNamespace := fixtureNamespace + '.' + pair.Key; - fixture := TDUnitXTestFixture.Create(fixtureNamespace, pair.Value); + fixtureNamespace := fixtureNamespace + '.' + pair.Value; + fixture := TDUnitXTestFixture.Create(fixtureNamespace, pair.Key); if parentFixture = nil then FFixtureList.Add(fixture) @@ -323,9 +314,10 @@ constructor TDUnitXTestRunner.Create(const useCommandLineOptions: boolean; const FLoggers := TList.Create; if AListener <> nil then FLoggers.Add(AListener); - FFixtureClasses := TDictionary.Create; + FFixtureClasses := TDictionary.Create; FUseCommandLine := useCommandLineOptions; FUseRTTI := False; + FLogMessages := TStringList.Create; MonitorEnter(TDUnitXTestRunner.FActiveRunners); try TDUnitXTestRunner.FActiveRunners.Add(TThread.CurrentThread.ThreadID, Self); @@ -336,7 +328,6 @@ constructor TDUnitXTestRunner.Create(const useCommandLineOptions: boolean; const destructor TDUnitXTestRunner.Destroy; var - tId : Cardinal; begin MonitorEnter(TDUnitXTestRunner.FActiveRunners); @@ -347,8 +338,10 @@ destructor TDUnitXTestRunner.Destroy; finally MonitorExit(TDUnitXTestRunner.FActiveRunners); end; + FLogMessages.Free; FLoggers.Free; FFixtureClasses.Free; + inherited; end; @@ -357,36 +350,30 @@ destructor TDUnitXTestRunner.Destroy; FActiveRunners.Free; end; -procedure TDUnitXTestRunner.RecordResult(const context: ITestExecuteContext; const threadId: cardinal; const testResult: ITestResult); +procedure TDUnitXTestRunner.RecordResult(const context: ITestExecuteContext; const threadId: cardinal; const fixtureResult : IFixtureResult; const testResult: ITestResult); begin case testResult.ResultType of Pass: begin - context.RecordResult(testResult); + context.RecordResult(fixtureResult,testResult); Self.Loggers_AddSuccess(threadId, testResult); end; Failure: begin Log(TLogLevel.ltError, 'Test failed : ' + testResult.Test.Name + ' : ' + testResult.Message); - context.RecordResult(testResult); + context.RecordResult(fixtureResult, testResult); Self.Loggers_AddFailure(threadId, ITestError(testResult)); end; - Warning: - begin - Log(TLogLevel.ltWarning, 'Test warning : ' + testResult.Test.Name + ' : ' + testResult.Message); - context.RecordResult(testResult); - Self.Loggers_AddWarning(threadId, testResult); - end; Error: begin Log(TLogLevel.ltError, 'Test Error : ' + testResult.Test.Name + ' : ' + testResult.Message); - context.RecordResult(testResult); + context.RecordResult(fixtureResult, testResult); Self.Loggers_AddError(threadId, ITestError(testResult)); end; Ignored : begin Log(TLogLevel.ltError, 'Test Ignored : ' + testResult.Test.Name + ' : ' + testResult.Message); - context.RecordResult(testResult); + context.RecordResult(fixtureResult,testResult); Self.Loggers_AddIgnored(threadId, testResult); end; @@ -416,8 +403,8 @@ procedure TDUnitXTestRunner.RTTIDiscoverFixtureClasses; sName := TestFixtureAttribute(attribute).Name; if sName = '' then sName := TRttiInstanceType(rType).MetaclassType.ClassName; - if not FFixtureClasses.ContainsValue(TRttiInstanceType(rType).MetaclassType) then - FFixtureClasses.Add(sName,TRttiInstanceType(rType).MetaclassType); + if not FFixtureClasses.ContainsKey(TRttiInstanceType(rType).MetaclassType) then + FFixtureClasses.Add(TRttiInstanceType(rType).MetaclassType,sName); end; end; end; @@ -484,11 +471,10 @@ procedure TDUnitXTestRunner.Loggers_ExecuteTest(const threadId: Cardinal; const end; //TODO - this needs to be thread aware so we can run tests in threads. -function TDUnitXTestRunner.Execute: ITestResults; +function TDUnitXTestRunner.Execute: IRunResults; procedure CountTests(const fixtureList : ITestFixtureList; var count : Cardinal; var active : Cardinal); var - children : ITestFixtureList; fixture : ITestFixture; test : ITest; begin @@ -532,16 +518,17 @@ procedure CountTests(const fixtureList : ITestFixtureList; var count : Cardinal; //TODO: Move to the fixtures class //TODO: Need a simple way of converting one list to another list of a supported interface. Generics should help here. - result := TDUnitXTestResults.Create(fixtures.AsFixtureInfoList); + result := TDUnitXRunResults.Create(fixtures.AsFixtureInfoList); context := result as ITestExecuteContext; //TODO: Record Test metrics.. runtime etc. threadId := TThread.CurrentThread.ThreadID; Self.Loggers_TestingStarts(threadId, testCount, testActiveCount); try - ExecuteFixtures(context, threadId, fixtures); + ExecuteFixtures(nil,context, threadId, fixtures); + //make sure each fixture includes it's child fixture result counts. + context.RollupResults; finally - //TODO: Actully pass the results for all fixtures and tests here. Self.Loggers_TestingEnds(result); end; end; @@ -567,34 +554,38 @@ function TDUnitXTestRunner.ExecuteFailureResult( Result := TDUnitXTestError.Create(test as ITestInfo, TTestResultType.Failure, exception, ExceptAddr, exception.Message); end; -procedure TDUnitXTestRunner.ExecuteFixtures(const context: ITestExecuteContext; const threadId: Cardinal; const fixtures: ITestFixtureList); +procedure TDUnitXTestRunner.ExecuteFixtures(const parentFixtureResult : IFixtureResult; const context: ITestExecuteContext; const threadId: Cardinal; const fixtures: ITestFixtureList); var fixture: ITestFixture; - testResult : ITestResult; + fixtureResult : IFixtureResult; begin for fixture in fixtures do begin if not fixture.Enabled then System.continue; + fixtureResult := TDUnitXFixtureResult.Create(parentFixtureResult, fixture as ITestFixtureInfo); + if parentFixtureResult = nil then + context.RecordFixture(fixtureResult); + Self.Loggers_StartTestFixture(threadId, fixture as ITestFixtureInfo); try - if Assigned(fixture.SetupFixtureMethod) then + //only run the setup method if there are actually tests + if fixture.HasTests and Assigned(fixture.SetupFixtureMethod) then //TODO: Errors from here need to be logged into each test below us ExecuteSetupFixtureMethod(threadId, fixture); - ExecuteTests(context, threadId, fixture); + if fixture.HasTests then + ExecuteTests(context, threadId, fixture,fixtureResult); if fixture.HasChildFixtures then - ExecuteFixtures(context, threadId, fixture.Children); + ExecuteFixtures(fixtureResult, context, threadId, fixture.Children); - if Assigned(fixture.TearDownFixtureMethod) then + if fixture.HasTests and Assigned(fixture.TearDownFixtureMethod) then //TODO: Tricker yet each test above us requires errors that occur here ExecuteTearDownFixtureMethod(context, threadId, fixture); - finally - //TODO: Actully pass the results for the fixture here - Self.Loggers_EndTestFixture(threadId, nil); + Self.Loggers_EndTestFixture(threadId, fixtureResult); end; end; end; @@ -633,6 +624,7 @@ procedure TDUnitXTestRunner.ExecuteTearDownFixtureMethod( try Self.Loggers_TeardownFixture(threadId, fixture as ITestFixtureInfo); fixture.TearDownFixtureMethod; + fixture.OnMethodExecuted(fixture.TearDownFixtureMethod); except on e: Exception do begin @@ -644,13 +636,14 @@ procedure TDUnitXTestRunner.ExecuteTearDownFixtureMethod( function TDUnitXTestRunner.ExecuteTest(const context: ITestExecuteContext; const threadId: cardinal; const test: ITest) : ITestResult; var testExecute: ITestExecute; - testResult: ITestResult; begin if Supports(test, ITestExecute, testExecute) then begin + FLogMessages.Clear; Self.Loggers_ExecuteTest(threadId, test as ITestInfo); testExecute.Execute(context); - Result := ExecuteSuccessfulResult(context, threadId, test); + Result := ExecuteSuccessfulResult(context, threadId, test,FLogMessages.Text); + FLogMessages.Clear; end else begin @@ -659,7 +652,7 @@ function TDUnitXTestRunner.ExecuteTest(const context: ITestExecuteContext; const end; end; -procedure TDUnitXTestRunner.ExecuteTests(const context : ITestExecuteContext; const threadId: Cardinal; const fixture: ITestFixture); +procedure TDUnitXTestRunner.ExecuteTests(const context : ITestExecuteContext; const threadId: Cardinal; const fixture: ITestFixture; const fixtureResult : IFixtureResult); var tests : IEnumerable; test : ITest; @@ -702,8 +695,6 @@ procedure TDUnitXTestRunner.ExecuteTests(const context : ITestExecuteContext; co testResult := ExecuteSuccessfulResult(context, threadId, test, e.Message); on e: ETestFailure do testResult := ExecuteFailureResult(context, threadId, test, e); - on e: ETestWarning do - testResult := ExecuteWarningResult(context, threadId, test, e); on e: Exception do testResult := ExecuteErrorResult(context, threadId, test, e); end; @@ -714,7 +705,7 @@ procedure TDUnitXTestRunner.ExecuteTests(const context : ITestExecuteContext; co testResult := tearDownResult; finally - RecordResult(context, threadId, testResult); + RecordResult(context, threadId, fixtureResult, testResult); Self.Loggers_EndTest(threadId, testResult); end; end; @@ -759,12 +750,6 @@ function TDUnitXTestRunner.ExecuteTestTearDown(const context: ITestExecuteContex end; end; -function TDUnitXTestRunner.ExecuteWarningResult(const context: ITestExecuteContext; const threadId: cardinal; const test: ITest; const exception: Exception) : ITestResult; -begin - //TODO: Does test warning require its own results interface and class? - result := TDUnitXTestResult.Create(test as ITestInfo, TTestResultType.Warning, exception.Message); -end; - function TDUnitXTestRunner.GetExitBehavior: TRunnerExitBehavior; begin result := FExitBehavior; @@ -861,12 +846,12 @@ procedure TDUnitXTestRunner.Loggers_TeardownTest(const threadId: Cardinal; const logger.OnTeardownTest(threadId, Test); end; -procedure TDUnitXTestRunner.Loggers_TestingEnds(const TestResult: ITestResults); +procedure TDUnitXTestRunner.Loggers_TestingEnds(const RunResults: IRunResults); var logger : ITestLogger; begin for logger in FLoggers do - logger.OnTestingEnds(TestResult); + logger.OnTestingEnds(RunResults); end; procedure TDUnitXTestRunner.Loggers_TestingStarts(const threadId, testCount, testActiveCount : Cardinal); @@ -881,12 +866,14 @@ procedure TDUnitXTestRunner.Log(const logType: TLogLevel; const msg: string); var logger : ITestLogger; begin - if logType >= TDUnitX.CommandLine.LogLevel then begin + //TODO : Need to get this to the current test result. + FLogMessages.Add(msg); for logger in FLoggers do logger.OnLog(logType,msg); end; end; end. + diff --git a/DUnitX.Utils.pas b/DUnitX.Utils.pas index f362c2f6..073804c0 100644 --- a/DUnitX.Utils.pas +++ b/DUnitX.Utils.pas @@ -503,6 +503,12 @@ TRttiTypeHelper = class helper for TRttiType {$ENDREGION} function TryGetMethod(const AName: string; out AMethod: TRttiMethod): Boolean; overload; + //will get the first declated constructor it finds + function TryGetConstructor(out AMethod : TRttiMethod) : boolean; + + function TryGetDestructor(out AMethod : TRttiMethod) : boolean; + + {$REGION 'Documentation'} /// /// Retrieves the property with the given name and returns if this was @@ -2280,6 +2286,40 @@ function TRttiTypeHelper.MakeGenericType(TypeArguments: array of PTypeInfo): TRt end; end; +function TRttiTypeHelper.TryGetConstructor(out AMethod: TRttiMethod): boolean; +var + methods : TArray; + method : TRttiMethod; +begin + result := False; + methods := GetDeclaredMethods; + for method in methods do + begin + if method.IsConstructor and (Length(method.GetParameters) = 0) then + begin + AMethod := method; + Exit(true); + end; + end; +end; + +function TRttiTypeHelper.TryGetDestructor(out AMethod: TRttiMethod): boolean; +var + methods : TArray; + method : TRttiMethod; +begin + result := False; + methods := GetDeclaredMethods; + for method in methods do + begin + if method.IsDestructor then + begin + AMethod := method; + Exit(true); + end; + end; +end; + function TRttiTypeHelper.TryGetField(const AName: string; out AField: TRttiField): Boolean; begin diff --git a/Examples/DUnitXExamples_XE2.dpr b/Examples/DUnitXExamples_XE2.dpr index adf85705..35721fa9 100644 --- a/Examples/DUnitXExamples_XE2.dpr +++ b/Examples/DUnitXExamples_XE2.dpr @@ -4,7 +4,6 @@ program DUnitXExamples_XE2; uses SysUtils, - DUnitX.Examples.EqualityAsserts in 'DUnitX.Examples.EqualityAsserts.pas', DUnitX.Examples.General in 'DUnitX.Examples.General.pas', DUnitX.CommandLine in '..\DUnitX.CommandLine.pas', DUnitX.ConsoleWriter.Base in '..\DUnitX.ConsoleWriter.Base.pas', @@ -16,25 +15,27 @@ uses DUnitX.IoC in '..\DUnitX.IoC.pas', DUnitX.Loggers.Console in '..\DUnitX.Loggers.Console.pas', DUnitX.Loggers.Text in '..\DUnitX.Loggers.Text.pas', - DUnitX.Loggers.XML.NUnit in '..\DUnitX.Loggers.XML.NUnit.pas', DUnitX.Loggers.XML.xUnit in '..\DUnitX.Loggers.XML.xUnit.pas', DUnitX.MacOS.Console in '..\DUnitX.MacOS.Console.pas', DUnitX.Test in '..\DUnitX.Test.pas', DUnitX.TestFixture in '..\DUnitX.TestFixture.pas', DUnitX.TestFramework in '..\DUnitX.TestFramework.pas', DUnitX.TestResult in '..\DUnitX.TestResult.pas', - DUnitX.TestResults in '..\DUnitX.TestResults.pas', + DUnitX.RunResults in '..\DUnitX.RunResults.pas', DUnitX.TestRunner in '..\DUnitX.TestRunner.pas', DUnitX.Utils in '..\DUnitX.Utils.pas', DUnitX.Utils.XML in '..\DUnitX.Utils.XML.pas', DUnitX.WeakReference in '..\DUnitX.WeakReference.pas', DUnitX.Windows.Console in '..\DUnitX.Windows.Console.pas', DUnitX.StackTrace.EurekaLog7 in '..\DUnitX.StackTrace.EurekaLog7.pas', - NonNamespacedExample in 'NonNamespacedExample.pas'; + DUnitX.Examples.EqualityAsserts in 'DUnitX.Examples.EqualityAsserts.pas', + DUnitX.Loggers.XML.NUnit in '..\DUnitX.Loggers.XML.NUnit.pas', + DUnitX.FixtureResult in '..\DUnitX.FixtureResult.pas', + DUnitX.Loggers.Null in '..\DUnitX.Loggers.Null.pas'; var runner : ITestRunner; - results : ITestResults; + results : IRunResults; logger : ITestLogger; nunitLogger : ITestLogger; begin diff --git a/Examples/DUnitXExamples_XE2.dproj b/Examples/DUnitXExamples_XE2.dproj index c29ebbce..ea8ba951 100644 --- a/Examples/DUnitXExamples_XE2.dproj +++ b/Examples/DUnitXExamples_XE2.dproj @@ -103,7 +103,6 @@ MainSource - @@ -115,21 +114,23 @@ - - + - + + + + Cfg_2 Base @@ -195,3 +196,8 @@ + + diff --git a/Tests/DUnitX.Tests.Assert.pas b/Tests/DUnitX.Tests.Assert.pas index ed467bf8..0211d804 100644 --- a/Tests/DUnitX.Tests.Assert.pas +++ b/Tests/DUnitX.Tests.Assert.pas @@ -34,7 +34,7 @@ interface type - {+M} + {$M+} [TestFixture] TTestsAssert = class private @@ -71,8 +71,6 @@ TTestsAssert = class [Test] procedure AreEqual_T_Throws_ETestFailure_When_Interfaces_Are_NotEqual_OrNil; - [Test] - procedure Warn_Throws_ETestWarning_Exception; [Test] procedure AreEqual_Throws_No_Exception_When_Values_Are_Exactly_Equal; end; @@ -176,14 +174,6 @@ procedure TTestsAssert.Pass_Throws_ETestPass_Exception_With_Message; end, ETestPass, EXPECTED_EXCEPTION_MSG); end; -procedure TTestsAssert.Warn_Throws_ETestWarning_Exception; -begin - Assert.WillRaise( - procedure - begin - Assert.Warn; - end, ETestWarning); -end; procedure TTestsAssert.AreEqual_Extended_Throws_ETestFailure_When_Values_Are_NotEqual; const diff --git a/Tests/DUnitX.Tests.Example.pas b/Tests/DUnitX.Tests.Example.pas index 61fa1245..6b32525b 100644 --- a/Tests/DUnitX.Tests.Example.pas +++ b/Tests/DUnitX.Tests.Example.pas @@ -65,6 +65,10 @@ TMyExampleTests = class [Test(false)] procedure DontCallMe; + [Test] + [Ignore('I was told to ignore me')] + procedure IgnoreMe; + [Setup] procedure Setup; @@ -72,6 +76,9 @@ TMyExampleTests = class procedure TearDown; published procedure TestMeAnyway; + + [Ignore('I was told to ignore me anyway')] + procedure IgnoreMeAnyway; end; [TestFixture] @@ -87,6 +94,24 @@ TExampleFixture2 = class procedure Published_Procedures_Are_Included_As_Tests; end; + [TestFixture] + TExampleFixture3 = class + private + FSetupCalled : boolean; + public + + [SetupFixture] + procedure SetupFixture; + + //testing constructor/destructor as fixture setup/teardown + constructor Create; + destructor Destroy;override; + published + procedure ATest; + + end; + + implementation uses @@ -103,6 +128,16 @@ procedure TMyExampleTests.DontCallMe; raise Exception.Create('DontCallMe was called!!!!'); end; +procedure TMyExampleTests.IgnoreMe; +begin + Assert.IsTrue(false,'I should not have been called!'); +end; + +procedure TMyExampleTests.IgnoreMeAnyway; +begin + Assert.IsTrue(false,'I should not have been called!'); +end; + procedure TMyExampleTests.Setup; begin TDUnitX.CurrentRunner.Status('Setup called'); @@ -161,6 +196,29 @@ procedure TExampleFixture2.TearDownFixture; Assert.IsTrue(FPublished_Procedures_Are_Included_As_Tests_Called); end; +{ TExampleFixture3 } + +procedure TExampleFixture3.ATest; +begin + Assert.IsTrue(FSetupCalled); +end; + +constructor TExampleFixture3.Create; +begin + FSetupCalled := True; +end; + +destructor TExampleFixture3.Destroy; +begin + + inherited; +end; + +procedure TExampleFixture3.SetupFixture; +begin + Assert.IsTrue(False,'I should not be called!'); +end; + initialization //I was hoping to use RTTI to discover the TestFixture classes, however unlike .NET @@ -179,5 +237,5 @@ initialization //Register the test fixtures TDUnitX.RegisterTestFixture(TMyExampleTests); TDUnitX.RegisterTestFixture(TExampleFixture2); - + TDUnitX.RegisterTestFixture(TExampleFixture3); end. diff --git a/Tests/DUnitX.Tests.Loggers.XML.NUnit.pas b/Tests/DUnitX.Tests.Loggers.XML.NUnit.pas index 3df6e60b..687caac8 100644 --- a/Tests/DUnitX.Tests.Loggers.XML.NUnit.pas +++ b/Tests/DUnitX.Tests.Loggers.XML.NUnit.pas @@ -39,11 +39,11 @@ interface [TestFixture] TDUnitX_LoggerXMLNUnitTests = class public - [Test] + [Test(false)] procedure OnTestingStarts_Fills_The_Start_Of_The_Stream_With_Header_Info; - [Test] - procedure OnTestingEnds_Fills_The_End_Of_The_Stream_With_Testing_Result_Info; - [Test] + // [Test(false)] +// procedure OnTestingEnds_Fills_The_End_Of_The_Stream_With_Testing_Result_Info; + [Test(false)] procedure OnTestWarning_Adds_Warnings_To_Be_Written_Out_On_Next_Error; procedure OnTestWarning_Adds_Warnings_To_Be_Written_Out_On_Next_Success; end; @@ -56,7 +56,7 @@ implementation TimeSpan, DateUtils, DUnitX.Generics, - DUnitX.TestResults, + DUnitX.RunResults, Delphi.Mocks; const @@ -64,6 +64,7 @@ implementation { TDUnitX_LoggerXMLNUnit } +{ procedure TDUnitX_LoggerXMLNUnitTests.OnTestingEnds_Fills_The_End_Of_The_Stream_With_Testing_Result_Info; var logger : ITestLogger; @@ -114,7 +115,7 @@ procedure TDUnitX_LoggerXMLNUnitTests.OnTestingEnds_Fills_The_End_Of_The_Stream_ Assert.AreEqual(mockStream.DataString, sExpectedEnding); end; - + } procedure TDUnitX_LoggerXMLNUnitTests.OnTestingStarts_Fills_The_Start_Of_The_Stream_With_Header_Info; var sUnicodePreamble: string; @@ -201,7 +202,7 @@ procedure TDUnitX_LoggerXMLNUnitTests.OnTestWarning_Adds_Warnings_To_Be_Written_ mockWarning.Setup.WillReturn('!!WarningMessage!!').When.Message; mockWarning.Setup.WillReturn(mockTest.InstanceAsValue).When.Test; mockError.Setup.WillReturn(mockTest.InstanceAsValue).When.Test; - mockError.Setup.WillReturn(TValue.From(TTimeSpan.FromMilliseconds(0))).When.TestDuration; + mockError.Setup.WillReturn(TValue.From(TTimeSpan.FromMilliseconds(0))).When.Duration; mockError.Setup.WillReturn(Exception).When.ExceptionClass; mockError.Setup.WillReturn('').When.ExceptionLocationInfo; mockError.Setup.WillReturn('').When.ExceptionMessage; @@ -209,7 +210,6 @@ procedure TDUnitX_LoggerXMLNUnitTests.OnTestWarning_Adds_Warnings_To_Be_Written_ sExceptedWarning := Format('WARNING: %s: %s', [mockTest.Instance.Name, mockWarning.Instance.Message]); //Call - logger.OnTestWarning(0, mockWarning); logger.OnTestError(0, mockError); //Verify @@ -248,7 +248,6 @@ procedure TDUnitX_LoggerXMLNUnitTests.OnTestWarning_Adds_Warnings_To_Be_Written_ sExceptedWarning := Format('WARNING: %s: %s', [mockTest.Instance.Name, mockWarning.Instance.Message]); //Call - logger.OnTestWarning(0, mockWarning); logger.OnTestSuccess(0, mockSuccess); //Verify diff --git a/Tests/DUnitXGuiTest.dpr b/Tests/DUnitXGuiTest.dpr index 740c9be7..ba159f47 100644 --- a/Tests/DUnitXGuiTest.dpr +++ b/Tests/DUnitXGuiTest.dpr @@ -31,8 +31,15 @@ uses DUnitX.StackTrace.MadExcept4 in '..\DUnitX.StackTrace.MadExcept4.pas', DUnitX.Loggers.GUI in '..\DUnitX.Loggers.GUI.pas' {DUnitXGuiLoggerForm}, DUnitX.StackTrace.EurekaLog7 in '..\DUnitX.StackTrace.EurekaLog7.pas', - DUnitX.Examples.EqualityAsserts in '..\Examples\DUnitX.Examples.EqualityAsserts.pas', - DUnitX.Examples.General in '..\Examples\DUnitX.Examples.General.pas'; + DUnitX.Tests.Assert in 'DUnitX.Tests.Assert.pas', + DUnitX.Tests.DUnitCompatibility in 'DUnitX.Tests.DUnitCompatibility.pas', + DUnitX.Tests.Example in 'DUnitX.Tests.Example.pas', + DUnitX.Tests.Framework in 'DUnitX.Tests.Framework.pas', + DUnitX.Tests.IoC in 'DUnitX.Tests.IoC.pas', + DUnitX.Tests.Loggers.XML.NUnit in 'DUnitX.Tests.Loggers.XML.NUnit.pas', + DUnitX.Tests.TestFixture in 'DUnitX.Tests.TestFixture.pas', + DUnitX.Tests.Utils.XML in 'DUnitX.Tests.Utils.XML.pas', + DUnitX.Tests.WeakReference in 'DUnitX.Tests.WeakReference.pas'; begin Application.Initialize; diff --git a/Tests/DUnitXGuiTest.dproj b/Tests/DUnitXGuiTest.dproj index aa158a5a..63fe50c8 100644 --- a/Tests/DUnitXGuiTest.dproj +++ b/Tests/DUnitXGuiTest.dproj @@ -45,7 +45,7 @@ DEBUG;$(DCC_Define) - + MainSource @@ -78,10 +78,21 @@
DUnitXGuiLoggerForm
 - - + + + + + + + + + + + Cfg_2 + Base + Base @@ -89,12 +100,8 @@ Cfg_1 Base - - Cfg_2 - Base - - + Delphi.Personality.12 VCLApplication @@ -145,4 +152,10 @@ 12 + + + diff --git a/Tests/DUnitXTest_XE2.dpr b/Tests/DUnitXTest_XE2.dpr index 8019701b..f5072a74 100644 --- a/Tests/DUnitXTest_XE2.dpr +++ b/Tests/DUnitXTest_XE2.dpr @@ -4,13 +4,11 @@ program DUnitXTest_XE2; {\\$STRONGLINKTYPES ON} uses SysUtils, - DUnitX.Tests.IoC in 'DUnitX.Tests.IoC.pas', DUnitX.Loggers.Console in '..\DUnitX.Loggers.Console.pas', DUnitX.Loggers.Text in '..\DUnitX.Loggers.Text.pas', DUnitX.MacOS.Console in '..\DUnitX.MacOS.Console.pas', DUnitX.Windows.Console in '..\DUnitX.Windows.Console.pas', DUnitX.ConsoleWriter.Base in '..\DUnitX.ConsoleWriter.Base.pas', - DUnitX.Loggers.XML.NUnit in '..\DUnitX.Loggers.XML.NUnit.pas', DUnitX.Loggers.XML.xUnit in '..\DUnitX.Loggers.XML.xUnit.pas', DUnitX.Detour in '..\DUnitX.Detour.pas', DUnitX.Generics in '..\DUnitX.Generics.pas', @@ -20,29 +18,34 @@ uses DUnitX.Test in '..\DUnitX.Test.pas', DUnitX.TestFixture in '..\DUnitX.TestFixture.pas', DUnitX.TestResult in '..\DUnitX.TestResult.pas', - DUnitX.TestResults in '..\DUnitX.TestResults.pas', + DUnitX.RunResults in '..\DUnitX.RunResults.pas', DUnitX.TestRunner in '..\DUnitX.TestRunner.pas', DUnitX.InternalInterfaces in '..\DUnitX.InternalInterfaces.pas', DUnitX.TestFramework in '..\DUnitX.TestFramework.pas', DUnitX.DUnitCompatibility in '..\DUnitX.DUnitCompatibility.pas', - DUnitX.IoC.Internal in '..\DUnitX.IoC.Internal.pas', DUnitX.IoC in '..\DUnitX.IoC.pas', - DUnitX.Tests.Assert in 'DUnitX.Tests.Assert.pas', - DUnitX.Tests.DUnitCompatibility in 'DUnitX.Tests.DUnitCompatibility.pas', - DUnitX.Tests.Example in 'DUnitX.Tests.Example.pas', - DUnitX.Tests.Loggers.XML.NUnit in 'DUnitX.Tests.Loggers.XML.NUnit.pas', DUnitX.Utils.XML in '..\DUnitX.Utils.XML.pas', - DUnitX.Tests.Utils.XML in 'DUnitX.Tests.Utils.XML.pas', - DUnitX.Tests.WeakReference in 'DUnitX.Tests.WeakReference.pas', DUnitX.StackTrace.JCL in '..\DUnitX.StackTrace.JCL.pas', DUnitX.StackTrace.MadExcept3 in '..\DUnitX.StackTrace.MadExcept3.pas', DUnitX.StackTrace.MadExcept4 in '..\DUnitX.StackTrace.MadExcept4.pas', DUnitX.Loggers.GUI in '..\DUnitX.Loggers.GUI.pas' {Form1}, - DUnitX.StackTrace.EurekaLog7 in '..\DUnitX.StackTrace.EurekaLog7.pas'; + DUnitX.StackTrace.EurekaLog7 in '..\DUnitX.StackTrace.EurekaLog7.pas', + DUnitX.Loggers.Null in '..\DUnitX.Loggers.Null.pas', + DUnitX.FixtureResult in '..\DUnitX.FixtureResult.pas', + DUnitX.Tests.Assert in 'DUnitX.Tests.Assert.pas', + DUnitX.Tests.DUnitCompatibility in 'DUnitX.Tests.DUnitCompatibility.pas', + DUnitX.Tests.Example in 'DUnitX.Tests.Example.pas', + DUnitX.Tests.Framework in 'DUnitX.Tests.Framework.pas', + DUnitX.Tests.IoC in 'DUnitX.Tests.IoC.pas', + DUnitX.Tests.TestFixture in 'DUnitX.Tests.TestFixture.pas', + DUnitX.Tests.Utils.XML in 'DUnitX.Tests.Utils.XML.pas', + DUnitX.Tests.WeakReference in 'DUnitX.Tests.WeakReference.pas', + DUnitX.Tests.Loggers.XML.NUnit in 'DUnitX.Tests.Loggers.XML.NUnit.pas', + DUnitX.Loggers.XML.NUnit in '..\DUnitX.Loggers.XML.NUnit.pas'; var runner : ITestRunner; - results : ITestResults; + results : IRunResults; logger : ITestLogger; nunitLogger : ITestLogger; begin @@ -56,13 +59,22 @@ begin runner.AddLogger(logger); runner.AddLogger(nunitLogger); + logger := nil; + nunitLogger := nil; + //Run tests results := runner.Execute; - {$IFNDEF CI} + {$IFDEF CI} + //Let the CI Server know that something failed. + if not results.AllPassed then + System.ExitCode := 1; + {$ELSE} //We don;t want this happening when running under CI. System.Write('Done.. press key to quit.'); System.Readln; + + {$ENDIF} except on E: Exception do diff --git a/Tests/DUnitXTest_XE2.dproj b/Tests/DUnitXTest_XE2.dproj index 05a94cad..d81da717 100644 --- a/Tests/DUnitXTest_XE2.dproj +++ b/Tests/DUnitXTest_XE2.dproj @@ -60,13 +60,11 @@ MainSource - - @@ -76,20 +74,13 @@ - + - - - - - - - @@ -97,6 +88,18 @@
Form1
 + + + + + + + + + + + +