├── .gitignore ├── .gitmodules ├── Build ├── TestAndBuild.fbp7 └── TestAndBuild.fbp8 ├── Examples ├── Delphi.Mocks.Example.ProjectSaveCheckVisitor.pas ├── Delphi.Mocks.Examples.Factory.pas ├── Delphi.Mocks.Examples.Implement.pas ├── Delphi.Mocks.Examples.Interfaces.pas ├── Delphi.Mocks.Examples.Matchers.pas ├── Delphi.Mocks.Examples.Objects.pas ├── Sample1.dpr ├── Sample1.dproj └── Sample1Main.pas ├── LICENSE.txt ├── README.md ├── Source ├── Delphi.Mocks.AutoMock.pas ├── Delphi.Mocks.Behavior.pas ├── Delphi.Mocks.Expectation.pas ├── Delphi.Mocks.Helpers.pas ├── Delphi.Mocks.Interfaces.pas ├── Delphi.Mocks.MethodData.pas ├── Delphi.Mocks.ObjectProxy.pas ├── Delphi.Mocks.ParamMatcher.pas ├── Delphi.Mocks.Proxy.TypeInfo.pas ├── Delphi.Mocks.Proxy.pas ├── Delphi.Mocks.ReturnTypePatch.pas ├── Delphi.Mocks.Utils.pas ├── Delphi.Mocks.Validation.pas ├── Delphi.Mocks.WeakReference.pas ├── Delphi.Mocks.When.pas ├── Delphi.Mocks.inc ├── Delphi.Mocks.pas ├── DelphiMocks.dpk ├── DelphiMocks.dproj ├── DelphiMocks104.dpk ├── DelphiMocks104.dproj ├── DelphiMocksXE5.dpk └── DelphiMocksXE5.dproj ├── Tests ├── .gitignore ├── Delphi.Mocks.Examples.Factory.pas ├── Delphi.Mocks.Examples.Implement.pas ├── Delphi.Mocks.Examples.Matchers.pas ├── Delphi.Mocks.Examples.Objects.pas ├── Delphi.Mocks.Tests.AutoMock.pas ├── Delphi.Mocks.Tests.Base.pas ├── Delphi.Mocks.Tests.Behavior.pas ├── Delphi.Mocks.Tests.Expectations.pas ├── Delphi.Mocks.Tests.InterfaceProxy.pas ├── Delphi.Mocks.Tests.Interfaces.pas ├── Delphi.Mocks.Tests.MethodData.pas ├── Delphi.Mocks.Tests.ObjectProxy.pas ├── Delphi.Mocks.Tests.Objects.pas ├── Delphi.Mocks.Tests.OpenArrayIntf.pas ├── Delphi.Mocks.Tests.Proxy.pas ├── Delphi.Mocks.Tests.ProxyBase.pas ├── Delphi.Mocks.Tests.Stubs.pas ├── Delphi.Mocks.Tests.TValue.pas ├── Delphi.Mocks.Tests.Utils.pas ├── Delphi.Mocks.Tests.dpr ├── Delphi.Mocks.Tests.dproj ├── Delphi.Mocks.Tests.res ├── Delphi.Mocks.Utils.Tests.pas └── MemoryLeakTest │ ├── FastMM4.pas │ ├── FastMM4Messages.pas │ ├── FastMM4Options.inc │ ├── MemoryLeakTest.dpr │ ├── MemoryLeakTest.dproj │ └── MockMemoryLeakTest.pas └── VSoft.DelphiMocks.dspec /.gitignore: -------------------------------------------------------------------------------- 1 | # Compiled source # 2 | ################### 3 | *.dcu 4 | *.obj 5 | *.exe 6 | *.mes 7 | *.res 8 | 9 | # Backup files # 10 | ################### 11 | *.~* 12 | 13 | # IDE Files # 14 | ################### 15 | *.dproj.local 16 | *.groupproj.local 17 | *.identcache 18 | *.dsk 19 | *.tvsconfig 20 | *.projdata 21 | 22 | # Output Folders # 23 | ################### 24 | /Win32 25 | /Win64 26 | /Tests/Win32 27 | /Tests/Win64 28 | /Examples/Win32 29 | /Examples/Win64 30 | 31 | Build/TestAndBuild.fb7lck 32 | *.fbl7 33 | *.fbpInf 34 | *.rc 35 | *.drc 36 | *.map 37 | ======= 38 | __history/** 39 | **.exe 40 | **.dcu 41 | *.local 42 | *.identcache 43 | *.xml 44 | *.fb8lck 45 | *.fbl8 46 | *.fbpbrk 47 | Tests/Delphi.Mocks.Tests.res 48 | Tests/Delphi.Mocks.Tests.res 49 | *.rsm 50 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "DUnitXML"] 2 | path = DUnitXML 3 | url = ../DUnit-XML.git 4 | -------------------------------------------------------------------------------- /Build/TestAndBuild.fbp7: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VSoftTechnologies/Delphi-Mocks/a0f6de8d6a0ebb2d4c09f5097f16d125c8c21969/Build/TestAndBuild.fbp7 -------------------------------------------------------------------------------- /Examples/Delphi.Mocks.Example.ProjectSaveCheckVisitor.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.Example.ProjectSaveCheckVisitor; 2 | 3 | interface 4 | 5 | type 6 | {$M+} 7 | IVisitor = interface; 8 | 9 | IElement = interface 10 | ['{A2F4744E-7ED3-4DE3-B1E4-5D6C256ACBF0}'] 11 | procedure Accept(const AVisitor : IVisitor); 12 | end; 13 | 14 | IVisitor = interface 15 | ['{0D150F9C-909A-413E-B29E-4B869C6BC309}'] 16 | procedure Visit(const AElement : IElement); 17 | end; 18 | 19 | IProject = interface 20 | ['{807AF964-E937-4A8A-A3D2-34074EF66EE8}'] 21 | procedure Save; 22 | function IsDirty : boolean; 23 | end; 24 | 25 | TElement = class(TInterfacedObject, IElement) 26 | public 27 | procedure Accept(const AVisitor : IVisitor); 28 | end; 29 | 30 | TProject = class(TInterfacedObject, IProject, IElement) 31 | protected 32 | function IsDirty : boolean; 33 | procedure Accept(const AVisitor : IVisitor); 34 | public 35 | procedure Save; 36 | end; 37 | 38 | TProjectSaveCheck = class(TInterfacedObject, IVisitor) 39 | public 40 | procedure Visit(const AElement : IElement); 41 | end; 42 | {$M-} 43 | 44 | implementation 45 | 46 | uses 47 | Rtti, 48 | SysUtils, 49 | TypInfo; 50 | 51 | { TProjectSaveCheckVisitor } 52 | 53 | procedure TProjectSaveCheck.Visit(const AElement: IElement); 54 | var 55 | project : IProject; 56 | begin 57 | if not Supports(AElement, IProject, project) then 58 | raise Exception.Create('Element passed to Visit was not a IProject.'); 59 | 60 | if project.IsDirty then 61 | project.Save; 62 | end; 63 | 64 | { TProject } 65 | 66 | procedure TProject.Accept(const AVisitor: IVisitor); 67 | begin 68 | AVisitor.Visit(Self); 69 | end; 70 | 71 | function TProject.IsDirty: boolean; 72 | begin 73 | Result := True; 74 | end; 75 | 76 | procedure TProject.Save; 77 | begin 78 | end; 79 | 80 | { TElement } 81 | 82 | procedure TElement.Accept(const AVisitor: IVisitor); 83 | begin 84 | 85 | end; 86 | 87 | 88 | end. 89 | -------------------------------------------------------------------------------- /Examples/Delphi.Mocks.Examples.Factory.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.Examples.Factory; 2 | 3 | interface 4 | 5 | uses 6 | Rtti, 7 | TypInfo, 8 | SysUtils; 9 | 10 | type 11 | {$M+} 12 | IFileService = interface 13 | ['{3BDAC049-F291-46CB-95A8-B177E3485752}'] 14 | function OpenForAppend(const AFilename : string) : THandle; 15 | function WriteLineTo(const AHandle : THandle; const ALine : string) : boolean; 16 | end; 17 | 18 | IApplicationInfo = interface 19 | ['{43C0AE45-F57F-4620-A902-35CEAB370BC1}'] 20 | function GetFileService : IFileService; 21 | property FileService : IFileService read GetFileService; 22 | end; 23 | 24 | ILogLine = interface 25 | ['{B230FBB5-EE90-4208-90A4-FF09274BD767}'] 26 | function FormattedLine : string; 27 | end; 28 | 29 | ILogLines = interface 30 | ['{0CAF05DA-6828-4651-8431-F4E6815AF1C0}'] 31 | function GetCount : Cardinal; 32 | function GetLine(const ALine: Cardinal) : ILogLine; 33 | 34 | property Line[const ALine : Cardinal] : ILogLine read GetLine; 35 | property Count : Cardinal read GetCount; 36 | end; 37 | 38 | ILogReceiver = interface 39 | ['{0EE8E9EC-0B2E-4052-827D-5EAF26AB08BC}'] 40 | function GetLogsAbove(const ALogLevel : Integer) : ILogLines; 41 | function Log(const AMessage: string; const ALogLevel : Integer) : boolean; 42 | end; 43 | 44 | IMessage = interface 45 | ['{9955A5F2-3BC3-43DA-81FC-AD16E02BC93F}'] 46 | end; 47 | 48 | IMessageChannel = interface 49 | ['{B2F9B8B0-93DD-4886-8141-CD043C32A9F1}'] 50 | function SendMessage(const AMessage : IMessage) : boolean; 51 | end; 52 | 53 | ICoreService = interface 54 | ['{48584DC8-C425-4F6C-8FC5-438F04A90052}'] 55 | function GetLogReciever : ILogReceiver; 56 | function GetApplication : IApplicationInfo; 57 | function GetAppMessageChannel : IMessageChannel; 58 | 59 | property Application : IApplicationInfo read GetApplication; 60 | property LogReciever : ILogReceiver read GetLogReciever; 61 | property AppMessageChannel : IMessageChannel read GetAppMessageChannel; 62 | end; 63 | 64 | ILogExporter = interface 65 | ['{037C6F9F-CA6A-4DE9-863C-0E3DC265B49B}'] 66 | function ExportLog(const AMinLogLevel : Integer; const AFilename: TFilename) : integer; 67 | end; 68 | 69 | TLogExporter = class(TInterfacedObject, ILogExporter) 70 | private 71 | FLogReciever : ILogReceiver; 72 | FApplication : IApplicationInfo; 73 | public 74 | constructor Create(const AServices : ICoreService); 75 | destructor Destroy; override; 76 | function ExportLog(const AMinLogLevel : Integer; const AFilename: TFilename) : integer; 77 | end; 78 | {$M-} 79 | 80 | {$M+} 81 | TExample_MockFactoryTests = class 82 | published 83 | procedure Implement_Multiple_Interfaces; 84 | procedure Create_T_From_TypeInfo; 85 | end; 86 | {$M-} 87 | 88 | IFakeGeneric = interface 89 | ['{682057B0-E265-45F1-ABF7-12A25683AF63}'] 90 | function Value : TValue; 91 | end; 92 | 93 | TFakeGeneric = class(TInterfacedObject, IFakeGeneric) 94 | private 95 | FValue : TValue; 96 | public 97 | constructor Create(const ATypeInfo : PTypeInfo); 98 | destructor Destroy; override; 99 | 100 | function Value : TValue; 101 | end; 102 | 103 | IFakeGeneric = interface 104 | ['{87853316-A14D-4BC6-9124-D947662243F0}'] 105 | function Value : T; 106 | end; 107 | 108 | TFakeGeneric = class(TInterfacedObject, IFakeGeneric) 109 | private 110 | FFakeGeneric : IFakeGeneric; 111 | public 112 | constructor Create; 113 | destructor Destroy; override; 114 | 115 | function Value : T; 116 | end; 117 | 118 | implementation 119 | 120 | uses 121 | Delphi.Mocks; 122 | 123 | function CreateFakeGeneric(const TypeInfo: PTypeInfo) : TObject; 124 | begin 125 | result := nil; 126 | end; 127 | 128 | { TLogExporter } 129 | 130 | constructor TLogExporter.Create(const AServices: ICoreService); 131 | begin 132 | inherited Create; 133 | 134 | FLogReciever := AServices.LogReciever; 135 | FApplication := AServices.Application; 136 | end; 137 | 138 | destructor TLogExporter.Destroy; 139 | begin 140 | FLogReciever := nil; 141 | FApplication := nil; 142 | 143 | inherited; 144 | end; 145 | 146 | function TLogExporter.ExportLog(const AMinLogLevel : Integer; const AFilename: TFilename) : integer; 147 | var 148 | fileService : IFileService; 149 | fileHandle: THandle; 150 | logs: ILogLines; 151 | iLine: Integer; 152 | begin 153 | //Very simplistic ExportLog function which uses a number of other services to 154 | //get its job done. The logic is simplistic, but the implementation over uses 155 | //services to show the power of AutoMocking, and the Factory. 156 | 157 | fileService := FApplication.FileService; 158 | 159 | //Create or open requested file. 160 | fileHandle := fileService.OpenForAppend(AFilename); 161 | 162 | //Make sure the got a valid handle from the file serice. 163 | if fileHandle = 0 then 164 | raise Exception.CreateFmt('The fileservice failed to return a handle for [%s]', [AFilename]); 165 | 166 | //Get the log from the log receiver for the passed in min log level. 167 | logs := FLogReciever.GetLogsAbove(AMinLogLevel - 1); 168 | 169 | //Write each line out with the formatting from the log. 170 | for iLine := 0 to logs.Count - 1 do 171 | fileService.WriteLineTo(fileHandle, logs.Line[iLine].FormattedLine); 172 | 173 | result := 0; 174 | end; 175 | 176 | { TExample_MockFactoryTests } 177 | 178 | procedure TExample_MockFactoryTests.Create_T_From_TypeInfo; 179 | var 180 | fakeExporter : IFakeGeneric; 181 | fakeLine : IFakeGeneric; 182 | begin 183 | fakeExporter := TFakeGeneric.Create; 184 | 185 | // Assert.AreEqual(fakeExporter.Value.ClassName, 'TLogExporter'); 186 | 187 | fakeLine := TFakeGeneric.Create; 188 | 189 | //Assert.AreEqual(fakeLine.Value.FormattedLine, 'TLogExporter'); 190 | end; 191 | 192 | procedure TExample_MockFactoryTests.Implement_Multiple_Interfaces; 193 | //var 194 | // logExporterSUT : ILogExporter; 195 | // 196 | // // mockFactory : TMockFactory; 197 | // mockContainer : TAutoMockContainer; 198 | // mockCoreService : TMock; 199 | begin 200 | //CREATE - Create a mock of the CoreService which we require for the LogExporter 201 | // We do this through creating a MockFactory to generate the Mock 202 | 203 | // mockFactory := TMockFactory.Create; 204 | // mockContainer := TAutoMockContainer.Create(mockFactory); 205 | // 206 | // mockCoreService := mockContainer.Mock; 207 | // 208 | // //CREATE - The log exporter ExportLog function is what we are looking at testing. 209 | // logExporterSUT := TLogExporter.Create(mockCoreService); 210 | // 211 | // //TEST - See if we can export a log. 212 | // logExporterSUT.ExportLog(0, ''); 213 | // 214 | // //VERIFY - Make sure that everything we have attached to the factory and its mocks 215 | // // has correctly run. 216 | // mockFactory.VerifyAll; 217 | end; 218 | 219 | { TFakeGeneric } 220 | 221 | constructor TFakeGeneric.Create(const ATypeInfo: PTypeInfo); 222 | var 223 | ctx: TRttiContext; 224 | rType: TRttiType; 225 | AMethCreate: TRttiMethod; 226 | instanceType: TRttiInstanceType; 227 | begin 228 | ctx := TRttiContext.Create; 229 | rType := ctx.GetType(ATypeInfo); 230 | 231 | for AMethCreate in rType.GetMethods do 232 | begin 233 | {$Message 'TODO Handle constructors with params.'} 234 | 235 | if (AMethCreate.IsConstructor) and (Length(AMethCreate.GetParameters) = 0) then 236 | begin 237 | instanceType := rType.AsInstance; 238 | 239 | FValue := AMethCreate.Invoke(instanceType.MetaclassType, []); 240 | 241 | Exit; 242 | end; 243 | end; 244 | end; 245 | 246 | destructor TFakeGeneric.Destroy; 247 | begin 248 | inherited; 249 | end; 250 | 251 | function TFakeGeneric.Value: TValue; 252 | begin 253 | Result := FValue; 254 | end; 255 | 256 | { TFakeGeneric } 257 | 258 | constructor TFakeGeneric.Create; 259 | begin 260 | FFakeGeneric := TFakeGeneric.Create(TypeInfo(T)); 261 | end; 262 | 263 | destructor TFakeGeneric.Destroy; 264 | begin 265 | FFakeGeneric := nil; 266 | inherited; 267 | end; 268 | 269 | function TFakeGeneric.Value: T; 270 | begin 271 | Result := FFakeGeneric.Value.AsType; 272 | end; 273 | 274 | 275 | end. 276 | -------------------------------------------------------------------------------- /Examples/Delphi.Mocks.Examples.Implement.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.Examples.Implement; 2 | 3 | interface 4 | 5 | uses 6 | Delphi.Mocks.Example.ProjectSaveCheckVisitor; 7 | 8 | type 9 | {$M+} 10 | TExample_InterfaceImplementTests = class 11 | published 12 | procedure Implement_Single_Interface; 13 | procedure Implement_Multiple_Interfaces; 14 | procedure SetupAndVerify_Mulitple_Interfaces; 15 | procedure SetupAndVerify_Object_And_Interfaces; 16 | end; 17 | {$M-} 18 | 19 | 20 | implementation 21 | 22 | uses 23 | Rtti, 24 | TypInfo, 25 | SysUtils, 26 | Delphi.Mocks; 27 | 28 | 29 | { TExample_InterfaceImplementTests } 30 | 31 | procedure TExample_InterfaceImplementTests.Implement_Single_Interface; 32 | var 33 | visitorSUT : IVisitor; 34 | mockElement : TMock; 35 | mockProject : TMock; 36 | projectAsValue : TValue; 37 | pInfo : PTypeInfo; 38 | dud : IProject; 39 | begin 40 | //Test that when we visit a project, and its dirty, we save. 41 | 42 | //CREATE - The visitor system under test. 43 | visitorSUT := TProjectSaveCheck.Create; 44 | 45 | //CREATE - Element mock we require. 46 | mockElement := TMock.Create; 47 | mockProject := TMock.Create; 48 | 49 | projectAsValue := TValue.From(mockProject.Instance); 50 | 51 | //SETUP - return mock project when IProject is asked for. 52 | pInfo := TypeInfo(IProject); 53 | mockElement.Setup.WillReturn(projectAsValue).When.QueryInterface(GetTypeData(pInfo).GUID, dud); 54 | 55 | //SETUP - mock project will show as dirty and will expect to be saved. 56 | mockProject.Setup.WillReturn(true).When.IsDirty; 57 | mockProject.Setup.Expect.Once.When.Save; 58 | 59 | try 60 | //TEST - Visit the mock element with 61 | visitorSUT.Visit(mockElement); 62 | 63 | //VERIFY - Make sure that save was indeed called. 64 | mockProject.Verify; 65 | 66 | //I don't expect to get here as an exception will be raised in Visit. The 67 | //mock can't return project via query interface as this is overriden internally 68 | //by the mocking library. 69 | 70 | //Didn't use CheckException to simpilfy this test. 71 | //Assert.Fail; 72 | except 73 | //Assert.Pass; 74 | end; 75 | end; 76 | 77 | procedure TExample_InterfaceImplementTests.Implement_Multiple_Interfaces; 78 | var 79 | visitorSUT : IVisitor; 80 | mockElement : TMock; 81 | begin 82 | //Test that when we visit a project, and its dirty, we save. 83 | 84 | //CREATE - The visitor system under test. 85 | visitorSUT := TProjectSaveCheck.Create; 86 | 87 | //CREATE - Element mock we require. 88 | mockElement := TMock.Create; 89 | 90 | //SETUP - Add the IProject interface as an implementation for the mock 91 | mockElement.Implement; 92 | 93 | //SETUP - mock project will show as dirty and will expect to be saved. 94 | mockElement.Setup.WillReturn(true).When.IsDirty; 95 | mockElement.Setup.Expect.Once.When.Save; 96 | 97 | //TEST - Visit the mock element with 98 | visitorSUT.Visit(mockElement); 99 | 100 | //VERIFY - Make sure that save was indeed called. 101 | mockElement.VerifyAll; 102 | end; 103 | 104 | procedure TExample_InterfaceImplementTests.SetupAndVerify_Mulitple_Interfaces; 105 | begin 106 | end; 107 | 108 | //This test fails at this time. Something to implement later. Need to make TObjectProxy pass 109 | //the query interface call to the TProxyVirtualInterface list to be queried. 110 | procedure TExample_InterfaceImplementTests.SetupAndVerify_Object_And_Interfaces; 111 | var 112 | visitorSUT : IVisitor; 113 | mockElement : TMock; 114 | setup : IMockSetup; 115 | begin 116 | //Test that when we visit a project, and its dirty, we save. 117 | 118 | //CREATE - The visitor system under test. 119 | visitorSUT := TProjectSaveCheck.Create; 120 | 121 | //CREATE - Element mock we require. 122 | mockElement := TMock.Create; 123 | 124 | //SETUP - Add the IProject interface as an implementation for the mock 125 | mockElement.Implement; 126 | 127 | //SETUP - mock project will show as dirty and will expect to be saved. 128 | setup := mockElement.Setup; 129 | 130 | setup.WillReturn(true).When.IsDirty; 131 | setup.Expect.Once.When.Save; 132 | 133 | //TEST - Visit the mock element with 134 | visitorSUT.Visit(mockElement); 135 | 136 | //VERIFY - Make sure that save was indeed called. 137 | mockElement.VerifyAll; 138 | end; 139 | 140 | 141 | 142 | initialization 143 | 144 | end. 145 | -------------------------------------------------------------------------------- /Examples/Delphi.Mocks.Examples.Interfaces.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.Examples.Interfaces; 2 | 3 | interface 4 | 5 | uses 6 | SysUtils, 7 | //DUnitX.TestFramework, 8 | Delphi.Mocks; 9 | 10 | type 11 | {$M+} 12 | TSimpleInterface = Interface 13 | ['{4131D033-2D80-42B8-AAA1-3C2DF0AC3BBD}'] 14 | procedure SimpleMethod; 15 | end; 16 | 17 | TSystemUnderTestInf = Interface 18 | ['{5E21CA8E-A4BB-4512-BCD4-22D7F10C5A0B}'] 19 | procedure CallsSimpleInterfaceMethod; 20 | end; 21 | {$M-} 22 | 23 | TSystemUnderTest = class(TInterfacedObject, TSystemUnderTestInf) 24 | private 25 | FInternalInf : TSimpleInterface; 26 | public 27 | constructor Create(const ARequiredInf: TSimpleInterface); 28 | procedure CallsSimpleInterfaceMethod; 29 | end; 30 | 31 | {$M+} 32 | TMockObjectTests = class 33 | published 34 | procedure Simple_Interface_Mock; 35 | end; 36 | {$M-} 37 | 38 | 39 | 40 | 41 | implementation 42 | 43 | uses 44 | Rtti; 45 | 46 | { TMockObjectTests } 47 | 48 | procedure TMockObjectTests.Simple_Interface_Mock; 49 | var 50 | mock : TMock; 51 | sutObject : TSystemUnderTestInf; 52 | begin 53 | //SETUP: Create a mock of the interface that is required by our system under test object. 54 | mock := TMock.Create; 55 | 56 | //SETUP: Add a check that SimpleMethod is called atleast once. 57 | mock.Setup.Expect.AtLeastOnce.When.SimpleMethod; 58 | 59 | //SETUP: Create the system under test object passing an instance of the mock interface it requires. 60 | sutObject := TSystemUnderTest.Create(mock.Instance); 61 | 62 | //TEST: Call CallsSimpleInterfaceMethod on the system under test. 63 | sutObject.CallsSimpleInterfaceMethod; 64 | 65 | //VERIFY: That our passed in interface was called at least once when CallsSimpleInterfaceMethod was called. 66 | mock.Verify('CallsSimpleInterfaceMethod should call SimpleMethod'); 67 | end; 68 | 69 | { TSystemUnderTest } 70 | 71 | procedure TSystemUnderTest.CallsSimpleInterfaceMethod; 72 | begin 73 | FInternalInf.SimpleMethod; 74 | end; 75 | 76 | constructor TSystemUnderTest.Create(const ARequiredInf: TSimpleInterface); 77 | begin 78 | FInternalInf := ARequiredInf; 79 | end; 80 | 81 | end. 82 | 83 | -------------------------------------------------------------------------------- /Examples/Delphi.Mocks.Examples.Matchers.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.Examples.Matchers; 2 | 3 | interface 4 | 5 | //uses 6 | //DUnitX.TestFramework; 7 | 8 | type 9 | {$M+} 10 | IInterfaceToTest = interface 11 | ['{2AB032A9-ED5B-4FDC-904B-E3F1B2C78978}'] 12 | function TakesTwoParams(const A: integer; const B: boolean) : integer; 13 | function TakesFourParams(const A: string; const B: boolean; const C: integer; const D: string) : integer; 14 | end; 15 | 16 | ILoan = interface 17 | 18 | end; 19 | {$M-} 20 | 21 | {$M+} 22 | TExample_MatchersTests = class 23 | published 24 | procedure Match_parameter_values; 25 | end; 26 | {$M-} 27 | 28 | 29 | implementation 30 | 31 | uses 32 | Rtti, 33 | SysUtils, 34 | TypInfo, 35 | Delphi.Mocks; 36 | 37 | 38 | { TExample_MatchersTests } 39 | 40 | 41 | procedure TExample_MatchersTests.Match_parameter_values; 42 | var 43 | mockCredit: TMock; 44 | begin 45 | mockCredit := TMock.Create; 46 | 47 | mockCredit.Setup.WillReturn(6).When.TakesTwoParams(It(0).IsEqualTo(1), It(1).IsEqualTo(true)); 48 | mockCredit.Setup.WillReturn(12).When.TakesTwoParams(It(0).IsEqualTo(2), It(1).IsEqualTo(true)); 49 | mockCredit.Setup.WillReturn(8).When.TakesTwoParams(It(0).IsAny(), It(1).IsEqualTo(false)); 50 | 51 | mockCredit.Setup.WillReturn(1).When.TakesFourParams(It0.IsAny(), It1.IsEqualTo(false), It2.IsEqualTo(1), It3.IsEqualTo('hello')); 52 | 53 | {Assert.AreEqual(6, mockCredit.Instance.TakesTwoParams(1, true)); 54 | Assert.AreEqual(12, mockCredit.Instance.TakesTwoParams(2, true)); 55 | Assert.AreEqual(8, mockCredit.Instance.TakesTwoParams(1, false)); 56 | 57 | Assert.AreEqual(1, mockCredit.Instance.TakesFourParams('asdfasfasdf', false, 1, 'hello')); 58 | Assert.AreEqual(1, mockCredit.Instance.TakesFourParams('asdfjkljklsdfjf', false, 1, 'hello')); } 59 | end; 60 | 61 | { TScorer } 62 | 63 | initialization 64 | //TDUnitX.RegisterTestFixture(TExample_MatchersTests); 65 | 66 | end. 67 | -------------------------------------------------------------------------------- /Examples/Delphi.Mocks.Examples.Objects.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.Examples.Objects; 2 | 3 | interface 4 | 5 | uses 6 | SysUtils, 7 | //DUnitX.TestFramework, 8 | Delphi.Mocks; 9 | 10 | type 11 | ESimpleException = exception; 12 | {$M+} 13 | TSimpleMockedObject = class(TObject) 14 | public 15 | procedure SimpleMethod;virtual; 16 | end; 17 | {$M-} 18 | 19 | TSystemUnderTest = class(TObject) 20 | private 21 | FMocked : TSimpleMockedObject; 22 | public 23 | constructor Create(const AMock: TSimpleMockedObject); 24 | procedure CallsSimpleMethodOnMock;virtual; 25 | end; 26 | 27 | {$M+} 28 | TMockObjectTests = class 29 | published 30 | procedure MockObject_Can_Call_Function;virtual; 31 | end; 32 | {$M-} 33 | 34 | implementation 35 | 36 | uses 37 | Rtti; 38 | 39 | { TMockObjectTests } 40 | 41 | procedure TMockObjectTests.MockObject_Can_Call_Function; 42 | var 43 | mock : TMock; 44 | systemUnderTest : TSystemUnderTest; 45 | begin 46 | //var mock = new Mock(); 47 | //mock.Setup(foo => foo.DoSomething("ping")).Returns(true); 48 | mock := TMock.Create; 49 | 50 | mock.Setup.WillRaise('SimpleMethod', ESimpleException); 51 | 52 | systemUnderTest := TSystemUnderTest.Create(mock.Instance); 53 | try 54 | {Assert.WillRaise(procedure 55 | begin 56 | systemUnderTest.CallsSimpleMethodOnMock; 57 | end, ESimpleException);} 58 | finally 59 | systemUnderTest.Free; 60 | end; 61 | end; 62 | 63 | { TSimpleObject } 64 | 65 | procedure TSimpleMockedObject.SimpleMethod; 66 | begin 67 | //Does nothing; 68 | end; 69 | 70 | { TSystemUnderTest } 71 | 72 | procedure TSystemUnderTest.CallsSimpleMethodOnMock; 73 | begin 74 | FMocked.SimpleMethod; 75 | end; 76 | 77 | constructor TSystemUnderTest.Create(const AMock: TSimpleMockedObject); 78 | begin 79 | FMocked := AMock; 80 | end; 81 | 82 | end. 83 | -------------------------------------------------------------------------------- /Examples/Sample1.dpr: -------------------------------------------------------------------------------- 1 | program Sample1; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | {$R *.res} 6 | 7 | uses 8 | SysUtils, 9 | Sample1Main in 'Sample1Main.pas', 10 | Delphi.Mocks.Example.ProjectSaveCheckVisitor in 'Delphi.Mocks.Example.ProjectSaveCheckVisitor.pas', 11 | Delphi.Mocks.Examples.Factory in 'Delphi.Mocks.Examples.Factory.pas', 12 | Delphi.Mocks.Examples.Implement in 'Delphi.Mocks.Examples.Implement.pas', 13 | Delphi.Mocks.Examples.Interfaces in 'Delphi.Mocks.Examples.Interfaces.pas'; 14 | 15 | begin 16 | try 17 | TesTObjectMock; 18 | Writeln('--------------'); 19 | Test; 20 | ReadLn; 21 | except 22 | on E: Exception do 23 | begin 24 | Writeln(E.ClassName, ': ', E.Message); 25 | ReadLn; 26 | end; 27 | end; 28 | end. 29 | -------------------------------------------------------------------------------- /Examples/Sample1Main.pas: -------------------------------------------------------------------------------- 1 | unit Sample1Main; 2 | 3 | interface 4 | 5 | uses 6 | Delphi.Mocks; 7 | 8 | 9 | procedure Test; 10 | 11 | procedure TesTObjectMock; 12 | 13 | 14 | type 15 | {$M+} 16 | IFoo = interface 17 | ['{69162E72-8C1E-421B-B970-15230BBB3B2B}'] 18 | function GetProp : string; 19 | procedure SetProp(const value : string); 20 | function GetIndexProp(index : integer) : string; 21 | procedure SetIndexedProp(index : integer; const value : string); 22 | function Bar(const param : integer) : string;overload; 23 | function Bar(const param : integer; const param2 : string) : string;overload; 24 | function ReturnObject : TObject; 25 | procedure TestMe; 26 | procedure TestVarParam(var msg : string); 27 | procedure TestOutParam(out msg : string); 28 | property MyProp : string read GetProp write SetProp; 29 | property IndexedProp[index : integer] : string read GetIndexProp write SetIndexedProp; 30 | end; 31 | {$M-} //important because otherwise the code below will fail! 32 | 33 | 34 | implementation 35 | 36 | uses 37 | SysUtils, 38 | Rtti; 39 | 40 | 41 | procedure Test; 42 | var 43 | mock : TMock; //our mock object 44 | stub : TStub; //our stub object; 45 | msg : string; 46 | 47 | 48 | procedure TestImplicit(value : IFoo); 49 | begin 50 | WriteLn('Calling Bar(1234567) : ' + value.Bar(1234567)); 51 | end; 52 | 53 | begin 54 | //Create our mock 55 | mock := TMock.Create; 56 | stub := TStub.Create; 57 | 58 | //Setup our stub. 59 | stub.Setup.WillReturnDefault('Bar', 'You called Bar on the stub and this is the default return value.' ); 60 | 61 | //Setup the behavior of our mock. 62 | 63 | //setup a default return value for method Bar 64 | mock.Setup.WillReturnDefault('Bar','hello world'); 65 | //setup explicit return values when parameters are matched 66 | mock.Setup.WillReturn('blah blah').When.Bar(1); 67 | mock.Setup.WillReturn('goodbye world').When.Bar(2,'sdfsd'); 68 | //method TestMe will raise an exception - using one that the debugger won't break on here! 69 | mock.Setup.WillRaise(EMockException,'You called me when I told you not to!').When.TestMe; 70 | 71 | //MyProp return value - note it really sets up the return value 72 | //for the getter method 73 | mock.Setup.WillReturn('hello').When.MyProp; 74 | 75 | mock.Setup.WillExecute( 76 | function (const args : TArray; const ReturnType : TRttiType) : TValue 77 | begin 78 | //Note - args[0] is the Self interface reference for the anon method, our first arg is [1] 79 | result := 'The result is ' + IntToStr(args[1].AsOrdinal); 80 | end 81 | ).When.Bar(200); 82 | 83 | mock.Setup.WillExecute( 84 | function (const args : TArray; const ReturnType : TRttiType) : TValue 85 | begin 86 | args[1] := 'hello Delphi Mocks!'; 87 | end 88 | ).When.TestVarParam(msg); 89 | 90 | mock.Setup.WillExecute( 91 | function (const args : TArray; const ReturnType : TRttiType) : TValue 92 | begin 93 | args[1] := 'hello Delphi Mocks! - With out Param'; 94 | end 95 | ).When.TestOutParam(msg); 96 | 97 | 98 | mock.Setup.WillExecute( 99 | function (const args : TArray; const ReturnType : TRttiType) : TValue 100 | begin 101 | //Note - args[0] is the Self interface reference for the anon method, our first arg is [1] 102 | result := TObject.Create; 103 | end 104 | ).When.ReturnObject; 105 | 106 | 107 | mock.Setup.WillReturn('helloooooooo').When.Bar(It(0).IsAny,It(1).IsAny); 108 | 109 | //Define our expectations - mostly about how many times we expect a method to be called. 110 | // 111 | //we expect the TestMe method to never be called 112 | mock.Setup.Expect.Never.When.TestMe; 113 | 114 | //we expect Bar to be called at lease once with a param value of 1 115 | mock.Setup.Expect.AtLeastOnce.When.Bar(1); 116 | 117 | mock.Setup.Expect.AtLeastOnce.When.Bar(99); 118 | mock.Setup.Expect.Between(2,4).When.Bar(23); 119 | 120 | mock.Setup.Expect.Exactly('Bar',5); 121 | 122 | 123 | //Now use our mock object 124 | mock.Instance.MyProp := 'hello'; 125 | mock.Instance.IndexedProp[1] := 'hello'; 126 | 127 | mock.Instance.TestVarParam(msg); 128 | WriteLn('Calling TestVarParam set msg to : ' + msg); 129 | 130 | mock.Instance.TestOutParam(msg); 131 | WriteLn('Calling TestOutParam set msg to : ' + msg); 132 | 133 | 134 | WriteLn('Calling Bar(1) : ' + mock.Instance.Bar(1)); 135 | WriteLn('Calling Bar(2) : ' + mock.Instance.Bar(2)); 136 | WriteLn('Calling Bar(999,sdfsd) : ' + mock.Instance.Bar(999,'sdfsd')); 137 | WriteLn('Calling Bar(2,sdfsd) : ' + mock.Instance.Bar(2,'sdfsd')); 138 | WriteLn('Calling Bar(200) : ' + mock.Instance.Bar(200)); 139 | 140 | WriteLn('Calling1 ReturnObject : ' + mock.Instance.ReturnObject.ClassName); 141 | 142 | 143 | WriteLn(stub.Instance.Bar(1234)); 144 | 145 | 146 | //Test the implicit operator by calling a method that expects IFoo 147 | TestImplicit(mock); 148 | try 149 | // test a method that we have setup to throw an exception 150 | mock.Instance.TestMe; 151 | except 152 | on e : Exception do 153 | begin 154 | WriteLn('We caught an exception : ' + e.Message); 155 | end; 156 | end; 157 | try 158 | mock.Verify('did it work???'); 159 | finally 160 | mock.Free; 161 | end; 162 | end; 163 | 164 | type 165 | TFoo = class 166 | public 167 | function Bar(const param : integer) : string;overload;virtual; 168 | function Bar(const param : integer; const param2 : string) : string;overload;virtual; 169 | procedure TestMe;virtual; 170 | function ReadString(const AName: string): string; virtual; abstract; 171 | end; 172 | 173 | procedure TesTObjectMock; 174 | var 175 | mock : TMock; 176 | begin 177 | mock := TMock.Create; 178 | mock.Setup.WillReturn('hello world').When.Bar(99); 179 | mock.Setup.WillReturn('hello world2').When.Bar(99,'abc'); 180 | mock.Setup.WillReturn('..\datadefinitions\').When.ReadString('DefinitionPath'); 181 | mock.Setup.WillReturn('test\').When.ReadString('Path'); 182 | WriteLn('Bar(99) returned : ' + mock.Instance.Bar(99)); 183 | WriteLn('Bar(99,abc) returned : ' + mock.Instance.Bar(99,'abc')); 184 | Writeln('ReadString(''DefinitionPath'') returned : ' + mock.Instance.ReadString('DefinitionPath')); 185 | Writeln('ReadString(''Path'') returned : ' + mock.Instance.ReadString('Path')); 186 | mock.Free; 187 | end; 188 | 189 | { TFoo } 190 | 191 | function TFoo.Bar(const param: integer): string; 192 | begin 193 | result := IntToStr(param); 194 | end; 195 | 196 | function TFoo.Bar(const param: integer; const param2: string): string; 197 | begin 198 | result := IntToStr(param) + '-' + param2; 199 | end; 200 | 201 | 202 | 203 | procedure TFoo.TestMe; 204 | begin 205 | //do nothing 206 | end; 207 | 208 | end. 209 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Delphi Mocks 2 | 3 | Delphi Mocks is a simple mocking framework for Delphi XE2 or later. It makes use of RTTI features that are only available in Delphi XE2. See the example at the bottom of the space for a complete explanation. 4 | 5 | # Parameter matching 6 | 7 | To match expectations or behavior there is extended parameter matching. 8 | 9 | ```Pascal 10 | function IsAny() : T ; 11 | function Matches(const predicate: TPredicate) : T; 12 | function IsNotNil : T; overload; 13 | function IsNotNil(const comparer: IEqualityComparer) : T; overload; 14 | function IsEqualTo(const value : T) : T; overload; 15 | function IsEqualTo(const value : T; const comparer: IEqualityComparer) : T; overload; 16 | function IsInRange(const fromValue : T; const toValue : T) : T; 17 | function IsIn(const values : TArray) : T; overload; 18 | function IsIn(const values : TArray; const comparer: IEqualityComparer) : T; overload; 19 | function IsIn(const values : IEnumerable) : T; overload; 20 | function IsIn(const values : IEnumerable; const comparer: IEqualityComparer) : T; overload; 21 | function IsNotIn(const values : TArray) : T; overload; 22 | function IsNotIn(const values : TArray; const comparer: IEqualityComparer) : T; overload; 23 | function IsNotIn(const values : IEnumerable) : T; overload; 24 | function IsNotIn(const values : IEnumerable; const comparer: IEqualityComparer) : T; overload; 25 | function IsRegex(const regex : string; const options : TRegExOptions = []) : string; 26 | function AreSamePropertiesThat(const Value: T): T; 27 | function AreSameFieldsThat(const Value: T): T; 28 | function AreSameFieldsAndPropertiedThat(const Value: T): T; 29 | ``` 30 | 31 | Usage is easy: 32 | 33 | ```Pascal 34 | mock.Setup.Expect.Once.When.SimpleMethod(It0.IsAny, It1.IsAny); 35 | mock.Setup.WillReturn(3).When.SimpleFunction(It0.IsEqualTo('hello')); 36 | ``` 37 | 38 | ## Class matching 39 | Some more attention should be payed for matching classes. Usage of `.IsAny` will not work as might be expected, because `nil` (which is the default return value of `IsAny`) is always a good match. Therefore the following setup will fail on the second line, because the framework will think that there is already behavior defined (in the first line). 40 | 41 | ```Pascal 42 | mock.Setup.Expect.Never.When.ExtendedMethod(It0.IsAny); 43 | mock.Setup.Expect.Never.When.ExtendedMethod(It0.IsAny); 44 | ``` 45 | 46 | This can easily be solved by using `.IsNotNil`: 47 | 48 | ```Pascal 49 | mock.Setup.Expect.Never.When.ExtendedMethod(It0.IsNotNil); 50 | mock.Setup.Expect.Never.When.ExtendedMethod(It0.IsNotNil); 51 | ``` 52 | 53 | # Example 54 | 55 | ```Pascal 56 | unit Delphi.Mocks.Examples.Interfaces; 57 | 58 | interface 59 | 60 | uses 61 | SysUtils, 62 | DUnitX.TestFramework, 63 | Delphi.Mocks; 64 | 65 | type 66 | {$M+} 67 | TSimpleInterface = Interface 68 | ['{4131D033-2D80-42B8-AAA1-3C2DF0AC3BBD}'] 69 | procedure SimpleMethod; 70 | end; 71 | 72 | TSystemUnderTestInf = Interface 73 | ['{5E21CA8E-A4BB-4512-BCD4-22D7F10C5A0B}'] 74 | procedure CallsSimpleInterfaceMethod; 75 | end; 76 | {$M-} 77 | 78 | TSystemUnderTest = class(TInterfacedObject, TSystemUnderTestInf) 79 | private 80 | FInternalInf : TSimpleInterface; 81 | public 82 | constructor Create(const ARequiredInf: TSimpleInterface); 83 | procedure CallsSimpleInterfaceMethod; 84 | end; 85 | 86 | TMockObjectTests = class 87 | published 88 | procedure Simple_Interface_Mock; 89 | end; 90 | 91 | implementation 92 | 93 | uses 94 | System.Rtti; 95 | 96 | { TMockObjectTests } 97 | 98 | procedure TMockObjectTests.Simple_Interface_Mock; 99 | var 100 | mock : TMock; 101 | sutObject : TSystemUnderTestInf; 102 | begin 103 | //SETUP: Create a mock of the interface that is required by our system under test object. 104 | mock := TMock.Create; 105 | 106 | //SETUP: Add a check that SimpleMethod is called atleast once. 107 | mock.Setup.Expect.AtLeastOnce.When.SimpleMethod; 108 | 109 | //SETUP: Create the system under test object passing an instance of the mock interface it requires. 110 | sutObject := TSystemUnderTest.Create(mock.Instance); 111 | 112 | //TEST: Call CallsSimpleInterfaceMethod on the system under test. 113 | sutObject.CallsSimpleInterfaceMethod; 114 | 115 | //VERIFY: That our passed in interface was called at least once when CallsSimpleInterfaceMethod was called. 116 | mock.Verify('CallsSimpleInterfaceMethod should call SimpleMethod'); 117 | end; 118 | 119 | { TSystemUnderTest } 120 | 121 | procedure TSystemUnderTest.CallsSimpleInterfaceMethod; 122 | begin 123 | FInternalInf.SimpleMethod; 124 | end; 125 | 126 | constructor TSystemUnderTest.Create(const ARequiredInf: TSimpleInterface); 127 | begin 128 | FInternalInf := ARequiredInf; 129 | end; 130 | 131 | end. 132 | ``` -------------------------------------------------------------------------------- /Source/Delphi.Mocks.AutoMock.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.AutoMock; 2 | 3 | interface 4 | 5 | uses 6 | System.TypInfo, 7 | System.Generics.Collections, 8 | Delphi.Mocks, 9 | Delphi.Mocks.WeakReference; 10 | 11 | type 12 | TAutoMock = class(TWeakReferencedObject, IAutoMock) 13 | private 14 | FMocks : TList; 15 | public 16 | function Mock(const ATypeInfo : PTypeInfo) : IProxy; 17 | procedure Add(const ATypeName : string; const AMock: IProxy); 18 | constructor Create; 19 | destructor Destroy; override; 20 | end; 21 | 22 | //TODO: Add getting out a previously added mock. This would be done in the RecordHit of the method data object. 23 | 24 | implementation 25 | 26 | uses 27 | Delphi.Mocks.Validation, 28 | Delphi.Mocks.Proxy.TypeInfo; 29 | 30 | { TAutoMock } 31 | 32 | procedure TAutoMock.Add(const ATypeName : string; const AMock: IProxy); 33 | begin 34 | FMocks.Add(AMock); 35 | end; 36 | 37 | constructor TAutoMock.Create; 38 | begin 39 | inherited Create; 40 | FMocks := TList.Create; 41 | end; 42 | 43 | destructor TAutoMock.Destroy; 44 | var 45 | I: Integer; 46 | begin 47 | for I := 0 to FMocks.Count - 1 do 48 | FMocks[I] := nil; 49 | 50 | FMocks.Clear; 51 | 52 | inherited; 53 | end; 54 | 55 | function TAutoMock.Mock(const ATypeInfo : PTypeInfo) : IProxy; 56 | var 57 | proxy: IProxy; 58 | proxyAsType: IProxy; 59 | begin 60 | //Raise exceptions if the mock doesn't meet the requirements. 61 | TMocksValidation.CheckMockType(ATypeInfo); 62 | 63 | //We create new mocks using ourself as the auto mocking reference 64 | proxy := TProxy.Create(ATypeInfo, Self, false); 65 | proxyAsType := proxy.ProxyFromType(ATypeInfo); 66 | 67 | FMocks.Add(proxy); 68 | 69 | //Push the proxy into the result we are returning. 70 | if proxyAsType.QueryInterface(GetTypeData(TypeInfo(IProxy)).Guid, result) <> 0 then 71 | //TODO: This raise seems superfluous as the only types which are created are controlled by us above. They all implement IProxy 72 | raise EMockNoProxyException.Create('Error casting to interface ' + ATypeInfo.NameStr + ' , proxy does not appear to implement IProxy'); 73 | end; 74 | 75 | end. 76 | -------------------------------------------------------------------------------- /Source/Delphi.Mocks.Behavior.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { Delphi.Mocks } 4 | { } 5 | { Copyright (C) 2011 Vincent Parrett } 6 | { } 7 | { http://www.finalbuilder.com } 8 | { } 9 | { } 10 | {***************************************************************************} 11 | { } 12 | { Licensed under the Apache License, Version 2.0 (the "License"); } 13 | { you may not use this file except in compliance with the License. } 14 | { You may obtain a copy of the License at } 15 | { } 16 | { http://www.apache.org/licenses/LICENSE-2.0 } 17 | { } 18 | { Unless required by applicable law or agreed to in writing, software } 19 | { distributed under the License is distributed on an "AS IS" BASIS, } 20 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 21 | { See the License for the specific language governing permissions and } 22 | { limitations under the License. } 23 | { } 24 | {***************************************************************************} 25 | 26 | unit Delphi.Mocks.Behavior; 27 | 28 | interface 29 | 30 | uses 31 | System.Rtti, 32 | System.SysUtils, 33 | Delphi.Mocks, 34 | Delphi.Mocks.Interfaces, 35 | Delphi.Mocks.ParamMatcher; 36 | 37 | type 38 | TBehavior = class(TInterfacedObject,IBehavior) 39 | private 40 | FAction : TExecuteFunc; 41 | FExceptClass : ExceptClass; 42 | FExceptionMessage : string; 43 | FReturnValue : TValue; 44 | FArgs : TArray; 45 | FBehaviorType : TBehaviorType; 46 | FHitCount : integer; 47 | FMatchers : TArray; 48 | protected 49 | function GetBehaviorType: TBehaviorType; 50 | function Match(const Args: TArray): Boolean; 51 | function Execute(const Args: TArray; const returnType: TRttiType): TValue; 52 | procedure CopyArgs(const Args: TArray); 53 | public 54 | //disable warnings about c++ compatibility, since we don't intend to support it. 55 | {$WARN DUPLICATE_CTOR_DTOR OFF} 56 | constructor CreateWillExecute(const AAction: TExecuteFunc); 57 | constructor CreateWillExecuteWhen(const Args: TArray; const AAction: TExecuteFunc; const matchers : TArray); 58 | constructor CreateWillReturnWhen(const Args: TArray; const ReturnValue: TValue; const matchers : TArray); 59 | constructor CreateReturnDefault(const ReturnValue: TValue); 60 | constructor CreateWillRaise(const AExceptClass : ExceptClass; const message : string); 61 | constructor CreateWillRaiseWhen(const Args: TArray; const AExceptClass : ExceptClass; const message : string; const matchers : TArray); 62 | end; 63 | 64 | implementation 65 | 66 | uses 67 | Delphi.Mocks.Helpers; 68 | 69 | { TBehavior } 70 | 71 | procedure TBehavior.CopyArgs(const Args: TArray); 72 | var 73 | l : integer; 74 | begin 75 | //Note : Args[0] is the Self Ptr for the proxy, we do not want to keep 76 | //a reference to it so it is ignored here. 77 | l := Length(Args) -1; 78 | if l > 0 then 79 | begin 80 | SetLength(FArgs,l); 81 | CopyArray(@FArgs[0],@args[1],TypeInfo(TValue),l); 82 | end; 83 | end; 84 | 85 | constructor TBehavior.CreateReturnDefault(const ReturnValue: TValue); 86 | begin 87 | FBehaviorType := TBehaviorType.ReturnDefault; 88 | FReturnValue := ReturnValue; 89 | end; 90 | 91 | constructor TBehavior.CreateWillExecute(const AAction: TExecuteFunc); 92 | begin 93 | FBehaviorType := TBehaviorType.WillExecute; 94 | FAction := AAction; 95 | FHitCount := 0; 96 | end; 97 | 98 | constructor TBehavior.CreateWillExecuteWhen(const Args: TArray; const AAction: TExecuteFunc; const matchers : TArray); 99 | begin 100 | FBehaviorType := TBehaviorType.WillExecuteWhen; 101 | CopyArgs(Args); 102 | FAction := AAction; 103 | FHitCount := 0; 104 | FMatchers := matchers; 105 | end; 106 | 107 | constructor TBehavior.CreateWillRaise(const AExceptClass: ExceptClass; const message : string); 108 | begin 109 | FBehaviorType := TBehaviorType.WillRaiseAlways; 110 | FExceptClass := AExceptClass; 111 | FExceptionMessage := message; 112 | FHitCount := 0; 113 | end; 114 | 115 | constructor TBehavior.CreateWillRaiseWhen(const Args: TArray; const AExceptClass: ExceptClass; const message : string; const matchers : TArray); 116 | begin 117 | FBehaviorType := TBehaviorType.WillRaise; 118 | FExceptClass := AExceptClass; 119 | FExceptionMessage := message; 120 | CopyArgs(Args); 121 | FHitCount := 0; 122 | FMatchers := matchers; 123 | end; 124 | 125 | constructor TBehavior.CreateWillReturnWhen(const Args: TArray; const ReturnValue: TValue; const matchers : TArray); 126 | begin 127 | FBehaviorType := TBehaviorType.WillReturn; 128 | CopyArgs(Args); 129 | FReturnValue := ReturnValue; 130 | FHitCount := 0; 131 | FMatchers := matchers; 132 | end; 133 | 134 | function TBehavior.Execute(const Args: TArray; const returnType: TRttiType): TValue; 135 | var 136 | msg : string; 137 | begin 138 | result := TValue.Empty; 139 | try 140 | case FBehaviorType of 141 | WillReturn: result := FReturnValue; 142 | ReturnDefault: result := FReturnValue; 143 | WillRaise,WillRaiseAlways: 144 | begin 145 | if FExceptClass <> nil then 146 | begin 147 | if FExceptionMessage <> '' then 148 | msg := FExceptionMessage 149 | else 150 | msg := 'raised by mock'; 151 | raise FExceptClass.Create(msg); 152 | end; 153 | end; 154 | WillExecute,WillExecuteWhen: 155 | begin 156 | if Assigned(FAction) then 157 | result := FAction(args,returnType); 158 | end; 159 | else 160 | // Hitcount Only 161 | end; 162 | finally 163 | //needs the finally as we may raise an exception above! 164 | Inc(FHitCount); 165 | end; 166 | 167 | end; 168 | 169 | function TBehavior.GetBehaviorType: TBehaviorType; 170 | begin 171 | Result := FBehaviorType; 172 | end; 173 | 174 | function TBehavior.Match(const Args: TArray): Boolean; 175 | 176 | function MatchArgs : boolean; 177 | var 178 | i : integer; 179 | begin 180 | result := False; 181 | if Length(Args) <> (Length(FArgs) + 1 ) then 182 | exit; 183 | //start at 1 as we don't care about matching the first arg (self) 184 | for i := 1 to Length(args) -1 do 185 | begin 186 | if not FArgs[i -1].Equals(args[i]) then 187 | exit; 188 | end; 189 | result := True; 190 | end; 191 | 192 | function MatchWithMatchers: Boolean; 193 | var 194 | i : integer; 195 | begin 196 | result := False; 197 | for i := 0 to High(FMatchers) do 198 | begin 199 | if not FMatchers[i].Match(Args[i+1]) then 200 | exit; 201 | end; 202 | result := True; 203 | end; 204 | 205 | begin 206 | result := False; 207 | 208 | if Length(FMatchers) > 0 then 209 | begin 210 | result := MatchWithMatchers; 211 | end else begin 212 | case FBehaviorType of 213 | WillReturn : result := MatchArgs; 214 | ReturnDefault : result := True; 215 | WillRaise : 216 | begin 217 | result := MatchArgs; 218 | if FExceptClass <> nil then 219 | raise FExceptClass.Create('Raised by Mock'); 220 | end; 221 | WillRaiseAlways : result := True; 222 | WillExecuteWhen : result := MatchArgs; 223 | WillExecute : result := True; 224 | end; 225 | end; 226 | end; 227 | 228 | end. 229 | -------------------------------------------------------------------------------- /Source/Delphi.Mocks.Interfaces.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { Delphi.Mocks } 4 | { } 5 | { Copyright (C) 2011 Vincent Parrett } 6 | { } 7 | { http://www.finalbuilder.com } 8 | { } 9 | { } 10 | {***************************************************************************} 11 | { } 12 | { Licensed under the Apache License, Version 2.0 (the "License"); } 13 | { you may not use this file except in compliance with the License. } 14 | { You may obtain a copy of the License at } 15 | { } 16 | { http://www.apache.org/licenses/LICENSE-2.0 } 17 | { } 18 | { Unless required by applicable law or agreed to in writing, software } 19 | { distributed under the License is distributed on an "AS IS" BASIS, } 20 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 21 | { See the License for the specific language governing permissions and } 22 | { limitations under the License. } 23 | { } 24 | {***************************************************************************} 25 | 26 | unit Delphi.Mocks.Interfaces; 27 | 28 | interface 29 | 30 | uses 31 | System.SysUtils, 32 | System.TypInfo, 33 | System.Rtti, 34 | System.Generics.Collections, 35 | Delphi.Mocks, 36 | Delphi.Mocks.ParamMatcher; 37 | 38 | type 39 | TBehaviorType = (WillReturn,ReturnDefault,WillRaise,WillRaiseAlways,WillExecute,WillExecuteWhen); 40 | 41 | IBehavior = interface 42 | ['{9F6FE14D-4522-48EE-B564-20E2BECF7992}'] 43 | function GetBehaviorType : TBehaviorType; 44 | function Match(const Args: TArray) : boolean; 45 | function Execute(const Args: TArray; const returnType : TRttiType) : TValue; 46 | property BehaviorType : TBehaviorType read GetBehaviorType; 47 | end; 48 | 49 | TExpectationType = (Once, //Called once only 50 | OnceWhen, //Called once only with specified params 51 | Never, //Never called 52 | NeverWhen, //Never called with specified params 53 | AtLeastOnce, //1 or more times 54 | AtLeastOnceWhen,//1 or more times with specified params 55 | AtLeast, //x or more times 56 | AtLeastWhen, //x or more times with specified params 57 | AtMostOnce, //0 or 1 times 58 | AtMostOnceWhen, //0 or 1 times with specified params 59 | AtMost, //0 to X times 60 | AtMostWhen, //0 to X times with specified params 61 | Between, //Between X & Y Inclusive times 62 | BetweenWhen, //Between X & Y Inclusive times with specified params 63 | Exactly, //Exactly X times 64 | ExactlyWhen, //Exactly X times with specified params 65 | Before, //Must be called before Method X is called 66 | BeforeWhen, //Must be called before Method x is called with specified params 67 | After, //Must be called after Method X is called 68 | AfterWhen); //Must be called after Method x is called with specified params 69 | TExpectationTypes = set of TExpectationType; 70 | 71 | IExpectation = interface 72 | ['{960B95B2-581D-4C18-A320-7E19190F29EF}'] 73 | function GetExpectationType : TExpectationType; 74 | function GetExpectationMet : boolean; 75 | function Match(const Args : TArray) : boolean; 76 | procedure RecordHit; 77 | procedure ResetCalls; 78 | function Report : string; 79 | property ExpectationType : TExpectationType read GetExpectationType; 80 | property ExpectationMet : boolean read GetExpectationMet; 81 | end; 82 | 83 | 84 | IMethodData = interface 85 | ['{640BFB71-85C2-4ED4-A863-5AF6535BD2E8}'] 86 | procedure RecordHit(const Args: TArray; const returnType : TRttiType; const method : TRttiMethod; out Result: TValue); 87 | 88 | //behaviors 89 | procedure WillReturnDefault(const returnValue : TValue); 90 | procedure WillReturnWhen(const Args: TArray; const returnValue : TValue; const matchers : TArray); 91 | procedure WillRaiseAlways(const exceptionClass : ExceptClass; const message : string); 92 | procedure WillRaiseWhen(const exceptionClass : ExceptClass; const message : string; const Args: TArray; const matchers : TArray); 93 | procedure WillExecute(const func : TExecuteFunc); 94 | procedure WillExecuteWhen(const func : TExecuteFunc; const Args: TArray; const matchers : TArray); 95 | 96 | //expectations 97 | procedure OnceWhen(const Args : TArray; const matchers : TArray); 98 | procedure Once; 99 | procedure NeverWhen(const Args : TArray; const matchers : TArray); 100 | procedure Never; 101 | procedure AtLeastOnceWhen(const Args : TArray; const matchers : TArray); 102 | procedure AtLeastOnce; 103 | procedure AtLeastWhen(const times : Cardinal; const Args : TArray; const matchers : TArray); 104 | procedure AtLeast(const times : Cardinal); 105 | procedure AtMostWhen(const times : Cardinal; const Args : TArray; const matchers : TArray); 106 | procedure AtMost(const times : Cardinal); 107 | procedure BetweenWhen(const a,b : Cardinal; const Args : TArray; const matchers : TArray); 108 | procedure Between(const a,b : Cardinal); 109 | procedure ExactlyWhen(const times : Cardinal; const Args : TArray; const matchers : TArray); 110 | procedure Exactly(const times : Cardinal); 111 | procedure BeforeWhen(const ABeforeMethodName : string ; const Args : TArray; const matchers : TArray); 112 | procedure Before(const ABeforeMethodName : string); 113 | procedure AfterWhen(const AAfterMethodName : string;const Args : TArray; const matchers : TArray); 114 | procedure After(const AAfterMethodName : string); 115 | procedure ClearExpectations; 116 | 117 | //Verification 118 | function Verify(var report : string) : boolean; 119 | procedure ResetCalls; 120 | 121 | function FindBestBehavior(const Args: TArray) : IBehavior; 122 | end; 123 | 124 | IVerify = interface 125 | ['{58C05610-4BDA-451E-9D61-17C6376C3B3F}'] 126 | procedure Verify(const message : string = ''); 127 | procedure VerifyAll(const message : string = ''); 128 | function CheckExpectations: string; 129 | procedure ResetCalls; 130 | end; 131 | 132 | implementation 133 | 134 | end. 135 | -------------------------------------------------------------------------------- /Source/Delphi.Mocks.ObjectProxy.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { Delphi.Mocks } 4 | { } 5 | { Copyright (C) 2011 Vincent Parrett } 6 | { } 7 | { http://www.finalbuilder.com } 8 | { } 9 | { } 10 | {***************************************************************************} 11 | { } 12 | { Licensed under the Apache License, Version 2.0 (the "License"); } 13 | { you may not use this file except in compliance with the License. } 14 | { You may obtain a copy of the License at } 15 | { } 16 | { http://www.apache.org/licenses/LICENSE-2.0 } 17 | { } 18 | { Unless required by applicable law or agreed to in writing, software } 19 | { distributed under the License is distributed on an "AS IS" BASIS, } 20 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 21 | { See the License for the specific language governing permissions and } 22 | { limitations under the License. } 23 | { } 24 | {***************************************************************************} 25 | 26 | unit Delphi.Mocks.ObjectProxy; 27 | 28 | interface 29 | 30 | uses 31 | System.Rtti, 32 | System.SysUtils, 33 | System.TypInfo, 34 | System.Generics.Collections, 35 | Delphi.Mocks, 36 | Delphi.Mocks.Interfaces, 37 | Delphi.Mocks.Proxy; 38 | 39 | type 40 | TObjectProxy = class(TProxy) 41 | private 42 | FInstance : T; 43 | FVMInterceptor : TVirtualMethodInterceptor; 44 | protected 45 | procedure DoBefore(Instance: TObject; Method: TRttiMethod; const Args: TArray; out DoInvoke: Boolean; out Result: TValue); 46 | function Proxy : T; override; 47 | public 48 | constructor Create( const ACreateFunc: TFunc; const AAutoMocker : IAutoMock = nil; const AIsStubOnly : boolean = false); reintroduce; 49 | destructor Destroy; override; 50 | end; 51 | 52 | implementation 53 | 54 | uses 55 | Delphi.Mocks.Helpers; 56 | 57 | { TObjectProxy } 58 | 59 | constructor TObjectProxy.Create(const ACreateFunc: TFunc; const AAutoMocker : IAutoMock; const AIsStubOnly : boolean); 60 | var 61 | ctx : TRttiContext; 62 | rType : TRttiType; 63 | ctor : TRttiMethod; 64 | instance : TValue; 65 | begin 66 | inherited Create(AAutoMocker, AIsStubOnly); 67 | ctx := TRttiContext.Create; 68 | rType := ctx.GetType(TypeInfo(T)); 69 | if rType = nil then 70 | raise EMockNoRTTIException.Create('No TypeInfo found for T'); 71 | 72 | if not Assigned(ACreateFunc) then 73 | begin 74 | ctor := rType.FindConstructor; 75 | if ctor = nil then 76 | raise EMockException.Create('Could not find constructor Create on type ' + rType.Name); 77 | 78 | instance := ctor.Invoke(rType.AsInstance.MetaclassType, []); 79 | end 80 | else 81 | instance := TValue.From(ACreateFunc); 82 | FInstance := instance.AsType(); 83 | FVMInterceptor := TVirtualMethodInterceptor.Create(rType.AsInstance.MetaclassType); 84 | 85 | FVMInterceptor.Proxify(instance.AsObject); 86 | FVMInterceptor.OnBefore := DoBefore; 87 | end; 88 | 89 | destructor TObjectProxy.Destroy; 90 | begin 91 | TObject(Pointer(@FInstance)^).Free;//always destroy the instance before the interceptor. 92 | FVMInterceptor.Free; 93 | inherited; 94 | end; 95 | 96 | procedure TObjectProxy.DoBefore(Instance: TObject; Method: TRttiMethod; const Args: TArray; out DoInvoke: Boolean; out Result: TValue); 97 | var 98 | vArgs: TArray; 99 | i, l: Integer; 100 | methodData : IMethodData; 101 | pInfo : PTypeInfo; 102 | begin 103 | //don't intercept the TObject methods like BeforeDestruction etc. 104 | if Method.Parent.AsInstance.MetaclassType <> TObject then 105 | begin 106 | pInfo := TypeInfo(T); 107 | methodData := GetMethodData(method.Name,pInfo.NameStr); 108 | 109 | //Included instance as first argument because TExpectation.Match 110 | //deduces that the first argument is the object instance. 111 | l := Length(Args); 112 | SetLength(vArgs, l+1); 113 | vArgs[0] := Instance; 114 | 115 | for i := 1 to l do 116 | begin 117 | vArgs[i] := Args[i-1]; 118 | end; 119 | 120 | //Call the original (virtual) method if: 121 | //-we are not a stub 122 | //-we have not defined any behavior (of course we count hits) 123 | //-the actual method is not an abstract method 124 | //-we are not setting up 125 | DoInvoke := not (FIsStubOnly or (methodData.FindBestBehavior(vArgs) <> nil) or Method.IsAbstract or (FSetupMode <> TSetupMode.None)); 126 | 127 | Self.DoInvoke(Method,vArgs,Result); 128 | 129 | for i := 1 to l do 130 | begin 131 | Args[i-1] := vArgs[i]; 132 | end; 133 | end; 134 | end; 135 | 136 | function TObjectProxy.Proxy: T; 137 | begin 138 | result := FInstance; 139 | end; 140 | 141 | end. 142 | 143 | -------------------------------------------------------------------------------- /Source/Delphi.Mocks.ParamMatcher.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { Delphi.Mocks } 4 | { } 5 | { Copyright (C) 2011 Vincent Parrett } 6 | { } 7 | { http://www.finalbuilder.com } 8 | { } 9 | { } 10 | {***************************************************************************} 11 | { } 12 | { Licensed under the Apache License, Version 2.0 (the "License"); } 13 | { you may not use this file except in compliance with the License. } 14 | { You may obtain a copy of the License at } 15 | { } 16 | { http://www.apache.org/licenses/LICENSE-2.0 } 17 | { } 18 | { Unless required by applicable law or agreed to in writing, software } 19 | { distributed under the License is distributed on an "AS IS" BASIS, } 20 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 21 | { See the License for the specific language governing permissions and } 22 | { limitations under the License. } 23 | { } 24 | {***************************************************************************} 25 | 26 | unit Delphi.Mocks.ParamMatcher; 27 | 28 | interface 29 | 30 | uses 31 | System.Generics.Collections, 32 | System.SysUtils, 33 | System.TypInfo, 34 | System.Rtti; 35 | 36 | 37 | type 38 | IMatcher = interface 39 | ['{C0F66756-F6DF-44D2-B3FC-E6B60F843D23}'] 40 | function Match(const value : TValue) : boolean; 41 | end; 42 | 43 | TMatcher = class(TInterfacedObject, IMatcher) 44 | private 45 | FPredicate : TPredicate; 46 | protected 47 | function Match(const value : TValue) : boolean; 48 | public 49 | constructor Create(const predicate : TPredicate); 50 | end; 51 | 52 | TMatcherFactory = class 53 | private 54 | class var 55 | FMatchers : TObjectDictionary>; 56 | FLock : TObject; 57 | protected 58 | class constructor Create; 59 | class destructor Destroy; 60 | class procedure AddMatcher(const paramIndex : integer; const matcher : IMatcher); 61 | public 62 | class procedure Create(const paramIndex : integer; const predicate: TPredicate); 63 | class function GetMatchers : TArray; 64 | end; 65 | 66 | 67 | implementation 68 | 69 | uses 70 | System.Classes, 71 | System.SyncObjs; 72 | 73 | 74 | { TMatcherFactory } 75 | 76 | class procedure TMatcherFactory.Create(const paramIndex : integer; const predicate: TPredicate); 77 | var 78 | matcher : IMatcher; 79 | begin 80 | matcher := TMatcher.Create(predicate); 81 | AddMatcher(paramIndex, matcher); 82 | end; 83 | 84 | { TMatcher } 85 | 86 | constructor TMatcher.Create(const predicate: TPredicate); 87 | begin 88 | FPredicate := predicate; 89 | end; 90 | 91 | function TMatcher.Match(const value: TValue): boolean; 92 | begin 93 | try 94 | result := FPredicate(value.AsType); 95 | except 96 | on E: EInvalidCast do 97 | Result := False 98 | else 99 | raise; 100 | end; 101 | end; 102 | 103 | class constructor TMatcherFactory.Create; 104 | begin 105 | FMatchers := TObjectDictionary>.Create([doOwnsValues]); 106 | FLock := TObject.Create; 107 | end; 108 | 109 | class destructor TMatcherFactory.Destroy; 110 | var 111 | pair : TPair>; 112 | begin 113 | for pair in FMatchers do 114 | pair.Value.Free; 115 | FMatchers.Free; 116 | FLock.Free; 117 | end; 118 | 119 | class function TMatcherFactory.GetMatchers : TArray; 120 | var 121 | threadMatchers : TList; 122 | begin 123 | SetLength(result,0); 124 | MonitorEnter(FLock); 125 | try 126 | if FMatchers.TryGetValue(TThread.CurrentThread.ThreadID,threadMatchers) then 127 | begin 128 | result := threadMatchers.ToArray; 129 | FMatchers.Remove(TThread.CurrentThread.ThreadID); 130 | end; 131 | finally 132 | MonitorExit(FLock); 133 | end; 134 | end; 135 | 136 | class procedure TMatcherFactory.AddMatcher(const paramIndex : integer; const matcher : IMatcher); 137 | var 138 | threadMatchers : TList; 139 | begin 140 | MonitorEnter(FLock); 141 | try 142 | if not FMatchers.TryGetValue(TThread.CurrentThread.ThreadID,threadMatchers) then 143 | begin 144 | threadMatchers := TList.Create; 145 | FMatchers.Add(TThread.CurrentThread.ThreadID,threadMatchers); 146 | end; 147 | 148 | while paramIndex > threadMatchers.Count - 1 do 149 | threadMatchers.Add(nil); 150 | 151 | if threadMatchers[paramIndex] = nil then 152 | threadMatchers[paramIndex] := matcher 153 | else 154 | threadMatchers.Insert(paramIndex, matcher); 155 | 156 | finally 157 | MonitorExit(FLock); 158 | end; 159 | end; 160 | 161 | end. 162 | -------------------------------------------------------------------------------- /Source/Delphi.Mocks.ReturnTypePatch.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { Delphi.Mocks } 4 | { } 5 | { Copyright (C) 2011 Vincent Parrett } 6 | { } 7 | { http://www.finalbuilder.com } 8 | { } 9 | { } 10 | {***************************************************************************} 11 | { } 12 | { Licensed under the Apache License, Version 2.0 (the "License"); } 13 | { you may not use this file except in compliance with the License. } 14 | { You may obtain a copy of the License at } 15 | { } 16 | { http://www.apache.org/licenses/LICENSE-2.0 } 17 | { } 18 | { Unless required by applicable law or agreed to in writing, software } 19 | { distributed under the License is distributed on an "AS IS" BASIS, } 20 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 21 | { See the License for the specific language governing permissions and } 22 | { limitations under the License. } 23 | { } 24 | {***************************************************************************} 25 | 26 | (* 27 | This unit courtesy of Stefen Glienke. 28 | 29 | This unit is a work around for QC98687 where RTTI is not generated for 30 | return types which are alias's of a generic type. 31 | 32 | http://qc.embarcadero.com/wc/qcmain.aspx?d=98687 33 | 34 | Usage : 35 | 36 | TOnFinalizedEvent = TMulticastEvent; 37 | 38 | type // <- mandatory otherwise you get: E2086 Type 'TMulticastEvent' is not yet completely defined 39 | {$M+} 40 | ISomeInterface = interface 41 | ['{7620908B-6DB7-4616-9A6F-AB2934F67077}'] 42 | [ReturnTypePatch(TypeInfo(TOnFinalizedEvent))] //<<< 43 | function GetOnFinalized: TOnFinalizedEvent; 44 | property OnFinalized: TOnFinalizedEvent read GetOnFinalized; 45 | end; 46 | 47 | initialization 48 | PatchMethodReturnType(TypeInfo(ISomeInterface)); 49 | 50 | *) 51 | 52 | unit Delphi.Mocks.ReturnTypePatch; 53 | 54 | interface 55 | 56 | uses 57 | System.Rtti, 58 | System.TypInfo; 59 | 60 | type 61 | ReturnTypePatchAttribute = class(TCustomAttribute) 62 | private 63 | FReturnType: PTypeInfo; 64 | public 65 | constructor Create(ATypeInfo: PTypeInfo); 66 | end; 67 | 68 | procedure PatchMethodReturnType(ATypeInfo: PTypeInfo); overload; 69 | procedure PatchMethodReturnType(const ATypeInfo: PTypeInfo; const AMethodName : string; const AReturnType: PTypeInfo); overload; 70 | procedure PatchMethodReturnType(AMethod: TRttiMethod; AReturnType: PTypeInfo); overload; 71 | 72 | implementation 73 | 74 | uses 75 | Winapi.Windows; 76 | 77 | type 78 | TRttiIntfMethod = class(TRttiMethod) 79 | public 80 | FTail: PIntfMethodEntryTail; 81 | FParameters: TArray; 82 | FReturnType: PTypeInfo; 83 | end; 84 | 85 | var 86 | ReturnTypes: array of PPTypeInfo; 87 | 88 | procedure Finalize; 89 | var 90 | i: Integer; 91 | begin 92 | for i := High(ReturnTypes) downto Low(ReturnTypes) do 93 | Dispose(ReturnTypes[i]); 94 | end; 95 | 96 | function NeedsPatch(AMethod: TRttiMethod): Boolean; 97 | begin 98 | Result := (AMethod.MethodKind = mkFunction) and (AMethod.ReturnType = nil); 99 | end; 100 | 101 | procedure PatchMethodReturnType(const ATypeInfo: PTypeInfo; const AMethodName : string; const AReturnType: PTypeInfo); overload; 102 | var 103 | LContext: TRttiContext; 104 | LMethod: TRttiMethod; 105 | begin 106 | for LMethod in LContext.GetType(ATypeInfo).GetDeclaredMethods do 107 | begin 108 | if LMethod.Name = AMethodName then 109 | begin 110 | if NeedsPatch(LMethod) then 111 | begin 112 | PatchMethodReturnType(LMethod, AReturnType); 113 | end; 114 | end; 115 | end; 116 | LContext.Free; 117 | end; 118 | 119 | 120 | procedure PatchMethodReturnType(ATypeInfo: PTypeInfo); 121 | var 122 | LContext: TRttiContext; 123 | LMethod: TRttiMethod; 124 | LAttribute: TCustomAttribute; 125 | begin 126 | for LMethod in LContext.GetType(ATypeInfo).GetDeclaredMethods do 127 | begin 128 | if NeedsPatch(LMethod) then 129 | begin 130 | for LAttribute in LMethod.GetAttributes do 131 | begin 132 | if LAttribute is ReturnTypePatchAttribute then 133 | PatchMethodReturnType(LMethod, ReturnTypePatchAttribute(LAttribute).FReturnType); 134 | end; 135 | end; 136 | end; 137 | LContext.Free; 138 | end; 139 | 140 | procedure PatchMethodReturnType(AMethod: TRttiMethod; AReturnType: PTypeInfo); 141 | var 142 | p: PByte; 143 | i: Integer; 144 | LByteCount: NativeUInt; 145 | LReturnType: PPTypeInfo; 146 | 147 | procedure SkipShortString(var p: PByte); 148 | begin 149 | Inc(p, p[0] + 1); 150 | end; 151 | 152 | begin 153 | if not NeedsPatch(AMethod) then 154 | Exit; 155 | 156 | Pointer(p) := TRttiIntfMethod(AMethod).FTail; 157 | Inc(p, SizeOf(TIntfMethodEntryTail)); 158 | 159 | for i := 0 to TRttiIntfMethod(AMethod).FTail.ParamCount - 1 do 160 | begin 161 | Inc(p); // Flags 162 | SkipShortString(p); // ParamName 163 | SkipShortString(p); // TypeName 164 | Inc(p, SizeOf(PTypeInfo)); // ParamType 165 | Inc(p, PWord(p)^); // AttrData 166 | end; 167 | 168 | LReturnType := nil; 169 | 170 | for i := Low(ReturnTypes) to High(ReturnTypes) do 171 | begin 172 | if ReturnTypes[i]^ = AReturnType then 173 | begin 174 | LReturnType := ReturnTypes[i]; 175 | Break; 176 | end; 177 | end; 178 | 179 | if LReturnType = nil then 180 | begin 181 | i := Length(ReturnTypes); 182 | SetLength(ReturnTypes, i + 1); 183 | New(LReturnType); 184 | LReturnType^ := AReturnType; 185 | ReturnTypes[i] := LReturnType; 186 | end; 187 | 188 | SkipShortString(p); 189 | WriteProcessMemory(GetCurrentProcess, p, @LReturnType, SizeOf(Pointer), LByteCount); 190 | TRttiIntfMethod(AMethod).FReturnType := LReturnType^; 191 | end; 192 | 193 | constructor ReturnTypePatchAttribute.Create(ATypeInfo: PTypeInfo); 194 | begin 195 | FReturnType := ATypeInfo; 196 | end; 197 | 198 | initialization 199 | 200 | finalization 201 | Finalize; 202 | 203 | end. 204 | -------------------------------------------------------------------------------- /Source/Delphi.Mocks.Utils.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { Delphi.Mocks } 4 | { } 5 | { Copyright (C) 2011 Vincent Parrett } 6 | { } 7 | { http://www.finalbuilder.com } 8 | { } 9 | { } 10 | {***************************************************************************} 11 | { } 12 | { Licensed under the Apache License, Version 2.0 (the "License"); } 13 | { you may not use this file except in compliance with the License. } 14 | { You may obtain a copy of the License at } 15 | { } 16 | { http://www.apache.org/licenses/LICENSE-2.0 } 17 | { } 18 | { Unless required by applicable law or agreed to in writing, software } 19 | { distributed under the License is distributed on an "AS IS" BASIS, } 20 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 21 | { See the License for the specific language governing permissions and } 22 | { limitations under the License. } 23 | { } 24 | {***************************************************************************} 25 | 26 | 27 | unit Delphi.Mocks.Utils; 28 | 29 | interface 30 | 31 | uses 32 | System.TypInfo, 33 | System.Rtti; 34 | 35 | function CheckInterfaceHasRTTI(const info : PTypeInfo) : boolean; 36 | 37 | function CheckClassHasRTTI(const info: PTypeInfo): boolean; 38 | 39 | function GetVirtualMethodCount(AClass: TClass): Integer; 40 | 41 | function GetDefaultValue(const rttiType : TRttiType) : TValue; 42 | 43 | function ArgsToString(const Args: TArray; OffSet: Integer = 0): string; 44 | 45 | implementation 46 | 47 | uses 48 | System.Variants, 49 | System.SysUtils; 50 | 51 | function CheckInterfaceHasRTTI(const info : PTypeInfo) : boolean; 52 | var 53 | rType : TRttiType; 54 | ctx : TRttiContext; 55 | methods : TArray; 56 | begin 57 | ctx := TRttiContext.Create; 58 | rType := ctx.GetType(info); 59 | methods := rType.GetMethods; 60 | 61 | result := Length(methods) > 0; 62 | end; 63 | 64 | function CheckClassHasRTTI(const info: PTypeInfo): boolean; 65 | var 66 | rType : TRttiType; 67 | ctx : TRttiContext; 68 | rttiMethods : TArray; 69 | rttiTObjectMethods : TArray; 70 | virtualMethods : Integer; 71 | 72 | rTObjectType : TRttiType; 73 | 74 | begin 75 | ctx := TRttiContext.Create; 76 | rType := ctx.GetType(info); 77 | rttiMethods := rType.GetMethods; 78 | 79 | rTObjectType := ctx.GetType(TypeInfo(TObject)); 80 | 81 | rttiTObjectMethods := rTObjectType.GetMethods; 82 | 83 | 84 | virtualMethods := GetVirtualMethodCount(GetTypeData(info).ClassType); 85 | 86 | result := (virtualMethods > 12);// and (Length(rttiMethods) > Length(rttiTObjectMethods)); 87 | end; 88 | 89 | 90 | //courtesy of Allen Bauer on stackoverflow 91 | //http://stackoverflow.com/questions/760513/where-can-i-find-information-on-the-structure-of-the-delphi-vmt 92 | function GetVirtualMethodCount(AClass: TClass): Integer; 93 | begin 94 | //Note that this returns all virtual methods in the class, including those from the base class. 95 | //Therefore anything that inherits from TObject will have atleast 12 virtual methods already 96 | Result := (PInteger(Integer(AClass) + vmtClassName)^ - 97 | (Integer(AClass) + vmtParent) - SizeOf(Pointer)) div SizeOf(Pointer); 98 | end; 99 | 100 | //TODO : There must be a better way than this. How does Default(X) work? Couldn't find the implementation. 101 | function GetDefaultValue(const rttiType : TRttiType) : TValue; 102 | begin 103 | result := TValue.Empty; 104 | case rttiType.TypeKind of 105 | tkUnknown: ; 106 | tkInteger: result := TValue.From(0); 107 | tkChar: result := TValue.From(#0); 108 | tkEnumeration: result := TValue.FromOrdinal(rttiType.Handle,rttiType.AsOrdinal.MinValue); 109 | tkFloat: result := TValue.From(0); 110 | tkString: result := TValue.From(''); 111 | tkSet: result := TValue.FromOrdinal(rttiType.Handle,rttiType.AsOrdinal.MinValue); 112 | tkClass: result := TValue.From(nil); 113 | tkMethod: result := TValue.From(nil); 114 | tkWChar: result := TValue.From(#0); 115 | tkLString: result := TValue.From(''); 116 | tkWString: result := TValue.From(''); 117 | tkVariant: result := TValue.From(null); 118 | tkArray: ; 119 | tkRecord: ; 120 | tkInterface: result := TValue.From(nil); 121 | tkInt64: result := TValue.FromOrdinal(rttiType.Handle,0); 122 | tkDynArray: ; 123 | tkUString: result := TValue.From(''); 124 | tkClassRef: result := TValue.From(nil); 125 | tkPointer: result := TValue.From(nil); 126 | tkProcedure: result := TValue.From(nil); 127 | end; 128 | end; 129 | 130 | function ArgsToString(const Args: TArray; OffSet: Integer = 0): string; 131 | var 132 | i : integer; 133 | begin 134 | result := EmptyStr; 135 | for i := Low(Args) + OffSet to High(Args) do 136 | begin 137 | if (result <> EmptyStr) then 138 | result := result + ', '; 139 | result := result + Args[i].ToString; 140 | end; 141 | result := '( ' + result + ' )'; 142 | end; 143 | 144 | end. 145 | -------------------------------------------------------------------------------- /Source/Delphi.Mocks.Validation.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.Validation; 2 | 3 | interface 4 | 5 | uses 6 | System.TypInfo; 7 | 8 | type 9 | TMocksValidation = class(TObject) 10 | class procedure CheckMockType(const ATypeInfo : PTypeInfo); static; 11 | class procedure CheckMockInterface(const ATypeInfo : PTypeInfo); static; 12 | class procedure CheckMockObject(const ATypeInfo : PTypeInfo); static; 13 | end; 14 | 15 | implementation 16 | 17 | uses 18 | Delphi.Mocks.Utils, 19 | Delphi.Mocks; 20 | 21 | { MocksValidation } 22 | 23 | class procedure TMocksValidation.CheckMockInterface(const ATypeInfo : PTypeInfo); 24 | begin 25 | //Check to make sure we have 26 | if not CheckInterfaceHasRTTI(ATypeInfo) then 27 | raise EMockNoRTTIException.Create(ATypeInfo.NameStr + ' does not have RTTI, specify {$M+} for the interface to enabled RTTI'); 28 | end; 29 | 30 | class procedure TMocksValidation.CheckMockObject(const ATypeInfo: PTypeInfo); 31 | begin 32 | //Check to make sure we have 33 | if not CheckClassHasRTTI(ATypeInfo) then 34 | raise EMockNoRTTIException.Create(ATypeInfo.NameStr + ' does not have RTTI, specify {$M+} for the object to enabled RTTI'); 35 | end; 36 | 37 | class procedure TMocksValidation.CheckMockType(const ATypeInfo: PTypeInfo); 38 | begin 39 | if not (ATypeInfo.Kind in [tkInterface,tkClass]) then 40 | raise EMockException.Create(ATypeInfo.NameStr + ' is not an Interface or Class. TMock supports interfaces and classes only'); 41 | 42 | case ATypeInfo.Kind of 43 | //NOTE: We have a weaker requirement for an object proxy opposed to an interface proxy. 44 | //NOTE: Object proxy doesn't require more than zero methods on the object. 45 | tkClass : CheckMockObject(ATypeInfo); 46 | tkInterface : CheckMockInterface(ATypeInfo); 47 | else 48 | raise EMockException.Create('Invalid type kind T'); 49 | end; 50 | end; 51 | 52 | 53 | end. 54 | -------------------------------------------------------------------------------- /Source/Delphi.Mocks.WeakReference.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { Delphi Mocks - Taken from DUnitX Project } 4 | { } 5 | { Copyright (C) 2013 Vincent Parrett } 6 | { } 7 | { vincent@finalbuilder.com } 8 | { http://www.finalbuilder.com } 9 | { } 10 | { } 11 | {***************************************************************************} 12 | { } 13 | { Licensed under the Apache License, Version 2.0 (the "License"); } 14 | { you may not use this file except in compliance with the License. } 15 | { You may obtain a copy of the License at } 16 | { } 17 | { http://www.apache.org/licenses/LICENSE-2.0 } 18 | { } 19 | { Unless required by applicable law or agreed to in writing, software } 20 | { distributed under the License is distributed on an "AS IS" BASIS, } 21 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 22 | { See the License for the specific language governing permissions and } 23 | { limitations under the License. } 24 | { } 25 | {***************************************************************************} 26 | 27 | unit Delphi.Mocks.WeakReference; 28 | 29 | 30 | interface 31 | 32 | {$I 'Delphi.Mocks.inc'} 33 | uses 34 | System.Generics.Collections; 35 | 36 | type 37 | /// Implemented by our weak referenced object base class 38 | IWeakReferenceableObject = interface 39 | ['{3D7F9CB5-27F2-41BF-8C5F-F6195C578755}'] 40 | procedure AddWeakRef(value : Pointer); 41 | procedure RemoveWeakRef(value : Pointer); 42 | function GetRefCount : integer; 43 | end; 44 | 45 | /// This is our base class for any object that can have a weak reference to 46 | /// it. It implements IInterface so the object can also be used just like 47 | /// any normal reference counted objects in Delphi. 48 | TWeakReferencedObject = class(TObject, IInterface, IWeakReferenceableObject) 49 | private const 50 | objDestroyingFlag = Integer($80000000); 51 | protected 52 | {$IFNDEF AUTOREFCOUNT} 53 | FRefCount: Integer; 54 | {$ENDIF} 55 | FWeakReferences : TList; 56 | function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; 57 | function _AddRef: Integer; virtual; stdcall; 58 | function _Release: Integer; virtual;stdcall; 59 | procedure AddWeakRef(value : Pointer); 60 | procedure RemoveWeakRef(value : Pointer); 61 | function GetRefCount : integer; inline; 62 | public 63 | procedure AfterConstruction; override; 64 | procedure BeforeDestruction; override; 65 | {$IFDEF NEXTGEN}[Result: Unsafe]{$ENDIF} class function NewInstance: TObject; override; 66 | {$IFNDEF AUTOREFCOUNT} 67 | property RefCount: Integer read GetRefCount; 68 | {$ENDIF} 69 | end; 70 | 71 | // This is our generic WeakReference interface 72 | IWeakReference = interface 73 | function IsAlive : boolean; 74 | function Data : T; 75 | end; 76 | 77 | //The actual WeakReference implementation. 78 | TWeakReference = class(TInterfacedObject, IWeakReference) 79 | private 80 | FData : Pointer; 81 | protected 82 | function IsAlive : boolean; 83 | function Data : T; 84 | public 85 | constructor Create(const data : T); 86 | destructor Destroy;override; 87 | end; 88 | 89 | //only here to work around compiler limitation. 90 | function SafeMonitorTryEnter(const AObject: TObject): Boolean; 91 | 92 | const 93 | SWeakReferenceError = 'TWeakReference can only be used with objects derived from TWeakReferencedObject'; 94 | 95 | 96 | implementation 97 | 98 | uses 99 | System.TypInfo, 100 | System.Classes, 101 | System.Sysutils, 102 | System.SyncObjs; 103 | 104 | //MonitorTryEnter doesn't do a nil check! 105 | function SafeMonitorTryEnter(const AObject: TObject): Boolean; 106 | begin 107 | if AObject <> nil then 108 | Result := TMonitor.TryEnter(AObject) 109 | else 110 | result := False; 111 | end; 112 | 113 | 114 | constructor TWeakReference.Create(const data: T); 115 | var 116 | target : IWeakReferenceableObject; 117 | begin 118 | if data = nil then 119 | raise Exception.Create(format('[%s] passed to TWeakReference was nil', [PTypeInfo(TypeInfo(T)).Name])); 120 | 121 | inherited Create; 122 | 123 | if Supports(IInterface(data),IWeakReferenceableObject,target) then 124 | begin 125 | FData := IInterface(data) as TObject; 126 | target.AddWeakRef(@FData); 127 | end 128 | else 129 | raise Exception.Create(SWeakReferenceError); 130 | end; 131 | 132 | function TWeakReference.Data: T; 133 | begin 134 | result := Default(T); /// can't assign nil to T 135 | if FData <> nil then 136 | begin 137 | //Make sure that the object supports the interface which is our generic type if we 138 | //simply pass in the interface base type, the method table doesn't work correctly 139 | if Supports(FData, GetTypeData(TypeInfo(T))^.Guid, result) then 140 | //if Supports(FData, IInterface, result) then 141 | result := T(result); 142 | end; 143 | end; 144 | 145 | destructor TWeakReference.Destroy; 146 | var 147 | target : IWeakReferenceableObject; 148 | begin 149 | if FData <> nil then 150 | begin 151 | if SafeMonitorTryEnter(FData) then //FData could become nil 152 | begin 153 | //get a strong reference to the target 154 | if Supports(FData,IWeakReferenceableObject,target) then 155 | begin 156 | target.RemoveWeakRef(@FData); 157 | target := nil; //release the reference asap. 158 | end; 159 | MonitorExit(FData); 160 | end; 161 | FData := nil; 162 | end; 163 | inherited; 164 | end; 165 | 166 | function TWeakReference.IsAlive: boolean; 167 | begin 168 | result := FData <> nil; 169 | end; 170 | 171 | { TWeakReferencedObject } 172 | 173 | procedure TWeakReferencedObject.AddWeakRef(value: Pointer); 174 | begin 175 | MonitorEnter(Self); 176 | try 177 | if FWeakReferences = nil then 178 | FWeakReferences := TList.Create; 179 | FWeakReferences.Add(value); 180 | finally 181 | MonitorExit(Self); 182 | end; 183 | end; 184 | 185 | procedure TWeakReferencedObject.RemoveWeakRef(value: Pointer); 186 | begin 187 | MonitorEnter(Self); 188 | try 189 | if FWeakReferences = nil then // should never happen 190 | {$IFDEF DEBUG} 191 | raise Exception.Create('FWeakReferences = nil'); 192 | {$ELSE} 193 | exit; 194 | {$ENDIF} 195 | FWeakReferences.Remove(value); 196 | if FWeakReferences.Count = 0 then 197 | FreeAndNil(FWeakReferences); 198 | finally 199 | MonitorExit(Self); 200 | end; 201 | end; 202 | 203 | procedure TWeakReferencedObject.AfterConstruction; 204 | begin 205 | {$IFNDEF AUTOREFCOUNT} 206 | TInterlocked.Decrement(FRefCount); 207 | {$ENDIF} 208 | end; 209 | 210 | procedure TWeakReferencedObject.BeforeDestruction; 211 | var 212 | value : PPointer; 213 | i: Integer; 214 | begin 215 | {$IFNDEF AUTOREFCOUNT} 216 | if RefCount <> 0 then 217 | System.Error(reInvalidPtr); 218 | {$ELSE} 219 | inherited BeforeDestruction; 220 | {$ENDIF} 221 | MonitorEnter(Self); 222 | try 223 | if FWeakReferences <> nil then 224 | begin 225 | for i := 0 to FWeakReferences.Count -1 do 226 | begin 227 | value := FWeakReferences.Items[i]; 228 | value^ := nil; 229 | end; 230 | FreeAndNil(FWeakReferences); 231 | end; 232 | finally 233 | MonitorExit(Self); 234 | end; 235 | end; 236 | 237 | function TWeakReferencedObject.GetRefCount: integer; 238 | begin 239 | Result := FRefCount and not objDestroyingFlag; 240 | end; 241 | 242 | class function TWeakReferencedObject.NewInstance: TObject; 243 | begin 244 | Result := inherited NewInstance; 245 | {$IFNDEF AUTOREFCOUNT} 246 | // Set an implicit refcount so that refcounting 247 | // during construction won't destroy the object. 248 | TWeakReferencedObject(Result).FRefCount := 1; 249 | {$ENDIF} 250 | end; 251 | 252 | function TWeakReferencedObject.QueryInterface(const IID: TGUID; out Obj): HResult; 253 | begin 254 | if GetInterface(IID, Obj) then 255 | Result := 0 256 | else 257 | Result := E_NOINTERFACE; 258 | end; 259 | 260 | function TWeakReferencedObject._AddRef: Integer; 261 | begin 262 | {$IFNDEF AUTOREFCOUNT} 263 | Result := TInterlocked.Increment(FRefCount); 264 | {$ELSE} 265 | Result := __ObjAddRef; 266 | {$ENDIF} 267 | end; 268 | 269 | function TWeakReferencedObject._Release: Integer; 270 | 271 | {$IFNDEF AUTOREFCOUNT} 272 | procedure __MarkDestroying(const Obj); 273 | var 274 | LRef: Integer; 275 | begin 276 | repeat 277 | LRef := TWeakReferencedObject(Obj).FRefCount; 278 | until TInterlocked.CompareExchange(TWeakReferencedObject(Obj).FRefCount, LRef or objDestroyingFlag, LRef) = LRef; 279 | end; 280 | {$ENDIF} 281 | 282 | begin 283 | {$IFNDEF AUTOREFCOUNT} 284 | Result := TInterlocked.Decrement(FRefCount); 285 | if Result = 0 then 286 | begin 287 | __MarkDestroying(Self); 288 | Destroy; 289 | end; 290 | {$ELSE} 291 | Result := __ObjRelease; 292 | {$ENDIF} 293 | end; 294 | 295 | end. 296 | -------------------------------------------------------------------------------- /Source/Delphi.Mocks.When.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { Delphi.Mocks } 4 | { } 5 | { Copyright (C) 2011 Vincent Parrett } 6 | { } 7 | { http://www.finalbuilder.com } 8 | { } 9 | { } 10 | {***************************************************************************} 11 | { } 12 | { Licensed under the Apache License, Version 2.0 (the "License"); } 13 | { you may not use this file except in compliance with the License. } 14 | { You may obtain a copy of the License at } 15 | { } 16 | { http://www.apache.org/licenses/LICENSE-2.0 } 17 | { } 18 | { Unless required by applicable law or agreed to in writing, software } 19 | { distributed under the License is distributed on an "AS IS" BASIS, } 20 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 21 | { See the License for the specific language governing permissions and } 22 | { limitations under the License. } 23 | { } 24 | {***************************************************************************} 25 | 26 | unit Delphi.Mocks.When; 27 | 28 | interface 29 | 30 | uses 31 | Delphi.Mocks; 32 | 33 | type 34 | TWhen = class(TInterfacedObject,IWhen) 35 | private 36 | FProxy : T; 37 | protected 38 | function When : T; 39 | public 40 | constructor Create(const AProxy : T); 41 | destructor Destroy;override; 42 | end; 43 | 44 | implementation 45 | 46 | uses 47 | System.SysUtils; 48 | 49 | { TWhen } 50 | 51 | constructor TWhen.Create(const AProxy: T); 52 | begin 53 | FProxy := AProxy; 54 | end; 55 | 56 | destructor TWhen.Destroy; 57 | begin 58 | FProxy := Default(T); 59 | inherited; 60 | end; 61 | 62 | function TWhen.When: T; 63 | begin 64 | result := FProxy; 65 | end; 66 | 67 | end. 68 | -------------------------------------------------------------------------------- /Source/Delphi.Mocks.inc: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { Delphi.Mocks } 4 | { } 5 | { Copyright (C) 2011 Vincent Parrett } 6 | { } 7 | { http://www.finalbuilder.com } 8 | { } 9 | { } 10 | {***************************************************************************} 11 | { } 12 | { Licensed under the Apache License, Version 2.0 (the "License"); } 13 | { you may not use this file except in compliance with the License. } 14 | { You may obtain a copy of the License at } 15 | { } 16 | { http://www.apache.org/licenses/LICENSE-2.0 } 17 | { } 18 | { Unless required by applicable law or agreed to in writing, software } 19 | { distributed under the License is distributed on an "AS IS" BASIS, } 20 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 21 | { See the License for the specific language governing permissions and } 22 | { limitations under the License. } 23 | { } 24 | {***************************************************************************} 25 | 26 | //Basic Version of Compiler Supported - XE2 Minimum 27 | {$IFDEF CONDITIONALEXPRESSIONS} //Started being defined with D2009 28 | {$IF CompilerVersion < 23.0} // Before RAD Studio XE2 29 | {$DEFINE UNSUPPORTED_COMPILER_VERSION} 30 | {$IFEND} 31 | {$ELSE} 32 | {$DEFINE UNSUPPORTED_COMPILER_VERSION} 33 | {$ENDIF} 34 | 35 | {$IFDEF UNSUPPORTED_COMPILER_VERSION} 36 | Unsupported Compiler Version (Delphi XE2 or later required!) 37 | {$ENDIF} 38 | 39 | {$IF CompilerVersion > 28.0} // XE8 up 40 | {$DEFINE HAS_SYSTEM_HASH} 41 | {$IFEND} 42 | 43 | 44 | -------------------------------------------------------------------------------- /Source/DelphiMocks.dpk: -------------------------------------------------------------------------------- 1 | package DelphiMocks; 2 | 3 | {$R *.res} 4 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO ON} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION OFF} 16 | {$OVERFLOWCHECKS OFF} 17 | {$RANGECHECKS OFF} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES ON} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DEFINE DEBUG} 27 | {$ENDIF IMPLICITBUILDING} 28 | {$RUNONLY} 29 | {$IMPLICITBUILD OFF} 30 | 31 | requires 32 | rtl; 33 | 34 | contains 35 | Delphi.Mocks.AutoMock in 'Delphi.Mocks.AutoMock.pas', 36 | Delphi.Mocks.Behavior in 'Delphi.Mocks.Behavior.pas', 37 | Delphi.Mocks.Expectation in 'Delphi.Mocks.Expectation.pas', 38 | Delphi.Mocks.Helpers in 'Delphi.Mocks.Helpers.pas', 39 | Delphi.Mocks.Interfaces in 'Delphi.Mocks.Interfaces.pas', 40 | Delphi.Mocks.MethodData in 'Delphi.Mocks.MethodData.pas', 41 | Delphi.Mocks.ObjectProxy in 'Delphi.Mocks.ObjectProxy.pas', 42 | Delphi.Mocks.ParamMatcher in 'Delphi.Mocks.ParamMatcher.pas', 43 | Delphi.Mocks in 'Delphi.Mocks.pas', 44 | Delphi.Mocks.Proxy in 'Delphi.Mocks.Proxy.pas', 45 | Delphi.Mocks.Proxy.TypeInfo in 'Delphi.Mocks.Proxy.TypeInfo.pas', 46 | Delphi.Mocks.ReturnTypePatch in 'Delphi.Mocks.ReturnTypePatch.pas', 47 | Delphi.Mocks.Utils in 'Delphi.Mocks.Utils.pas', 48 | Delphi.Mocks.Validation in 'Delphi.Mocks.Validation.pas', 49 | Delphi.Mocks.WeakReference in 'Delphi.Mocks.WeakReference.pas', 50 | Delphi.Mocks.When in 'Delphi.Mocks.When.pas'; 51 | 52 | end. 53 | -------------------------------------------------------------------------------- /Source/DelphiMocks.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {95C966B8-00C0-4F2D-BE60-93794EC1525F} 4 | DelphiMocks.dpk 5 | 13.4 6 | None 7 | True 8 | Debug 9 | Win64 10 | 3 11 | Package 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | true 44 | All 45 | true 46 | System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 47 | true 48 | true 49 | .\$(Platform)\$(Config) 50 | .\$(Platform)\$(Config) 51 | 52 | 53 | 1033 54 | true 55 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 56 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) 57 | 58 | 59 | 1033 60 | true 61 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 62 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 63 | 64 | 65 | DEBUG;$(DCC_Define) 66 | false 67 | true 68 | true 69 | true 70 | 71 | 72 | true 73 | 1033 74 | false 75 | 76 | 77 | false 78 | RELEASE;$(DCC_Define) 79 | 0 80 | false 81 | 82 | 83 | 84 | MainSource 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | Cfg_2 105 | Base 106 | 107 | 108 | Base 109 | 110 | 111 | Cfg_1 112 | Base 113 | 114 | 115 | 116 | Delphi.Personality.12 117 | Package 118 | 119 | 120 | 121 | DelphiMocks.dpk 122 | 123 | 124 | True 125 | False 126 | 1 127 | 0 128 | 0 129 | 0 130 | False 131 | False 132 | False 133 | False 134 | False 135 | 3081 136 | 1252 137 | 138 | 139 | 140 | 141 | 1.0.0.0 142 | 143 | 144 | 145 | 146 | 147 | 1.0.0.0 148 | 149 | 150 | 151 | madBasic 1.2.7 - www.madshi.net 152 | madHelp 1.1.1 - www.madshi.net 153 | madDisAsm 2.2.6 - www.madshi.net 154 | madExceptIde 1.1.0 - www.madshi.net 155 | madExcept 5.1.0 - www.madshi.net 156 | madExceptVcl 2.1.0 - www.madshi.net 157 | madExceptWizard 3.1.8 - www.madshi.net 158 | 159 | 160 | 161 | 162 | True 163 | True 164 | 165 | 166 | 12 167 | 168 | 169 | 170 | 171 | -------------------------------------------------------------------------------- /Source/DelphiMocks104.dpk: -------------------------------------------------------------------------------- 1 | package DelphiMocks104; 2 | 3 | {$R *.res} 4 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO ON} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION OFF} 16 | {$OVERFLOWCHECKS OFF} 17 | {$RANGECHECKS OFF} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES ON} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DEFINE DEBUG} 27 | {$ENDIF IMPLICITBUILDING} 28 | {$RUNONLY} 29 | {$IMPLICITBUILD OFF} 30 | 31 | requires 32 | rtl; 33 | 34 | contains 35 | Delphi.Mocks.AutoMock in 'Delphi.Mocks.AutoMock.pas', 36 | Delphi.Mocks.Behavior in 'Delphi.Mocks.Behavior.pas', 37 | Delphi.Mocks.Expectation in 'Delphi.Mocks.Expectation.pas', 38 | Delphi.Mocks.Helpers in 'Delphi.Mocks.Helpers.pas', 39 | Delphi.Mocks.Interfaces in 'Delphi.Mocks.Interfaces.pas', 40 | Delphi.Mocks.MethodData in 'Delphi.Mocks.MethodData.pas', 41 | Delphi.Mocks.ObjectProxy in 'Delphi.Mocks.ObjectProxy.pas', 42 | Delphi.Mocks.ParamMatcher in 'Delphi.Mocks.ParamMatcher.pas', 43 | Delphi.Mocks in 'Delphi.Mocks.pas', 44 | Delphi.Mocks.Proxy in 'Delphi.Mocks.Proxy.pas', 45 | Delphi.Mocks.Proxy.TypeInfo in 'Delphi.Mocks.Proxy.TypeInfo.pas', 46 | Delphi.Mocks.ReturnTypePatch in 'Delphi.Mocks.ReturnTypePatch.pas', 47 | Delphi.Mocks.Utils in 'Delphi.Mocks.Utils.pas', 48 | Delphi.Mocks.Validation in 'Delphi.Mocks.Validation.pas', 49 | Delphi.Mocks.WeakReference in 'Delphi.Mocks.WeakReference.pas', 50 | Delphi.Mocks.When in 'Delphi.Mocks.When.pas'; 51 | 52 | end. 53 | -------------------------------------------------------------------------------- /Source/DelphiMocksXE5.dpk: -------------------------------------------------------------------------------- 1 | package DelphiMocksXE5; 2 | 3 | {$R *.res} 4 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO ON} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION OFF} 16 | {$OVERFLOWCHECKS OFF} 17 | {$RANGECHECKS OFF} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES ON} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DEFINE DEBUG} 27 | {$ENDIF IMPLICITBUILDING} 28 | {$RUNONLY} 29 | {$IMPLICITBUILD OFF} 30 | 31 | requires 32 | rtl; 33 | 34 | contains 35 | Delphi.Mocks.AutoMock in 'Delphi.Mocks.AutoMock.pas', 36 | Delphi.Mocks.Behavior in 'Delphi.Mocks.Behavior.pas', 37 | Delphi.Mocks.Expectation in 'Delphi.Mocks.Expectation.pas', 38 | Delphi.Mocks.Helpers in 'Delphi.Mocks.Helpers.pas', 39 | Delphi.Mocks.Interfaces in 'Delphi.Mocks.Interfaces.pas', 40 | Delphi.Mocks.MethodData in 'Delphi.Mocks.MethodData.pas', 41 | Delphi.Mocks.ObjectProxy in 'Delphi.Mocks.ObjectProxy.pas', 42 | Delphi.Mocks.ParamMatcher in 'Delphi.Mocks.ParamMatcher.pas', 43 | Delphi.Mocks in 'Delphi.Mocks.pas', 44 | Delphi.Mocks.Proxy in 'Delphi.Mocks.Proxy.pas', 45 | Delphi.Mocks.Proxy.TypeInfo in 'Delphi.Mocks.Proxy.TypeInfo.pas', 46 | Delphi.Mocks.ReturnTypePatch in 'Delphi.Mocks.ReturnTypePatch.pas', 47 | Delphi.Mocks.Utils in 'Delphi.Mocks.Utils.pas', 48 | Delphi.Mocks.Validation in 'Delphi.Mocks.Validation.pas', 49 | Delphi.Mocks.WeakReference in 'Delphi.Mocks.WeakReference.pas', 50 | Delphi.Mocks.When in 'Delphi.Mocks.When.pas'; 51 | 52 | end. 53 | -------------------------------------------------------------------------------- /Source/DelphiMocksXE5.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {95C966B8-00C0-4F2D-BE60-93794EC1525F} 4 | DelphiMocksXE5.dpk 5 | 15.3 6 | None 7 | True 8 | Debug 9 | Win64 10 | 3 11 | Package 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | true 44 | All 45 | true 46 | System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 47 | true 48 | true 49 | .\$(Platform)\$(Config) 50 | .\$(Platform)\$(Config) 51 | 52 | 53 | 1033 54 | true 55 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 56 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 57 | 58 | 59 | 1033 60 | true 61 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 62 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) 63 | 64 | 65 | DEBUG;$(DCC_Define) 66 | false 67 | true 68 | true 69 | true 70 | 71 | 72 | true 73 | 1033 74 | false 75 | 76 | 77 | false 78 | RELEASE;$(DCC_Define) 79 | 0 80 | 0 81 | 82 | 83 | 84 | MainSource 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | Cfg_2 105 | Base 106 | 107 | 108 | Base 109 | 110 | 111 | Cfg_1 112 | Base 113 | 114 | 115 | 116 | Delphi.Personality.12 117 | Package 118 | 119 | 120 | 121 | DelphiMocksXE5.dpk 122 | 123 | 124 | True 125 | False 126 | 1 127 | 0 128 | 0 129 | 0 130 | False 131 | False 132 | False 133 | False 134 | False 135 | 3081 136 | 1252 137 | 138 | 139 | 140 | 141 | 1.0.0.0 142 | 143 | 144 | 145 | 146 | 147 | 1.0.0.0 148 | 149 | 150 | 151 | 152 | 153 | False 154 | False 155 | False 156 | True 157 | True 158 | 159 | 160 | 12 161 | 162 | 163 | 164 | 165 | -------------------------------------------------------------------------------- /Tests/.gitignore: -------------------------------------------------------------------------------- 1 | # Compiled source # 2 | ################### 3 | *.dcu 4 | *.obj 5 | *.exe 6 | 7 | # Backup files # 8 | ################### 9 | *.~* 10 | 11 | # IDE Files # 12 | ################### 13 | *.dproj.local 14 | *.groupproj.local 15 | *.identcache 16 | *.dsk 17 | *.tvsconfig 18 | 19 | # Output Folders # 20 | ################### 21 | /Win32 22 | /Win64 23 | 24 | -------------------------------------------------------------------------------- /Tests/Delphi.Mocks.Examples.Factory.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.Examples.Factory; 2 | 3 | interface 4 | 5 | uses 6 | Rtti, 7 | TypInfo, 8 | SysUtils, 9 | DUnitX.TestFramework; 10 | 11 | type 12 | {$M+} 13 | IFileService = interface 14 | ['{3BDAC049-F291-46CB-95A8-B177E3485752}'] 15 | function OpenForAppend(const AFilename : string) : THandle; 16 | function WriteLineTo(const AHandle : THandle; const ALine : string) : boolean; 17 | end; 18 | 19 | IApplicationInfo = interface 20 | ['{43C0AE45-F57F-4620-A902-35CEAB370BC1}'] 21 | function GetFileService : IFileService; 22 | property FileService : IFileService read GetFileService; 23 | end; 24 | 25 | ILogLine = interface 26 | ['{B230FBB5-EE90-4208-90A4-FF09274BD767}'] 27 | function FormattedLine : string; 28 | end; 29 | 30 | ILogLines = interface 31 | ['{0CAF05DA-6828-4651-8431-F4E6815AF1C0}'] 32 | function GetCount : Cardinal; 33 | function GetLine(const ALine: Cardinal) : ILogLine; 34 | 35 | property Line[const ALine : Cardinal] : ILogLine read GetLine; 36 | property Count : Cardinal read GetCount; 37 | end; 38 | 39 | ILogReceiver = interface 40 | ['{0EE8E9EC-0B2E-4052-827D-5EAF26AB08BC}'] 41 | function GetLogsAbove(const ALogLevel : Integer) : ILogLines; 42 | function Log(const AMessage: string; const ALogLevel : Integer) : boolean; 43 | end; 44 | 45 | IMessage = interface 46 | ['{9955A5F2-3BC3-43DA-81FC-AD16E02BC93F}'] 47 | end; 48 | 49 | IMessageChannel = interface 50 | ['{B2F9B8B0-93DD-4886-8141-CD043C32A9F1}'] 51 | function SendMessage(const AMessage : IMessage) : boolean; 52 | end; 53 | 54 | ICoreService = interface 55 | ['{48584DC8-C425-4F6C-8FC5-438F04A90052}'] 56 | function GetLogReciever : ILogReceiver; 57 | function GetApplication : IApplicationInfo; 58 | function GetAppMessageChannel : IMessageChannel; 59 | 60 | property Application : IApplicationInfo read GetApplication; 61 | property LogReciever : ILogReceiver read GetLogReciever; 62 | property AppMessageChannel : IMessageChannel read GetAppMessageChannel; 63 | end; 64 | 65 | ILogExporter = interface 66 | ['{037C6F9F-CA6A-4DE9-863C-0E3DC265B49B}'] 67 | function ExportLog(const AMinLogLevel : Integer; const AFilename: TFilename) : integer; 68 | end; 69 | 70 | TLogExporter = class(TInterfacedObject, ILogExporter) 71 | private 72 | FLogReciever : ILogReceiver; 73 | FApplication : IApplicationInfo; 74 | public 75 | constructor Create(const AServices : ICoreService); 76 | destructor Destroy; override; 77 | function ExportLog(const AMinLogLevel : Integer; const AFilename: TFilename) : integer; 78 | end; 79 | {$M-} 80 | 81 | TExample_MockFactoryTests = class 82 | published 83 | procedure Implement_Multiple_Interfaces; 84 | procedure Create_T_From_TypeInfo; 85 | end; 86 | 87 | IFakeGeneric = interface 88 | ['{682057B0-E265-45F1-ABF7-12A25683AF63}'] 89 | function Value : TValue; 90 | end; 91 | 92 | TFakeGeneric = class(TInterfacedObject, IFakeGeneric) 93 | private 94 | FValue : TValue; 95 | public 96 | constructor Create(const ATypeInfo : PTypeInfo); 97 | destructor Destroy; override; 98 | 99 | function Value : TValue; 100 | end; 101 | 102 | IFakeGeneric = interface 103 | ['{87853316-A14D-4BC6-9124-D947662243F0}'] 104 | function Value : T; 105 | end; 106 | 107 | TFakeGeneric = class(TInterfacedObject, IFakeGeneric) 108 | private 109 | FFakeGeneric : IFakeGeneric; 110 | public 111 | constructor Create; 112 | destructor Destroy; override; 113 | 114 | function Value : T; 115 | end; 116 | 117 | implementation 118 | 119 | uses 120 | Delphi.Mocks; 121 | 122 | function CreateFakeGeneric(const TypeInfo: PTypeInfo) : TObject; 123 | begin 124 | end; 125 | 126 | { TLogExporter } 127 | 128 | constructor TLogExporter.Create(const AServices: ICoreService); 129 | begin 130 | inherited Create; 131 | 132 | FLogReciever := AServices.LogReciever; 133 | FApplication := AServices.Application; 134 | end; 135 | 136 | destructor TLogExporter.Destroy; 137 | begin 138 | FLogReciever := nil; 139 | FApplication := nil; 140 | 141 | inherited; 142 | end; 143 | 144 | function TLogExporter.ExportLog(const AMinLogLevel : Integer; const AFilename: TFilename) : integer; 145 | var 146 | fileService : IFileService; 147 | fileHandle: THandle; 148 | logs: ILogLines; 149 | iLine: Integer; 150 | begin 151 | //Very simplistic ExportLog function which uses a number of other services to 152 | //set its job done. The logic is simplistic, but the implementation over uses 153 | //services to show the power of AutoMocking, and the Factory. 154 | 155 | fileService := FApplication.FileService; 156 | 157 | //Create or open requested file. 158 | fileHandle := fileService.OpenForAppend(AFilename); 159 | 160 | //Make sure the got a valid handle from the file serice. 161 | if fileHandle = 0 then 162 | raise Exception.CreateFmt('The fileservice failed to return a handle for [%s]', [AFilename]); 163 | 164 | //Get the log from the log receiver for the passed in min log level. 165 | logs := FLogReciever.GetLogsAbove(AMinLogLevel - 1); 166 | 167 | //Write each line out with the formatting from the log. 168 | for iLine := 0 to logs.Count - 1 do 169 | fileService.WriteLineTo(fileHandle, logs.Line[iLine].FormattedLine); 170 | end; 171 | 172 | { TExample_MockFactoryTests } 173 | 174 | procedure TExample_MockFactoryTests.Create_T_From_TypeInfo; 175 | var 176 | fakeExporter : IFakeGeneric; 177 | fakeLine : IFakeGeneric; 178 | begin 179 | fakeExporter := TFakeGeneric.Create; 180 | 181 | Assert.AreEqual(fakeExporter.Value.ClassName, 'TLogExporter'); 182 | 183 | fakeLine := TFakeGeneric.Create; 184 | 185 | Assert.AreEqual(fakeLine.Value.FormattedLine, 'TLogExporter'); 186 | end; 187 | 188 | procedure TExample_MockFactoryTests.Implement_Multiple_Interfaces; 189 | var 190 | logExporterSUT : ILogExporter; 191 | 192 | // mockFactory : TMockFactory; 193 | mockContainer : TAutoMockContainer; 194 | mockCoreService : TMock; 195 | begin 196 | //CREATE - Create a mock of the CoreService which we require for the LogExporter 197 | // We do this through creating a MockFactory to generate the Mock 198 | 199 | // mockFactory := TMockFactory.Create; 200 | // mockContainer := TAutoMockContainer.Create(mockFactory); 201 | // 202 | // mockCoreService := mockContainer.Mock; 203 | // 204 | // //CREATE - The log exporter ExportLog function is what we are looking at testing. 205 | // logExporterSUT := TLogExporter.Create(mockCoreService); 206 | // 207 | // //TEST - See if we can export a log. 208 | // logExporterSUT.ExportLog(0, ''); 209 | // 210 | // //VERIFY - Make sure that everything we have attached to the factory and its mocks 211 | // // has correctly run. 212 | // mockFactory.VerifyAll; 213 | end; 214 | 215 | { TFakeGeneric } 216 | 217 | constructor TFakeGeneric.Create(const ATypeInfo: PTypeInfo); 218 | var 219 | AValue: TValue; 220 | ctx: TRttiContext; 221 | rType: TRttiType; 222 | AMethCreate: TRttiMethod; 223 | instanceType: TRttiInstanceType; 224 | begin 225 | ctx := TRttiContext.Create; 226 | rType := ctx.GetType(ATypeInfo); 227 | 228 | for AMethCreate in rType.GetMethods do 229 | begin 230 | {$Message 'TODO Handle constructors with params.'} 231 | 232 | if (AMethCreate.IsConstructor) and (Length(AMethCreate.GetParameters) = 0) then 233 | begin 234 | instanceType := rType.AsInstance; 235 | 236 | FValue := AMethCreate.Invoke(instanceType.MetaclassType, []); 237 | 238 | Exit; 239 | end; 240 | end; 241 | end; 242 | 243 | destructor TFakeGeneric.Destroy; 244 | begin 245 | FreeAndNil(FValue); 246 | inherited; 247 | end; 248 | 249 | function TFakeGeneric.Value: TValue; 250 | begin 251 | Result := FValue; 252 | end; 253 | 254 | { TFakeGeneric } 255 | 256 | constructor TFakeGeneric.Create; 257 | begin 258 | FFakeGeneric := TFakeGeneric.Create(TypeInfo(T)); 259 | end; 260 | 261 | destructor TFakeGeneric.Destroy; 262 | begin 263 | FFakeGeneric := nil; 264 | inherited; 265 | end; 266 | 267 | function TFakeGeneric.Value: T; 268 | begin 269 | Result := FFakeGeneric.Value.AsType; 270 | end; 271 | 272 | initialization 273 | TDUnitX.RegisterTestFixture(TExample_MockFactoryTests); 274 | 275 | end. 276 | -------------------------------------------------------------------------------- /Tests/Delphi.Mocks.Examples.Implement.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.Examples.Implement; 2 | 3 | interface 4 | 5 | uses 6 | Delphi.Mocks.Example.ProjectSaveCheckVisitor, 7 | DUnitX.TestFramework; 8 | 9 | type 10 | TExample_InterfaceImplementTests = class 11 | published 12 | procedure Implement_Single_Interface; 13 | procedure Implement_Multiple_Interfaces; 14 | procedure SetupAndVerify_Mulitple_Interfaces; 15 | procedure SetupAndVerify_Object_And_Interfaces; 16 | end; 17 | 18 | 19 | implementation 20 | 21 | uses 22 | Rtti, 23 | TypInfo, 24 | SysUtils, 25 | Delphi.Mocks; 26 | 27 | 28 | { TExample_InterfaceImplementTests } 29 | 30 | procedure TExample_InterfaceImplementTests.Implement_Single_Interface; 31 | var 32 | visitorSUT : IVisitor; 33 | mockElement : TMock; 34 | mockProject : TMock; 35 | projectAsValue : TValue; 36 | pInfo : PTypeInfo; 37 | dud : IProject; 38 | begin 39 | //Test that when we visit a project, and its dirty, we save. 40 | 41 | //CREATE - The visitor system under test. 42 | visitorSUT := TProjectSaveCheck.Create; 43 | 44 | //CREATE - Element mock we require. 45 | mockElement := TMock.Create; 46 | mockProject := TMock.Create; 47 | 48 | projectAsValue := TValue.From(mockProject.Instance); 49 | 50 | //SETUP - return mock project when IProject is asked for. 51 | pInfo := TypeInfo(IProject); 52 | mockElement.Setup.WillReturn(projectAsValue).When.QueryInterface(GetTypeData(pInfo).GUID, dud); 53 | 54 | //SETUP - mock project will show as dirty and will expect to be saved. 55 | mockProject.Setup.WillReturn(true).When.IsDirty; 56 | mockProject.Setup.Expect.Once.When.Save; 57 | 58 | try 59 | //TEST - Visit the mock element with 60 | visitorSUT.Visit(mockElement); 61 | 62 | //VERIFY - Make sure that save was indeed called. 63 | mockProject.Verify; 64 | 65 | //I don't expect to get here as an exception will be raised in Visit. The 66 | //mock can't return project via query interface as this is overriden internally 67 | //by the mocking library. 68 | 69 | //Didn't use CheckException to simpilfy this test. 70 | Assert.Fail; 71 | except 72 | Assert.Pass; 73 | end; 74 | end; 75 | 76 | procedure TExample_InterfaceImplementTests.Implement_Multiple_Interfaces; 77 | var 78 | visitorSUT : IVisitor; 79 | mockElement : TMock; 80 | begin 81 | //Test that when we visit a project, and its dirty, we save. 82 | 83 | //CREATE - The visitor system under test. 84 | visitorSUT := TProjectSaveCheck.Create; 85 | 86 | //CREATE - Element mock we require. 87 | mockElement := TMock.Create; 88 | 89 | //SETUP - Add the IProject interface as an implementation for the mock 90 | mockElement.Implement; 91 | 92 | //SETUP - mock project will show as dirty and will expect to be saved. 93 | mockElement.Setup.WillReturn(true).When.IsDirty; 94 | mockElement.Setup.Expect.Once.When.Save; 95 | 96 | //TEST - Visit the mock element with 97 | visitorSUT.Visit(mockElement); 98 | 99 | //VERIFY - Make sure that save was indeed called. 100 | mockElement.VerifyAll; 101 | end; 102 | 103 | procedure TExample_InterfaceImplementTests.SetupAndVerify_Mulitple_Interfaces; 104 | begin 105 | end; 106 | 107 | //This test fails at this time. Something to implement later. Need to make TObjectProxy pass 108 | //the query interface call to the TProxyVirtualInterface list to be queried. 109 | procedure TExample_InterfaceImplementTests.SetupAndVerify_Object_And_Interfaces; 110 | var 111 | visitorSUT : IVisitor; 112 | mockElement : TMock; 113 | setup : IMockSetup; 114 | begin 115 | //Test that when we visit a project, and its dirty, we save. 116 | 117 | //CREATE - The visitor system under test. 118 | visitorSUT := TProjectSaveCheck.Create; 119 | 120 | //CREATE - Element mock we require. 121 | mockElement := TMock.Create; 122 | 123 | //SETUP - Add the IProject interface as an implementation for the mock 124 | mockElement.Implement; 125 | 126 | //SETUP - mock project will show as dirty and will expect to be saved. 127 | setup := mockElement.Setup; 128 | 129 | setup.WillReturn(true).When.IsDirty; 130 | setup.Expect.Once.When.Save; 131 | 132 | //TEST - Visit the mock element with 133 | visitorSUT.Visit(mockElement); 134 | 135 | //VERIFY - Make sure that save was indeed called. 136 | mockElement.VerifyAll; 137 | end; 138 | 139 | 140 | 141 | initialization 142 | 143 | end. 144 | -------------------------------------------------------------------------------- /Tests/Delphi.Mocks.Examples.Objects.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.Examples.Objects; 2 | 3 | interface 4 | 5 | uses 6 | SysUtils, 7 | DUnitX.TestFramework, 8 | Delphi.Mocks; 9 | 10 | type 11 | ESimpleException = exception; 12 | {$M+} 13 | TSimpleMockedObject = class(TObject) 14 | public 15 | procedure SimpleMethod;virtual; 16 | end; 17 | {$M-} 18 | 19 | TSystemUnderTest = class(TObject) 20 | private 21 | FMocked : TSimpleMockedObject; 22 | public 23 | constructor Create(const AMock: TSimpleMockedObject); 24 | procedure CallsSimpleMethodOnMock;virtual; 25 | end; 26 | 27 | TMockObjectTests = class 28 | published 29 | procedure MockObject_Can_Call_Function;virtual; 30 | end; 31 | 32 | implementation 33 | 34 | uses 35 | Rtti; 36 | 37 | { TMockObjectTests } 38 | 39 | procedure TMockObjectTests.MockObject_Can_Call_Function; 40 | var 41 | mock : TMock; 42 | systemUnderTest : TSystemUnderTest; 43 | begin 44 | //var mock = new Mock(); 45 | //mock.Setup(foo => foo.DoSomething("ping")).Returns(true); 46 | mock := TMock.Create; 47 | 48 | mock.Setup.WillRaise('SimpleMethod', ESimpleException); 49 | 50 | systemUnderTest := TSystemUnderTest.Create(mock.Instance); 51 | try 52 | Assert.WillRaise(procedure 53 | begin 54 | systemUnderTest.CallsSimpleMethodOnMock; 55 | end, ESimpleException); 56 | finally 57 | systemUnderTest.Free; 58 | end; 59 | end; 60 | 61 | { TSimpleObject } 62 | 63 | procedure TSimpleMockedObject.SimpleMethod; 64 | begin 65 | //Does nothing; 66 | end; 67 | 68 | { TSystemUnderTest } 69 | 70 | procedure TSystemUnderTest.CallsSimpleMethodOnMock; 71 | begin 72 | FMocked.SimpleMethod; 73 | end; 74 | 75 | constructor TSystemUnderTest.Create(const AMock: TSimpleMockedObject); 76 | begin 77 | FMocked := AMock; 78 | end; 79 | 80 | end. 81 | -------------------------------------------------------------------------------- /Tests/Delphi.Mocks.Tests.AutoMock.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.Tests.AutoMock; 2 | 3 | interface 4 | 5 | uses 6 | SysUtils, 7 | DUnitX.TestFramework, 8 | Delphi.Mocks; 9 | 10 | type 11 | {$M+} 12 | TReturnedObject = class(TObject) 13 | end; 14 | {$M-} 15 | 16 | {$M+} 17 | IReturnedInterface = interface 18 | ['{8C9AA0D8-5788-4B40-986A-46422BB05E9A}'] 19 | procedure Dud; 20 | end; 21 | {$M-} 22 | 23 | {$M+} 24 | IReturnedInterfaceWhichAlsoReturns = interface 25 | ['{8E3D166F-ED6A-40D9-8C0A-4EC8FF969AF9}'] 26 | procedure Dud; 27 | end; 28 | {$M-} 29 | 30 | {$M+} 31 | IAutoMockedInterface = interface 32 | ['{CC254E0F-63D0-49CB-9918-63AE5D388842}'] 33 | function FuncToReturnInterface : IReturnedInterface; 34 | function FuncToReturnClass : TReturnedObject; 35 | function FuncToReturnInterfaceWhichAlsoReturn : IReturnedInterfaceWhichAlsoReturns; 36 | end; 37 | {$M-} 38 | 39 | {$M+} 40 | [TestFixture] 41 | TAutoMockTests = class 42 | published 43 | procedure AutoMock_Can_Mock_Interface; 44 | [Test, Ignore] 45 | procedure AutoMock_Automatically_Mocks_Contained_Returned_Interface; 46 | end; 47 | {$M-} 48 | 49 | implementation 50 | 51 | { TAutoMockTests } 52 | 53 | procedure TAutoMockTests.AutoMock_Automatically_Mocks_Contained_Returned_Interface; 54 | var 55 | automockSUT : TAutoMockContainer; 56 | mock : TMock; 57 | mockInterface : IReturnedInterface; 58 | mockObject : TReturnedObject; 59 | begin 60 | automockSUT := TAutoMockContainer.Create; 61 | 62 | mock := automockSUT.Mock; 63 | 64 | mockInterface := mock.Instance.FuncToReturnInterface; 65 | mockObject := mock.Instance.FuncToReturnClass; 66 | 67 | Assert.IsNotNull(mockInterface, 'Expected the interface off the mock to be automatically created and the instance returned.'); 68 | Assert.IsNotNull(mockObject, 'Expected the object off the mock to be automatically created and the instance returned.'); 69 | end; 70 | 71 | procedure TAutoMockTests.AutoMock_Can_Mock_Interface; 72 | var 73 | automockSUT : TAutoMockContainer; 74 | mock : TMock; 75 | begin 76 | automockSUT := TAutoMockContainer.Create; 77 | 78 | mock := automockSUT.Mock; 79 | 80 | Assert.IsNotNull(mock.Instance, 'Expect the interface returned from mock is not null'); 81 | end; 82 | 83 | initialization 84 | TDUnitX.RegisterTestFixture(TAutoMockTests); 85 | 86 | end. 87 | -------------------------------------------------------------------------------- /Tests/Delphi.Mocks.Tests.Behavior.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.Tests.Behavior; 2 | 3 | interface 4 | 5 | uses 6 | SysUtils, 7 | DUnitX.TestFramework, 8 | Rtti, 9 | Delphi.Mocks, 10 | Delphi.Mocks.ParamMatcher; 11 | 12 | type 13 | ETestBehaviourException = class(Exception); 14 | 15 | {$M+} 16 | [TestFixture] 17 | TTestBehaviors = class 18 | private 19 | FContext : TRttiContext; 20 | FMatchers : TArray; 21 | protected 22 | procedure SetUp; 23 | published 24 | procedure Test_WillReturnBehavior_Match; 25 | procedure Test_WillReturnBehavior_NoMatch; 26 | procedure Test_WillReturnBehavior_Default; 27 | procedure Test_WillExecute; 28 | 29 | // WillRaise-Execute tests 30 | procedure CreateWillRaise_Execute_Raises_Exception_Of_Our_Choice; 31 | procedure CreateWillRaise_Execute_Raises_Exception_Message_Of_Our_Choice; 32 | procedure CreateWillRaise_Execute_Raises_No_Exception_If_Passed_Nil_For_Exception_Class; 33 | procedure CreateWillRaise_Execute_Raises_Exception_Of_Our_Choice_With_Default_Message; 34 | 35 | // WillRaiseWhen-Exexute tests 36 | procedure CreateWillRaiseWhen_Execute_Raises_Exception_Of_Our_Choice; 37 | procedure CreateWillRaiseWhen_Execute_Raises_Exception_Message_Of_Our_Choice; 38 | procedure CreateWillRaiseWhen_Execute_Raises_No_Exception_If_Passed_Nil_For_Exception_Class; 39 | procedure CreateWillRaiseWhen_Execute_Raises_Exception_Of_Our_Choice_With_Default_Message; 40 | 41 | // Test Behavior Types After Construction. 42 | procedure CreateWillExecute_Behavior_Type_Set_To_WillExecute; 43 | procedure CreateWillExecuteWhen_Behavior_Type_Set_To_WillExecuteWhen; 44 | procedure CreateWillReturnWhen_Behavior_Type_Set_To_WillReturn; 45 | procedure CreateReturnDefault_Behavior_Type_Set_To_ReturnDefault; 46 | procedure CreateWillRaise_Behavior_Type_Set_To_WillAlwaysRaise; 47 | procedure CreateWillRaiseWhen_Behavior_Type_Set_To_WillRaise; 48 | end; 49 | {$M-} 50 | 51 | implementation 52 | 53 | uses 54 | Delphi.Mocks.Helpers, 55 | Delphi.Mocks.Interfaces, 56 | Delphi.Mocks.Behavior, 57 | classes; 58 | 59 | { TTestBehaviors } 60 | 61 | 62 | procedure TTestBehaviors.SetUp; 63 | begin 64 | inherited; 65 | FContext := TRttiContext.Create; 66 | end; 67 | 68 | procedure TTestBehaviors.Test_WillExecute; 69 | var 70 | behavior : IBehavior; 71 | returnValue: TValue; 72 | begin 73 | behavior := TBehavior.CreateWillExecute( 74 | function (const args : TArray; const returnType : TRttiType) : TValue 75 | begin 76 | result := 'hello world'; 77 | end 78 | ); 79 | 80 | returnValue := behavior.Execute(nil,nil); 81 | 82 | Assert.IsTrue(SameText(returnValue.AsString,'hello world')); 83 | end; 84 | 85 | procedure TTestBehaviors.Test_WillReturnBehavior_Default; 86 | var 87 | behavior : IBehavior; 88 | args : TArray; 89 | returnValue : TValue; 90 | rType : TRttiType; 91 | begin 92 | returnValue := 123; 93 | behavior := TBehavior.CreateReturnDefault(returnValue); 94 | SetLength(args,3); 95 | args[0] := 1; 96 | args[1] := 2; 97 | args[2] := 3; 98 | rType := FContext.GetType(TypeInfo(Int64)); 99 | returnValue := behavior.Execute(args,rType); 100 | Assert.IsTrue(returnValue.AsInt64 = 123); 101 | end; 102 | 103 | procedure TTestBehaviors.Test_WillReturnBehavior_Match; 104 | var 105 | behavior : IBehavior; 106 | args : TArray; 107 | returnValue : TValue; 108 | begin 109 | SetLength(args,3); 110 | args[0] := 1; 111 | args[1] := 2; 112 | args[2] := 'hello'; 113 | behavior := TBehavior.CreateWillReturnWhen(args,returnValue,Fmatchers); 114 | args[0] := 1; 115 | args[1] := 2; 116 | args[2] := 'hello'; 117 | Assert.IsTrue(behavior.Match(args)); 118 | end; 119 | 120 | procedure TTestBehaviors.Test_WillReturnBehavior_NoMatch; 121 | var 122 | behavior : IBehavior; 123 | args : TArray; 124 | returnValue : TValue; 125 | begin 126 | SetLength(args,3); 127 | args[0] := 1; 128 | args[1] := 2; 129 | args[2] := 'hello'; 130 | behavior := TBehavior.CreateWillReturnWhen(args,returnValue,FMatchers); 131 | args[0] := 1; 132 | args[1] := 2; 133 | args[2] := 'hello world'; 134 | Assert.IsFalse(behavior.Match(args)); 135 | end; 136 | 137 | procedure TTestBehaviors.CreateReturnDefault_Behavior_Type_Set_To_ReturnDefault; 138 | var 139 | behavior: IBehavior; 140 | begin 141 | behavior := TBehavior.CreateReturnDefault(nil); 142 | 143 | Assert.IsTrue(behavior.BehaviorType = TBehaviorType.ReturnDefault, 'CreateReturnDefault behavior type isn''t ReturnDefault'); 144 | end; 145 | 146 | procedure TTestBehaviors.CreateWillExecuteWhen_Behavior_Type_Set_To_WillExecuteWhen; 147 | var 148 | behavior: IBehavior; 149 | begin 150 | behavior := TBehavior.CreateWillExecuteWhen(nil, nil,FMatchers); 151 | 152 | Assert.IsTrue(behavior.BehaviorType = TBehaviorType.WillExecuteWhen, 'CreateWillExecuteWhen behavior type isn''t WillExecuteWhen'); 153 | end; 154 | 155 | procedure TTestBehaviors.CreateWillExecute_Behavior_Type_Set_To_WillExecute; 156 | var 157 | behavior: IBehavior; 158 | begin 159 | behavior := TBehavior.CreateWillExecute(nil); 160 | 161 | Assert.IsTrue(behavior.BehaviorType = TBehaviorType.WillExecute, 'CreateWillExecute behavior type isn''t WillExecute'); 162 | end; 163 | 164 | procedure TTestBehaviors.CreateWillRaiseWhen_Behavior_Type_Set_To_WillRaise; 165 | var 166 | behavior: IBehavior; 167 | begin 168 | //What is passed here shouldn't affect the result of the behavior being set. No way to avoid it however. 169 | behavior := TBehavior.CreateWillRaiseWhen(nil, ETestBehaviourException, '',FMatchers); 170 | 171 | Assert.IsTrue(behavior.BehaviorType = TBehaviorType.WillRaise, 'CreateWillRaiseWhen behavior type isn''t WillRaise'); 172 | end; 173 | 174 | procedure TTestBehaviors.CreateWillRaiseWhen_Execute_Raises_Exception_Message_Of_Our_Choice; 175 | var 176 | behavior: IBehavior; 177 | const 178 | EXCEPTION_STRING = 'Exception!'; 179 | begin 180 | behavior := TBehavior.CreateWillRaiseWhen(nil, ETestBehaviourException, EXCEPTION_STRING,FMatchers); 181 | 182 | //Passing nils as we don't care about these values for the exception 183 | Assert.WillRaise(procedure 184 | begin 185 | behavior.Execute(nil, nil); 186 | end, ETestBehaviourException); 187 | end; 188 | 189 | procedure TTestBehaviors.CreateWillRaiseWhen_Execute_Raises_Exception_Of_Our_Choice; 190 | var 191 | behavior: IBehavior; 192 | begin 193 | behavior := TBehavior.CreateWillRaiseWhen(nil, ETestBehaviourException, '',FMatchers); 194 | 195 | Assert.WillRaise(procedure 196 | begin 197 | //Passing nils as we don't care about these values for the exception 198 | behavior.Execute(nil, nil); 199 | end, ETestBehaviourException); 200 | 201 | end; 202 | 203 | procedure TTestBehaviors.CreateWillRaiseWhen_Execute_Raises_Exception_Of_Our_Choice_With_Default_Message; 204 | var 205 | behavior: IBehavior; 206 | const 207 | EXCEPTION_STRING = 'raised by mock'; 208 | begin 209 | behavior := TBehavior.CreateWillRaiseWhen(nil, ETestBehaviourException, '',FMatchers); 210 | 211 | Assert.WillRaiseWithMessage(procedure 212 | begin 213 | //Passing nils as we don't care about these values for the exception 214 | behavior.Execute(nil, nil); 215 | end, ETestBehaviourException, EXCEPTION_STRING); 216 | 217 | end; 218 | 219 | procedure TTestBehaviors.CreateWillRaiseWhen_Execute_Raises_No_Exception_If_Passed_Nil_For_Exception_Class; 220 | var 221 | behavior: IBehavior; 222 | begin 223 | behavior := TBehavior.CreateWillRaise(nil, ''); 224 | 225 | //No exception coverage. Therefore we shouldn't get an exception 226 | behavior.Execute(nil, nil); 227 | 228 | //If we have gotten here no exception was recieved. 229 | Assert.IsTrue(True); 230 | end; 231 | 232 | procedure TTestBehaviors.CreateWillRaise_Behavior_Type_Set_To_WillAlwaysRaise; 233 | begin 234 | Assert.Pass; 235 | end; 236 | 237 | procedure TTestBehaviors.CreateWillRaise_Execute_Raises_Exception_Message_Of_Our_Choice; 238 | var 239 | behavior: IBehavior; 240 | const 241 | EXCEPTION_STRING = 'Exception!'; 242 | begin 243 | behavior := TBehavior.CreateWillRaise(ETestBehaviourException, EXCEPTION_STRING); 244 | 245 | Assert.WillRaise(procedure 246 | begin 247 | //Passing nils as we don't care about these values for the exception 248 | behavior.Execute(nil, nil); 249 | end, ETestBehaviourException); 250 | end; 251 | 252 | procedure TTestBehaviors.CreateWillRaise_Execute_Raises_Exception_Of_Our_Choice; 253 | var 254 | behavior: IBehavior; 255 | begin 256 | behavior := TBehavior.CreateWillRaise(ETestBehaviourException, ''); 257 | 258 | Assert.WillRaise(procedure 259 | begin 260 | //Passing nils as we don't care about these values for the exception 261 | behavior.Execute(nil, nil); 262 | end, ETestBehaviourException); 263 | end; 264 | 265 | 266 | procedure TTestBehaviors.CreateWillRaise_Execute_Raises_Exception_Of_Our_Choice_With_Default_Message; 267 | var 268 | behavior: IBehavior; 269 | const 270 | EXCEPTION_STRING = 'raised by mock'; 271 | begin 272 | behavior := TBehavior.CreateWillRaise(ETestBehaviourException, ''); 273 | 274 | Assert.WillRaiseWithMessage(procedure 275 | begin 276 | //Passing nils as we don't care about these values for the exception 277 | behavior.Execute(nil, nil); 278 | end, ETestBehaviourException, EXCEPTION_STRING); 279 | end; 280 | 281 | procedure TTestBehaviors.CreateWillRaise_Execute_Raises_No_Exception_If_Passed_Nil_For_Exception_Class; 282 | var 283 | behavior: IBehavior; 284 | begin 285 | behavior := TBehavior.CreateWillRaise(nil, ''); 286 | 287 | //No exception coverage. Therefore we shouldn't get an exception 288 | behavior.Execute(nil, nil); 289 | 290 | //If we have gotten here no exception was recieved. 291 | Assert.IsTrue(True); 292 | end; 293 | 294 | procedure TTestBehaviors.CreateWillReturnWhen_Behavior_Type_Set_To_WillReturn; 295 | begin 296 | Assert.Pass; 297 | end; 298 | 299 | 300 | initialization 301 | TDUnitX.RegisterTestFixture(TTestBehaviors); 302 | 303 | end. 304 | -------------------------------------------------------------------------------- /Tests/Delphi.Mocks.Tests.InterfaceProxy.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************} 2 | { } 3 | { Delphi.Mocks } 4 | { } 5 | { Copyright (C) 2011 Vincent Parrett } 6 | { } 7 | { http://www.finalbuilder.com } 8 | { } 9 | { } 10 | {***************************************************************************} 11 | { } 12 | { Licensed under the Apache License, Version 2.0 (the "License"); } 13 | { you may not use this file except in compliance with the License. } 14 | { You may obtain a copy of the License at } 15 | { } 16 | { http://www.apache.org/licenses/LICENSE-2.0 } 17 | { } 18 | { Unless required by applicable law or agreed to in writing, software } 19 | { distributed under the License is distributed on an "AS IS" BASIS, } 20 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 21 | { See the License for the specific language governing permissions and } 22 | { limitations under the License. } 23 | { } 24 | {***************************************************************************} 25 | 26 | unit Delphi.Mocks.Tests.InterfaceProxy; 27 | 28 | interface 29 | 30 | uses 31 | DUnitX.TestFramework; 32 | 33 | type 34 | {$M+} 35 | IInterfaceOne = Interface 36 | ['{F1731F12-2453-4818-A785-997AF7A3D51F}'] 37 | procedure Execute1; 38 | End; 39 | 40 | {$M+} 41 | IInterfaceTwo = Interface 42 | ['{C7191239-2E89-4D3A-9D1B-F894BACBBB39}'] 43 | procedure Execute2; 44 | End; 45 | 46 | {$M+} 47 | IInterfaceThree = interface 48 | ['{E3BE68FA-E318-49CA-B93F-DAB02C07B3A3}'] 49 | procedure Execute3; 50 | end; 51 | 52 | {$M+} 53 | ICommand = interface 54 | ['{9742A11D-69A4-422E-A2F3-CCEC4934DFC0}'] 55 | procedure Execute; 56 | procedure TestVarParam(var msg : string); 57 | procedure TestOutParam(out msg : string); 58 | end; 59 | {$M-} 60 | 61 | {$M+} 62 | [TestFixture] 63 | TTestInterfaceProxy = class 64 | published 65 | procedure After_Proxy_AddImplement_ProxyProxy_Implements_Original_Interface; 66 | procedure After_Proxy_AddImplement_ProxyProxy_Implements_New_Interface; 67 | procedure After_Proxy_AddImplement_ProxyFromType_Returns_Proxy_For_Implemented_Interface; 68 | procedure MockNoArgProcedureUsingOnce; 69 | procedure MockNoArgProcedureUsingOnceWhen; 70 | procedure MockNoArgProcedureUsingNeverWhen; 71 | procedure MockNoArgProcedureUsingAtLeastOnceWhen; 72 | procedure MockNoArgProcedureUsingAtLeastWhen; 73 | procedure MockNoArgProcedureUsingAtMostBetweenWhen; 74 | procedure MockNoArgProcedureUsingExactlyWhen; 75 | procedure TestOuParam; 76 | procedure TestVarParam; 77 | end; 78 | {$M-} 79 | 80 | implementation 81 | 82 | uses 83 | SysUtils, 84 | Delphi.Mocks, 85 | Delphi.Mocks.Proxy, 86 | System.Rtti; 87 | 88 | { TTestInterfaceProxy } 89 | 90 | procedure TTestInterfaceProxy.After_Proxy_AddImplement_ProxyFromType_Returns_Proxy_For_Implemented_Interface; 91 | var 92 | proxySUT : IProxy; 93 | newInterface : IInterfaceTwo; 94 | newProxy : IProxy; 95 | begin 96 | //SETUP 97 | proxySUT := TProxy.Create; 98 | 99 | //SETUP - Added the implementation of Interface 100 | proxySUT.AddImplement(TProxy.Create, TypeInfo(IInterfaceTwo)); 101 | 102 | newProxy := proxySUT.ProxyFromType(TypeInfo(IInterfaceTwo)); 103 | 104 | //TEST - Make sure proxy value implements IInterfaceTwo 105 | Assert.IsTrue(Supports(newProxy.ProxyInterface, IInterfaceTwo, newInterface)); 106 | end; 107 | 108 | procedure TTestInterfaceProxy.After_Proxy_AddImplement_ProxyProxy_Implements_New_Interface; 109 | var 110 | proxySUT : IProxy; 111 | newInterface : IInterfaceTwo; 112 | begin 113 | //SETUP 114 | proxySUT := TProxy.Create; 115 | 116 | //SETUP - Added the implementation of Interface 117 | proxySUT.AddImplement(TProxy.Create, TypeInfo(IInterfaceTwo)); 118 | 119 | //TEST - Make sure proxy value implements IInterfaceTwo 120 | Assert.IsTrue(Supports(proxySUT.Proxy, IInterfaceTwo, newInterface)); 121 | end; 122 | 123 | procedure TTestInterfaceProxy.After_Proxy_AddImplement_ProxyProxy_Implements_Original_Interface; 124 | var 125 | proxySUT : IProxy; 126 | originalInterface : IInterfaceOne; 127 | begin 128 | //SETUP 129 | proxySUT := TProxy.Create; 130 | 131 | //SETUP - Added the implementation of Interface 132 | proxySUT.AddImplement(TProxy.Create, TypeInfo(IInterfaceTwo)); 133 | 134 | //TEST - Make sure proxy value implements IInterfaceOne 135 | Assert.IsTrue(Supports(proxySUT.Proxy, IInterfaceOne, originalInterface)); 136 | Assert.IsNotNull(originalInterface); 137 | Assert.IsTrue(originalInterface = proxySUT.Proxy); 138 | end; 139 | 140 | procedure TTestInterfaceProxy.MockNoArgProcedureUsingAtLeastOnceWhen; 141 | var 142 | mock : TMock; 143 | begin 144 | mock := TMock.Create; 145 | mock.Setup.Expect.AtLeastOnce.When.Execute; 146 | mock.Instance.Execute; 147 | mock.Instance.Execute; 148 | mock.Verify; 149 | Assert.Pass; 150 | end; 151 | 152 | procedure TTestInterfaceProxy.MockNoArgProcedureUsingAtLeastWhen; 153 | var 154 | mock : TMock; 155 | begin 156 | mock := TMock.Create; 157 | mock.Setup.Expect.AtLeast(3).When.Execute; 158 | mock.Instance.Execute; 159 | mock.Instance.Execute; 160 | mock.Instance.Execute; 161 | mock.Verify; 162 | Assert.Pass; 163 | end; 164 | 165 | procedure TTestInterfaceProxy.MockNoArgProcedureUsingAtMostBetweenWhen; 166 | var 167 | mock : TMock; 168 | begin 169 | mock := TMock.Create; 170 | mock.Setup.Expect.AtMost(2).When.Execute; 171 | mock.Instance.Execute; 172 | mock.Instance.Execute; 173 | mock.Verify; 174 | Assert.Pass; 175 | end; 176 | 177 | procedure TTestInterfaceProxy.MockNoArgProcedureUsingExactlyWhen; 178 | var 179 | mock : TMock; 180 | begin 181 | mock := TMock.Create; 182 | mock.Setup.Expect.Exactly(2).When.Execute; 183 | mock.Instance.Execute; 184 | mock.Instance.Execute; 185 | mock.Verify; 186 | Assert.Pass; 187 | end; 188 | 189 | procedure TTestInterfaceProxy.MockNoArgProcedureUsingNeverWhen; 190 | var 191 | mock : TMock; 192 | begin 193 | mock := TMock.Create; 194 | mock.Setup.Expect.Never.When.Execute; 195 | 196 | mock.Verify; 197 | Assert.Pass; 198 | end; 199 | 200 | procedure TTestInterfaceProxy.MockNoArgProcedureUsingOnce; 201 | var 202 | mock : TMock; 203 | begin 204 | mock := TMock.Create; 205 | mock.Setup.Expect.Once('Execute'); 206 | mock.Instance.Execute; 207 | mock.Verify; 208 | Assert.Pass; 209 | end; 210 | 211 | procedure TTestInterfaceProxy.MockNoArgProcedureUsingOnceWhen; 212 | var 213 | mock : TMock; 214 | begin 215 | mock := TMock.Create; 216 | mock.Setup.Expect.Once.When.Execute; 217 | mock.Instance.Execute; 218 | mock.Verify; 219 | Assert.Pass; 220 | end; 221 | 222 | procedure TTestInterfaceProxy.TestOuParam; 223 | const 224 | RETURN_MSG = 'hello Delphi Mocks! - With out Param'; 225 | var 226 | mock : TMock; 227 | msg: string; 228 | begin 229 | mock := TMock.Create; 230 | 231 | mock.Setup.WillExecute( 232 | function (const args : TArray; const ReturnType : TRttiType) : TValue 233 | begin 234 | Assert.AreEqual(2, Length(Args), 'Args Length'); 235 | //Argument Zero is Self Instance 236 | args[1] := RETURN_MSG; 237 | end 238 | ).When.TestOutParam(msg); 239 | 240 | msg := EmptyStr; 241 | mock.Instance.TestOutParam(msg); 242 | 243 | Assert.AreEqual(RETURN_MSG, msg); 244 | 245 | mock.Verify; 246 | Assert.Pass; 247 | end; 248 | 249 | procedure TTestInterfaceProxy.TestVarParam; 250 | const 251 | RETURN_MSG = 'hello Delphi Mocks!'; 252 | var 253 | mock : TMock; 254 | msg: string; 255 | begin 256 | mock := TMock.Create; 257 | 258 | mock.Setup.WillExecute( 259 | function (const args : TArray; const ReturnType : TRttiType) : TValue 260 | begin 261 | Assert.AreEqual(2, Length(Args), 'Args Length'); 262 | //Argument Zero is Self Instance 263 | args[1] := RETURN_MSG; 264 | end 265 | ).When.TestVarParam(msg); 266 | 267 | msg := EmptyStr; 268 | mock.Instance.TestVarParam(msg); 269 | 270 | Assert.AreEqual(RETURN_MSG, msg); 271 | 272 | mock.Verify; 273 | Assert.Pass; 274 | end; 275 | 276 | 277 | initialization 278 | TDUnitX.RegisterTestFixture(TTestInterfaceProxy); 279 | 280 | 281 | end. 282 | -------------------------------------------------------------------------------- /Tests/Delphi.Mocks.Tests.Interfaces.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.Tests.Interfaces; 2 | 3 | interface 4 | 5 | uses 6 | DUnitX.TestFramework, 7 | Delphi.Mocks; 8 | 9 | type 10 | {$M+} 11 | IA = interface 12 | ['{551FA8FF-E038-49BB-BCBC-E1F82544CA97}'] 13 | procedure Method1; 14 | end; 15 | 16 | IB = interface 17 | ['{956B7421-7F45-4E22-BD5F-E5898EC186F4}'] 18 | procedure Method2; 19 | end; 20 | 21 | IC = interface 22 | ['{4B52C6FE-43EE-44B5-AC01-B4371944322D}'] 23 | procedure Method3; 24 | end; 25 | 26 | ID = interface 27 | ['{E222BB8F-6E89-4E54-B2DC-E54C5F280E86}'] 28 | procedure Method4; 29 | end; 30 | {$M-} 31 | 32 | 33 | {$M+} 34 | ISafeCallInterface = interface 35 | ['{50960499-4347-421A-B28B-3C05AE9CB351}'] 36 | function DoSomething(const value : WideString) : integer;safecall; 37 | function Foo2(const value : WideString): string; safecall; 38 | procedure Foo; safecall; 39 | end; 40 | 41 | ISimpleInterface = interface 42 | ['{35DA1428-5183-43FE-BEE8-1010C75EF4D6}'] 43 | procedure SimpleProcedure(const value: widestring); 44 | function SimpleFunction: Integer; 45 | end; 46 | 47 | IVariant = interface 48 | procedure VariantParam(Value: Variant); 49 | end; 50 | {$M-} 51 | 52 | {$M+} 53 | [TestFixture] 54 | TSafeCallTest = class 55 | published 56 | [Test] 57 | procedure CanMockSafecallFunction; 58 | [Test, Ignore] 59 | procedure CanMockSafecallProc; 60 | [Test, Ignore] 61 | procedure CanMockSimpleProcedureCall; 62 | [Test] 63 | procedure CanMockProcedureWithVariantParam; 64 | [Test] 65 | procedure CanMockSimpleFunctionCallBehavior; 66 | [Test] 67 | procedure CanMockSimpleFunctionCallDefault; 68 | end; 69 | {$M-} 70 | 71 | {$M+} 72 | TInterfaceTests = class 73 | published 74 | [Test] 75 | procedure Cast_Mock_As_Interfaces_It_Implements; 76 | [Test] 77 | procedure Cast_MockInstance_As_Interfaces_It_Implements; 78 | [Test] 79 | procedure MockInstance_As_Interfaces_It_Implements; 80 | end; 81 | {$M-} 82 | 83 | implementation 84 | uses 85 | Rtti, 86 | System.Variants; 87 | 88 | 89 | { TValueTests } 90 | 91 | procedure TSafeCallTest.CanMockProcedureWithVariantParam; 92 | var 93 | mock : TMock; 94 | begin 95 | mock := TMock.Create; 96 | 97 | mock.Setup.Expect.Once.When.VariantParam(Null); 98 | 99 | mock.Instance.VariantParam(Null); 100 | mock.Verify; 101 | Assert.Pass; 102 | end; 103 | 104 | procedure TSafeCallTest.CanMockSafecallFunction; 105 | var 106 | mock : TMock; 107 | value: Integer; 108 | begin 109 | mock := TMock.Create; 110 | mock.Setup.WillReturn(123).When.DoSomething('hello'); 111 | 112 | value := mock.Instance.DoSomething('hello'); 113 | 114 | Assert.AreEqual(123, value); 115 | end; 116 | 117 | procedure TSafeCallTest.CanMockSafecallProc; 118 | var 119 | mock : TMock; 120 | begin 121 | mock := TMock.Create; 122 | 123 | Assert.NotImplemented; 124 | end; 125 | 126 | 127 | procedure TSafeCallTest.CanMockSimpleFunctionCallBehavior; 128 | var 129 | mock : TMock; 130 | begin 131 | mock := TMock.Create; 132 | mock.Setup.WillReturn(2).When.SimpleFunction; 133 | Assert.AreEqual(2, mock.Instance.SimpleFunction); 134 | end; 135 | 136 | procedure TSafeCallTest.CanMockSimpleFunctionCallDefault; 137 | var 138 | mock : TMock; 139 | begin 140 | mock := TMock.Create; 141 | mock.Setup.WillReturnDefault('SimpleFunction', 2); 142 | Assert.AreEqual(2, mock.Instance.SimpleFunction); 143 | end; 144 | 145 | procedure TSafeCallTest.CanMockSimpleProcedureCall; 146 | var 147 | mock : TMock; 148 | begin 149 | mock := TMock.Create; 150 | 151 | mock.Instance.SimpleProcedure('hello'); 152 | 153 | Assert.NotImplemented; 154 | end; 155 | 156 | procedure TInterfaceTests.Cast_Mock_As_Interfaces_It_Implements; 157 | var 158 | mock : TMock; 159 | a : IA; 160 | b : IB; 161 | c : IC; 162 | d : ID; 163 | i : IInterface; 164 | begin 165 | mock := TMock.Create; 166 | mock.Setup.Expect.Exactly(2).When.Method1; 167 | 168 | mock.Implement; 169 | mock.Setup.Expect.Exactly(2).When.Method2; 170 | 171 | mock.Implement; 172 | mock.Setup.Expect.Exactly(2).When.Method3; 173 | 174 | mock.Implement; 175 | mock.Setup.Expect.Exactly(2).When.Method4; 176 | 177 | //Transfer through mock references. 178 | a := mock; 179 | a.Method1; 180 | 181 | b := a as IB; 182 | b.Method2; 183 | 184 | c := a as IC; 185 | c.Method3; 186 | 187 | d := a as ID; 188 | d.Method4; 189 | 190 | i := a as IInterface; 191 | 192 | 193 | //Transfer through interfaces references. 194 | a := mock; 195 | a.Method1; 196 | 197 | b := a as IB; 198 | b.Method2; 199 | 200 | c := b as IC; 201 | c.Method3; 202 | 203 | d := c as ID; 204 | d.Method4; 205 | 206 | i := d as IInterface; 207 | 208 | mock.VerifyAll(); 209 | Assert.Pass(); 210 | end; 211 | 212 | procedure TInterfaceTests.MockInstance_As_Interfaces_It_Implements; 213 | var 214 | mock : TMock; 215 | a : IA; 216 | b : IB; 217 | c : IC; 218 | d : ID; 219 | i : IInterface; 220 | begin 221 | mock := TMock.Create; 222 | mock.Setup.Expect.Exactly(1).When.Method1; 223 | 224 | mock.Implement; 225 | mock.Setup.Expect.Exactly(1).When.Method2; 226 | 227 | mock.Implement; 228 | mock.Setup.Expect.Exactly(1).When.Method3; 229 | 230 | mock.Implement; 231 | mock.Setup.Expect.Exactly(1).When.Method4; 232 | 233 | //Transfer through mock instance. 234 | a := mock.Instance; 235 | a.Method1; 236 | 237 | b := mock.Instance; 238 | b.Method2; 239 | 240 | c := mock.Instance; 241 | c.Method3; 242 | 243 | d := mock.Instance; 244 | d.Method4; 245 | 246 | i := a as IInterface; 247 | 248 | mock.VerifyAll(); 249 | Assert.Pass(); 250 | end; 251 | 252 | procedure TInterfaceTests.Cast_MockInstance_As_Interfaces_It_Implements; 253 | var 254 | mock : TMock; 255 | a : IA; 256 | b : IB; 257 | c : IC; 258 | d : ID; 259 | i : IInterface; 260 | begin 261 | mock := TMock.Create; 262 | mock.Setup.Expect.Exactly(2).When.Method1; 263 | 264 | mock.Implement; 265 | mock.Setup.Expect.Exactly(2).When.Method2; 266 | 267 | mock.Implement; 268 | mock.Setup.Expect.Exactly(2).When.Method3; 269 | 270 | mock.Implement; 271 | mock.Setup.Expect.Exactly(2).When.Method4; 272 | 273 | //Transfer through mock instance. 274 | a := mock.Instance; 275 | a.Method1; 276 | 277 | b := a as IB; 278 | b.Method2; 279 | 280 | c := a as IC; 281 | c.Method3; 282 | 283 | d := a as ID; 284 | d.Method4; 285 | 286 | i := a as IInterface; 287 | 288 | a := mock.Instance; 289 | a.Method1; 290 | 291 | b := a as IB; 292 | b.Method2; 293 | 294 | c := b as IC; 295 | c.Method3; 296 | 297 | d := c as ID; 298 | d.Method4; 299 | 300 | i := d as IInterface; 301 | 302 | mock.VerifyAll(); 303 | Assert.Pass(); 304 | end; 305 | 306 | initialization 307 | TDUnitX.RegisterTestFixture(TSafeCallTest); 308 | TDUnitX.RegisterTestFixture(TInterfaceTests); 309 | 310 | end. 311 | -------------------------------------------------------------------------------- /Tests/Delphi.Mocks.Tests.MethodData.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.Tests.MethodData; 2 | 3 | interface 4 | 5 | uses 6 | SysUtils, 7 | DUnitX.TestFramework, 8 | Rtti, 9 | Delphi.Mocks, 10 | Delphi.Mocks.Interfaces; 11 | 12 | type 13 | {$M+} 14 | ISimpleInterface = interface 15 | function MissingArg(Value: Integer): Integer; 16 | end; 17 | {$M-} 18 | 19 | TObjectToTest = class 20 | private 21 | FPropertyToTest: Integer; 22 | public 23 | FieldToTest: Integer; 24 | 25 | property PropertyToTest: Integer read FPropertyToTest write FPropertyToTest; 26 | end; 27 | 28 | TAnotherObject = class(TObjectToTest); 29 | 30 | TAndAnotherObject = class(TObjectToTest); 31 | 32 | {$M+} 33 | [TestFixture] 34 | TTestMethodData = class 35 | published 36 | [Test, Ignore] 37 | procedure Expectation_Before_Verifies_To_True_When_Prior_Method_Called_Atleast_Once; 38 | [Test] 39 | procedure AllowRedefineBehaviorDefinitions_IsTrue_RedefinedIsAllowed; 40 | [Test] 41 | procedure AllowRedefineBehaviorDefinitions_IsFalse_ExceptionIsThrown_WhenRedefining; 42 | [Test] 43 | procedure AllowRedefineBehaviorDefinitions_IsFalse_NoExceptionIsThrown_WhenAddingNormal; 44 | [Test] 45 | procedure AllowRedefineBehaviorDefinitions_IsTrue_OldBehaviorIsDeleted; 46 | [Test] 47 | procedure BehaviourMustBeDefined_IsFalse_AndBehaviourIsNotDefined_RaisesNoException; 48 | [Test] 49 | procedure BehaviourMustBeDefined_IsTrue_AndBehaviourIsNotDefined_RaisesException; 50 | [Test] 51 | procedure AllowRedefineBehaviorDefinitions_IsTrue_NoExceptionIsThrown_WhenMatcherAreDifferent; 52 | [Test] 53 | procedure Expectations_NoExceptionIsThrown_WhenMatcherAreDifferent; 54 | end; 55 | {$M-} 56 | 57 | implementation 58 | 59 | uses 60 | Delphi.Mocks.Helpers, 61 | Delphi.Mocks.MethodData, 62 | classes, System.TypInfo, StrUtils, Delphi.Mocks.ParamMatcher; 63 | 64 | 65 | { TTestMethodData } 66 | 67 | procedure TTestMethodData.Expectations_NoExceptionIsThrown_WhenMatcherAreDifferent; 68 | var 69 | methodData : IMethodData; 70 | someParam, 71 | someValue1, 72 | someValue2 : TValue; 73 | LObjectToTest : TObjectToTest; 74 | LAnotherObject: TAnotherObject; 75 | LAndAnotherObject: TAndAnotherObject; 76 | begin 77 | LObjectToTest := TObjectToTest.Create; 78 | LAnotherObject := TAnotherObject.Create; 79 | LAndAnotherObject := TAndAnotherObject.Create; 80 | try 81 | someValue1 := TValue.From(LAnotherObject); 82 | someValue2 := TValue.From(LAndAnotherObject); 83 | someParam := TValue.From(LObjectToTest); 84 | 85 | methodData := TMethodData.Create('x', 'x', TSetupMethodDataParameters.Create(FALSE, FALSE, FALSE)); 86 | methodData.NeverWhen([nil, someParam], [TMatcher.Create(function(value : TAnotherObject) : boolean 87 | begin 88 | result := true; 89 | end)]); 90 | 91 | Assert.WillNotRaise(procedure 92 | begin 93 | methodData.NeverWhen([nil, someParam], [TMatcher.Create(function(value : TAndAnotherObject) : boolean 94 | begin 95 | result := true; 96 | end)]); 97 | end, EMockSetupException); 98 | finally 99 | LObjectToTest.Free; 100 | LAnotherObject.Free; 101 | LAndAnotherObject.Free; 102 | end; 103 | end; 104 | 105 | procedure TTestMethodData.Expectation_Before_Verifies_To_True_When_Prior_Method_Called_Atleast_Once; 106 | begin 107 | Assert.IsTrue(False, 'Not implemented'); 108 | end; 109 | 110 | procedure TTestMethodData.AllowRedefineBehaviorDefinitions_IsTrue_RedefinedIsAllowed; 111 | var 112 | methodData : IMethodData; 113 | someValue1, 114 | someValue2 : TValue; 115 | begin 116 | someValue1 := TValue.From(1); 117 | someValue2 := TValue.From(2); 118 | 119 | methodData := TMethodData.Create('x', 'x', TSetupMethodDataParameters.Create(FALSE, False, TRUE)); 120 | methodData.WillReturnWhen(TArray.Create(someValue1), someValue1, nil); 121 | methodData.WillReturnWhen(TArray.Create(someValue1), someValue2, nil); 122 | 123 | // no exception is raised 124 | Assert.IsTrue(True); 125 | end; 126 | 127 | procedure TTestMethodData.AllowRedefineBehaviorDefinitions_IsFalse_ExceptionIsThrown_WhenRedefining; 128 | var 129 | methodData : IMethodData; 130 | someValue1, 131 | someValue2 : TValue; 132 | begin 133 | someValue1 := TValue.From(1); 134 | someValue2 := TValue.From(2); 135 | 136 | methodData := TMethodData.Create('x', 'x', TSetupMethodDataParameters.Create(FALSE, FALSE, FALSE)); 137 | methodData.WillReturnWhen(TArray.Create(someValue1), someValue1, nil); 138 | 139 | Assert.WillRaise(procedure 140 | begin 141 | methodData.WillReturnWhen(TArray.Create(someValue1), someValue2, nil); 142 | end, EMockSetupException); 143 | end; 144 | 145 | procedure TTestMethodData.AllowRedefineBehaviorDefinitions_IsFalse_NoExceptionIsThrown_WhenAddingNormal; 146 | var 147 | methodData : IMethodData; 148 | someValue1, 149 | someValue2 : TValue; 150 | begin 151 | someValue1 := TValue.From(1); 152 | someValue2 := TValue.From(2); 153 | methodData := TMethodData.Create('x', 'x', TSetupMethodDataParameters.Create(FALSE, FALSE, FALSE)); 154 | methodData.WillReturnWhen([nil, someValue1], someValue1, nil); 155 | methodData.WillReturnWhen([nil, someValue2], someValue2, nil); 156 | 157 | Assert.IsTrue(True); 158 | end; 159 | 160 | procedure TTestMethodData.AllowRedefineBehaviorDefinitions_IsTrue_NoExceptionIsThrown_WhenMatcherAreDifferent; 161 | var 162 | methodData : IMethodData; 163 | someParam, 164 | someValue1, 165 | someValue2 : TValue; 166 | LObjectToTest : TObjectToTest; 167 | LAnotherObject: TAnotherObject; 168 | LAndAnotherObject: TAndAnotherObject; 169 | begin 170 | LObjectToTest := TObjectToTest.Create; 171 | LAnotherObject := TAnotherObject.Create; 172 | LAndAnotherObject := TAndAnotherObject.Create; 173 | try 174 | someValue1 := TValue.From(LAnotherObject); 175 | someValue2 := TValue.From(LAndAnotherObject); 176 | someParam := TValue.From(LObjectToTest); 177 | 178 | methodData := TMethodData.Create('x', 'x', TSetupMethodDataParameters.Create(FALSE, FALSE, FALSE)); 179 | methodData.WillReturnWhen([nil, someParam], someValue1, [TMatcher.Create(function(value : TAnotherObject) : boolean 180 | begin 181 | result := true; 182 | end)]); 183 | 184 | Assert.WillNotRaise(procedure 185 | begin 186 | methodData.WillReturnWhen([nil, someParam], someValue2, [TMatcher.Create(function(value : TAndAnotherObject) : boolean 187 | begin 188 | result := true; 189 | end)]); 190 | end, EMockSetupException); 191 | finally 192 | LAnotherObject.Free; 193 | LAndAnotherObject.Free; 194 | end; 195 | end; 196 | 197 | procedure TTestMethodData.AllowRedefineBehaviorDefinitions_IsTrue_OldBehaviorIsDeleted; 198 | var 199 | methodData : IMethodData; 200 | someValue1, 201 | someValue2 : TValue; 202 | outValue : TValue; 203 | begin 204 | someValue1 := TValue.From(1); 205 | someValue2 := TValue.From(2); 206 | methodData := TMethodData.Create('x', 'x', TSetupMethodDataParameters.Create(TRUE, TRUE, TRUE)); 207 | methodData.WillReturnWhen(TArray.Create(someValue1), someValue1, nil); 208 | methodData.WillReturnWhen(TArray.Create(someValue1), someValue2, nil); 209 | 210 | methodData.RecordHit(TArray.Create(someValue1), TrttiContext.Create.GetType(TypeInfo(integer)), nil, outValue); 211 | 212 | Assert.AreEqual(someValue2.AsInteger, outValue.AsInteger ); 213 | end; 214 | 215 | 216 | procedure TTestMethodData.BehaviourMustBeDefined_IsFalse_AndBehaviourIsNotDefined_RaisesNoException; 217 | var 218 | methodData : IMethodData; 219 | someValue : TValue; 220 | begin 221 | methodData := TMethodData.Create('x', 'x', TSetupMethodDataParameters.Create(FALSE, FALSE, FALSE)); 222 | methodData.RecordHit(TArray.Create(), nil, nil, someValue); 223 | // no exception should be raised 224 | Assert.IsTrue(True); 225 | end; 226 | 227 | procedure TTestMethodData.BehaviourMustBeDefined_IsTrue_AndBehaviourIsNotDefined_RaisesException; 228 | var 229 | methodData : IMethodData; 230 | someValue : TValue; 231 | begin 232 | methodData := TMethodData.Create('x', 'x', TSetupMethodDataParameters.Create(FALSE, TRUE, FALSE)); 233 | 234 | Assert.WillRaise(procedure 235 | begin 236 | methodData.RecordHit(TArray.Create(), TRttiContext.Create.GetType(TypeInfo(Integer)), nil, someValue); 237 | end, EMockException); 238 | end; 239 | 240 | 241 | initialization 242 | TDUnitX.RegisterTestFixture(TTestMethodData); 243 | 244 | end. 245 | -------------------------------------------------------------------------------- /Tests/Delphi.Mocks.Tests.ObjectProxy.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.Tests.ObjectProxy; 2 | 3 | interface 4 | 5 | uses 6 | Rtti, 7 | SysUtils, 8 | DUnitX.TestFramework, 9 | Delphi.Mocks; 10 | 11 | type 12 | TSimpleObject = class(TObject) 13 | private 14 | FCreateCalled: Cardinal; 15 | public 16 | constructor Create; 17 | property CreateCalled: Cardinal read FCreateCalled; 18 | end; 19 | 20 | TMultipleConstructor = class 21 | private 22 | FCreateCalled: Cardinal; 23 | public 24 | constructor Create(Dummy: Integer);overload; 25 | constructor Create;overload; 26 | property CreateCalled: Cardinal read FCreateCalled; 27 | end; 28 | 29 | TCommand = class 30 | private 31 | FVirtualMethodCalled: Boolean; 32 | public 33 | constructor Create; 34 | 35 | procedure Execute;virtual;abstract; 36 | procedure Run(value: Integer);virtual;abstract; 37 | procedure TestVarParam(var msg : string);virtual;abstract; 38 | procedure TestOutParam(out msg : string);virtual;abstract; 39 | function VirtualMethod: Integer; overload; virtual; 40 | function VirtualMethod(const Arg: String): Integer; overload; virtual; 41 | function NonVirtualMethod: Integer; 42 | 43 | property VirtualMethodCalled: Boolean read FVirtualMethodCalled; 44 | end; 45 | 46 | {$M+} 47 | [TestFixture] 48 | TTestObjectProxy = class 49 | published 50 | [Test] 51 | procedure ProxyObject_Calls_The_Create_Of_The_Object_Type; 52 | [Test] 53 | procedure ProxyObject_MultipleConstructor; 54 | [Test] 55 | procedure MockWithArgProcedureUsingOnce; 56 | [Test] 57 | procedure MockNoArgProcedureUsingOnce; 58 | [Test] 59 | procedure MockNoArgProcedureUsingOnceWhen; 60 | [Test] 61 | procedure MockNoArgProcedureUsingNeverWhen; 62 | [Test] 63 | procedure MockNoArgProcedureUsingAtLeastOnceWhen; 64 | [Test] 65 | procedure MockNoArgProcedureUsingAtLeastWhen; 66 | [Test] 67 | procedure MockNoArgProcedureUsingAtMostBetweenWhen; 68 | [Test] 69 | procedure MockNoArgProcedureUsingExactlyWhen; 70 | [Test] 71 | procedure TestOutParam; 72 | [Test] 73 | procedure TestVarParam; 74 | [Test] 75 | procedure MockNoBehaviorDefined; 76 | [Test] 77 | procedure WillRaiseMockNonVirtualMethod; 78 | [Test] 79 | procedure VirtualMethodNotCalledDuringMockSetup; 80 | [Test] 81 | procedure VirtualMethodCalledIfNoBehaviorDefined; 82 | [Test] 83 | procedure VirtualMethodNotCalledIfBehaviorMatches; 84 | [Test] 85 | procedure VirtualMethodCalledIfBehaviorNotMatches; 86 | end; 87 | {$M-} 88 | 89 | implementation 90 | 91 | uses 92 | Delphi.Mocks.ObjectProxy; 93 | 94 | const 95 | G_CREATE_CALLED_UNIQUE_ID = 909090; 96 | 97 | { TTestObjectProxy } 98 | 99 | procedure TTestObjectProxy.ProxyObject_Calls_The_Create_Of_The_Object_Type; 100 | var 101 | objectProxy: IProxy; 102 | begin 103 | objectProxy := TObjectProxy.Create(function: TSimpleObject 104 | begin 105 | result := TSimpleObject.Create; 106 | end); 107 | 108 | Assert.AreEqual(objectProxy.Proxy.CreateCalled, G_CREATE_CALLED_UNIQUE_ID); 109 | end; 110 | 111 | procedure TTestObjectProxy.ProxyObject_MultipleConstructor; 112 | var 113 | objectProxy: IProxy; 114 | begin 115 | objectProxy := TObjectProxy.Create(function: TMultipleConstructor 116 | begin 117 | result := TMultipleConstructor.Create; 118 | end); 119 | 120 | Assert.AreEqual(objectProxy.Proxy.CreateCalled, G_CREATE_CALLED_UNIQUE_ID); 121 | end; 122 | 123 | procedure TTestObjectProxy.TestOutParam; 124 | const 125 | RETURN_MSG = 'hello Delphi Mocks! - With out Param'; 126 | var 127 | mock : TMock; 128 | msg: string; 129 | begin 130 | mock := TMock.Create; 131 | 132 | mock.Setup.WillExecute( 133 | function (const args : TArray; const ReturnType : TRttiType) : TValue 134 | begin 135 | Assert.AreEqual(2, Length(Args), 'Args Length'); 136 | //Argument Zero is Self Instance 137 | args[1] := RETURN_MSG; 138 | end 139 | ).When.TestOutParam(msg); 140 | 141 | msg := EmptyStr; 142 | mock.Instance.TestOutParam(msg); 143 | 144 | Assert.AreEqual(RETURN_MSG, msg); 145 | 146 | mock.Verify; 147 | Assert.Pass; 148 | end; 149 | 150 | procedure TTestObjectProxy.TestVarParam; 151 | const 152 | RETURN_MSG = 'hello Delphi Mocks!'; 153 | var 154 | mock : TMock; 155 | msg: string; 156 | begin 157 | mock := TMock.Create; 158 | 159 | mock.Setup.WillExecute( 160 | function (const args : TArray; const ReturnType : TRttiType) : TValue 161 | begin 162 | Assert.AreEqual(2, Length(Args), 'Args Length'); 163 | //Argument Zero is Self Instance 164 | args[1] := RETURN_MSG; 165 | end 166 | ).When.TestVarParam(msg); 167 | 168 | msg := EmptyStr; 169 | mock.Instance.TestVarParam(msg); 170 | 171 | Assert.AreEqual(RETURN_MSG, msg); 172 | 173 | mock.Verify; 174 | Assert.Pass; 175 | end; 176 | 177 | procedure TTestObjectProxy.VirtualMethodCalledIfBehaviorNotMatches; 178 | var 179 | mock : TMock; 180 | begin 181 | mock := TMock.Create; 182 | mock.Setup.WillReturn(2).When.VirtualMethod('test'); 183 | 184 | Assert.AreEqual(1, mock.Instance.VirtualMethod('test2')); 185 | Assert.IsTrue(mock.Instance.VirtualMethodCalled); 186 | end; 187 | 188 | procedure TTestObjectProxy.VirtualMethodCalledIfNoBehaviorDefined; 189 | var 190 | mock : TMock; 191 | begin 192 | mock := TMock.Create; 193 | 194 | Assert.AreEqual(1, mock.Instance.VirtualMethod('test')); 195 | Assert.IsTrue(mock.Instance.VirtualMethodCalled); 196 | end; 197 | 198 | procedure TTestObjectProxy.VirtualMethodNotCalledDuringMockSetup; 199 | var 200 | mock : TMock; 201 | begin 202 | mock := TMock.Create; 203 | mock.Setup.Expect.AtLeastOnce.When.VirtualMethod; 204 | mock.Setup.WillReturn(1).When.VirtualMethod; 205 | mock.Setup.WillReturnDefault('VirtualMethod', 1); 206 | 207 | Assert.IsFalse(mock.Instance.VirtualMethodCalled); 208 | end; 209 | 210 | procedure TTestObjectProxy.VirtualMethodNotCalledIfBehaviorMatches; 211 | var 212 | mock : TMock; 213 | begin 214 | mock := TMock.Create; 215 | mock.Setup.WillReturn(2).When.VirtualMethod('test'); 216 | Assert.AreEqual(2, mock.Instance.VirtualMethod('test')); 217 | 218 | Assert.IsFalse(mock.Instance.VirtualMethodCalled); 219 | end; 220 | 221 | procedure TTestObjectProxy.MockNoArgProcedureUsingAtLeastOnceWhen; 222 | var 223 | mock : TMock; 224 | begin 225 | mock := TMock.Create; 226 | mock.Setup.Expect.AtLeastOnce.When.Execute; 227 | mock.Instance.Execute; 228 | mock.Instance.Execute; 229 | mock.Verify; 230 | Assert.Pass; 231 | end; 232 | 233 | procedure TTestObjectProxy.MockNoArgProcedureUsingAtLeastWhen; 234 | var 235 | mock : TMock; 236 | begin 237 | mock := TMock.Create; 238 | mock.Setup.Expect.AtLeast(3).When.Execute; 239 | mock.Instance.Execute; 240 | mock.Instance.Execute; 241 | mock.Instance.Execute; 242 | mock.Verify; 243 | Assert.Pass; 244 | end; 245 | 246 | procedure TTestObjectProxy.MockNoArgProcedureUsingAtMostBetweenWhen; 247 | var 248 | mock : TMock; 249 | begin 250 | mock := TMock.Create; 251 | mock.Setup.Expect.AtMost(2).When.Execute; 252 | mock.Instance.Execute; 253 | mock.Instance.Execute; 254 | mock.Verify; 255 | Assert.Pass; 256 | end; 257 | 258 | procedure TTestObjectProxy.MockNoArgProcedureUsingExactlyWhen; 259 | var 260 | mock : TMock; 261 | begin 262 | mock := TMock.Create; 263 | mock.Setup.Expect.Exactly(2).When.Execute; 264 | mock.Instance.Execute; 265 | mock.Instance.Execute; 266 | mock.Verify; 267 | Assert.Pass; 268 | end; 269 | 270 | procedure TTestObjectProxy.MockNoArgProcedureUsingNeverWhen; 271 | var 272 | mock : TMock; 273 | begin 274 | mock := TMock.Create; 275 | mock.Setup.Expect.Never.When.Execute; 276 | mock.Instance.Execute; 277 | Assert.WillRaiseAny(procedure 278 | begin 279 | mock.Verify; 280 | end); 281 | end; 282 | 283 | procedure TTestObjectProxy.MockNoArgProcedureUsingOnce; 284 | var 285 | mock : TMock; 286 | begin 287 | mock := TMock.Create; 288 | mock.Setup.Expect.Once('Execute'); 289 | mock.Instance.Execute; 290 | Assert.Pass; 291 | end; 292 | 293 | procedure TTestObjectProxy.MockNoArgProcedureUsingOnceWhen; 294 | var 295 | mock : TMock; 296 | begin 297 | mock := TMock.Create; 298 | mock.Setup.Expect.Once.When.Execute; 299 | mock.Instance.Execute; 300 | mock.Verify; 301 | Assert.Pass; 302 | end; 303 | 304 | procedure TTestObjectProxy.MockNoBehaviorDefined; 305 | var 306 | mock : TMock; 307 | begin 308 | mock := TMock.Create; 309 | mock.Setup.Expect.Once.When.VirtualMethod; 310 | Assert.AreEqual(1, mock.Instance.VirtualMethod); 311 | mock.Verify; 312 | end; 313 | 314 | procedure TTestObjectProxy.WillRaiseMockNonVirtualMethod; 315 | var 316 | mock : TMock; 317 | begin 318 | mock := TMock.Create; 319 | Assert.WillRaise(procedure begin mock.Setup.Expect.Once.When.NonVirtualMethod; end); 320 | Assert.WillRaise(procedure begin mock.Setup.WillReturn(2).When.NonVirtualMethod; end); 321 | end; 322 | 323 | procedure TTestObjectProxy.MockWithArgProcedureUsingOnce; 324 | var 325 | mock : TMock; 326 | begin 327 | mock := TMock.Create; 328 | mock.Setup.Expect.Once.When.Run(3); 329 | mock.Instance.Run(3); 330 | mock.Verify; 331 | Assert.Pass; 332 | end; 333 | 334 | { TSimpleObject } 335 | 336 | constructor TSimpleObject.Create; 337 | begin 338 | FCreateCalled := G_CREATE_CALLED_UNIQUE_ID; 339 | end; 340 | 341 | { TMultipleConstructor } 342 | 343 | constructor TMultipleConstructor.Create(Dummy: Integer); 344 | begin 345 | 346 | end; 347 | 348 | constructor TMultipleConstructor.Create; 349 | begin 350 | FCreateCalled := G_CREATE_CALLED_UNIQUE_ID; 351 | end; 352 | 353 | 354 | { TCommand } 355 | 356 | constructor TCommand.Create; 357 | begin 358 | FVirtualMethodCalled := False; 359 | end; 360 | 361 | function TCommand.NonVirtualMethod: Integer; 362 | begin 363 | Result := 1; 364 | end; 365 | 366 | function TCommand.VirtualMethod(const Arg: String): Integer; 367 | begin 368 | FVirtualMethodCalled := True; 369 | Result := 1; 370 | end; 371 | 372 | function TCommand.VirtualMethod: Integer; 373 | begin 374 | FVirtualMethodCalled := True; 375 | Result := 1; 376 | end; 377 | 378 | initialization 379 | TDUnitX.RegisterTestFixture(TTestObjectProxy); 380 | 381 | end. 382 | -------------------------------------------------------------------------------- /Tests/Delphi.Mocks.Tests.Objects.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.Tests.Objects; 2 | 3 | interface 4 | 5 | uses 6 | SysUtils, 7 | DUnitX.TestFramework, 8 | Delphi.Mocks; 9 | 10 | type 11 | ESimpleException = exception; 12 | 13 | TSimpleMockedObject = class(TObject) 14 | public 15 | procedure SimpleMethod; 16 | function VirtualAbstract: Integer; virtual; abstract; 17 | end; 18 | 19 | TSystemUnderTest = class(TObject) 20 | private 21 | FMocked : TSimpleMockedObject; 22 | public 23 | constructor Create(const AMock: TSimpleMockedObject); 24 | procedure CallsSimpleMethodOnMock; 25 | end; 26 | 27 | {$M+} 28 | [TestFixture] 29 | TMockObjectTests = class 30 | published 31 | procedure MockObject_Can_Call_Function; 32 | [Test] 33 | procedure CanMockVirtualAbstractCallBehavior; 34 | [Test] 35 | procedure CanMockVirtualAbstractCallDefault; 36 | end; 37 | {$M-} 38 | 39 | 40 | implementation 41 | 42 | uses 43 | Rtti; 44 | 45 | { TMockObjectTests } 46 | 47 | procedure TMockObjectTests.CanMockVirtualAbstractCallBehavior; 48 | var 49 | Mock: TMock; 50 | begin 51 | Mock := TMock.Create; 52 | Mock.Setup.WillReturn(2).When.VirtualAbstract; 53 | Assert.AreEqual(2, Mock.Instance.VirtualAbstract); 54 | end; 55 | 56 | procedure TMockObjectTests.CanMockVirtualAbstractCallDefault; 57 | var 58 | Mock: TMock; 59 | begin 60 | Mock := TMock.Create; 61 | Mock.Setup.WillReturnDefault('VirtualAbstract', 2); 62 | Assert.AreEqual(2, Mock.Instance.VirtualAbstract); 63 | end; 64 | 65 | procedure TMockObjectTests.MockObject_Can_Call_Function; 66 | var 67 | mock : TMock; 68 | systemUnderTest : TSystemUnderTest; 69 | begin 70 | //var mock = new Mock(); 71 | //mock.Setup(foo => foo.DoSomething("ping")).Returns(true); 72 | mock := TMock.Create; 73 | 74 | mock.Setup.WillRaise('SimpleMethod', ESimpleException); 75 | 76 | systemUnderTest := TSystemUnderTest.Create(mock.Instance); 77 | 78 | systemUnderTest.CallsSimpleMethodOnMock; 79 | 80 | mock.VerifyAll; 81 | 82 | Assert.Pass; 83 | end; 84 | 85 | { TSimpleObject } 86 | 87 | procedure TSimpleMockedObject.SimpleMethod; 88 | begin 89 | //Does nothing; 90 | end; 91 | 92 | { TSystemUnderTest } 93 | 94 | procedure TSystemUnderTest.CallsSimpleMethodOnMock; 95 | begin 96 | FMocked.SimpleMethod; 97 | end; 98 | 99 | constructor TSystemUnderTest.Create(const AMock: TSimpleMockedObject); 100 | begin 101 | FMocked := AMock; 102 | end; 103 | 104 | initialization 105 | TDUnitX.RegisterTestFixture(TMockObjectTests); 106 | end. 107 | -------------------------------------------------------------------------------- /Tests/Delphi.Mocks.Tests.OpenArrayIntf.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.Tests.OpenArrayIntf; 2 | 3 | interface 4 | 5 | uses 6 | DUnitX.TestFramework; 7 | 8 | type 9 | {$M+} 10 | [TestFixture] 11 | TestIOpenArray = class 12 | published 13 | procedure TestMyMethodDynamicArray; 14 | procedure TestMyMethodTypedArray; 15 | end; 16 | {$M-} 17 | 18 | TMyArray = array of Integer; 19 | 20 | {$M+} 21 | IDynamicArray = interface 22 | // This crashes: One open array + one more parameter. Only the open array works. 23 | function MyMethod(MyArray: array of Integer; Number: Integer): Integer; 24 | end; 25 | 26 | ITypedArray = interface 27 | function MyMethod(MyArray: TMyArray; Number: Integer): Integer; 28 | 29 | end; 30 | {$M-} 31 | 32 | implementation 33 | 34 | uses 35 | Delphi.Mocks; 36 | 37 | procedure TestIOpenArray.TestMyMethodDynamicArray; 38 | var 39 | Mock: TMock; 40 | Intf: IDynamicArray; 41 | returnValue: integer; 42 | begin 43 | Mock := TMock.Create; 44 | 45 | Mock.Setup.WillReturn(3).When.MyMethod([123], 1); 46 | 47 | Intf := Mock; 48 | 49 | // in XE6 there was only an access violation, when using the Method inside the "Assert.AreEqual" method 50 | // Using a local variable fixed this AV 51 | returnValue := Intf.MyMethod([123], 1); 52 | Assert.AreEqual(3, returnValue); 53 | end; 54 | 55 | procedure TestIOpenArray.TestMyMethodTypedArray; 56 | var 57 | Mock: TMock; 58 | Intf: ITypedArray; 59 | MyArray: TMyArray; 60 | begin 61 | Mock := TMock.Create; 62 | 63 | // Setup our typed array 64 | SetLength(MyArray, 1); 65 | MyArray[0] := 123; 66 | 67 | Mock.Setup.WillReturn(2).When.MyMethod(MyArray, 1); 68 | 69 | Intf := Mock; 70 | 71 | // This works! yay :D 72 | Assert.AreEqual(2, Intf.MyMethod(MyArray, 1)); 73 | end; 74 | 75 | initialization 76 | TDUnitX.RegisterTestFixture(TestIOpenArray); 77 | end. 78 | -------------------------------------------------------------------------------- /Tests/Delphi.Mocks.Tests.Proxy.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.Tests.Proxy; 2 | 3 | interface 4 | 5 | uses 6 | Rtti, 7 | SysUtils, 8 | DUnitX.TestFramework, 9 | Delphi.Mocks; 10 | 11 | type 12 | {$M+} 13 | [TestFixture] 14 | TTestMock = class 15 | published 16 | [Test, Ignore] 17 | procedure Expectation_Before_Verifies_To_True_When_Prior_Method_Called_Atleast_Once; 18 | [Test] 19 | procedure VerifyAllRespectsMessage; 20 | [Test] 21 | procedure ResetCallsWorks; 22 | [Test] 23 | procedure ClearExpectationsWorks; 24 | end; 25 | {$M-} 26 | 27 | implementation 28 | 29 | uses 30 | Delphi.Mocks.Helpers, 31 | Delphi.Mocks.Interfaces, 32 | Delphi.Mocks.MethodData, 33 | classes; 34 | 35 | type 36 | TSimpleClass = class 37 | public 38 | procedure DoTest; virtual; abstract; 39 | end; 40 | 41 | { TTestMock } 42 | 43 | procedure TTestMock.ClearExpectationsWorks; 44 | var 45 | m: TMock; 46 | begin 47 | m := TMock.Create; 48 | m.Setup.Expect.Once.When.DoTest; 49 | Assert.WillRaise(procedure begin m.VerifyAll() end, EMockVerificationException); 50 | m.Setup.Expect.Clear; 51 | Assert.WillNotRaise(procedure begin m.VerifyAll() end); 52 | end; 53 | 54 | procedure TTestMock.Expectation_Before_Verifies_To_True_When_Prior_Method_Called_Atleast_Once; 55 | begin 56 | Assert.NotImplemented; 57 | end; 58 | 59 | procedure TTestMock.ResetCallsWorks; 60 | var 61 | m: TMock; 62 | begin 63 | m := TMock.Create; 64 | m.Setup.Expect.Once.When.DoTest; 65 | m.Instance.DoTest; 66 | Assert.WillNotRaise(procedure begin m.VerifyAll() end); 67 | m.ResetCalls; 68 | Assert.WillRaise(procedure begin m.VerifyAll() end, EMockVerificationException); 69 | end; 70 | 71 | procedure TTestMock.VerifyAllRespectsMessage; 72 | var 73 | m: TMock; 74 | begin 75 | m := TMock.Create; 76 | m.Setup.Expect.Once.When.DoTest; 77 | try 78 | m.VerifyAll('test'); 79 | except 80 | on E: EMockVerificationException do begin 81 | Assert.IsTrue(E.Message.StartsWith('test')); 82 | Exit; 83 | end; 84 | end; 85 | Assert.Fail('Verifyall does not respect message'); 86 | end; 87 | 88 | initialization 89 | TDUnitX.RegisterTestFixture(TTestMock); 90 | end. 91 | -------------------------------------------------------------------------------- /Tests/Delphi.Mocks.Tests.ProxyBase.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.Tests.ProxyBase; 2 | 3 | interface 4 | 5 | uses 6 | Rtti, 7 | SysUtils, 8 | DUnitX.TestFramework, 9 | Delphi.Mocks; 10 | 11 | type 12 | {$M+} 13 | TSimpleTestObject = class(TObject); 14 | {$M-} 15 | 16 | {$M+} 17 | [TestFixture] 18 | TTestProxyBase = class 19 | published 20 | [Setup] 21 | procedure SetUp; 22 | end; 23 | {$M-} 24 | 25 | implementation 26 | 27 | uses 28 | Delphi.Mocks.Helpers, 29 | Delphi.Mocks.Interfaces, 30 | classes; 31 | 32 | { TTestProxyBase } 33 | 34 | procedure TTestProxyBase.Setup; 35 | begin 36 | end; 37 | 38 | initialization 39 | TDUnitX.RegisterTestFixture(TTestProxyBase); 40 | 41 | end. 42 | -------------------------------------------------------------------------------- /Tests/Delphi.Mocks.Tests.Stubs.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.Tests.Stubs; 2 | 3 | interface 4 | 5 | uses 6 | DUnitX.TestFramework; 7 | type 8 | {$M+} 9 | [TestFixture] 10 | TStubTests = class 11 | published 12 | procedure Test_WillReturnDefault; 13 | procedure Test_CanStubInheritedMethods; 14 | end; 15 | {$M-} 16 | 17 | {$M+} 18 | ITestable = interface 19 | function DoSomething(const value : string) : string; 20 | end; 21 | {$M-} 22 | 23 | 24 | implementation 25 | 26 | uses 27 | Classes, 28 | Delphi.Mocks; 29 | { TUtilsTests } 30 | { TStubTests } 31 | 32 | procedure TStubTests.Test_CanStubInheritedMethods; 33 | var 34 | stub : TStub; 35 | begin 36 | stub := TStub.Create; 37 | stub.Setup.BehaviorMustBeDefined := false; 38 | stub.Setup.WillReturnDefault('Add', 0); 39 | // stub.Setup.WillReturn(1).When.Add(It(0).IsAny); 40 | stub.Instance.Add('2'); 41 | end; 42 | 43 | procedure TStubTests.Test_WillReturnDefault; 44 | var 45 | stub : TStub; 46 | intf : ITestable; 47 | actual : string; 48 | begin 49 | stub := TStub.Create; 50 | stub.Setup.WillReturnDefault('DoSomething','hello'); 51 | intf := stub.Instance; 52 | actual := intf.DoSomething('world'); 53 | Assert.AreEqual('hello', actual); 54 | end; 55 | 56 | initialization 57 | TDUnitX.RegisterTestFixture(TStubTests); 58 | 59 | 60 | end. 61 | -------------------------------------------------------------------------------- /Tests/Delphi.Mocks.Tests.TValue.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.Tests.TValue; 2 | 3 | interface 4 | 5 | uses 6 | DUnitX.TestFramework; 7 | 8 | type 9 | {$M+} 10 | TValueTests = class 11 | published 12 | procedure Test_IsRecord; 13 | procedure Test_IsArray; 14 | end; 15 | {$M-} 16 | 17 | implementation 18 | 19 | uses 20 | Delphi.Mocks.Helpers, System.Rtti; 21 | 22 | { TValueTests } 23 | 24 | type 25 | TMyRec = record 26 | Value: String; 27 | end; 28 | 29 | procedure TValueTests.Test_IsArray; 30 | begin 31 | Assert.IsFalse(TValue.From('test').IsArray); 32 | Assert.IsTrue(TValue.From>(['a', 'b']).IsArray); 33 | end; 34 | 35 | procedure TValueTests.Test_IsRecord; 36 | var 37 | r: TMyRec; 38 | o: TObject; 39 | i: IInterface; 40 | begin 41 | o := TObject.Create; 42 | try 43 | Assert.IsFalse(TValue.From('test').IsRecord); 44 | Assert.IsFalse(TValue.From(o).IsRecord); 45 | Assert.IsFalse(TValue.From(i).IsRecord); 46 | Assert.IsTrue(TValue.From(r).IsRecord); 47 | finally 48 | o.Free; 49 | end; 50 | end; 51 | 52 | initialization 53 | TDUnitX.RegisterTestFixture(TValueTests); 54 | end. 55 | -------------------------------------------------------------------------------- /Tests/Delphi.Mocks.Tests.Utils.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.Tests.Utils; 2 | 3 | interface 4 | uses 5 | DUnitX.TestFramework, 6 | Rtti, 7 | Delphi.Mocks.Helpers; 8 | 9 | type 10 | //Testing TValue helper methods in TValueHelper 11 | {$M+} 12 | [TestFixture] 13 | TTestTValue = class 14 | published 15 | procedure Test_TValue_Equals_Interfaces; 16 | procedure Test_TValue_NotEquals_Interfaces; 17 | procedure Test_TValue_Equals_Strings; 18 | procedure Test_TValue_NotEquals_Strings; 19 | 20 | procedure Test_TValue_Equals_SameGuid_Instance; 21 | procedure Test_TValue_Equals_DifferentGuid_Instance; 22 | procedure Test_TValue_NotEquals_Guid; 23 | 24 | procedure Test_TRttiMethod_IsAbstract; 25 | procedure Test_TRttiMethod_IsVirtual; 26 | 27 | procedure Test_CompareValue_RecordEquals; 28 | procedure Test_CompareValue_RecordNotEquals; 29 | procedure Test_CompareValue_RecordNoEqualsOperator; 30 | 31 | procedure Test_CompareValue_ArrayEquals; 32 | procedure Test_CompareValue_ArrayNotEquals; 33 | 34 | procedure Test_CompareValue_ObjectEquals; 35 | procedure Test_CompareValue_ObjectNotEquals; 36 | end; 37 | {$M-} 38 | 39 | implementation 40 | 41 | uses 42 | SysUtils; 43 | 44 | type 45 | TMyClass = class 46 | private 47 | FValue: Integer; 48 | public 49 | procedure NormalMethod; 50 | procedure AbstractMethod; virtual; abstract; 51 | procedure VirtualMethod; virtual; 52 | 53 | constructor Create(AValue: Integer); 54 | 55 | function Equals(AItem: TObject): Boolean; override; 56 | end; 57 | 58 | TMyRec = record 59 | Value: String; 60 | 61 | class operator Equal(a, b: TMyRec): Boolean; 62 | end; 63 | 64 | TMySimpleRec = record 65 | Value: String; 66 | end; 67 | 68 | { TTestTValue } 69 | 70 | procedure TTestTValue.Test_TValue_Equals_Interfaces; 71 | var 72 | i1,i2 : IInterface; 73 | v1, v2 : TValue; 74 | begin 75 | i1 := TInterfacedObject.Create; 76 | i2 := i1; 77 | v1 := TValue.From(i1); 78 | v2 := TValue.From(i2); 79 | 80 | Assert.IsTrue(v1.Equals(v2)); 81 | end; 82 | 83 | procedure TTestTValue.Test_TValue_Equals_Strings; 84 | var 85 | s1,s2 : string; 86 | v1, v2 : TValue; 87 | begin 88 | s1 := 'hello'; 89 | s2 := 'hello'; 90 | v1 := s1; 91 | v2 := s2; 92 | Assert.IsTrue(v1.Equals(v2)); 93 | end; 94 | 95 | procedure TTestTValue.Test_TValue_Equals_SameGuid_Instance; 96 | var 97 | s1,s2 : TGUID; 98 | v1, v2 : TValue; 99 | begin 100 | s1 := StringToGUID( '{2933052C-79D0-48C9-86D3-8FF29416033C}' ); 101 | s2 := s1; 102 | v1 := TValue.From( s1 ); 103 | v2 := TValue.From( s2 ); 104 | Assert.IsTrue(v1.Equals(v2)); 105 | end; 106 | 107 | procedure TTestTValue.Test_CompareValue_ArrayEquals; 108 | var 109 | a1, a2: TArray; 110 | begin 111 | a1 := []; 112 | a2 := []; 113 | Assert.AreEqual(0, CompareValue(TValue.From(a1), TValue.From(a2))); 114 | 115 | a1 := ['a', 'b']; 116 | a2 := ['a', 'b']; 117 | Assert.AreEqual(0, CompareValue(TValue.From(a1), TValue.From(a2))); 118 | end; 119 | 120 | procedure TTestTValue.Test_CompareValue_ArrayNotEquals; 121 | var 122 | a1, a2: TArray; 123 | begin 124 | a1 := ['a']; 125 | a2 := ['a', 'b']; 126 | Assert.AreNotEqual(0, CompareValue(TValue.From(a1), TValue.From(a2))); 127 | 128 | a1 := ['a', 'b']; 129 | a2 := ['a']; 130 | Assert.AreNotEqual(0, CompareValue(TValue.From(a1), TValue.From(a2))); 131 | 132 | a1 := []; 133 | a2 := ['a']; 134 | Assert.AreNotEqual(0, CompareValue(TValue.From(a1), TValue.From(a2))); 135 | 136 | a1 := ['a']; 137 | a2 := []; 138 | Assert.AreNotEqual(0, CompareValue(TValue.From(a1), TValue.From(a2))); 139 | end; 140 | 141 | procedure TTestTValue.Test_CompareValue_ObjectEquals; 142 | var 143 | o1, o2: TMyClass; 144 | begin 145 | o1 := TMyClass.Create(1); 146 | o2 := TMyClass.Create(1); 147 | try 148 | Assert.AreEqual(0, CompareValue(TValue.From(o1), TValue.From(o1))); 149 | Assert.AreEqual(0, CompareValue(TValue.From(o2), TValue.From(o2))); 150 | Assert.AreEqual(0, CompareValue(TValue.From(o1), TValue.From(o2))); 151 | finally 152 | o1.Free; 153 | o2.Free; 154 | end; 155 | end; 156 | 157 | procedure TTestTValue.Test_CompareValue_ObjectNotEquals; 158 | var 159 | o1, o2: TMyClass; 160 | begin 161 | o1 := TMyClass.Create(1); 162 | o2 := TMyClass.Create(2); 163 | try 164 | Assert.AreEqual(0, CompareValue(TValue.From(o1), TValue.From(o1))); 165 | Assert.AreEqual(0, CompareValue(TValue.From(o2), TValue.From(o2))); 166 | Assert.AreNotEqual(0, CompareValue(TValue.From(o1), TValue.From(o2))); 167 | finally 168 | o1.Free; 169 | o2.Free; 170 | end; 171 | end; 172 | 173 | procedure TTestTValue.Test_CompareValue_RecordEquals; 174 | var 175 | r1, r2: TMyRec; 176 | begin 177 | r1.Value := 'test'; 178 | r2.Value := 'test'; 179 | 180 | Assert.AreEqual(0, CompareValue(TValue.From(r1), TValue.From(r2))); 181 | end; 182 | 183 | procedure TTestTValue.Test_CompareValue_RecordNoEqualsOperator; 184 | var 185 | r1, r2: TMySimpleRec; 186 | begin 187 | r1.Value := 'test'; 188 | r2.Value := 'test1'; 189 | 190 | Assert.AreEqual(0, CompareValue(TValue.From(r1), TValue.From(r2))); 191 | end; 192 | 193 | procedure TTestTValue.Test_CompareValue_RecordNotEquals; 194 | var 195 | r1, r2: TMyRec; 196 | begin 197 | r1.Value := 'test'; 198 | r2.Value := 'test1'; 199 | 200 | Assert.AreNotEqual(0, CompareValue(TValue.From(r1), TValue.From(r2))); 201 | end; 202 | 203 | procedure TTestTValue.Test_TRttiMethod_IsAbstract; 204 | var 205 | LCtx: TRttiContext; 206 | begin 207 | Assert.IsFalse(LCtx.GetType(TMyClass).GetMethod('NormalMethod').IsAbstract); 208 | Assert.IsTrue(LCtx.GetType(TMyClass).GetMethod('AbstractMethod').IsAbstract); 209 | Assert.IsFalse(LCtx.GetType(TMyClass).GetMethod('VirtualMethod').IsAbstract); 210 | end; 211 | 212 | procedure TTestTValue.Test_TRttiMethod_IsVirtual; 213 | var 214 | LCtx: TRttiContext; 215 | begin 216 | Assert.IsFalse(LCtx.GetType(TMyClass).GetMethod('NormalMethod').IsVirtual); 217 | Assert.IsTrue(LCtx.GetType(TMyClass).GetMethod('AbstractMethod').IsVirtual); 218 | Assert.IsTrue(LCtx.GetType(TMyClass).GetMethod('VirtualMethod').IsVirtual); 219 | end; 220 | 221 | procedure TTestTValue.Test_TValue_Equals_DifferentGuid_Instance; 222 | var 223 | s1,s2 : TGUID; 224 | v1, v2 : TValue; 225 | begin 226 | s1 := StringToGUID( '{2933052C-79D0-48C9-86D3-8FF29416033C}' ); 227 | s2 := StringToGUID( '{2933052C-79D0-48C9-86D3-8FF29416033C}' ); 228 | v1 := TValue.From( s1 ); 229 | v2 := TValue.From( s2 ); 230 | Assert.IsTrue(v1.Equals(v2)); 231 | end; 232 | 233 | procedure TTestTValue.Test_TValue_NotEquals_Guid; 234 | var 235 | s1,s2 : TGUID; 236 | v1, v2 : TValue; 237 | begin 238 | s1 := StringToGUID( '{2933052C-79D0-48C9-86D3-8FF294160000}' ); 239 | s2 := StringToGUID( '{2933052C-79D0-48C9-86D3-8FF29416FFFF}' ); 240 | v1 := TValue.From( s1 ); 241 | v2 := TValue.From( s2 ); 242 | Assert.IsFalse(v1.Equals(v2)); 243 | end; 244 | 245 | procedure TTestTValue.Test_TValue_NotEquals_Interfaces; 246 | var 247 | i1,i2 : IInterface; 248 | v1, v2 : TValue; 249 | begin 250 | i1 := TInterfacedObject.Create; 251 | i2 := TInterfacedObject.Create; 252 | v1 := TValue.From(i1); 253 | v2 := TValue.From(i2); 254 | Assert.IsFalse(v1.Equals(v2)); 255 | end; 256 | 257 | procedure TTestTValue.Test_TValue_NotEquals_Strings; 258 | var 259 | s1,s2 : string; 260 | v1, v2 : TValue; 261 | begin 262 | s1 := 'hello'; 263 | s2 := 'goodbye'; 264 | v1 := s1; 265 | v2 := s2; 266 | Assert.IsFalse(v1.Equals(v2)); 267 | end; 268 | 269 | { TMyClass } 270 | 271 | constructor TMyClass.Create(AValue: Integer); 272 | begin 273 | FValue := AValue; 274 | end; 275 | 276 | function TMyClass.Equals(AItem: TObject): Boolean; 277 | begin 278 | Result := AItem is TMyClass; 279 | if Result then 280 | Result := TMyClass(AItem).FValue = Self.FValue; 281 | end; 282 | 283 | procedure TMyClass.NormalMethod; 284 | begin 285 | //No op 286 | end; 287 | 288 | procedure TMyClass.VirtualMethod; 289 | begin 290 | //No op 291 | end; 292 | 293 | { TMyRec } 294 | 295 | class operator TMyRec.Equal(a, b: TMyRec): Boolean; 296 | begin 297 | Result := a.Value = b.Value; 298 | end; 299 | 300 | initialization 301 | TDUnitX.RegisterTestFixture(TTestTValue); 302 | 303 | end. 304 | -------------------------------------------------------------------------------- /Tests/Delphi.Mocks.Tests.dpr: -------------------------------------------------------------------------------- 1 | program Delphi.Mocks.Tests; 2 | { 3 | 4 | Delphi DUnit Test Project 5 | ------------------------- 6 | This project contains the DUnit test framework and the GUI/Console test runners. 7 | Add "CONSOLE_TESTRUNNER" to the conditional defines entry in the project options 8 | to use the console test runner. Otherwise the GUI test runner will be used by 9 | default. 10 | 11 | } 12 | 13 | {.$DEFINE XMLOUTPUT} 14 | {.$DEFINE ISCONSOLE} 15 | 16 | {$IFDEF ISCONSOLE} 17 | {$APPTYPE CONSOLE} 18 | {$ENDIF} 19 | 20 | {$WARN DUPLICATE_CTOR_DTOR OFF} 21 | 22 | uses 23 | Forms, 24 | DUnitX.TestFramework, 25 | DUnitX.Loggers.Console, 26 | DUnitX.Windows.Console, 27 | DUnitX.Loggers.XML.NUnit, 28 | SysUtils, 29 | Sample1Main in '..\Examples\Sample1Main.pas', 30 | Delphi.Mocks.Tests.AutoMock in 'Delphi.Mocks.Tests.AutoMock.pas', 31 | Delphi.Mocks.Tests.Base in 'Delphi.Mocks.Tests.Base.pas', 32 | Delphi.Mocks.Tests.Behavior in 'Delphi.Mocks.Tests.Behavior.pas', 33 | Delphi.Mocks.Tests.Expectations in 'Delphi.Mocks.Tests.Expectations.pas', 34 | Delphi.Mocks.Tests.InterfaceProxy in 'Delphi.Mocks.Tests.InterfaceProxy.pas', 35 | Delphi.Mocks.Tests.Interfaces in 'Delphi.Mocks.Tests.Interfaces.pas', 36 | Delphi.Mocks.Tests.MethodData in 'Delphi.Mocks.Tests.MethodData.pas', 37 | Delphi.Mocks.Tests.ObjectProxy in 'Delphi.Mocks.Tests.ObjectProxy.pas', 38 | Delphi.Mocks.Tests.Objects in 'Delphi.Mocks.Tests.Objects.pas', 39 | Delphi.Mocks.Tests.OpenArrayIntf in 'Delphi.Mocks.Tests.OpenArrayIntf.pas', 40 | Delphi.Mocks.Tests.Proxy in 'Delphi.Mocks.Tests.Proxy.pas', 41 | Delphi.Mocks.Tests.ProxyBase in 'Delphi.Mocks.Tests.ProxyBase.pas', 42 | Delphi.Mocks.Tests.TValue in 'Delphi.Mocks.Tests.TValue.pas', 43 | Delphi.Mocks.Tests.Utils in 'Delphi.Mocks.Tests.Utils.pas', 44 | Delphi.Mocks.Utils.Tests in 'Delphi.Mocks.Utils.Tests.pas', 45 | Delphi.Mocks.Examples.Matchers in 'Delphi.Mocks.Examples.Matchers.pas', 46 | Delphi.Mocks.Tests.Stubs in 'Delphi.Mocks.Tests.Stubs.pas'; 47 | 48 | {$R *.RES} 49 | 50 | 51 | //{$IFDEF XMLOUTPUT} 52 | //var 53 | // OutputFile : string = 'dunit-report.xml'; 54 | // 55 | //var 56 | // ConfigFile : string; 57 | //{$ENDIF} 58 | // 59 | //{$IFDEF ISCONSOLE} 60 | //var 61 | // ExitBehavior: TRunnerExitBehavior; 62 | //{$EndIf} 63 | // 64 | //begin 65 | // {$IFDEF ISCONSOLE} 66 | // {$IFDEF XMLOUTPUT} 67 | // if ConfigFile <> '' then 68 | // begin 69 | // RegisteredTests.LoadConfiguration(ConfigFile, False, True); 70 | // WriteLn('Loaded config file ' + ConfigFile); 71 | // end; 72 | // if ParamCount > 0 then 73 | // OutputFile := ParamStr(1); 74 | // WriteLn('Writing output to ' + OutputFile); 75 | // WriteLn('Running ' + IntToStr(RegisteredTests.CountEnabledTestCases) + ' of ' + IntToStr(RegisteredTests.CountTestCases) + ' test cases'); 76 | // TXMLTestListener.RunRegisteredTests(OutputFile); 77 | // {$ELSE} 78 | // WriteLn('To run with rxbPause, use -p switch'); 79 | // WriteLn('To run with rxbHaltOnFailures, use -h switch'); 80 | // WriteLn('No switch runs as rxbContinue'); 81 | // 82 | // if FindCmdLineSwitch('p', ['-', '/'], true) then 83 | // ExitBehavior := rxbPause 84 | // else if FindCmdLineSwitch('h', ['-', '/'], true) then 85 | // ExitBehavior := rxbHaltOnFailures 86 | // else 87 | // ExitBehavior := rxbContinue; 88 | // 89 | // TextTestRunner.RunRegisteredTests(ExitBehavior); 90 | // {$ENDIF} 91 | // {$ELSE} 92 | // ReportMemoryLeaksOnShutdown := True; 93 | // Application.Initialize; 94 | // TGUITestRunner.RunRegisteredTests; 95 | // {$ENDIF} 96 | 97 | var 98 | runner : ITestRunner; 99 | results : IRunResults; 100 | logger : ITestLogger; 101 | nunitLogger : ITestLogger; 102 | begin 103 | {$IFDEF TESTINSIGHT} 104 | TestInsight.DUnitX.RunRegisteredTests; 105 | exit; 106 | {$ENDIF} 107 | try 108 | //Check command line options, will exit if invalid 109 | TDUnitX.CheckCommandLine; 110 | //Create the test runner 111 | runner := TDUnitX.CreateRunner; 112 | //Tell the runner to use RTTI to find Fixtures 113 | runner.UseRTTI := True; 114 | //tell the runner how we will log things 115 | //Log to the console window 116 | logger := TDUnitXConsoleLogger.Create(true); 117 | runner.AddLogger(logger); 118 | //Generate an NUnit compatible XML File 119 | if (TDUnitX.Options.XMLOutputFile <> '') then 120 | begin 121 | nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile); 122 | runner.AddLogger(nunitLogger); 123 | end; 124 | runner.FailsOnNoAsserts := False; //When true, Assertions must be made during tests; 125 | 126 | //Run tests 127 | results := runner.Execute; 128 | if not results.AllPassed then 129 | System.ExitCode := EXIT_ERRORS; 130 | 131 | {$IFNDEF CI} 132 | //We don't want this happening when running under CI. 133 | if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then 134 | begin 135 | System.Write('Done.. press key to quit.'); 136 | System.Readln; 137 | end; 138 | {$ENDIF} 139 | except 140 | on E: Exception do 141 | System.Writeln(E.ClassName, ': ', E.Message); 142 | end; 143 | 144 | 145 | 146 | end. 147 | 148 | -------------------------------------------------------------------------------- /Tests/Delphi.Mocks.Tests.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VSoftTechnologies/Delphi-Mocks/a0f6de8d6a0ebb2d4c09f5097f16d125c8c21969/Tests/Delphi.Mocks.Tests.res -------------------------------------------------------------------------------- /Tests/Delphi.Mocks.Utils.Tests.pas: -------------------------------------------------------------------------------- 1 | unit Delphi.Mocks.Utils.Tests; 2 | 3 | interface 4 | uses 5 | DUnitX.TestFramework; 6 | type 7 | {$M+} 8 | [TestFixture] 9 | TUtilsTests = class 10 | published 11 | procedure CheckInterfaceHasRTTIWithoutRTTI; 12 | procedure CheckInterfaceHasRTTIWithNonInterface; 13 | procedure CheckInterfaceHasRTTIWithInterfaceRTTI; 14 | end; 15 | {$M-} 16 | 17 | {$M+} 18 | ITestable = interface 19 | procedure DoSomething; 20 | end; 21 | {$M-} 22 | 23 | 24 | implementation 25 | uses 26 | Delphi.Mocks.Utils; 27 | { TUtilsTests } 28 | 29 | procedure TUtilsTests.CheckInterfaceHasRTTIWithInterfaceRTTI; 30 | 31 | begin 32 | Assert.IsTrue(CheckInterfaceHasRTTI(TypeInfo(ITestable))); 33 | end; 34 | 35 | procedure TUtilsTests.CheckInterfaceHasRTTIWithNonInterface; 36 | begin 37 | Assert.IsTrue(CheckInterfaceHasRTTI(TypeInfo(TObject))); 38 | end; 39 | 40 | procedure TUtilsTests.CheckInterfaceHasRTTIWithoutRTTI; 41 | begin 42 | Assert.IsFalse(CheckInterfaceHasRTTI(TypeInfo(IInterface))); 43 | end; 44 | 45 | 46 | initialization 47 | TDUnitX.RegisterTestFixture(TUtilsTests); 48 | end. 49 | -------------------------------------------------------------------------------- /Tests/MemoryLeakTest/FastMM4.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VSoftTechnologies/Delphi-Mocks/a0f6de8d6a0ebb2d4c09f5097f16d125c8c21969/Tests/MemoryLeakTest/FastMM4.pas -------------------------------------------------------------------------------- /Tests/MemoryLeakTest/FastMM4Messages.pas: -------------------------------------------------------------------------------- 1 | { 2 | 3 | Fast Memory Manager: Messages 4 | 5 | English translation by Pierre le Riche. 6 | 7 | } 8 | 9 | unit FastMM4Messages; 10 | 11 | interface 12 | 13 | {$Include FastMM4Options.inc} 14 | 15 | const 16 | {The name of the debug info support DLL} 17 | FullDebugModeLibraryName32Bit = 'FastMM_FullDebugMode.dll'; 18 | FullDebugModeLibraryName64Bit = 'FastMM_FullDebugMode64.dll'; 19 | {Event log strings} 20 | LogFileExtension = '_MemoryManager_EventLog.txt'#0; 21 | CRLF = #13#10; 22 | EventSeparator = '--------------------------------'; 23 | {Class name messages} 24 | UnknownClassNameMsg = 'Unknown'; 25 | {Memory dump message} 26 | MemoryDumpMsg = #13#10#13#10'Current memory dump of 256 bytes starting at pointer address '; 27 | {Block Error Messages} 28 | BlockScanLogHeader = 'Allocated block logged by LogAllocatedBlocksToFile. The size is: '; 29 | ErrorMsgHeader = 'FastMM has detected an error during a '; 30 | GetMemMsg = 'GetMem'; 31 | FreeMemMsg = 'FreeMem'; 32 | ReallocMemMsg = 'ReallocMem'; 33 | BlockCheckMsg = 'free block scan'; 34 | OperationMsg = ' operation. '; 35 | BlockHeaderCorruptedMsg = 'The block header has been corrupted. '; 36 | BlockFooterCorruptedMsg = 'The block footer has been corrupted. '; 37 | FreeModifiedErrorMsg = 'FastMM detected that a block has been modified after being freed. '; 38 | FreeModifiedDetailMsg = #13#10#13#10'Modified byte offsets (and lengths): '; 39 | DoubleFreeErrorMsg = 'An attempt has been made to free/reallocate an unallocated block.'; 40 | WrongMMFreeErrorMsg = 'An attempt has been made to free/reallocate a block that was allocated through a different FastMM instance. Check your memory manager sharing settings.'; 41 | PreviousBlockSizeMsg = #13#10#13#10'The previous block size was: '; 42 | CurrentBlockSizeMsg = #13#10#13#10'The block size is: '; 43 | PreviousObjectClassMsg = #13#10#13#10'The block was previously used for an object of class: '; 44 | CurrentObjectClassMsg = #13#10#13#10'The block is currently used for an object of class: '; 45 | PreviousAllocationGroupMsg = #13#10#13#10'The allocation group was: '; 46 | PreviousAllocationNumberMsg = #13#10#13#10'The allocation number was: '; 47 | CurrentAllocationGroupMsg = #13#10#13#10'The allocation group is: '; 48 | CurrentAllocationNumberMsg = #13#10#13#10'The allocation number is: '; 49 | BlockErrorMsgTitle = 'Memory Error Detected'; 50 | VirtualMethodErrorHeader = 'FastMM has detected an attempt to call a virtual method on a freed object. An access violation will now be raised in order to abort the current operation.'; 51 | InterfaceErrorHeader = 'FastMM has detected an attempt to use an interface of a freed object. An access violation will now be raised in order to abort the current operation.'; 52 | BlockHeaderCorruptedNoHistoryMsg = ' Unfortunately the block header has been corrupted so no history is available.'; 53 | FreedObjectClassMsg = #13#10#13#10'Freed object class: '; 54 | VirtualMethodName = #13#10#13#10'Virtual method: '; 55 | VirtualMethodOffset = 'Offset +'; 56 | VirtualMethodAddress = #13#10#13#10'Virtual method address: '; 57 | {Stack trace messages} 58 | CurrentThreadIDMsg = #13#10#13#10'The current thread ID is 0x'; 59 | CurrentStackTraceMsg = ', and the stack trace (return addresses) leading to this error is:'; 60 | ThreadIDPrevAllocMsg = #13#10#13#10'This block was previously allocated by thread 0x'; 61 | ThreadIDAtAllocMsg = #13#10#13#10'This block was allocated by thread 0x'; 62 | ThreadIDAtFreeMsg = #13#10#13#10'The block was previously freed by thread 0x'; 63 | ThreadIDAtObjectAllocMsg = #13#10#13#10'The object was allocated by thread 0x'; 64 | ThreadIDAtObjectFreeMsg = #13#10#13#10'The object was subsequently freed by thread 0x'; 65 | StackTraceMsg = ', and the stack trace (return addresses) at the time was:'; 66 | {Installation Messages} 67 | AlreadyInstalledMsg = 'FastMM4 is already installed.'; 68 | AlreadyInstalledTitle = 'Already installed.'; 69 | OtherMMInstalledMsg = 'FastMM4 cannot be installed since another third party memory ' 70 | + 'manager has already installed itself.'#13#10'If you want to use FastMM4, ' 71 | + 'please make sure that FastMM4.pas is the very first unit in the "uses"' 72 | + #13#10'section of your project''s .dpr file.'; 73 | OtherMMInstalledTitle = 'Cannot install FastMM4 - Another memory manager is already installed'; 74 | MemoryAllocatedMsg = 'FastMM4 cannot install since memory has already been ' 75 | + 'allocated through the default memory manager.'#13#10'FastMM4.pas MUST ' 76 | + 'be the first unit in your project''s .dpr file, otherwise memory may ' 77 | + 'be allocated'#13#10'through the default memory manager before FastMM4 ' 78 | + 'gains control. '#13#10#13#10'If you are using an exception trapper ' 79 | + 'like MadExcept (or any tool that modifies the unit initialization ' 80 | + 'order),'#13#10'go into its configuration page and ensure that the ' 81 | + 'FastMM4.pas unit is initialized before any other unit.'; 82 | MemoryAllocatedTitle = 'Cannot install FastMM4 - Memory has already been allocated'; 83 | {Leak checking messages} 84 | LeakLogHeader = 'A memory block has been leaked. The size is: '; 85 | LeakMessageHeader = 'This application has leaked memory. '; 86 | SmallLeakDetail = 'The small block leaks are' 87 | {$ifdef HideExpectedLeaksRegisteredByPointer} 88 | + ' (excluding expected leaks registered by pointer)' 89 | {$endif} 90 | + ':'#13#10; 91 | LargeLeakDetail = 'The sizes of leaked medium and large blocks are' 92 | {$ifdef HideExpectedLeaksRegisteredByPointer} 93 | + ' (excluding expected leaks registered by pointer)' 94 | {$endif} 95 | + ': '; 96 | BytesMessage = ' bytes: '; 97 | AnsiStringBlockMessage = 'AnsiString'; 98 | UnicodeStringBlockMessage = 'UnicodeString'; 99 | LeakMessageFooter = #13#10 100 | {$ifndef HideMemoryLeakHintMessage} 101 | + #13#10'Note: ' 102 | {$ifdef RequireIDEPresenceForLeakReporting} 103 | + 'This memory leak check is only performed if Delphi is currently running on the same computer. ' 104 | {$endif} 105 | {$ifdef FullDebugMode} 106 | {$ifdef LogMemoryLeakDetailToFile} 107 | + 'Memory leak detail is logged to a text file in the same folder as this application. ' 108 | {$else} 109 | + 'Enable the "LogMemoryLeakDetailToFile" to obtain a log file containing detail on memory leaks. ' 110 | {$endif} 111 | {$else} 112 | + 'To obtain a log file containing detail on memory leaks, enable the "FullDebugMode" and "LogMemoryLeakDetailToFile" conditional defines. ' 113 | {$endif} 114 | + 'To disable this memory leak check, undefine "EnableMemoryLeakReporting".'#13#10 115 | {$endif} 116 | + #0; 117 | LeakMessageTitle = 'Memory Leak Detected'; 118 | {$ifdef UseOutputDebugString} 119 | FastMMInstallMsg = 'FastMM has been installed.'; 120 | FastMMInstallSharedMsg = 'Sharing an existing instance of FastMM.'; 121 | FastMMUninstallMsg = 'FastMM has been uninstalled.'; 122 | FastMMUninstallSharedMsg = 'Stopped sharing an existing instance of FastMM.'; 123 | {$endif} 124 | {$ifdef DetectMMOperationsAfterUninstall} 125 | InvalidOperationTitle = 'MM Operation after uninstall.'; 126 | InvalidGetMemMsg = 'FastMM has detected a GetMem call after FastMM was uninstalled.'; 127 | InvalidFreeMemMsg = 'FastMM has detected a FreeMem call after FastMM was uninstalled.'; 128 | InvalidReallocMemMsg = 'FastMM has detected a ReallocMem call after FastMM was uninstalled.'; 129 | InvalidAllocMemMsg = 'FastMM has detected an AllocMem call after FastMM was uninstalled.'; 130 | {$endif} 131 | 132 | implementation 133 | 134 | end. 135 | 136 | -------------------------------------------------------------------------------- /Tests/MemoryLeakTest/MemoryLeakTest.dpr: -------------------------------------------------------------------------------- 1 | program MemoryLeakTest; 2 | { 3 | 4 | Delphi DUnit Test Project 5 | ------------------------- 6 | This project contains the DUnit test framework and the GUI/Console test runners. 7 | Add "CONSOLE_TESTRUNNER" to the conditional defines entry in the project options 8 | to use the console test runner. Otherwise the GUI test runner will be used by 9 | default. 10 | 11 | } 12 | 13 | {$IFDEF CONSOLE_TESTRUNNER} 14 | {$APPTYPE CONSOLE} 15 | {$ENDIF} 16 | 17 | uses 18 | FastMM4, 19 | DUnitTestRunner, 20 | MockMemoryLeakTest in 'MockMemoryLeakTest.pas'; 21 | 22 | begin 23 | DUnitTestRunner.RunRegisteredTests; 24 | end. 25 | 26 | -------------------------------------------------------------------------------- /Tests/MemoryLeakTest/MockMemoryLeakTest.pas: -------------------------------------------------------------------------------- 1 | unit MockMemoryLeakTest; 2 | 3 | interface 4 | 5 | uses 6 | DUnitX.TestFramework, Delphi.Mocks; 7 | 8 | type 9 | {$M+} 10 | IMyInterface = interface 11 | procedure MyMethod; 12 | end; 13 | {$M-} 14 | 15 | TMockMemoryLeakTest = class(TTestCase) 16 | published 17 | procedure ItMakesMemoryLeaks; 18 | end; 19 | 20 | implementation 21 | 22 | { TMockMemoryLeakTest } 23 | 24 | procedure TMockMemoryLeakTest.ItMakesMemoryLeaks; 25 | var 26 | I: TMock; 27 | begin 28 | I := TMock.Create; 29 | //I.Instance; // Uncomment and get rid of leaks 30 | I.Free; // Not really needed 31 | end; 32 | 33 | initialization 34 | RegisterTest(TMockMemoryLeakTest.Suite); 35 | end. 36 | -------------------------------------------------------------------------------- /VSoft.DelphiMocks.dspec: -------------------------------------------------------------------------------- 1 | { 2 | "metadata": { 3 | "id": "VSoft.DelphiMocks", 4 | "version": "0.3.1", 5 | "description": "Simple mocking framework for Delphi XE2 or later.", 6 | "authors": "Vincent Parrett", 7 | "projectUrl": "https://github.com/VSoftTechnologies/Delphi-Mocks", 8 | "repositoryUrl": "https://github.com/VSoftTechnologies/Delphi-Mocks", 9 | "license": "Apache-2.0", 10 | "copyright": "Vincent Parrett and contributors", 11 | "tags": "mocking unittesting" 12 | }, 13 | "targetPlatforms": [ 14 | { 15 | "compiler": "XE2", 16 | "platforms": "Win32, Win64", 17 | "template": "default" 18 | }, 19 | { 20 | "compiler": "XE3", 21 | "platforms": "Win32, Win64", 22 | "template": "default" 23 | }, 24 | { 25 | "compiler": "XE4", 26 | "platforms": "Win32, Win64", 27 | "template": "default" 28 | }, 29 | { 30 | "compiler": "XE5", 31 | "platforms": "Win32, Win64", 32 | "template": "XE5+" 33 | }, 34 | { 35 | "compiler": "XE6", 36 | "platforms": "Win32, Win64", 37 | "template": "XE5+" 38 | }, 39 | { 40 | "compiler": "XE7", 41 | "platforms": "Win32, Win64", 42 | "template": "XE5+" 43 | }, 44 | { 45 | "compiler": "XE8", 46 | "platforms": "Win32, Win64", 47 | "template": "XE5+" 48 | }, 49 | { 50 | "compiler": "10.0", 51 | "platforms": "Win32, Win64", 52 | "template": "XE5+" 53 | }, 54 | { 55 | "compiler": "10.1", 56 | "platforms": "Win32, Win64", 57 | "template": "XE5+" 58 | }, 59 | { 60 | "compiler": "10.2", 61 | "platforms": "Win32, Win64", 62 | "template": "XE5+" 63 | }, 64 | { 65 | "compiler": "10.3", 66 | "platforms": "Win32, Win64", 67 | "template": "XE5+" 68 | }, 69 | { 70 | "compiler": "10.4", 71 | "platforms": "Win32, Win64", 72 | "template": "10.4+" 73 | }, 74 | { 75 | "compiler": "11.0", 76 | "platforms": "Win32, Win64", 77 | "template": "10.4+" 78 | }, 79 | { 80 | "compiler": "12.0", 81 | "platforms": "Win32, Win64", 82 | "template": "10.4+" 83 | } 84 | ], 85 | "templates": [ 86 | { 87 | "name": "default", 88 | "source": [ 89 | { 90 | "src": "Source\\*.pas", 91 | "dest": "src" 92 | }, 93 | { 94 | "src": "Source\\*.inc", 95 | "dest": "src" 96 | }, 97 | { 98 | "src": "Source\\DelphiMocks.dpk", 99 | "dest": "src" 100 | }, 101 | { 102 | "src": "Source\\DelphiMocks.dproj", 103 | "dest": "src" 104 | } 105 | 106 | ], 107 | "searchPaths": [ 108 | { 109 | "path": "src" 110 | } 111 | ], 112 | "build": [ 113 | { 114 | "id": "DelphiMocks", 115 | "project": ".\\src\\DelphiMocks.dproj" 116 | } 117 | ] 118 | }, 119 | { 120 | "name": "XE5+", 121 | "source": [ 122 | { 123 | "src": "Source\\*.pas", 124 | "dest": "src" 125 | }, 126 | { 127 | "src": "Source\\*.inc", 128 | "dest": "src" 129 | }, 130 | { 131 | "src": "Source\\DelphiMocksXE5.dpk", 132 | "dest": "src" 133 | }, 134 | { 135 | "src": "Source\\DelphiMocksXE5.dproj", 136 | "dest": "src" 137 | } 138 | 139 | ], 140 | "searchPaths": [ 141 | { 142 | "path": "src" 143 | } 144 | ], 145 | "build": [ 146 | { 147 | "id": "DelphiMocks", 148 | "project": ".\\src\\DelphiMocksXE5.dproj" 149 | } 150 | ] 151 | }, 152 | { 153 | "name": "10.4+", 154 | "source": [ 155 | { 156 | "src": "Source\\*.pas", 157 | "dest": "src" 158 | }, 159 | { 160 | "src": "Source\\*.inc", 161 | "dest": "src" 162 | }, 163 | { 164 | "src": "Source\\DelphiMocks104.dpk", 165 | "dest": "src" 166 | }, 167 | { 168 | "src": "Source\\DelphiMocks104.dproj", 169 | "dest": "src" 170 | } 171 | 172 | ], 173 | "searchPaths": [ 174 | { 175 | "path": "src" 176 | } 177 | ], 178 | "build": [ 179 | { 180 | "id": "DelphiMocks", 181 | "project": ".\\src\\DelphiMocks104.dproj" 182 | } 183 | ] 184 | } 185 | 186 | ] 187 | } 188 | --------------------------------------------------------------------------------