From 6a49b4939324a76133a087ae9587f747f823e63d Mon Sep 17 00:00:00 2001 From: Vincent Parrett Date: Fri, 10 Apr 2020 16:43:25 +1000 Subject: [PATCH] Repo reorg, added dpm spec. --- .gitignore | 4 + DUnitXML | 1 - Delphi.Mocks.dspec | 94 + DelphiMocks.groupproj | 48 - Examples/Sample1.dpr | 28 + Sample1.dproj => Examples/Sample1.dproj | 44 +- Sample1Main.pas => Examples/Sample1Main.pas | 0 Sample1.RES | Bin 824 -> 0 bytes Sample1.dpr | 46 - .../Delphi.Mocks.AutoMock.pas | 0 .../Delphi.Mocks.Behavior.pas | 0 .../Delphi.Mocks.Expectation.pas | 0 .../Delphi.Mocks.Helpers.pas | 0 .../Delphi.Mocks.Interfaces.pas | 0 .../Delphi.Mocks.MethodData.pas | 0 .../Delphi.Mocks.ObjectProxy.pas | 20 +- .../Delphi.Mocks.ParamMatcher.pas | 0 .../Delphi.Mocks.Proxy.TypeInfo.pas | 22 +- .../Delphi.Mocks.Proxy.pas | 1928 ++++++++--------- .../Delphi.Mocks.ReturnTypePatch.pas | 0 .../Delphi.Mocks.Utils.pas | 0 .../Delphi.Mocks.Validation.pas | 0 .../Delphi.Mocks.VirtualInterface.pas | 0 .../Delphi.Mocks.VirtualMethodInterceptor.pas | 0 .../Delphi.Mocks.WeakReference.pas | 0 .../Delphi.Mocks.When.pas | 0 Delphi.Mocks.inc => Source/Delphi.Mocks.inc | 37 +- Delphi.Mocks.pas => Source/Delphi.Mocks.pas | 76 +- Tests/Delphi.Mocks.Tests.Stubs.pas | 13 + Tests/Delphi.Mocks.Tests.dpr | 20 +- Tests/Delphi.Mocks.Tests.dproj | 1103 +++++----- 31 files changed, 1760 insertions(+), 1724 deletions(-) delete mode 160000 DUnitXML create mode 100644 Delphi.Mocks.dspec delete mode 100644 DelphiMocks.groupproj create mode 100644 Examples/Sample1.dpr rename Sample1.dproj => Examples/Sample1.dproj (91%) rename Sample1Main.pas => Examples/Sample1Main.pas (100%) delete mode 100644 Sample1.RES delete mode 100644 Sample1.dpr rename Delphi.Mocks.AutoMock.pas => Source/Delphi.Mocks.AutoMock.pas (100%) rename Delphi.Mocks.Behavior.pas => Source/Delphi.Mocks.Behavior.pas (100%) rename Delphi.Mocks.Expectation.pas => Source/Delphi.Mocks.Expectation.pas (100%) rename Delphi.Mocks.Helpers.pas => Source/Delphi.Mocks.Helpers.pas (100%) rename Delphi.Mocks.Interfaces.pas => Source/Delphi.Mocks.Interfaces.pas (100%) rename Delphi.Mocks.MethodData.pas => Source/Delphi.Mocks.MethodData.pas (100%) rename Delphi.Mocks.ObjectProxy.pas => Source/Delphi.Mocks.ObjectProxy.pas (99%) rename Delphi.Mocks.ParamMatcher.pas => Source/Delphi.Mocks.ParamMatcher.pas (100%) rename Delphi.Mocks.Proxy.TypeInfo.pas => Source/Delphi.Mocks.Proxy.TypeInfo.pas (99%) rename Delphi.Mocks.Proxy.pas => Source/Delphi.Mocks.Proxy.pas (97%) rename Delphi.Mocks.ReturnTypePatch.pas => Source/Delphi.Mocks.ReturnTypePatch.pas (100%) rename Delphi.Mocks.Utils.pas => Source/Delphi.Mocks.Utils.pas (100%) rename Delphi.Mocks.Validation.pas => Source/Delphi.Mocks.Validation.pas (100%) rename Delphi.Mocks.VirtualInterface.pas => Source/Delphi.Mocks.VirtualInterface.pas (100%) rename Delphi.Mocks.VirtualMethodInterceptor.pas => Source/Delphi.Mocks.VirtualMethodInterceptor.pas (100%) rename Delphi.Mocks.WeakReference.pas => Source/Delphi.Mocks.WeakReference.pas (100%) rename Delphi.Mocks.When.pas => Source/Delphi.Mocks.When.pas (100%) rename Delphi.Mocks.inc => Source/Delphi.Mocks.inc (90%) rename Delphi.Mocks.pas => Source/Delphi.Mocks.pas (99%) diff --git a/.gitignore b/.gitignore index cfd7f87..87fe708 100644 --- a/.gitignore +++ b/.gitignore @@ -23,6 +23,10 @@ ################### /Win32 /Win64 +/Tests/Win32 +/Tests/Win64 +/Examples/Win32 +/Examples/Win64 Build/TestAndBuild.fb7lck *.fbl7 diff --git a/DUnitXML b/DUnitXML deleted file mode 160000 index e446bfb..0000000 --- a/DUnitXML +++ /dev/null @@ -1 +0,0 @@ -Subproject commit e446bfb2c06edba676f9d32317c23b0e9135fc7f diff --git a/Delphi.Mocks.dspec b/Delphi.Mocks.dspec new file mode 100644 index 0000000..2e7066b --- /dev/null +++ b/Delphi.Mocks.dspec @@ -0,0 +1,94 @@ +{ + "metadata": { + "id": "Delphi.Mocks", + "version": "0.0.2", + "description": "Simple mocking framework for Delphi XE2 or later.", + "authors": "Vincent Parrett", + "projectUrl": "https://github.com/VSoftTechnologies/Delphi-Mocks", + "license": "Apache-2.0", + "copyright": "Vincent Parrett and contributors", + "tags": "mocking unittesting" + }, + "targetPlatforms": [ + { + "compiler": "XE2", + "platforms": "Win32, Win64", + "template": "default" + }, + { + "compiler": "XE3", + "platforms": "Win32, Win64", + "template": "default" + }, + { + "compiler": "XE4", + "platforms": "Win32, Win64", + "template": "default" + }, + { + "compiler": "XE5", + "platforms": "Win32, Win64", + "template": "default" + }, + { + "compiler": "XE6", + "platforms": "Win32, Win64", + "template": "default" + }, + { + "compiler": "XE7", + "platforms": "Win32, Win64", + "template": "default" + }, + { + "compiler": "XE8", + "platforms": "Win32, Win64", + "template": "default" + }, + { + "compiler": "10.0", + "platforms": "Win32, Win64", + "template": "default" + }, + { + "compiler": "10.1", + "platforms": "Win32, Win64", + "template": "default" + }, + { + "compiler": "10.2", + "platforms": "Win32, Win64", + "template": "default" + }, + { + "compiler": "10.3", + "platforms": "Win32, Win64", + "template": "default" + }, + { + "compiler": "10.4", + "platforms": "Win32, Win64", + "template": "default" + } + ], + "templates": [ + { + "name": "default", + "source": [ + { + "src": "Source\\*.pas", + "dest": "src" + }, + { + "src": "Source\\*.inc", + "dest": "src" + } + ], + "searchPaths": [ + { + "path": "src" + } + ] + } + ] +} diff --git a/DelphiMocks.groupproj b/DelphiMocks.groupproj deleted file mode 100644 index e159ed4..0000000 --- a/DelphiMocks.groupproj +++ /dev/null @@ -1,48 +0,0 @@ - - - {5B50C9A9-C667-497D-954F-FA8A2C43C41B} - - - - - - - - - - - Default.Personality.12 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/Examples/Sample1.dpr b/Examples/Sample1.dpr new file mode 100644 index 0000000..020fa8a --- /dev/null +++ b/Examples/Sample1.dpr @@ -0,0 +1,28 @@ +program Sample1; + +{$APPTYPE CONSOLE} + +{$R *.res} + +uses + SysUtils, + Sample1Main in 'Sample1Main.pas', + Delphi.Mocks.Example.ProjectSaveCheckVisitor in 'Delphi.Mocks.Example.ProjectSaveCheckVisitor.pas', + Delphi.Mocks.Examples.Factory in 'Delphi.Mocks.Examples.Factory.pas', + Delphi.Mocks.Examples.Implement in 'Delphi.Mocks.Examples.Implement.pas', + Delphi.Mocks.Examples.Interfaces in 'Delphi.Mocks.Examples.Interfaces.pas'; + +begin + try + TesTObjectMock; + Writeln('--------------'); + Test; + ReadLn; + except + on E: Exception do + begin + Writeln(E.ClassName, ': ', E.Message); + ReadLn; + end; + end; +end. diff --git a/Sample1.dproj b/Examples/Sample1.dproj similarity index 91% rename from Sample1.dproj rename to Examples/Sample1.dproj index 99586fd..1a2096b 100644 --- a/Sample1.dproj +++ b/Examples/Sample1.dproj @@ -54,7 +54,7 @@ true - $(DUNITX);$(DCC_UnitSearchPath) + ..\Source;$(DCC_UnitSearchPath) Sample1 false CompanyName=;FileDescription=;FileVersion=1.2.3.4;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0 @@ -125,29 +125,11 @@ MainSource - - - - - - - - - - - - - - - - - - - - - - + + + + Cfg_2 Base @@ -201,20 +183,28 @@ True False - + + madBasic 1.2.7 - www.madshi.net + madHelp 1.1.1 - www.madshi.net + madDisAsm 2.2.6 - www.madshi.net + madExceptIde 1.1.0 - www.madshi.net + madExcept 5.0.0 - www.madshi.net + madExceptVcl 2.1.0 - www.madshi.net + madExceptWizard 3.1.8 - www.madshi.net + - + Sample1.exe - + Sample1.rsm - + diff --git a/Sample1Main.pas b/Examples/Sample1Main.pas similarity index 100% rename from Sample1Main.pas rename to Examples/Sample1Main.pas diff --git a/Sample1.RES b/Sample1.RES deleted file mode 100644 index adc244970dfe2b0f664abf409c78c7647e66e63c..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 824 zcmZXSNlODk5QX2wQH**JPabpdU2r~Q zKS8(k8oqx@fmXGqtX8mit^;=~8KJj)8~AM!JAiMjp}LCIhOMifnlQ&|X#nN}r$7ZA zB4wmR4wlg#kpip(^_8d&{+Vp*oSH5`to0nh+@k`?zaX(VS#ZSO>;fo#a z39b>EkCWmf@I&k~Tv0p9tH@`2fxYbfx3x$dt7GhZV)%M<8Frl2=bCreDweiGSyc)3 zSXbKWz#!e@T}QW7(h}S=d<|q>5BT@_5B2CWpZV2!q(s;a2wX7yUlgJ1JAzkulrjm2_Y diff --git a/Sample1.dpr b/Sample1.dpr deleted file mode 100644 index e94181e..0000000 --- a/Sample1.dpr +++ /dev/null @@ -1,46 +0,0 @@ -program Sample1; - -{$APPTYPE CONSOLE} - -{$R *.res} - -uses - SysUtils, - Delphi.Mocks.AutoMock in 'Delphi.Mocks.AutoMock.pas', - Delphi.Mocks.Behavior in 'Delphi.Mocks.Behavior.pas', - Delphi.Mocks.Expectation in 'Delphi.Mocks.Expectation.pas', - Delphi.Mocks.Helpers in 'Delphi.Mocks.Helpers.pas', - Delphi.Mocks.Interfaces in 'Delphi.Mocks.Interfaces.pas', - Delphi.Mocks.MethodData in 'Delphi.Mocks.MethodData.pas', - Delphi.Mocks.ObjectProxy in 'Delphi.Mocks.ObjectProxy.pas', - Delphi.Mocks.ParamMatcher in 'Delphi.Mocks.ParamMatcher.pas', - Delphi.Mocks in 'Delphi.Mocks.pas', - Delphi.Mocks.Proxy in 'Delphi.Mocks.Proxy.pas', - Delphi.Mocks.Proxy.TypeInfo in 'Delphi.Mocks.Proxy.TypeInfo.pas', - Delphi.Mocks.ReturnTypePatch in 'Delphi.Mocks.ReturnTypePatch.pas', - Delphi.Mocks.Utils in 'Delphi.Mocks.Utils.pas', - Delphi.Mocks.Validation in 'Delphi.Mocks.Validation.pas', - Delphi.Mocks.VirtualInterface in 'Delphi.Mocks.VirtualInterface.pas', - Delphi.Mocks.VirtualMethodInterceptor in 'Delphi.Mocks.VirtualMethodInterceptor.pas', - Delphi.Mocks.WeakReference in 'Delphi.Mocks.WeakReference.pas', - Delphi.Mocks.When in 'Delphi.Mocks.When.pas', - Sample1Main in 'Sample1Main.pas', - Delphi.Mocks.Example.ProjectSaveCheckVisitor in 'Examples\Delphi.Mocks.Example.ProjectSaveCheckVisitor.pas', - Delphi.Mocks.Examples.Factory in 'Examples\Delphi.Mocks.Examples.Factory.pas', - Delphi.Mocks.Examples.Implement in 'Examples\Delphi.Mocks.Examples.Implement.pas', - Delphi.Mocks.Examples.Interfaces in 'Examples\Delphi.Mocks.Examples.Interfaces.pas'; - -begin - try - TesTObjectMock; - Writeln('--------------'); - Test; - ReadLn; - except - on E: Exception do - begin - Writeln(E.ClassName, ': ', E.Message); - ReadLn; - end; - end; -end. diff --git a/Delphi.Mocks.AutoMock.pas b/Source/Delphi.Mocks.AutoMock.pas similarity index 100% rename from Delphi.Mocks.AutoMock.pas rename to Source/Delphi.Mocks.AutoMock.pas diff --git a/Delphi.Mocks.Behavior.pas b/Source/Delphi.Mocks.Behavior.pas similarity index 100% rename from Delphi.Mocks.Behavior.pas rename to Source/Delphi.Mocks.Behavior.pas diff --git a/Delphi.Mocks.Expectation.pas b/Source/Delphi.Mocks.Expectation.pas similarity index 100% rename from Delphi.Mocks.Expectation.pas rename to Source/Delphi.Mocks.Expectation.pas diff --git a/Delphi.Mocks.Helpers.pas b/Source/Delphi.Mocks.Helpers.pas similarity index 100% rename from Delphi.Mocks.Helpers.pas rename to Source/Delphi.Mocks.Helpers.pas diff --git a/Delphi.Mocks.Interfaces.pas b/Source/Delphi.Mocks.Interfaces.pas similarity index 100% rename from Delphi.Mocks.Interfaces.pas rename to Source/Delphi.Mocks.Interfaces.pas diff --git a/Delphi.Mocks.MethodData.pas b/Source/Delphi.Mocks.MethodData.pas similarity index 100% rename from Delphi.Mocks.MethodData.pas rename to Source/Delphi.Mocks.MethodData.pas diff --git a/Delphi.Mocks.ObjectProxy.pas b/Source/Delphi.Mocks.ObjectProxy.pas similarity index 99% rename from Delphi.Mocks.ObjectProxy.pas rename to Source/Delphi.Mocks.ObjectProxy.pas index db75e7d..6013cce 100644 --- a/Delphi.Mocks.ObjectProxy.pas +++ b/Source/Delphi.Mocks.ObjectProxy.pas @@ -72,16 +72,16 @@ constructor TObjectProxy.Create(const ACreateFunc: TFunc; const AAutoMocke if not Assigned(ACreateFunc) then begin - ctor := rType.FindConstructor; - if ctor = nil then - raise EMockException.Create('Could not find constructor Create on type ' + rType.Name); - - instance := ctor.Invoke(rType.AsInstance.MetaclassType, []); - end - else - instance := TValue.From(ACreateFunc); - FInstance := instance.AsType(); - FVMInterceptor := TVirtualMethodInterceptor.Create(rType.AsInstance.MetaclassType); + ctor := rType.FindConstructor; + if ctor = nil then + raise EMockException.Create('Could not find constructor Create on type ' + rType.Name); + + instance := ctor.Invoke(rType.AsInstance.MetaclassType, []); + end + else + instance := TValue.From(ACreateFunc); + FInstance := instance.AsType(); + FVMInterceptor := TVirtualMethodInterceptor.Create(rType.AsInstance.MetaclassType); FVMInterceptor.Proxify(instance.AsObject); FVMInterceptor.OnBefore := DoBefore; diff --git a/Delphi.Mocks.ParamMatcher.pas b/Source/Delphi.Mocks.ParamMatcher.pas similarity index 100% rename from Delphi.Mocks.ParamMatcher.pas rename to Source/Delphi.Mocks.ParamMatcher.pas diff --git a/Delphi.Mocks.Proxy.TypeInfo.pas b/Source/Delphi.Mocks.Proxy.TypeInfo.pas similarity index 99% rename from Delphi.Mocks.Proxy.TypeInfo.pas rename to Source/Delphi.Mocks.Proxy.TypeInfo.pas index dc9a61d..e8681e6 100644 --- a/Delphi.Mocks.Proxy.TypeInfo.pas +++ b/Source/Delphi.Mocks.Proxy.TypeInfo.pas @@ -440,9 +440,9 @@ function TProxy.GetMethodData(const AMethodName: string; const ATypeName: string setupParams := TSetupMethodDataParameters.Create(FIsStubOnly, FBehaviorMustBeDefined, FAllowRedefineBehaviorDefinitions); {$IFNDEF NEXTGEN} - Result := TMethodData.Create(string(FTypeInfo.Name), AMethodName, setupParams, FAutoMocker); -{$ELSE} - Result := TMethodData.Create(FTypeInfo.NameFld.ToString, AMethodName, setupParams, FAutoMocker); + Result := TMethodData.Create(string(FTypeInfo.Name), AMethodName, setupParams, FAutoMocker); +{$ELSE} + Result := TMethodData.Create(FTypeInfo.NameFld.ToString, AMethodName, setupParams, FAutoMocker); {$ENDIF} FMethodData.Add(methodName,Result); end; @@ -556,10 +556,10 @@ procedure TProxy.SetParentProxy(const AProxy : IProxy); end; function TProxy.SupportsIInterface: Boolean; -begin - Result := (FParentProxy = nil); -end; - +begin + Result := (FParentProxy = nil); +end; + function TProxy.ProxyFromType(const ATypeInfo: PTypeInfo): IProxy; var interfaceID : TGUID; @@ -749,13 +749,13 @@ function TProxy.TProxyVirtualInterface.QueryProxy(const IID: TGUID; out Obj : IP end; function TProxy.TProxyVirtualInterface.SupportsIInterface: Boolean; -begin - if FProxy <> nil then +begin + if FProxy <> nil then Result := FProxy.Data.SupportsIInterface else Result := True; -end; - +end; + function TProxy.TProxyVirtualInterface._AddRef: Integer; begin result := inherited; diff --git a/Delphi.Mocks.Proxy.pas b/Source/Delphi.Mocks.Proxy.pas similarity index 97% rename from Delphi.Mocks.Proxy.pas rename to Source/Delphi.Mocks.Proxy.pas index 75068eb..38d9e04 100644 --- a/Delphi.Mocks.Proxy.pas +++ b/Source/Delphi.Mocks.Proxy.pas @@ -1,964 +1,964 @@ -{***************************************************************************} -{ } -{ Delphi.Mocks } -{ } -{ Copyright (C) 2011 Vincent Parrett } -{ } -{ 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 Delphi.Mocks.Proxy; - -interface - -uses - Rtti, - SysUtils, - TypInfo, - Generics.Collections, - Delphi.Mocks, - Delphi.Mocks.WeakReference, - Delphi.Mocks.Interfaces, - Delphi.Mocks.Behavior; - - {$I 'Delphi.Mocks.inc'} - -type - TProxyBaseInvokeEvent = procedure (Method: TRttiMethod; const Args: TArray; out Result: TValue) of object; - - TSetupMode = (None, Behavior, Expectation); - - {$IFOPT M+} - {$M-} - {$DEFINE ENABLED_M+} - {$ENDIF} - IProxyVirtualInterface = interface - ['{A0394EB0-245E-4AE6-AD71-3BC9815CD173}'] - function QueryProxy(const IID: TGUID; out Obj : IProxy) : HRESULT; - function QueryInterfaceWithOwner(const IID: TGUID; out Obj; const ACheckOwner : Boolean): HRESULT; overload; - function QueryInterfaceWithOwner(const IID: TGUID; const ACheckOwner : Boolean): HRESULT; overload; - end; - {$IFDEF ENABLED_M+} - {$M+} - {$ENDIF} - - TProxy = class(TWeakReferencedObject, IWeakReferenceableObject, IInterface, IProxy, IProxy, IStubProxy, IMockSetup, IStubSetup, IExpect, IVerify) - private - //Implements members. - //Can't define TProxy or any other generic type as that type will be defined at runtime. - FParentProxy : IWeakReference; - FInterfaceProxies : TDictionary; - - FVirtualInterface : IProxyVirtualInterface; - FName : string; - - FMethodData : TDictionary; - FBehaviorMustBeDefined : Boolean; - FAllowRedefineBehaviorDefinitions : Boolean; - FSetupMode : TSetupMode; - //behavior setup - FNextBehavior : TBehaviorType; - FReturnValue : TValue; - FReturnValueNilAllowed : Boolean; - FNextFunc : TExecuteFunc; - FExceptClass : ExceptClass; - FExceptionMessage : string; - //expectation setup - FNextExpectation : TExpectationType; - FTimes : Cardinal; - FBetween : array[0..1] of Cardinal; - FIsStubOnly : boolean; - - FQueryingInterface : boolean; - FQueryingInternalInterface : boolean; - FAutoMocker : IAutoMock; - - protected type - TProxyVirtualInterface = class(TVirtualInterface, IInterface, IProxyVirtualInterface) - private - FProxy : IWeakReference>; - function SupportsIInterface: Boolean; - protected - //IProxyVirtualInterface - function QueryProxy(const IID: TGUID; out Obj : IProxy) : HRESULT; - function QueryInterfaceWithOwner(const IID: TGUID; out Obj; const ACheckOwner : Boolean): HRESULT; overload; - function QueryInterfaceWithOwner(const IID: TGUID; const ACheckOwner : Boolean): HRESULT; overload; - public - //TVirtualInterface overrides - constructor Create(const AProxy : IProxy; const AInterface: Pointer; const InvokeEvent: TVirtualInterfaceInvokeEvent); - function QueryInterface(const IID: TGUID; out Obj): HRESULT; override; stdcall; - end; - - protected - procedure SetParentProxy(const AProxy : IProxy); - function SupportsIInterface: Boolean; - - function QueryImplementedInterface(const IID: TGUID; out Obj): HRESULT; stdcall; - function QueryInterface(const IID: TGUID; out Obj): HRESULT; virtual; stdcall; - function _AddRef: Integer; override; stdcall; - function _Release: Integer; override; stdcall; - - //IProxy - function ProxyInterface : IInterface; - - function ProxySupports(const Instance: IInterface; const IID: TGUID) : boolean; virtual; - function ProxyFromType(const ATypeInfo : PTypeInfo) : IProxy; virtual; - procedure AddImplement(const AProxy : IProxy; const ATypeInfo : PTypeInfo); virtual; - - //IProxy - function MockSetup : IMockSetup; - function StubSetup : IStubSetup; - - function IProxy.Setup = MockSetup; - function IStubProxy.Setup = StubSetup; - - function Proxy : T; virtual; - - //ISetup - function GetBehaviorMustBeDefined : boolean; - procedure SetBehaviorMustBeDefined(const value : boolean); - function GetAllowRedefineBehaviorDefinitions : boolean; - procedure SetAllowRedefineBehaviorDefinitions(const value : boolean); - - function Expect : IExpect; - - {$Message 'TODO: Implement ISetup.Before and ISetup.After.'} - function WillReturn(const value : TValue) : IWhen; overload; - function WillReturn(const value : TValue; const AllowNil: Boolean) : IWhen; overload; - procedure WillReturnDefault(const AMethodName : string; const value : TValue); - function WillReturnNil: IWhen; - function WillRaise(const exceptionClass : ExceptClass; const message : string = '') : IWhen; overload; - procedure WillRaise(const AMethodName : string; const exceptionClass : ExceptClass; const message : string = ''); overload; - - function WillRaiseWhen(const exceptionClass : ExceptClass; const message : string = '') : IWhen; - - function WillExecute(const func : TExecuteFunc) : IWhen; overload; - procedure WillExecute(const AMethodName : string; const func : TExecuteFunc); overload; - - procedure DoInvoke(Method: TRttiMethod; const Args: TArray; out Result: TValue); - - //IVerify - procedure Verify(const message : string = ''); - procedure VerifyAll(const message : string = ''); - - function CheckExpectations: string; - - function GetMethodData(const AMethodName : string; const ATypeName: string) : IMethodData; overload; - - procedure ClearSetupState; - - //IExpect - function Once : IWhen;overload; - procedure Once(const AMethodName : string);overload; - - function Never : IWhen;overload; - procedure Never(const AMethodName : string);overload; - - function AtLeastOnce : IWhen;overload; - procedure AtLeastOnce(const AMethodName : string);overload; - - function AtLeast(const times : Cardinal) : IWhen;overload; - procedure AtLeast(const AMethodName : string; const times : Cardinal);overload; - - function AtMost(const times : Cardinal) : IWhen;overload; - procedure AtMost(const AMethodName : string; const times : Cardinal);overload; - - function Between(const a,b : Cardinal) : IWhen;overload; - procedure Between(const AMethodName : string; const a,b : Cardinal);overload; - - function Exactly(const times : Cardinal) : IWhen;overload; - procedure Exactly(const AMethodName : string; const times : Cardinal);overload; - - function Before(const AMethodName : string) : IWhen;overload; - procedure Before(const AMethodName : string; const ABeforeMethodName : string);overload; - - function After(const AMethodName : string) : IWhen;overload; - procedure After(const AMethodName : string; const AAfterMethodName : string);overload; - public - constructor Create(const AAutoMocker : IAutoMock = nil; const AIsStubOnly : boolean = false); virtual; - destructor Destroy; override; - end; - -function Supports(const Instance: IProxyVirtualInterface; const IID: TGUID; out Intf; const ACheckOwner: Boolean): Boolean; overload; -function Supports(const Instance: IProxyVirtualInterface; const IID: TGUID; const ACheckOwner: Boolean): Boolean; overload; -function MethodKindToStr(const AMethodKind : TMethodKind) : string; - -implementation - -uses - Delphi.Mocks.Utils, - Delphi.Mocks.When, - Delphi.Mocks.MethodData, - Delphi.Mocks.ParamMatcher; - -function Supports(const Instance: IProxyVirtualInterface; const IID: TGUID; out Intf; const ACheckOwner: Boolean): Boolean; -begin - //See if we support the passed in interface. Passed on whether we need to check - //the owner for the implementation as well. - Result := (Instance <> nil) and (Instance.QueryInterfaceWithOwner(IID, Intf, ACheckOwner) = 0); -end; - -function Supports(const Instance: IProxyVirtualInterface; const IID: TGUID; const ACheckOwner: Boolean): Boolean; overload; -begin - //See if we support the passed in interface. Passed on whether we need to check - //the owner for the implementation as well. - Result := (Instance <> nil) and (Instance.QueryInterfaceWithOwner(IID, ACheckOwner) = 0); -end; - -function MethodKindToStr(const AMethodKind : TMethodKind) : string; -begin - case AMethodKind of - mkProcedure: Result := 'Procedure'; - mkFunction: Result := 'Function'; - mkConstructor: Result := 'Constructor'; - mkDestructor: Result := 'Destructor'; - mkClassProcedure: Result := 'Class Procedure'; - mkClassFunction: Result := 'Class Function'; - mkClassConstructor: Result := 'Class Constructor'; - mkClassDestructor: Result := 'Class Destructor'; - mkOperatorOverload: Result := 'Operator Overload'; - mkSafeProcedure: Result := 'Safe Procedure'; - mkSafeFunction: Result := 'Safe Function'; - else - raise Exception.CreateFmt('Unexpected method kind passed to [%s]', [Ord(AMethodKind)]); - end; -end; -{ TProxyBase } - -procedure TProxy.AddImplement(const AProxy: IProxy; const ATypeInfo : PTypeInfo); -begin - - if FInterfaceProxies.ContainsKey(GetTypeData(ATypeInfo).Guid) then - raise EMockProxyAlreadyImplemented.Create('The mock already implements ' + ATypeInfo.NameStr); - - FInterfaceProxies.Add(GetTypeData(ATypeInfo).Guid, AProxy); - AProxy.SetParentProxy(Self); -end; - -procedure TProxy.After(const AMethodName, AAfterMethodName: string); -begin - raise Exception.Create('Not implemented'); -end; - -function TProxy.After(const AMethodName: string): IWhen; -begin - raise Exception.Create('Not implemented'); -end; - -procedure TProxy.AtLeast(const AMethodName: string; const times: Cardinal); -var - methodData : IMethodData; - pInfo : PTypeInfo; -begin - pInfo := TypeInfo(T); - methodData := GetMethodData(AMethodName, pInfo.NameStr); - Assert(methodData <> nil); - methodData.AtLeast(times); - ClearSetupState; -end; - -function TProxy.AtLeast(const times: Cardinal): IWhen; -begin - FSetupMode := TSetupMode.Expectation; - FNextExpectation := TExpectationType.AtLeastWhen; - FTimes := times; - result := TWhen.Create(Self.Proxy); -end; - -procedure TProxy.AtLeastOnce(const AMethodName: string); -var - methodData : IMethodData; - pInfo : PTypeInfo; -begin - pInfo := TypeInfo(T); - methodData := GetMethodData(AMethodName,pInfo.NameStr); - Assert(methodData <> nil); - methodData.AtLeastOnce; - ClearSetupState; -end; - -function TProxy.AtLeastOnce: IWhen; -begin - FSetupMode := TSetupMode.Expectation; - FNextExpectation := TExpectationType.AtLeastOnceWhen; - FTimes := 1; - result := TWhen.Create(Self.Proxy); -end; - -procedure TProxy.AtMost(const AMethodName: string; const times: Cardinal); -var - methodData : IMethodData; - pInfo : PTypeInfo; -begin - pInfo := TypeInfo(T); - methodData := GetMethodData(AMethodName, pInfo.NameStr); - Assert(methodData <> nil); - methodData.AtMost(times); - ClearSetupState; -end; - -function TProxy.AtMost(const times: Cardinal): IWhen; -begin - FSetupMode := TSetupMode.Expectation; - FNextExpectation := TExpectationType.AtMostWhen; - FTimes := times; - result := TWhen.Create(Self.Proxy); -end; - -procedure TProxy.Before(const AMethodName, ABeforeMethodName: string); -begin - raise Exception.Create('not implemented'); -end; - -function TProxy.Before(const AMethodName: string): IWhen; -begin - raise Exception.Create('not implemented'); -end; - -procedure TProxy.Between(const AMethodName: string; const a, b: Cardinal); -var - methodData : IMethodData; - pInfo : PTypeInfo; -begin - pInfo := TypeInfo(T); - methodData := GetMethodData(AMethodName,pInfo.NameStr); - Assert(methodData <> nil); - methodData.Between(a,b); - ClearSetupState; -end; - -function TProxy.Between(const a, b: Cardinal): IWhen; -begin - FSetupMode := TSetupMode.Expectation; - FNextExpectation := TExpectationType.BetweenWhen; - FBetween[0] := a; - FBetween[1] := b; - result := TWhen.Create(Self.Proxy); - -end; - -function TProxy.CheckExpectations: string; -var - methodData : IMethodData; - report : string; -begin - Result := ''; - for methodData in FMethodData.Values do - begin - report := ''; - if not methodData.Verify(report) then - begin - if Result <> '' then - Result := Result + #13#10; - Result := Result + report ; - end; - end; -end; - -procedure TProxy.ClearSetupState; -begin - FSetupMode := TSetupMode.None; - FReturnValue := TValue.Empty; - FExceptClass := nil; - FNextFunc := nil; -end; - -constructor TProxy.Create(const AAutoMocker : IAutoMock; const AIsStubOnly : boolean); -var - pInfo : PTypeInfo; -begin - inherited Create; - - FAutoMocker := AAutoMocker; - FParentProxy := nil; - FVirtualInterface := nil; - - FSetupMode := TSetupMode.None; - FBehaviorMustBeDefined := False; - FMethodData := TDictionary.Create; - FIsStubOnly := AIsStubOnly; - - FInterfaceProxies := TDictionary.Create; - - pInfo := TypeInfo(T); - - case pInfo.Kind of - //Create our proxy interface object, which will implement our interface T - tkInterface : - begin - FVirtualInterface := TProxyVirtualInterface.Create(Self, TypeInfo(T), Self.DoInvoke); - - end; - end; - - FName := pInfo.NameStr; -end; - -destructor TProxy.Destroy; -begin - FVirtualInterface := nil; - - FMethodData.Clear; - FMethodData.Free; - FInterfaceProxies.Clear; - FInterfaceProxies.Free; - - FParentProxy := nil; - - inherited; -end; - -procedure TProxy.DoInvoke(Method: TRttiMethod; const Args: TArray; out Result: TValue); -var - returnVal : TValue; - methodData : IMethodData; - behavior : IBehavior; - pInfo : PTypeInfo; - matchers : TArray; -begin - pInfo := TypeInfo(T); - - case FSetupMode of - TSetupMode.None: - begin - //record actual behavior - methodData := GetMethodData(method.Name,pInfo.NameStr); - Assert(methodData <> nil); - - methodData.RecordHit(Args,Method.ReturnType,Result); - end; - TSetupMode.Behavior: - begin - try - matchers := TMatcherFactory.GetMatchers; - if Length(matchers) > 0 then - if Length(matchers) < Length(Args) -1 then - raise EMockSetupException.Create('Setup called with Matchers but on all parameters : ' + Method.Name ); - //record desired behavior - //first see if we know about this method - methodData := GetMethodData(method.Name,pInfo.NameStr); - Assert(methodData <> nil); - case FNextBehavior of - TBehaviorType.WillReturn: - begin - case Method.MethodKind of - mkProcedure, - mkDestructor, - mkClassProcedure, - mkClassDestructor, - mkSafeProcedure : raise EMockSetupException.CreateFmt('Setup.WillReturn called on [%s] method [%s] which does not have a return value.', [MethodKindToStr(Method.MethodKind), Method.Name]); - - //Method kinds which have a return value. - mkFunction, mkConstructor, mkClassFunction, - mkClassConstructor, mkOperatorOverload, mkSafeFunction: ; - end; - - //We don't test for the return type being valid as XE5 and below have a RTTI bug which does not return - //a return type for function which reference their own class/interface. Even when RTTI is specified on - //the declaration and forward declaration. - if (FReturnValue.IsEmpty and not FReturnValueNilAllowed) or - (FReturnValueNilAllowed and ((FReturnValue.TypeInfo = nil) or (FReturnValue.TypeData = nil))) then - raise EMockSetupException.CreateFmt('Setup.WillReturn call on method [%s] was not passed a return value.', [Method.Name]); - - methodData.WillReturnWhen(Args,FReturnValue,matchers); - end; - TBehaviorType.WillRaise: - begin - methodData.WillRaiseWhen(FExceptClass, FExceptionMessage, Args, matchers); - end; - TBehaviorType.WillRaiseAlways: - begin - methodData.WillRaiseAlways(FExceptClass,FExceptionMessage); - end; - TBehaviorType.WillExecuteWhen : - begin - methodData.WillExecuteWhen(FNextFunc,Args,matchers); - end; - end; - finally - ClearSetupState; - end; - end; - TSetupMode.Expectation: - begin - try - //record expectations - //first see if we know about this method - methodData := GetMethodData(method.Name, pInfo.NameStr); - Assert(methodData <> nil); - - matchers := TMatcherFactory.GetMatchers; - - case FNextExpectation of - OnceWhen : methodData.OnceWhen(Args, matchers); - NeverWhen : methodData.NeverWhen(Args, matchers) ; - AtLeastOnceWhen : methodData.AtLeastOnceWhen(Args, matchers); - AtLeastWhen : methodData.AtLeastWhen(FTimes, args, matchers); - AtMostOnceWhen : methodData.AtLeastOnceWhen(Args, matchers); - AtMostWhen : methodData.AtMostWhen(FTimes, args, matchers); - BetweenWhen : methodData.BetweenWhen(FBetween[0], FBetween[1],Args, matchers); - ExactlyWhen : methodData.ExactlyWhen(FTimes, Args, matchers); - BeforeWhen : raise exception.Create('not implemented') ; - AfterWhen : raise exception.Create('not implemented'); - end; - - finally - ClearSetupState; - end; - end; - end; - -end; - -procedure TProxy.Exactly(const AMethodName: string; const times: Cardinal); -var - methodData : IMethodData; - pInfo : PTypeInfo; -begin - pInfo := TypeInfo(T); - methodData := GetMethodData(AMethodName,pInfo.NameStr); - Assert(methodData <> nil); - methodData.Exactly(times); - ClearSetupState; -end; - -function TProxy.Exactly(const times: Cardinal): IWhen; -begin - FSetupMode := TSetupMode.Expectation; - FNextExpectation := TExpectationType.ExactlyWhen; - FTimes := times; - result := TWhen.Create(Self.Proxy); -end; - -function TProxy.Expect: IExpect; -begin - result := Self as IExpect ; -end; - -function TProxy.GetBehaviorMustBeDefined: boolean; -begin - Result := FBehaviorMustBeDefined; -end; - -function TProxy.GetAllowRedefineBehaviorDefinitions : boolean; -begin - result := FAllowRedefineBehaviorDefinitions; -end; - -function TProxy.GetMethodData(const AMethodName: string; const ATypeName: string): IMethodData; -var - methodName : string; - pInfo : PTypeInfo; - setupParams: TSetupMethodDataParameters; -begin - methodName := LowerCase(AMethodName); - if FMethodData.TryGetValue(methodName,Result) then - exit; - - setupParams := TSetupMethodDataParameters.Create(FIsStubOnly, FBehaviorMustBeDefined, FAllowRedefineBehaviorDefinitions); - Result := TMethodData.Create(ATypeName, AMethodName, setupParams, FAutoMocker); - FMethodData.Add(methodName,Result); -end; - -function TProxy.QueryImplementedInterface(const IID: TGUID; out Obj): HRESULT; -var - virtualProxy : IProxy; -begin - Result := E_NOINTERFACE; - - if FQueryingInternalInterface then - Exit; - - FQueryingInternalInterface := True; - try - Result := FVirtualInterface.QueryInterface(IID, obj); - if Result = S_OK then - Exit; - - //Otherwise look in the list of interface proxies that might have been implemented - if (FInterfaceProxies.ContainsKey(IID)) then - begin - virtualProxy := FInterfaceProxies.Items[IID]; - Result := virtualProxy.ProxyInterface.QueryInterface(IID, Obj); - - if Result = S_OK then - Exit; - end; - - { $Message 'TODO: Need to query the parent, but exclude ourselves and any other children which have already been called.'} - - //Call the parent. - if FParentProxy <> nil then - begin - Result := FParentProxy.Data.QueryInterface(IID, obj); - if Result = S_OK then - Exit; - - Result := FParentProxy.Data.QueryImplementedInterface(IID, obj); - end; - finally - FQueryingInternalInterface := False; - end; -end; - -procedure TProxy.Never(const AMethodName: string); -var - methodData : IMethodData; - pInfo : PTypeInfo; -begin - pInfo := TypeInfo(T); - methodData := GetMethodData(AMethodName, pInfo.NameStr); - Assert(methodData <> nil); - methodData.Never; - ClearSetupState; -end; - -function TProxy.Never: IWhen; -begin - FSetupMode := TSetupMode.Expectation; - FNextExpectation := TExpectationType.NeverWhen; - result := TWhen.Create(Self.Proxy); -end; - -function TProxy.Once: IWhen; -begin - FSetupMode := TSetupMode.Expectation; - FNextExpectation := TExpectationType.OnceWhen; - result := TWhen.Create(Self.Proxy); -end; - -procedure TProxy.Once(const AMethodName: string); -var - methodData : IMethodData; - pInfo : PTypeInfo; -begin - pInfo := TypeInfo(T); - - methodData := GetMethodData(AMethodName,pInfo.NameStr); - Assert(methodData <> nil); - methodData.Once; - ClearSetupState; -end; - - -function TProxy.Proxy: T; -var - pInfo : PTypeInfo; - virtualProxy : IInterface; -begin - pInfo := TypeInfo(T); - - if FVirtualInterface = nil then - raise EMockNoProxyException.Create('Error casting to interface ' + pInfo.NameStr + ' , proxy does not appear to implememnt T'); - - if FVirtualInterface.QueryInterface(GetTypeData(pInfo).Guid, result) <> 0 then - raise EMockNoProxyException.Create('Error casting to interface ' + pInfo.NameStr + ' , proxy does not appear to implememnt T'); -end; - -function TProxy.QueryInterface(const IID: TGUID; out Obj): HRESULT; -begin - Result := E_NOINTERFACE; - - //If we are already querying this interface, leave. - if FQueryingInterface then - Exit; - - FQueryingInterface := True; - try - //The interface requested might be one of this classes interfaces. E.g. IProxy - if not (IID = IInterface) then - Result := inherited QueryInterface(IID, Obj); - - //If we have found the interface then return it. - if Result = S_OK then - Exit; - finally - FQueryingInterface := False; - end; -end; - -procedure TProxy.SetBehaviorMustBeDefined(const value: boolean); -begin - FBehaviorMustBeDefined := value; -end; - -procedure TProxy.SetAllowRedefineBehaviorDefinitions(const value : boolean); -begin - FAllowRedefineBehaviorDefinitions := value; -end; - -procedure TProxy.SetParentProxy(const AProxy : IProxy); -begin - FParentProxy := TWeakReference.Create(AProxy); -end; - -function TProxy.ProxyFromType(const ATypeInfo: PTypeInfo): IProxy; -var - interfaceID : TGUID; -begin - //Get the GUID of the type the proxy needs to support - interfaceID := GetTypeData(ATypeInfo).Guid; - - //If we support the passed in type then return ourselves. - if ProxySupports(FVirtualInterface, interfaceID) then - begin - Result := Self; - Exit; - end; - - //Are our children the proxy for this type? - if FInterfaceProxies.ContainsKey(interfaceID) then - begin - //Remember that the virtual interface will be of the passed in type, therefore - //return its proxy. - Result := FInterfaceProxies.Items[interfaceID].ProxyFromType(ATypeInfo); - Exit; - end; - - raise EMockNoProxyException.Create('Error - No Proxy of type [' + ATypeInfo.NameStr + '] was found'); -end; - -function TProxy.ProxySupports(const Instance: IInterface; const IID: TGUID): boolean; -begin - //We support the proxy if we have a virtual interface, which supports the passed in - //interface. As the virtual interface is built to support mulitple interfaces we - //need to ask it not check the other implementations. - Result := (FVirtualInterface <> nil) and Supports(FVirtualInterface, IID, False); -end; - -function TProxy.StubSetup: IStubSetup; -begin - result := Self; -end; - -function TProxy.SupportsIInterface: Boolean; -begin - Result := (FParentProxy = nil); -end; - -function TProxy.MockSetup: IMockSetup; -begin - result := Self; -end; - -function TProxy.ProxyInterface: IInterface; -var - pInfo : PTypeInfo; - virtualProxy : IInterface; -begin - pInfo := TypeInfo(T); - - if FVirtualInterface = nil then - raise EMockNoProxyException.Create('Error casting to interface ' + pInfo.NameStr + ' , proxy does not appear to implememnt T'); - - if FVirtualInterface.QueryInterface(GetTypeData(pInfo).Guid, result) <> 0 then - raise EMockNoProxyException.Create('Error casting to interface ' + pInfo.NameStr + ' , proxy does not appear to implememnt T'); -end; - -procedure TProxy.Verify(const message: string); -var - msg : string; -begin - msg := CheckExpectations; - if msg <> '' then - raise EMockVerificationException.Create(message + #13#10 + msg); - -end; - -function TProxy.WillExecute(const func: TExecuteFunc): IWhen; -begin - FSetupMode := TSetupMode.Behavior; - FNextBehavior := TBehaviorType.WillExecuteWhen; - FNextFunc := func; - result := TWhen.Create(Self.Proxy); -end; - -procedure TProxy.WillExecute(const AMethodName: string; const func: TExecuteFunc); -var - methodData : IMethodData; - pInfo : PTypeInfo; -begin - //actually record the behaviour here! - pInfo := TypeInfo(T); - methodData := GetMethodData(AMethodName,pInfo.NameStr); - Assert(methodData <> nil); - methodData.WillExecute(func); - ClearSetupState; -end; - -function TProxy.WillRaise(const exceptionClass: ExceptClass;const message : string): IWhen; -begin - FSetupMode := TSetupMode.Behavior; - FNextBehavior := TBehaviorType.WillRaiseAlways; - FExceptClass := exceptionClass; - FExceptionMessage := message; - result := TWhen.Create(Self.Proxy); -end; - -procedure TProxy.WillRaise(const AMethodName: string; const exceptionClass: ExceptClass;const message : string); -var - methodData : IMethodData; - pInfo : PTypeInfo; -begin - //actually record the behaviour here! - pInfo := TypeInfo(T); - methodData := GetMethodData(AMethodName, pInfo.NameStr); - Assert(methodData <> nil); - methodData.WillRaiseAlways(exceptionClass,message); - ClearSetupState; -end; - -function TProxy.WillRaiseWhen(const exceptionClass: ExceptClass; const message: string): IWhen; -begin - FSetupMode := TSetupMode.Behavior; - FNextBehavior := TBehaviorType.WillRaise; - FExceptClass := exceptionClass; - FExceptionMessage := message; - result := TWhen.Create(Self.Proxy); -end; - -function TProxy.WillReturn(const value: TValue): IWhen; -begin - FSetupMode := TSetupMode.Behavior; - FReturnValue := value; - FNextBehavior := TBehaviorType.WillReturn; - result := TWhen.Create(Self.Proxy); -end; - -function TProxy.WillReturn(const value: TValue; const AllowNil: Boolean): IWhen; -begin - FSetupMode := TSetupMode.Behavior; - FReturnValue := value; - FReturnValueNilAllowed := AllowNil; - FNextBehavior := TBehaviorType.WillReturn; - result := TWhen.Create(Self.Proxy); -end; - -procedure TProxy.WillReturnDefault(const AMethodName : string; const value : TValue); -var - methodData : IMethodData; - pInfo : PTypeInfo; -begin - //actually record the behaviour here! - pInfo := TypeInfo(T); - methodData := GetMethodData(AMethodName,pInfo.NameStr); - Assert(methodData <> nil); - methodData.WillReturnDefault(value); - ClearSetupState; -end; - -function TProxy.WillReturnNil: IWhen; -begin - FSetupMode := TSetupMode.Behavior; - FReturnValue := TValue.From(nil); - FReturnValueNilAllowed := True; - FNextBehavior := TBehaviorType.WillReturn; - result := TWhen.Create(Self.Proxy); -end; - -function TProxy._AddRef: Integer; -begin - result := inherited; -end; - -function TProxy._Release: Integer; -begin - result := inherited; -end; - -{ TProxy.TProxyVirtualInterface } - -constructor TProxy.TProxyVirtualInterface.Create(const AProxy : IProxy; - const AInterface: Pointer; const InvokeEvent: TVirtualInterfaceInvokeEvent); -begin - //Create a weak reference to our owner proxy. This is the proxy who implements - //all the mocking interfaces required to setup, and verify us. - FProxy := TWeakReference>.Create(AProxy); - - inherited Create(Ainterface, InvokeEvent); -end; - -function TProxy.TProxyVirtualInterface.QueryInterface(const IID: TGUID; out Obj): HRESULT; -begin - //The default query interface will ask the owner for the implementing virtual - //interface for the type being queried for. This allows a virtual interface of - //IInterfaceOne to support IInterfaceTwo when asked. Use this when looking for - //the implementing virtual interface, use QueryProxy when looking for the - //owning proxy of the implemented type. - Result := QueryInterfaceWithOwner(IID, Obj, True); -end; - -function TProxy.TProxyVirtualInterface.QueryInterfaceWithOwner(const IID: TGUID; out Obj; const ACheckOwner: Boolean): HRESULT; -begin - //See if we support the passed in interface. - - if IsEqualGUID(IID, IInterface) and not SupportsIInterface then - Result := E_NOINTERFACE - else - Result := inherited QueryInterface(IID, Obj); - - //If we don't support the interface, then we need to look to our owner to see - //who does implement it. This allows for a single proxy to implement multiple - //interfaces at once. - if (ACheckOwner) and (Result <> 0) then - begin - if FProxy <> nil then - Result := FProxy.Data.QueryImplementedInterface(IID, Obj); - end; -end; - -function TProxy.TProxyVirtualInterface.QueryInterfaceWithOwner(const IID: TGUID; const ACheckOwner: Boolean): HRESULT; -var - dud : IInterface; -begin - Result := QueryInterfaceWithOwner(IID, dud, ACheckOwner); -end; - -function TProxy.TProxyVirtualInterface.QueryProxy(const IID: TGUID; out Obj : IProxy): HRESULT; -begin - Result := E_NOINTERFACE; - //If this virtual proxy (and only this virtual proxy) supports the passed in - //interface, return the proxy who owns us. - if QueryInterfaceWithOwner(IID, Obj, False) <> 0 then - Result := FProxy.QueryInterface(IProxy, Obj); -end; - -function TProxy.TProxyVirtualInterface.SupportsIInterface: Boolean; -begin - if FProxy <> nil then - Result := FProxy.Data.SupportsIInterface - else - Result := True; -end; - -procedure TProxy.VerifyAll(const message: string); -var - proxy : IProxy; - interfaceV : IVerify; -begin - //Verify ourselves. - Verify; - - //Now verify all our children. - for proxy in FInterfaceProxies.Values.ToArray do - if Supports(proxy, IVerify, interfaceV) then - interfaceV.Verify(message); -end; - -end. +{***************************************************************************} +{ } +{ Delphi.Mocks } +{ } +{ Copyright (C) 2011 Vincent Parrett } +{ } +{ 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 Delphi.Mocks.Proxy; + +interface + +uses + Rtti, + SysUtils, + TypInfo, + Generics.Collections, + Delphi.Mocks, + Delphi.Mocks.WeakReference, + Delphi.Mocks.Interfaces, + Delphi.Mocks.Behavior; + + {$I 'Delphi.Mocks.inc'} + +type + TProxyBaseInvokeEvent = procedure (Method: TRttiMethod; const Args: TArray; out Result: TValue) of object; + + TSetupMode = (None, Behavior, Expectation); + + {$IFOPT M+} + {$M-} + {$DEFINE ENABLED_M+} + {$ENDIF} + IProxyVirtualInterface = interface + ['{A0394EB0-245E-4AE6-AD71-3BC9815CD173}'] + function QueryProxy(const IID: TGUID; out Obj : IProxy) : HRESULT; + function QueryInterfaceWithOwner(const IID: TGUID; out Obj; const ACheckOwner : Boolean): HRESULT; overload; + function QueryInterfaceWithOwner(const IID: TGUID; const ACheckOwner : Boolean): HRESULT; overload; + end; + {$IFDEF ENABLED_M+} + {$M+} + {$ENDIF} + + TProxy = class(TWeakReferencedObject, IWeakReferenceableObject, IInterface, IProxy, IProxy, IStubProxy, IMockSetup, IStubSetup, IExpect, IVerify) + private + //Implements members. + //Can't define TProxy or any other generic type as that type will be defined at runtime. + FParentProxy : IWeakReference; + FInterfaceProxies : TDictionary; + + FVirtualInterface : IProxyVirtualInterface; + FName : string; + + FMethodData : TDictionary; + FBehaviorMustBeDefined : Boolean; + FAllowRedefineBehaviorDefinitions : Boolean; + FSetupMode : TSetupMode; + //behavior setup + FNextBehavior : TBehaviorType; + FReturnValue : TValue; + FReturnValueNilAllowed : Boolean; + FNextFunc : TExecuteFunc; + FExceptClass : ExceptClass; + FExceptionMessage : string; + //expectation setup + FNextExpectation : TExpectationType; + FTimes : Cardinal; + FBetween : array[0..1] of Cardinal; + FIsStubOnly : boolean; + + FQueryingInterface : boolean; + FQueryingInternalInterface : boolean; + FAutoMocker : IAutoMock; + + protected type + TProxyVirtualInterface = class(TVirtualInterface, IInterface, IProxyVirtualInterface) + private + FProxy : IWeakReference>; + function SupportsIInterface: Boolean; + protected + //IProxyVirtualInterface + function QueryProxy(const IID: TGUID; out Obj : IProxy) : HRESULT; + function QueryInterfaceWithOwner(const IID: TGUID; out Obj; const ACheckOwner : Boolean): HRESULT; overload; + function QueryInterfaceWithOwner(const IID: TGUID; const ACheckOwner : Boolean): HRESULT; overload; + public + //TVirtualInterface overrides + constructor Create(const AProxy : IProxy; const AInterface: Pointer; const InvokeEvent: TVirtualInterfaceInvokeEvent); + function QueryInterface(const IID: TGUID; out Obj): HRESULT; override; stdcall; + end; + + protected + procedure SetParentProxy(const AProxy : IProxy); + function SupportsIInterface: Boolean; + + function QueryImplementedInterface(const IID: TGUID; out Obj): HRESULT; stdcall; + function QueryInterface(const IID: TGUID; out Obj): HRESULT; virtual; stdcall; + function _AddRef: Integer; override; stdcall; + function _Release: Integer; override; stdcall; + + //IProxy + function ProxyInterface : IInterface; + + function ProxySupports(const Instance: IInterface; const IID: TGUID) : boolean; virtual; + function ProxyFromType(const ATypeInfo : PTypeInfo) : IProxy; virtual; + procedure AddImplement(const AProxy : IProxy; const ATypeInfo : PTypeInfo); virtual; + + //IProxy + function MockSetup : IMockSetup; + function StubSetup : IStubSetup; + + function IProxy.Setup = MockSetup; + function IStubProxy.Setup = StubSetup; + + function Proxy : T; virtual; + + //ISetup + function GetBehaviorMustBeDefined : boolean; + procedure SetBehaviorMustBeDefined(const value : boolean); + function GetAllowRedefineBehaviorDefinitions : boolean; + procedure SetAllowRedefineBehaviorDefinitions(const value : boolean); + + function Expect : IExpect; + + {$Message 'TODO: Implement ISetup.Before and ISetup.After.'} + function WillReturn(const value : TValue) : IWhen; overload; + function WillReturn(const value : TValue; const AllowNil: Boolean) : IWhen; overload; + procedure WillReturnDefault(const AMethodName : string; const value : TValue); + function WillReturnNil: IWhen; + function WillRaise(const exceptionClass : ExceptClass; const message : string = '') : IWhen; overload; + procedure WillRaise(const AMethodName : string; const exceptionClass : ExceptClass; const message : string = ''); overload; + + function WillRaiseWhen(const exceptionClass : ExceptClass; const message : string = '') : IWhen; + + function WillExecute(const func : TExecuteFunc) : IWhen; overload; + procedure WillExecute(const AMethodName : string; const func : TExecuteFunc); overload; + + procedure DoInvoke(Method: TRttiMethod; const Args: TArray; out Result: TValue); + + //IVerify + procedure Verify(const message : string = ''); + procedure VerifyAll(const message : string = ''); + + function CheckExpectations: string; + + function GetMethodData(const AMethodName : string; const ATypeName: string) : IMethodData; overload; + + procedure ClearSetupState; + + //IExpect + function Once : IWhen;overload; + procedure Once(const AMethodName : string);overload; + + function Never : IWhen;overload; + procedure Never(const AMethodName : string);overload; + + function AtLeastOnce : IWhen;overload; + procedure AtLeastOnce(const AMethodName : string);overload; + + function AtLeast(const times : Cardinal) : IWhen;overload; + procedure AtLeast(const AMethodName : string; const times : Cardinal);overload; + + function AtMost(const times : Cardinal) : IWhen;overload; + procedure AtMost(const AMethodName : string; const times : Cardinal);overload; + + function Between(const a,b : Cardinal) : IWhen;overload; + procedure Between(const AMethodName : string; const a,b : Cardinal);overload; + + function Exactly(const times : Cardinal) : IWhen;overload; + procedure Exactly(const AMethodName : string; const times : Cardinal);overload; + + function Before(const AMethodName : string) : IWhen;overload; + procedure Before(const AMethodName : string; const ABeforeMethodName : string);overload; + + function After(const AMethodName : string) : IWhen;overload; + procedure After(const AMethodName : string; const AAfterMethodName : string);overload; + public + constructor Create(const AAutoMocker : IAutoMock = nil; const AIsStubOnly : boolean = false); virtual; + destructor Destroy; override; + end; + +function Supports(const Instance: IProxyVirtualInterface; const IID: TGUID; out Intf; const ACheckOwner: Boolean): Boolean; overload; +function Supports(const Instance: IProxyVirtualInterface; const IID: TGUID; const ACheckOwner: Boolean): Boolean; overload; +function MethodKindToStr(const AMethodKind : TMethodKind) : string; + +implementation + +uses + Delphi.Mocks.Utils, + Delphi.Mocks.When, + Delphi.Mocks.MethodData, + Delphi.Mocks.ParamMatcher; + +function Supports(const Instance: IProxyVirtualInterface; const IID: TGUID; out Intf; const ACheckOwner: Boolean): Boolean; +begin + //See if we support the passed in interface. Passed on whether we need to check + //the owner for the implementation as well. + Result := (Instance <> nil) and (Instance.QueryInterfaceWithOwner(IID, Intf, ACheckOwner) = 0); +end; + +function Supports(const Instance: IProxyVirtualInterface; const IID: TGUID; const ACheckOwner: Boolean): Boolean; overload; +begin + //See if we support the passed in interface. Passed on whether we need to check + //the owner for the implementation as well. + Result := (Instance <> nil) and (Instance.QueryInterfaceWithOwner(IID, ACheckOwner) = 0); +end; + +function MethodKindToStr(const AMethodKind : TMethodKind) : string; +begin + case AMethodKind of + mkProcedure: Result := 'Procedure'; + mkFunction: Result := 'Function'; + mkConstructor: Result := 'Constructor'; + mkDestructor: Result := 'Destructor'; + mkClassProcedure: Result := 'Class Procedure'; + mkClassFunction: Result := 'Class Function'; + mkClassConstructor: Result := 'Class Constructor'; + mkClassDestructor: Result := 'Class Destructor'; + mkOperatorOverload: Result := 'Operator Overload'; + mkSafeProcedure: Result := 'Safe Procedure'; + mkSafeFunction: Result := 'Safe Function'; + else + raise Exception.CreateFmt('Unexpected method kind passed to [%s]', [Ord(AMethodKind)]); + end; +end; +{ TProxyBase } + +procedure TProxy.AddImplement(const AProxy: IProxy; const ATypeInfo : PTypeInfo); +begin + + if FInterfaceProxies.ContainsKey(GetTypeData(ATypeInfo).Guid) then + raise EMockProxyAlreadyImplemented.Create('The mock already implements ' + ATypeInfo.NameStr); + + FInterfaceProxies.Add(GetTypeData(ATypeInfo).Guid, AProxy); + AProxy.SetParentProxy(Self); +end; + +procedure TProxy.After(const AMethodName, AAfterMethodName: string); +begin + raise Exception.Create('Not implemented'); +end; + +function TProxy.After(const AMethodName: string): IWhen; +begin + raise Exception.Create('Not implemented'); +end; + +procedure TProxy.AtLeast(const AMethodName: string; const times: Cardinal); +var + methodData : IMethodData; + pInfo : PTypeInfo; +begin + pInfo := TypeInfo(T); + methodData := GetMethodData(AMethodName, pInfo.NameStr); + Assert(methodData <> nil); + methodData.AtLeast(times); + ClearSetupState; +end; + +function TProxy.AtLeast(const times: Cardinal): IWhen; +begin + FSetupMode := TSetupMode.Expectation; + FNextExpectation := TExpectationType.AtLeastWhen; + FTimes := times; + result := TWhen.Create(Self.Proxy); +end; + +procedure TProxy.AtLeastOnce(const AMethodName: string); +var + methodData : IMethodData; + pInfo : PTypeInfo; +begin + pInfo := TypeInfo(T); + methodData := GetMethodData(AMethodName,pInfo.NameStr); + Assert(methodData <> nil); + methodData.AtLeastOnce; + ClearSetupState; +end; + +function TProxy.AtLeastOnce: IWhen; +begin + FSetupMode := TSetupMode.Expectation; + FNextExpectation := TExpectationType.AtLeastOnceWhen; + FTimes := 1; + result := TWhen.Create(Self.Proxy); +end; + +procedure TProxy.AtMost(const AMethodName: string; const times: Cardinal); +var + methodData : IMethodData; + pInfo : PTypeInfo; +begin + pInfo := TypeInfo(T); + methodData := GetMethodData(AMethodName, pInfo.NameStr); + Assert(methodData <> nil); + methodData.AtMost(times); + ClearSetupState; +end; + +function TProxy.AtMost(const times: Cardinal): IWhen; +begin + FSetupMode := TSetupMode.Expectation; + FNextExpectation := TExpectationType.AtMostWhen; + FTimes := times; + result := TWhen.Create(Self.Proxy); +end; + +procedure TProxy.Before(const AMethodName, ABeforeMethodName: string); +begin + raise Exception.Create('not implemented'); +end; + +function TProxy.Before(const AMethodName: string): IWhen; +begin + raise Exception.Create('not implemented'); +end; + +procedure TProxy.Between(const AMethodName: string; const a, b: Cardinal); +var + methodData : IMethodData; + pInfo : PTypeInfo; +begin + pInfo := TypeInfo(T); + methodData := GetMethodData(AMethodName,pInfo.NameStr); + Assert(methodData <> nil); + methodData.Between(a,b); + ClearSetupState; +end; + +function TProxy.Between(const a, b: Cardinal): IWhen; +begin + FSetupMode := TSetupMode.Expectation; + FNextExpectation := TExpectationType.BetweenWhen; + FBetween[0] := a; + FBetween[1] := b; + result := TWhen.Create(Self.Proxy); + +end; + +function TProxy.CheckExpectations: string; +var + methodData : IMethodData; + report : string; +begin + Result := ''; + for methodData in FMethodData.Values do + begin + report := ''; + if not methodData.Verify(report) then + begin + if Result <> '' then + Result := Result + #13#10; + Result := Result + report ; + end; + end; +end; + +procedure TProxy.ClearSetupState; +begin + FSetupMode := TSetupMode.None; + FReturnValue := TValue.Empty; + FExceptClass := nil; + FNextFunc := nil; +end; + +constructor TProxy.Create(const AAutoMocker : IAutoMock; const AIsStubOnly : boolean); +var + pInfo : PTypeInfo; +begin + inherited Create; + + FAutoMocker := AAutoMocker; + FParentProxy := nil; + FVirtualInterface := nil; + + FSetupMode := TSetupMode.None; + FBehaviorMustBeDefined := False; + FMethodData := TDictionary.Create; + FIsStubOnly := AIsStubOnly; + + FInterfaceProxies := TDictionary.Create; + + pInfo := TypeInfo(T); + + case pInfo.Kind of + //Create our proxy interface object, which will implement our interface T + tkInterface : + begin + FVirtualInterface := TProxyVirtualInterface.Create(Self, TypeInfo(T), Self.DoInvoke); + + end; + end; + + FName := pInfo.NameStr; +end; + +destructor TProxy.Destroy; +begin + FVirtualInterface := nil; + + FMethodData.Clear; + FMethodData.Free; + FInterfaceProxies.Clear; + FInterfaceProxies.Free; + + FParentProxy := nil; + + inherited; +end; + +procedure TProxy.DoInvoke(Method: TRttiMethod; const Args: TArray; out Result: TValue); +var + returnVal : TValue; + methodData : IMethodData; + behavior : IBehavior; + pInfo : PTypeInfo; + matchers : TArray; +begin + pInfo := TypeInfo(T); + + case FSetupMode of + TSetupMode.None: + begin + //record actual behavior + methodData := GetMethodData(method.Name,pInfo.NameStr); + Assert(methodData <> nil); + + methodData.RecordHit(Args,Method.ReturnType,Result); + end; + TSetupMode.Behavior: + begin + try + matchers := TMatcherFactory.GetMatchers; + if Length(matchers) > 0 then + if Length(matchers) < Length(Args) -1 then + raise EMockSetupException.Create('Setup called with Matchers but on all parameters : ' + Method.Name ); + //record desired behavior + //first see if we know about this method + methodData := GetMethodData(method.Name,pInfo.NameStr); + Assert(methodData <> nil); + case FNextBehavior of + TBehaviorType.WillReturn: + begin + case Method.MethodKind of + mkProcedure, + mkDestructor, + mkClassProcedure, + mkClassDestructor, + mkSafeProcedure : raise EMockSetupException.CreateFmt('Setup.WillReturn called on [%s] method [%s] which does not have a return value.', [MethodKindToStr(Method.MethodKind), Method.Name]); + + //Method kinds which have a return value. + mkFunction, mkConstructor, mkClassFunction, + mkClassConstructor, mkOperatorOverload, mkSafeFunction: ; + end; + + //We don't test for the return type being valid as XE5 and below have a RTTI bug which does not return + //a return type for function which reference their own class/interface. Even when RTTI is specified on + //the declaration and forward declaration. + if (FReturnValue.IsEmpty and not FReturnValueNilAllowed) or + (FReturnValueNilAllowed and ((FReturnValue.TypeInfo = nil) or (FReturnValue.TypeData = nil))) then + raise EMockSetupException.CreateFmt('Setup.WillReturn call on method [%s] was not passed a return value.', [Method.Name]); + + methodData.WillReturnWhen(Args,FReturnValue,matchers); + end; + TBehaviorType.WillRaise: + begin + methodData.WillRaiseWhen(FExceptClass, FExceptionMessage, Args, matchers); + end; + TBehaviorType.WillRaiseAlways: + begin + methodData.WillRaiseAlways(FExceptClass,FExceptionMessage); + end; + TBehaviorType.WillExecuteWhen : + begin + methodData.WillExecuteWhen(FNextFunc,Args,matchers); + end; + end; + finally + ClearSetupState; + end; + end; + TSetupMode.Expectation: + begin + try + //record expectations + //first see if we know about this method + methodData := GetMethodData(method.Name, pInfo.NameStr); + Assert(methodData <> nil); + + matchers := TMatcherFactory.GetMatchers; + + case FNextExpectation of + OnceWhen : methodData.OnceWhen(Args, matchers); + NeverWhen : methodData.NeverWhen(Args, matchers) ; + AtLeastOnceWhen : methodData.AtLeastOnceWhen(Args, matchers); + AtLeastWhen : methodData.AtLeastWhen(FTimes, args, matchers); + AtMostOnceWhen : methodData.AtLeastOnceWhen(Args, matchers); + AtMostWhen : methodData.AtMostWhen(FTimes, args, matchers); + BetweenWhen : methodData.BetweenWhen(FBetween[0], FBetween[1],Args, matchers); + ExactlyWhen : methodData.ExactlyWhen(FTimes, Args, matchers); + BeforeWhen : raise exception.Create('not implemented') ; + AfterWhen : raise exception.Create('not implemented'); + end; + + finally + ClearSetupState; + end; + end; + end; + +end; + +procedure TProxy.Exactly(const AMethodName: string; const times: Cardinal); +var + methodData : IMethodData; + pInfo : PTypeInfo; +begin + pInfo := TypeInfo(T); + methodData := GetMethodData(AMethodName,pInfo.NameStr); + Assert(methodData <> nil); + methodData.Exactly(times); + ClearSetupState; +end; + +function TProxy.Exactly(const times: Cardinal): IWhen; +begin + FSetupMode := TSetupMode.Expectation; + FNextExpectation := TExpectationType.ExactlyWhen; + FTimes := times; + result := TWhen.Create(Self.Proxy); +end; + +function TProxy.Expect: IExpect; +begin + result := Self as IExpect ; +end; + +function TProxy.GetBehaviorMustBeDefined: boolean; +begin + Result := FBehaviorMustBeDefined; +end; + +function TProxy.GetAllowRedefineBehaviorDefinitions : boolean; +begin + result := FAllowRedefineBehaviorDefinitions; +end; + +function TProxy.GetMethodData(const AMethodName: string; const ATypeName: string): IMethodData; +var + methodName : string; + pInfo : PTypeInfo; + setupParams: TSetupMethodDataParameters; +begin + methodName := LowerCase(AMethodName); + if FMethodData.TryGetValue(methodName,Result) then + exit; + + setupParams := TSetupMethodDataParameters.Create(FIsStubOnly, FBehaviorMustBeDefined, FAllowRedefineBehaviorDefinitions); + Result := TMethodData.Create(ATypeName, AMethodName, setupParams, FAutoMocker); + FMethodData.Add(methodName,Result); +end; + +function TProxy.QueryImplementedInterface(const IID: TGUID; out Obj): HRESULT; +var + virtualProxy : IProxy; +begin + Result := E_NOINTERFACE; + + if FQueryingInternalInterface then + Exit; + + FQueryingInternalInterface := True; + try + Result := FVirtualInterface.QueryInterface(IID, obj); + if Result = S_OK then + Exit; + + //Otherwise look in the list of interface proxies that might have been implemented + if (FInterfaceProxies.ContainsKey(IID)) then + begin + virtualProxy := FInterfaceProxies.Items[IID]; + Result := virtualProxy.ProxyInterface.QueryInterface(IID, Obj); + + if Result = S_OK then + Exit; + end; + + { $Message 'TODO: Need to query the parent, but exclude ourselves and any other children which have already been called.'} + + //Call the parent. + if FParentProxy <> nil then + begin + Result := FParentProxy.Data.QueryInterface(IID, obj); + if Result = S_OK then + Exit; + + Result := FParentProxy.Data.QueryImplementedInterface(IID, obj); + end; + finally + FQueryingInternalInterface := False; + end; +end; + +procedure TProxy.Never(const AMethodName: string); +var + methodData : IMethodData; + pInfo : PTypeInfo; +begin + pInfo := TypeInfo(T); + methodData := GetMethodData(AMethodName, pInfo.NameStr); + Assert(methodData <> nil); + methodData.Never; + ClearSetupState; +end; + +function TProxy.Never: IWhen; +begin + FSetupMode := TSetupMode.Expectation; + FNextExpectation := TExpectationType.NeverWhen; + result := TWhen.Create(Self.Proxy); +end; + +function TProxy.Once: IWhen; +begin + FSetupMode := TSetupMode.Expectation; + FNextExpectation := TExpectationType.OnceWhen; + result := TWhen.Create(Self.Proxy); +end; + +procedure TProxy.Once(const AMethodName: string); +var + methodData : IMethodData; + pInfo : PTypeInfo; +begin + pInfo := TypeInfo(T); + + methodData := GetMethodData(AMethodName,pInfo.NameStr); + Assert(methodData <> nil); + methodData.Once; + ClearSetupState; +end; + + +function TProxy.Proxy: T; +var + pInfo : PTypeInfo; + virtualProxy : IInterface; +begin + pInfo := TypeInfo(T); + + if FVirtualInterface = nil then + raise EMockNoProxyException.Create('Error casting to interface ' + pInfo.NameStr + ' , proxy does not appear to implememnt T'); + + if FVirtualInterface.QueryInterface(GetTypeData(pInfo).Guid, result) <> 0 then + raise EMockNoProxyException.Create('Error casting to interface ' + pInfo.NameStr + ' , proxy does not appear to implememnt T'); +end; + +function TProxy.QueryInterface(const IID: TGUID; out Obj): HRESULT; +begin + Result := E_NOINTERFACE; + + //If we are already querying this interface, leave. + if FQueryingInterface then + Exit; + + FQueryingInterface := True; + try + //The interface requested might be one of this classes interfaces. E.g. IProxy + if not (IID = IInterface) then + Result := inherited QueryInterface(IID, Obj); + + //If we have found the interface then return it. + if Result = S_OK then + Exit; + finally + FQueryingInterface := False; + end; +end; + +procedure TProxy.SetBehaviorMustBeDefined(const value: boolean); +begin + FBehaviorMustBeDefined := value; +end; + +procedure TProxy.SetAllowRedefineBehaviorDefinitions(const value : boolean); +begin + FAllowRedefineBehaviorDefinitions := value; +end; + +procedure TProxy.SetParentProxy(const AProxy : IProxy); +begin + FParentProxy := TWeakReference.Create(AProxy); +end; + +function TProxy.ProxyFromType(const ATypeInfo: PTypeInfo): IProxy; +var + interfaceID : TGUID; +begin + //Get the GUID of the type the proxy needs to support + interfaceID := GetTypeData(ATypeInfo).Guid; + + //If we support the passed in type then return ourselves. + if ProxySupports(FVirtualInterface, interfaceID) then + begin + Result := Self; + Exit; + end; + + //Are our children the proxy for this type? + if FInterfaceProxies.ContainsKey(interfaceID) then + begin + //Remember that the virtual interface will be of the passed in type, therefore + //return its proxy. + Result := FInterfaceProxies.Items[interfaceID].ProxyFromType(ATypeInfo); + Exit; + end; + + raise EMockNoProxyException.Create('Error - No Proxy of type [' + ATypeInfo.NameStr + '] was found'); +end; + +function TProxy.ProxySupports(const Instance: IInterface; const IID: TGUID): boolean; +begin + //We support the proxy if we have a virtual interface, which supports the passed in + //interface. As the virtual interface is built to support mulitple interfaces we + //need to ask it not check the other implementations. + Result := (FVirtualInterface <> nil) and Supports(FVirtualInterface, IID, False); +end; + +function TProxy.StubSetup: IStubSetup; +begin + result := Self; +end; + +function TProxy.SupportsIInterface: Boolean; +begin + Result := (FParentProxy = nil); +end; + +function TProxy.MockSetup: IMockSetup; +begin + result := Self; +end; + +function TProxy.ProxyInterface: IInterface; +var + pInfo : PTypeInfo; + virtualProxy : IInterface; +begin + pInfo := TypeInfo(T); + + if FVirtualInterface = nil then + raise EMockNoProxyException.Create('Error casting to interface ' + pInfo.NameStr + ' , proxy does not appear to implememnt T'); + + if FVirtualInterface.QueryInterface(GetTypeData(pInfo).Guid, result) <> 0 then + raise EMockNoProxyException.Create('Error casting to interface ' + pInfo.NameStr + ' , proxy does not appear to implememnt T'); +end; + +procedure TProxy.Verify(const message: string); +var + msg : string; +begin + msg := CheckExpectations; + if msg <> '' then + raise EMockVerificationException.Create(message + #13#10 + msg); + +end; + +function TProxy.WillExecute(const func: TExecuteFunc): IWhen; +begin + FSetupMode := TSetupMode.Behavior; + FNextBehavior := TBehaviorType.WillExecuteWhen; + FNextFunc := func; + result := TWhen.Create(Self.Proxy); +end; + +procedure TProxy.WillExecute(const AMethodName: string; const func: TExecuteFunc); +var + methodData : IMethodData; + pInfo : PTypeInfo; +begin + //actually record the behaviour here! + pInfo := TypeInfo(T); + methodData := GetMethodData(AMethodName,pInfo.NameStr); + Assert(methodData <> nil); + methodData.WillExecute(func); + ClearSetupState; +end; + +function TProxy.WillRaise(const exceptionClass: ExceptClass;const message : string): IWhen; +begin + FSetupMode := TSetupMode.Behavior; + FNextBehavior := TBehaviorType.WillRaiseAlways; + FExceptClass := exceptionClass; + FExceptionMessage := message; + result := TWhen.Create(Self.Proxy); +end; + +procedure TProxy.WillRaise(const AMethodName: string; const exceptionClass: ExceptClass;const message : string); +var + methodData : IMethodData; + pInfo : PTypeInfo; +begin + //actually record the behaviour here! + pInfo := TypeInfo(T); + methodData := GetMethodData(AMethodName, pInfo.NameStr); + Assert(methodData <> nil); + methodData.WillRaiseAlways(exceptionClass,message); + ClearSetupState; +end; + +function TProxy.WillRaiseWhen(const exceptionClass: ExceptClass; const message: string): IWhen; +begin + FSetupMode := TSetupMode.Behavior; + FNextBehavior := TBehaviorType.WillRaise; + FExceptClass := exceptionClass; + FExceptionMessage := message; + result := TWhen.Create(Self.Proxy); +end; + +function TProxy.WillReturn(const value: TValue): IWhen; +begin + FSetupMode := TSetupMode.Behavior; + FReturnValue := value; + FNextBehavior := TBehaviorType.WillReturn; + result := TWhen.Create(Self.Proxy); +end; + +function TProxy.WillReturn(const value: TValue; const AllowNil: Boolean): IWhen; +begin + FSetupMode := TSetupMode.Behavior; + FReturnValue := value; + FReturnValueNilAllowed := AllowNil; + FNextBehavior := TBehaviorType.WillReturn; + result := TWhen.Create(Self.Proxy); +end; + +procedure TProxy.WillReturnDefault(const AMethodName : string; const value : TValue); +var + methodData : IMethodData; + pInfo : PTypeInfo; +begin + //actually record the behaviour here! + pInfo := TypeInfo(T); + methodData := GetMethodData(AMethodName,pInfo.NameStr); + Assert(methodData <> nil); + methodData.WillReturnDefault(value); + ClearSetupState; +end; + +function TProxy.WillReturnNil: IWhen; +begin + FSetupMode := TSetupMode.Behavior; + FReturnValue := TValue.From(nil); + FReturnValueNilAllowed := True; + FNextBehavior := TBehaviorType.WillReturn; + result := TWhen.Create(Self.Proxy); +end; + +function TProxy._AddRef: Integer; +begin + result := inherited; +end; + +function TProxy._Release: Integer; +begin + result := inherited; +end; + +{ TProxy.TProxyVirtualInterface } + +constructor TProxy.TProxyVirtualInterface.Create(const AProxy : IProxy; + const AInterface: Pointer; const InvokeEvent: TVirtualInterfaceInvokeEvent); +begin + //Create a weak reference to our owner proxy. This is the proxy who implements + //all the mocking interfaces required to setup, and verify us. + FProxy := TWeakReference>.Create(AProxy); + + inherited Create(Ainterface, InvokeEvent); +end; + +function TProxy.TProxyVirtualInterface.QueryInterface(const IID: TGUID; out Obj): HRESULT; +begin + //The default query interface will ask the owner for the implementing virtual + //interface for the type being queried for. This allows a virtual interface of + //IInterfaceOne to support IInterfaceTwo when asked. Use this when looking for + //the implementing virtual interface, use QueryProxy when looking for the + //owning proxy of the implemented type. + Result := QueryInterfaceWithOwner(IID, Obj, True); +end; + +function TProxy.TProxyVirtualInterface.QueryInterfaceWithOwner(const IID: TGUID; out Obj; const ACheckOwner: Boolean): HRESULT; +begin + //See if we support the passed in interface. + + if IsEqualGUID(IID, IInterface) and not SupportsIInterface then + Result := E_NOINTERFACE + else + Result := inherited QueryInterface(IID, Obj); + + //If we don't support the interface, then we need to look to our owner to see + //who does implement it. This allows for a single proxy to implement multiple + //interfaces at once. + if (ACheckOwner) and (Result <> 0) then + begin + if FProxy <> nil then + Result := FProxy.Data.QueryImplementedInterface(IID, Obj); + end; +end; + +function TProxy.TProxyVirtualInterface.QueryInterfaceWithOwner(const IID: TGUID; const ACheckOwner: Boolean): HRESULT; +var + dud : IInterface; +begin + Result := QueryInterfaceWithOwner(IID, dud, ACheckOwner); +end; + +function TProxy.TProxyVirtualInterface.QueryProxy(const IID: TGUID; out Obj : IProxy): HRESULT; +begin + Result := E_NOINTERFACE; + //If this virtual proxy (and only this virtual proxy) supports the passed in + //interface, return the proxy who owns us. + if QueryInterfaceWithOwner(IID, Obj, False) <> 0 then + Result := FProxy.QueryInterface(IProxy, Obj); +end; + +function TProxy.TProxyVirtualInterface.SupportsIInterface: Boolean; +begin + if FProxy <> nil then + Result := FProxy.Data.SupportsIInterface + else + Result := True; +end; + +procedure TProxy.VerifyAll(const message: string); +var + proxy : IProxy; + interfaceV : IVerify; +begin + //Verify ourselves. + Verify; + + //Now verify all our children. + for proxy in FInterfaceProxies.Values.ToArray do + if Supports(proxy, IVerify, interfaceV) then + interfaceV.Verify(message); +end; + +end. diff --git a/Delphi.Mocks.ReturnTypePatch.pas b/Source/Delphi.Mocks.ReturnTypePatch.pas similarity index 100% rename from Delphi.Mocks.ReturnTypePatch.pas rename to Source/Delphi.Mocks.ReturnTypePatch.pas diff --git a/Delphi.Mocks.Utils.pas b/Source/Delphi.Mocks.Utils.pas similarity index 100% rename from Delphi.Mocks.Utils.pas rename to Source/Delphi.Mocks.Utils.pas diff --git a/Delphi.Mocks.Validation.pas b/Source/Delphi.Mocks.Validation.pas similarity index 100% rename from Delphi.Mocks.Validation.pas rename to Source/Delphi.Mocks.Validation.pas diff --git a/Delphi.Mocks.VirtualInterface.pas b/Source/Delphi.Mocks.VirtualInterface.pas similarity index 100% rename from Delphi.Mocks.VirtualInterface.pas rename to Source/Delphi.Mocks.VirtualInterface.pas diff --git a/Delphi.Mocks.VirtualMethodInterceptor.pas b/Source/Delphi.Mocks.VirtualMethodInterceptor.pas similarity index 100% rename from Delphi.Mocks.VirtualMethodInterceptor.pas rename to Source/Delphi.Mocks.VirtualMethodInterceptor.pas diff --git a/Delphi.Mocks.WeakReference.pas b/Source/Delphi.Mocks.WeakReference.pas similarity index 100% rename from Delphi.Mocks.WeakReference.pas rename to Source/Delphi.Mocks.WeakReference.pas diff --git a/Delphi.Mocks.When.pas b/Source/Delphi.Mocks.When.pas similarity index 100% rename from Delphi.Mocks.When.pas rename to Source/Delphi.Mocks.When.pas diff --git a/Delphi.Mocks.inc b/Source/Delphi.Mocks.inc similarity index 90% rename from Delphi.Mocks.inc rename to Source/Delphi.Mocks.inc index 1ac8162..5910d56 100644 --- a/Delphi.Mocks.inc +++ b/Source/Delphi.Mocks.inc @@ -39,6 +39,7 @@ Unsupported Compiler Version (Delphi 2010 or later required!) {$ENDIF} +{$DEFINE DELPHI_XE104_DOWN} {$DEFINE DELPHI_XE103_DOWN} {$DEFINE DELPHI_XE102_DOWN} {$DEFINE DELPHI_XE101_DOWN} @@ -310,4 +311,38 @@ {$UNDEF DELPHI_XE102_DOWN} {$ENDIF VER330} - +{$IFDEF VER340} // RAD Studio 10.4 + {$DEFINE DELPHI_2010_UP} + {$DEFINE DELPHI_XE_UP} + {$DEFINE DELPHI_XE2_UP} + {$DEFINE DELPHI_XE3_UP} + {$DEFINE DELPHI_XE4_UP} + {$DEFINE DELPHI_XE5_UP} + {$DEFINE DELPHI_XE6_UP} + {$DEFINE DELPHI_XE7} + {$DEFINE DELPHI_XE7_UP} + {$DEFINE DELPHI_XE8_UP} + {$DEFINE DELPHIX_SEATTLE_UP} + {$DEFINE DELPHIX_SEATTLE} + {$DEFINE DELPHI_XE10_UP} + {$DEFINE DELPHI_XE101_UP} + {$DEFINE DELPHI_XE102_UP} + {$DEFINE DELPHI_XE103_UP} + {$DEFINE DELPHI_XE104_UP} + {$DEFINE DELPHI_XE103} + {$DEFINE SUPPORTS_REGEX} + {$DEFINE USE_NS} + {$UNDEF DELPHI_2010_DOWN} + {$UNDEF DELPHI_XE_DOWN} + {$UNDEF DELPHI_XE2_DOWN} + {$UNDEF DELPHI_XE3_DOWN} + {$UNDEF DELPHI_XE4_DOWN} + {$UNDEF DELPHI_XE5_DOWN} + {$UNDEF DELPHI_XE6_DOWN} + {$UNDEF DELPHI_XE7_DOWN} + {$UNDEF DELPHI_XE8_DOWN} + {$UNDEF DELPHI_XE10_DOWN} + {$UNDEF DELPHI_XE101_DOWN} + {$UNDEF DELPHI_XE102_DOWN} + {$UNDEF DELPHI_XE103_DOWN} +{$ENDIF VER340} diff --git a/Delphi.Mocks.pas b/Source/Delphi.Mocks.pas similarity index 99% rename from Delphi.Mocks.pas rename to Source/Delphi.Mocks.pas index 7858f8d..b4c5540 100644 --- a/Delphi.Mocks.pas +++ b/Source/Delphi.Mocks.pas @@ -256,16 +256,16 @@ ItRec = record function IsRegex(const regex : string; const options : TRegExOptions = []) : string; {$ENDIF} function AreSamePropertiesThat(const Value: T): T; - function AreSameFieldsThat(const Value: T): T; - function AreSameFieldsAndPropertiedThat(const Value: T): T; - end; + function AreSameFieldsThat(const Value: T): T; + function AreSameFieldsAndPropertiedThat(const Value: T): T; + end; TComparer = class - public - class function CompareFields(Param1, Param2: T): Boolean; - class function CompareMembers(Members: TArray; Param1, Param2: T2): Boolean; - class function CompareProperties(Param1, Param2: T): Boolean; - end; + public + class function CompareFields(Param1, Param2: T): Boolean; + class function CompareMembers(Members: TArray; Param1, Param2: T2): Boolean; + class function CompareProperties(Param1, Param2: T): Boolean; + end; //Exception Types that the mocks will raise. EMockException = class(Exception); @@ -546,7 +546,7 @@ procedure TMock.VerifyAll(const message: string); class function TStub.Create(): TStub; begin - result := TStub.Create(nil); + result := TStub.Create(nil); end; @@ -663,37 +663,37 @@ function TAutoMockContainer.Mock: TMock; { It } function ItRec.AreSameFieldsAndPropertiedThat(const Value: T): T; -begin - Result := Value; - +begin + Result := Value; + TMatcherFactory.Create(ParamIndex, function(Param: T): Boolean begin Result := TComparer.CompareFields(Param, Value) and TComparer.CompareProperties(Param, Value); end); -end; +end; + +function ItRec.AreSameFieldsThat(const Value: T): T; +begin + Result := Value; -function ItRec.AreSameFieldsThat(const Value: T): T; -begin - Result := Value; - TMatcherFactory.Create(ParamIndex, function(Param: T): Boolean begin Result := TComparer.CompareFields(Param, Value); end); -end; +end; + +function ItRec.AreSamePropertiesThat(const Value: T): T; +begin + Result := Value; -function ItRec.AreSamePropertiesThat(const Value: T): T; -begin - Result := Value; - TMatcherFactory.Create(ParamIndex, function(Param: T): Boolean begin Result := TComparer.CompareProperties(Param, Value); end); -end; +end; constructor ItRec.Create(const AParamIndex : Integer); begin @@ -901,19 +901,19 @@ function It9 : ItRec; end; { TComparer } - -class function TComparer.CompareFields(Param1, Param2: T): Boolean; -var - RTTI: TRttiContext; - + +class function TComparer.CompareFields(Param1, Param2: T): Boolean; +var + RTTI: TRttiContext; + begin RTTI := TRttiContext.Create; Result := CompareMembers(RTTI.GetType(TypeInfo(T)).GetFields, Param1, Param2); end; - -class function TComparer.CompareMembers(Members: TArray; Param1, Param2: T2): Boolean; -var - PublicMember: TRttiMember; + +class function TComparer.CompareMembers(Members: TArray; Param1, Param2: T2): Boolean; +var + PublicMember: TRttiMember; Instance1, Instance2, MemberValue1, MemberValue2: TValue; @@ -954,15 +954,15 @@ class function TComparer.CompareMembers(Members: TArray; Param1, Param end; end; end; - -class function TComparer.CompareProperties(Param1, Param2: T): Boolean; -var - RTTI: TRttiContext; - + +class function TComparer.CompareProperties(Param1, Param2: T): Boolean; +var + RTTI: TRttiContext; + begin RTTI := TRttiContext.Create; Result := CompareMembers(RTTI.GetType(TypeInfo(T)).GetProperties, Param1, Param2); end; - + end. diff --git a/Tests/Delphi.Mocks.Tests.Stubs.pas b/Tests/Delphi.Mocks.Tests.Stubs.pas index 93a8ec6..124fe06 100644 --- a/Tests/Delphi.Mocks.Tests.Stubs.pas +++ b/Tests/Delphi.Mocks.Tests.Stubs.pas @@ -10,6 +10,7 @@ interface TStubTests = class published procedure Test_WillReturnDefault; + procedure Test_CanStubInheritedMethods; end; {$M-} @@ -23,10 +24,22 @@ TStubTests = class implementation uses + Classes, Delphi.Mocks; { TUtilsTests } { TStubTests } +procedure TStubTests.Test_CanStubInheritedMethods; +var + stub : TStub; +begin + stub := TStub.Create; + stub.Setup.BehaviorMustBeDefined := false; + stub.Setup.WillReturnDefault('Add', 0); +// stub.Setup.WillReturn(1).When.Add(It(0).IsAny); + stub.Instance.Add('2'); +end; + procedure TStubTests.Test_WillReturnDefault; var stub : TStub; diff --git a/Tests/Delphi.Mocks.Tests.dpr b/Tests/Delphi.Mocks.Tests.dpr index 0c9f134..e89d3fe 100644 --- a/Tests/Delphi.Mocks.Tests.dpr +++ b/Tests/Delphi.Mocks.Tests.dpr @@ -26,25 +26,7 @@ uses DUnitX.Windows.Console, DUnitX.Loggers.XML.NUnit, SysUtils, - Delphi.Mocks.AutoMock in '..\Delphi.Mocks.AutoMock.pas', - Delphi.Mocks.Behavior in '..\Delphi.Mocks.Behavior.pas', - Delphi.Mocks.Expectation in '..\Delphi.Mocks.Expectation.pas', - Delphi.Mocks.Helpers in '..\Delphi.Mocks.Helpers.pas', - Delphi.Mocks.Interfaces in '..\Delphi.Mocks.Interfaces.pas', - Delphi.Mocks.MethodData in '..\Delphi.Mocks.MethodData.pas', - Delphi.Mocks.ObjectProxy in '..\Delphi.Mocks.ObjectProxy.pas', - Delphi.Mocks.ParamMatcher in '..\Delphi.Mocks.ParamMatcher.pas', - Delphi.Mocks in '..\Delphi.Mocks.pas', - Delphi.Mocks.Proxy in '..\Delphi.Mocks.Proxy.pas', - Delphi.Mocks.Proxy.TypeInfo in '..\Delphi.Mocks.Proxy.TypeInfo.pas', - Delphi.Mocks.ReturnTypePatch in '..\Delphi.Mocks.ReturnTypePatch.pas', - Delphi.Mocks.Utils in '..\Delphi.Mocks.Utils.pas', - Delphi.Mocks.Validation in '..\Delphi.Mocks.Validation.pas', - Delphi.Mocks.VirtualInterface in '..\Delphi.Mocks.VirtualInterface.pas', - Delphi.Mocks.VirtualMethodInterceptor in '..\Delphi.Mocks.VirtualMethodInterceptor.pas', - Delphi.Mocks.WeakReference in '..\Delphi.Mocks.WeakReference.pas', - Delphi.Mocks.When in '..\Delphi.Mocks.When.pas', - Sample1Main in '..\Sample1Main.pas', + Sample1Main in '..\Examples\Sample1Main.pas', Delphi.Mocks.Tests.AutoMock in 'Delphi.Mocks.Tests.AutoMock.pas', Delphi.Mocks.Tests.Base in 'Delphi.Mocks.Tests.Base.pas', Delphi.Mocks.Tests.Behavior in 'Delphi.Mocks.Tests.Behavior.pas', diff --git a/Tests/Delphi.Mocks.Tests.dproj b/Tests/Delphi.Mocks.Tests.dproj index f69ec91..e346f46 100644 --- a/Tests/Delphi.Mocks.Tests.dproj +++ b/Tests/Delphi.Mocks.Tests.dproj @@ -1,559 +1,544 @@ - - - {09065B0C-BFB4-4C27-A57A-26E99D078545} - 16.1 - VCL - True - TestInsight - Win32 - 3 - Application - Delphi.Mocks.Tests.dpr - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_1 - true - true - - - true - Cfg_1 - true - true - - - true - Cfg_3 - true - true - true - - - true - Base - true - - - true - Delphi_Mocks_Tests - $(BDS)\bin\default_app.manifest - _ISCONSOLE;_XMLOUTPUT;$(BRCC_Defines) - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - 3081 - $(DUNITX);$(DCC_UnitSearchPath) - bindcompfmx;dsnap;fmx;rtl;IndySystem;IndyCore;dbrtl;bindcomp;inetdb;fmxase;inet;fmxobj;xmlrtl;inetdbxpress;IndyProtocols;fmxdae;bindengine;soaprtl;$(DCC_UsePackage) - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - . - .\$(Platform)\$(Config) - false - false - false - false - false - - - true - bindcompvcl;vclie;vcltouch;websnap;vcldbx;VclSmp;vcl;inetdbbde;dsnapcon;vclx;svnui;webdsnap;svn;vclimg;fmi;bdertl;vclactnband;vcldb;vcldsnap;$(DCC_UsePackage) - true - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - 1033 - $(BDS)\bin\default_app.manifest - - - true - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - 1033 - $(BDS)\bin\default_app.manifest - bindcompvcl;vclie;vcltouch;websnap;VclSmp;vcl;dsnapcon;vclx;webdsnap;vclimg;vclactnband;vcldb;vcldsnap;$(DCC_UsePackage) - - - true - DEBUG;DUNITX-DEBUG;$(DCC_Define) - false - true - true - true - - - $(BDS)\bin\default_app.manifest - 3 - true - 1033 - false - - - 1033 - true - - - false - RELEASE;$(DCC_Define) - 0 - 0 - - - - MainSource - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Cfg_2 - Base - - - Cfg_3 - Cfg_1 - - - Base - - - Cfg_1 - Base - - - - Delphi.Personality.12 - - - - - False - False - 1 - 0 - 0 - 0 - False - False - False - False - False - 1033 - 1252 - - - - - 1.0.0.0 - - - - - - 1.0.0.0 - - - - Delphi.Mocks.Tests.dpr - - - - - - Delphi_Mocks_Tests.exe - true - - - - - 1 - .dylib - - - 0 - .bpl - - - Contents\MacOS - 1 - .dylib - - - 1 - .dylib - - - - - 1 - .dylib - - - 0 - .dll;.bpl - - - Contents\MacOS - 1 - .dylib - - - 1 - .dylib - - - - - 1 - - - 1 - - - - - Contents - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - res\drawable-normal - 1 - - - - - library\lib\x86 - 1 - - - - - 1 - - - 1 - - - - - ../ - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - 1 - - - 1 - - - - - res\drawable-xlarge - 1 - - - - - res\drawable-xhdpi - 1 - - - - - 1 - - - 1 - - - - - res\drawable-xxhdpi - 1 - - - - - library\lib\mips - 1 - - - - - res\drawable - 1 - - - - - Contents\MacOS - 1 - - - 1 - - - 0 - - - - - Contents\MacOS - 1 - .framework - - - 0 - - - - - res\drawable-small - 1 - - - - - ../ - 1 - - - - - Contents\MacOS - 1 - - - 1 - - - Contents\MacOS - 0 - - - - - classes - 1 - - - - - 1 - - - 1 - - - - - 1 - - - 1 - - - - - res\drawable - 1 - - - - - Contents\Resources - 1 - - - - - 1 - - - - - 1 - - - 1 - - - - - 1 - - - library\lib\armeabi-v7a - 1 - - - 0 - - - Contents\MacOS - 1 - - - 1 - - - - - library\lib\armeabi - 1 - - - - - res\drawable-large - 1 - - - - - 0 - - - 0 - - - 0 - - - Contents\MacOS - 0 - - - 0 - - - - - 1 - - - 1 - - - - - res\drawable-ldpi - 1 - - - - - res\values - 1 - - - - - 1 - - - 1 - - - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - - - 1 - - - - - - - - - - - False - True - True - - - DUnit / Delphi Win32 - GUI - \\cirrus\c$\Users\vincent.OFFICE\Documents\RAD Studio\Projects\DelphiXE2Mocks\Project1.dproj - - - - 12 - - - - - + + + {09065B0C-BFB4-4C27-A57A-26E99D078545} + 16.1 + VCL + True + TestInsight + Win32 + 3 + Application + Delphi.Mocks.Tests.dpr + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Cfg_3 + true + true + true + + + true + Base + true + + + true + Delphi_Mocks_Tests + $(BDS)\bin\default_app.manifest + _ISCONSOLE;_XMLOUTPUT;$(BRCC_Defines) + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + 3081 + ..\Source;$(DUNITX);$(DCC_UnitSearchPath) + bindcompfmx;dsnap;fmx;rtl;IndySystem;IndyCore;dbrtl;bindcomp;inetdb;fmxase;inet;fmxobj;xmlrtl;inetdbxpress;IndyProtocols;fmxdae;bindengine;soaprtl;$(DCC_UsePackage) + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + . + .\$(Platform)\$(Config) + false + false + false + false + false + + + true + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + 1033 + $(BDS)\bin\default_app.manifest + bindcompvcl;vclie;vcltouch;websnap;VclSmp;vcl;dsnapcon;vclx;webdsnap;vclimg;vclactnband;vcldb;vcldsnap;$(DCC_UsePackage) + + + true + bindcompvcl;vclie;vcltouch;websnap;vcldbx;VclSmp;vcl;inetdbbde;dsnapcon;vclx;svnui;webdsnap;svn;vclimg;fmi;bdertl;vclactnband;vcldb;vcldsnap;$(DCC_UsePackage) + true + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + 1033 + $(BDS)\bin\default_app.manifest + + + true + DEBUG;DUNITX-DEBUG;$(DCC_Define) + false + true + true + true + + + $(BDS)\bin\default_app.manifest + 3 + true + 1033 + false + + + 1033 + true + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + + MainSource + + + + + + + + + + + + + + + + + + + + + Cfg_2 + Base + + + Cfg_3 + Cfg_1 + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + + + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1033 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + Delphi.Mocks.Tests.dpr + + + madBasic 1.2.7 - www.madshi.net + madHelp 1.1.1 - www.madshi.net + madDisAsm 2.2.6 - www.madshi.net + madExceptIde 1.1.0 - www.madshi.net + madExcept 5.0.0 - www.madshi.net + madExceptVcl 2.1.0 - www.madshi.net + madExceptWizard 3.1.8 - www.madshi.net + + + + + + Delphi_Mocks_Tests.exe + + + + + 1 + .dylib + + + 0 + .bpl + + + Contents\MacOS + 1 + .dylib + + + 1 + .dylib + + + + + 1 + .dylib + + + 0 + .dll;.bpl + + + Contents\MacOS + 1 + .dylib + + + 1 + .dylib + + + + + 1 + + + 1 + + + + + Contents + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + res\drawable-normal + 1 + + + + + library\lib\x86 + 1 + + + + + 1 + + + 1 + + + + + ../ + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + + + res\drawable-xlarge + 1 + + + + + res\drawable-xhdpi + 1 + + + + + 1 + + + 1 + + + + + res\drawable-xxhdpi + 1 + + + + + library\lib\mips + 1 + + + + + res\drawable + 1 + + + + + Contents\MacOS + 1 + + + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + res\drawable-small + 1 + + + + + ../ + 1 + + + + + Contents\MacOS + 1 + + + 1 + + + Contents\MacOS + 0 + + + + + classes + 1 + + + + + 1 + + + 1 + + + + + 1 + + + 1 + + + + + res\drawable + 1 + + + + + Contents\Resources + 1 + + + + + 1 + + + + + 1 + + + 1 + + + + + 1 + + + library\lib\armeabi-v7a + 1 + + + 0 + + + Contents\MacOS + 1 + + + 1 + + + + + library\lib\armeabi + 1 + + + + + res\drawable-large + 1 + + + + + 0 + + + 0 + + + 0 + + + Contents\MacOS + 0 + + + 0 + + + + + 1 + + + 1 + + + + + res\drawable-ldpi + 1 + + + + + res\values + 1 + + + + + 1 + + + 1 + + + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + + + 1 + + + + + + + + + + + False + True + True + + + 12 + + + + +