Merge pull request #130 from mendrix/master

Call original method if behavior is not defined

Author: vincentparrett

Source/Delphi.Mocks.Helpers.pas

@@ -77,6 +77,10 @@   TRttiTypeHelper = class helper for TRttiType
     function FindConstructor : TRttiMethod;
   end;
 
+  TRttiMethodHelper = class helper for TRttiMethod
+    function IsAbstract: Boolean;
+  end;
+
 
 function CompareValue(const Left, Right: TValue): Integer;
 function SameValue(const Left, Right: TValue): Boolean;
@@ -307,4 +311,14 @@ function TRttiTypeHelper.TryGetMethod(const AName: string; out AMethod: TRttiMet
   Result := Assigned(AMethod);
 end;
 
+{ TRttiMethodHelper }
+
+function TRttiMethodHelper.IsAbstract: Boolean;
+begin
+  if Self = nil then
+    Result := True
+  else
+    Result := PVmtMethodExEntry(Handle).Flags and (1 shl 7) <> 0;
+end;
+
 end.

Source/Delphi.Mocks.Interfaces.pas

@@ -82,7 +82,7 @@ interface
 
   IMethodData = interface
   ['{640BFB71-85C2-4ED4-A863-5AF6535BD2E8}']
-    procedure RecordHit(const Args: TArray<TValue>; const returnType : TRttiType; out Result: TValue);
+    procedure RecordHit(const Args: TArray<TValue>; const returnType : TRttiType; const method : TRttiMethod; out Result: TValue);
 
     //behaviors
     procedure WillReturnDefault(const returnValue : TValue);
@@ -114,6 +114,8 @@ interface
 
     //Verification
     function Verify(var report : string) : boolean;
+
+    function BehaviorDefined: Boolean;
   end;
 
   IVerify = interface

Source/Delphi.Mocks.MethodData.pas

@@ -70,7 +70,7 @@   TMethodData = class(TInterfacedObject,IMethodData)
     function FindBehavior(const behaviorType : TBehaviorType; const Args: TArray<TValue>) : IBehavior; overload;
     function FindBehavior(const behaviorType : TBehaviorType) : IBehavior; overload;
     function FindBestBehavior(const Args: TArray<TValue>) : IBehavior;
-    procedure RecordHit(const Args: TArray<TValue>; const returnType : TRttiType; out Result : TValue);
+    procedure RecordHit(const Args: TArray<TValue>; const returnType : TRttiType; const method : TRttiMethod; out Result : TValue);
 
     //Expectations
     function FindExpectation(const expectationType : TExpectationType; const Args: TArray<TValue>) : IExpectation;overload;
@@ -96,6 +96,8 @@   TMethodData = class(TInterfacedObject,IMethodData)
     procedure After(const AAfterMethodName : string);
 
     function Verify(var report : string) : boolean;
+
+    function BehaviorDefined: Boolean;
   public
     constructor Create(const ATypeName : string; const AMethodName : string; const ASetupParameters: TSetupMethodDataParameters; const AAutoMocker : IAutoMock = nil);
     destructor Destroy;override;
@@ -111,7 +113,7 @@ implementation
   System.TypInfo,
   Delphi.Mocks.Utils,
   Delphi.Mocks.Behavior,
-  Delphi.Mocks.Expectation;
+  Delphi.Mocks.Expectation, Delphi.Mocks.Helpers;
 
 
 
@@ -263,6 +265,11 @@ function TMethodData.FindExpectation(const expectationTypes : TExpectationTypes)
   end;
 end;
 
+function TMethodData.BehaviorDefined: Boolean;
+begin
+  Result := (FBehaviors.Count <> 0);
+end;
+
 procedure TMethodData.MockNoBehaviourRecordHit(const Args: TArray<TValue>; const AExpectationHitCtr : Integer; const returnType: TRttiType; out Result: TValue);
 var
   behavior : IBehavior;
@@ -499,7 +506,7 @@ procedure TMethodData.OnceWhen(const Args: TArray<TValue>; const matchers : TArr
 end;
 
 
-procedure TMethodData.RecordHit(const Args: TArray<TValue>; const returnType : TRttiType; out Result: TValue);
+procedure TMethodData.RecordHit(const Args: TArray<TValue>; const returnType : TRttiType; const method : TRttiMethod; out Result: TValue);
 var
   behavior : IBehavior;
   expectation : IExpectation;
@@ -519,17 +526,16 @@ procedure TMethodData.RecordHit(const Args: TArray<TValue>; const returnType : T
   behavior := FindBestBehavior(Args);
   if behavior <> nil then
     returnValue := behavior.Execute(Args, returnType)
-  else
-  begin
+  else begin
     if FSetupParameters.IsStub then
       StubNoBehaviourRecordHit(Args, expectationHitCtr, returnType, returnValue)
     else
-      MockNoBehaviourRecordHit(Args, expectationHitCtr, returnType, returnValue);
+      if method.IsAbstract then
+        MockNoBehaviourRecordHit(Args, expectationHitCtr, returnType, returnValue);
   end;
 
   if returnType <> nil then
     Result := returnValue;
-
 end;
 
 procedure TMethodData.StubNoBehaviourRecordHit(const Args: TArray<TValue>; const AExpectationHitCtr : Integer; const returnType: TRttiType; out Result: TValue);

Source/Delphi.Mocks.ObjectProxy.pas

@@ -97,11 +97,20 @@ procedure TObjectProxy<T>.DoBefore(Instance: TObject; Method: TRttiMethod; const
 var
   vArgs: TArray<TValue>;
   i, l: Integer;
+  methodData : IMethodData;
+  pInfo : PTypeInfo;
 begin
   //don't intercept the TObject methods like BeforeDestruction etc.
   if Method.Parent.AsInstance.MetaclassType <> TObject then
   begin
-    DoInvoke := False; //don't call the actual method.
+    pInfo := TypeInfo(T);
+    methodData := GetMethodData(method.Name,pInfo.NameStr);
+
+    //Call the original (virtual) method if:
+    //-we are not a stub
+    //-we have not defined any behavior (of course we count hits)
+    //-the actual method is not an abstract method
+    DoInvoke := not (FIsStubOnly or methodData.BehaviorDefined or Method.IsAbstract);
 
     //Included instance as first argument because TExpectation.Match
     //deduces that the first argument is the object instance.

Source/Delphi.Mocks.Proxy.TypeInfo.pas

@@ -333,7 +333,7 @@ procedure TProxy.DoInvoke(Method: TRttiMethod; const Args: TArray<TValue>; out R
       //record actual behavior
       methodData := GetMethodData(method.Name,pInfo.NameStr);
       Assert(methodData <> nil);
-      methodData.RecordHit(Args,Method.ReturnType,Result);
+      methodData.RecordHit(Args,Method.ReturnType,Method,Result);
     end;
     TSetupMode.Behavior:
     begin

Source/Delphi.Mocks.Proxy.pas

@@ -71,7 +71,6 @@   TProxy<T> = class(TWeakReferencedObject, IWeakReferenceableObject, IInterface,
     FMethodData             : TDictionary<string, IMethodData>;
     FBehaviorMustBeDefined  : Boolean;
     FAllowRedefineBehaviorDefinitions : Boolean;
-    FSetupMode              : TSetupMode;
     //behavior setup
     FNextBehavior           : TBehaviorType;
     FReturnValue            : TValue;
@@ -83,7 +82,6 @@   TProxy<T> = class(TWeakReferencedObject, IWeakReferenceableObject, IInterface,
     FNextExpectation        : TExpectationType;
     FTimes                  : Cardinal;
     FBetween                : array[0..1] of Cardinal;
-    FIsStubOnly             : boolean;
 
     FQueryingInterface      : boolean;
     FQueryingInternalInterface : boolean;
@@ -106,6 +104,9 @@     TProxyVirtualInterface = class(TVirtualInterface, IInterface, IProxyVirtualI
     end;
 
   protected
+    FSetupMode              : TSetupMode;
+    FIsStubOnly             : boolean;
+
     procedure SetParentProxy(const AProxy : IProxy);
     function SupportsIInterface: Boolean;
 
@@ -441,7 +442,7 @@ procedure TProxy<T>.DoInvoke(Method: TRttiMethod; const Args: TArray<TValue>; ou
       methodData := GetMethodData(method.Name,pInfo.NameStr);
       Assert(methodData <> nil);
 
-      methodData.RecordHit(Args,Method.ReturnType,Result);
+      methodData.RecordHit(Args,Method.ReturnType,Method,Result);
     end;
     TSetupMode.Behavior:
     begin

Tests/Delphi.Mocks.Tests.MethodData.pas

@@ -115,7 +115,7 @@ procedure TTestMethodData.AllowRedefineBehaviorDefinitions_IsTrue_OldBehaviorIsD
   methodData.WillReturnWhen(TArray<TValue>.Create(someValue1), someValue1, nil);
   methodData.WillReturnWhen(TArray<TValue>.Create(someValue1), someValue2, nil);
 
-  methodData.RecordHit(TArray<TValue>.Create(someValue1), TrttiContext.Create.GetType(TypeInfo(integer)), outValue);
+  methodData.RecordHit(TArray<TValue>.Create(someValue1), TrttiContext.Create.GetType(TypeInfo(integer)), nil, outValue);
 
   Assert.AreEqual(someValue2.AsInteger, outValue.AsInteger );
 end;
@@ -127,7 +127,7 @@ procedure TTestMethodData.BehaviourMustBeDefined_IsFalse_AndBehaviourIsNotDefine
   someValue   : TValue;
 begin
   methodData := TMethodData.Create('x', 'x', TSetupMethodDataParameters.Create(FALSE, FALSE, FALSE));
-  methodData.RecordHit(TArray<TValue>.Create(), nil, someValue);
+  methodData.RecordHit(TArray<TValue>.Create(), nil, nil, someValue);
   // no exception should be raised
   Assert.IsTrue(True);
 end;
@@ -141,7 +141,7 @@ procedure TTestMethodData.BehaviourMustBeDefined_IsTrue_AndBehaviourIsNotDefined
 
   Assert.WillRaise(procedure
   begin
-  methodData.RecordHit(TArray<TValue>.Create(), TRttiContext.Create.GetType(TypeInfo(Integer)), someValue);
+  methodData.RecordHit(TArray<TValue>.Create(), TRttiContext.Create.GetType(TypeInfo(Integer)), nil, someValue);
   end, EMockException);
 end;
 

Tests/Delphi.Mocks.Tests.ObjectProxy.pas

@@ -32,6 +32,7 @@   TCommand = class
     procedure Run(value: Integer);virtual;abstract;
     procedure TestVarParam(var msg : string);virtual;abstract;
     procedure TestOutParam(out msg : string);virtual;abstract;
+    function VirtualMethod: Integer; virtual;
   end;
 
   {$M+}
@@ -62,6 +63,8 @@   TTestObjectProxy = class
     procedure TestOutParam;
     [Test]
     procedure TestVarParam;
+    [Test]
+    procedure MockNoBehaviorDefined;
   end;
   {$M-}
 
@@ -236,6 +239,16 @@ procedure TTestObjectProxy.MockNoArgProcedureUsingOnceWhen;
   Assert.Pass;
 end;
 
+procedure TTestObjectProxy.MockNoBehaviorDefined;
+var
+  mock : TMock<TCommand>;
+begin
+  mock := TMock<TCommand>.Create;
+  mock.Setup.Expect.Once.When.VirtualMethod;
+  Assert.AreEqual(1, mock.Instance.VirtualMethod);
+  mock.Verify;
+end;
+
 procedure TTestObjectProxy.MockWithArgProcedureUsingOnce;
 var
   mock : TMock<TCommand>;
@@ -267,6 +280,13 @@ constructor TMultipleConstructor.Create;
 end;
 
 
+{ TCommand }
+
+function TCommand.VirtualMethod: Integer;
+begin
+  Result := 1;
+end;
+
 initialization
   TDUnitX.RegisterTestFixture(TTestObjectProxy);