Skip to content
This repository has been archived by the owner on Nov 19, 2021. It is now read-only.

Commit

Permalink
Added build script for automated build.
Browse files Browse the repository at this point in the history
  • Loading branch information
staticcat committed Aug 15, 2013
1 parent 6c83c39 commit e838a8d
Show file tree
Hide file tree
Showing 9 changed files with 154 additions and 32 deletions.
6 changes: 6 additions & 0 deletions .gitignore
Expand Up @@ -23,3 +23,9 @@
/Win32
/Win64

Build/TestAndBuild.fb7lck
*.fbl7
*.fbpInf
*.rc
*.drc
*.map
Binary file added Build/TestAndBuild.fbp7
Binary file not shown.
61 changes: 47 additions & 14 deletions Delphi.Mocks.InterfaceProxy.pas
Expand Up @@ -30,15 +30,15 @@ interface
uses
Rtti,
SysUtils,
Generics.Collections,
Delphi.Mocks,
Delphi.Mocks.Interfaces,
// Delphi.Mocks.VirtualInterface,
Delphi.Mocks.ProxyBase;

type
TProxyBaseInvokeEvent = procedure (Method: TRttiMethod; const Args: TArray<TValue>; out Result: TValue) of object;

TSetupMode = (None,Behavior,Expectation);
TSetupMode = (None, Behavior, Expectation);

TInterfaceProxy<T> = class(TBaseProxy<T>)
private type
Expand All @@ -51,11 +51,12 @@ TProxyVirtualInterface = class(TVirtualInterface)
constructor Create(AProxy : TInterfaceProxy<T>; AInterface: Pointer; InvokeEvent: TVirtualInterfaceInvokeEvent);
end;
private
FVirtualInterface : IInterface;
FVirtualInterfaces : TDictionary<TGUID, TProxyVirtualInterface>;
protected
function InternalQueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
function QueryInterface(const IID: TGUID; out Obj): HRESULT; override;
function Proxy : T;override;
function CastAs<I: IInterface> : I;
public
constructor Create;override;
destructor Destroy;override;
Expand All @@ -69,53 +70,85 @@ implementation

{ TInterfaceProxy<T> }

function TInterfaceProxy<T>.CastAs<I>: I;
var
virtualProxy : TProxyVirtualInterface;
begin
virtualProxy := TProxyVirtualInterface.Create(Self, TypeInfo(I), Self.DoInvoke);

FVirtualInterfaces.Add(GetTypeData(TypeInfo(I)).Guid, virtualProxy);
end;

constructor TInterfaceProxy<T>.Create;
var
virtualProxy : TProxyVirtualInterface;
begin
inherited;
FVirtualInterface := TProxyVirtualInterface.Create(Self,TypeInfo(T),Self.DoInvoke);

FVirtualInterfaces := TDictionary<TGUID, TProxyVirtualInterface>.Create;

virtualProxy := TProxyVirtualInterface.Create(Self, TypeInfo(T), Self.DoInvoke);

FVirtualInterfaces.Add(GetTypeData(TypeInfo(T)).Guid, virtualProxy);
end;

destructor TInterfaceProxy<T>.Destroy;
begin
FVirtualInterface := nil;
FVirtualInterfaces.Clear;
FreeAndNil(FVirtualInterfaces);

inherited;
end;

function TInterfaceProxy<T>.InternalQueryInterface(const IID: TGUID; out Obj): HRESULT;
begin
Result := E_NOINTERFACE;
if (IsEqualGUID(IID,IInterface)) then
if (IsEqualGUID(IID, IInterface)) then
if GetInterface(IID, Obj) then
Result := 0;
end;

function TInterfaceProxy<T>.Proxy: T;
var
pInfo : PTypeInfo;
virtualProxy : IInterface;
begin
pInfo := TypeInfo(T);
if FVirtualInterface.QueryInterface(GetTypeData(pInfo).Guid,result) <> 0 then

if FVirtualInterfaces.ContainsKey(GetTypeData(pInfo).Guid) then
virtualProxy := FVirtualInterfaces.Items[GetTypeData(pInfo).Guid]
else
raise EMockNoProxyException.Create('Error proxy casting to interface');

if virtualProxy.QueryInterface(GetTypeData(pInfo).Guid,result) <> 0 then
raise EMockNoProxyException.Create('Error casting to interface ' + string(pInfo.Name) + ' , proxy does not appear to implememnt T');
end;

function TInterfaceProxy<T>.QueryInterface(const IID: TGUID; out Obj): HRESULT;
var
virtualProxy : IInterface;
begin
Result := E_NOINTERFACE;
if (FVirtualInterface <> nil) then
Result := FVirtualInterface.QueryInterface(IID, Obj);

if (FVirtualInterfaces <> nil) then
if (FVirtualInterfaces.Count <> 0) then
if (FVirtualInterfaces.ContainsKey(IID)) then
begin
virtualProxy := FVirtualInterfaces.Items[IID];
Result := virtualProxy.QueryInterface(IID, Obj);
end;

if result <> 0 then
Result := inherited;

end;

{ TInterfaceProxy<T>.TProxyVirtualInterface }

constructor TInterfaceProxy<T>.TProxyVirtualInterface.Create(
AProxy: TInterfaceProxy<T>; AInterface: Pointer;
InvokeEvent: TVirtualInterfaceInvokeEvent);
constructor TInterfaceProxy<T>.TProxyVirtualInterface.Create(AProxy: TInterfaceProxy<T>;
AInterface: Pointer; InvokeEvent: TVirtualInterfaceInvokeEvent);
begin
FProxy := AProxy;
inherited Create(Ainterface,InvokeEvent);
inherited Create(Ainterface, InvokeEvent);
end;


Expand Down
Binary file modified Sample1.RES
Binary file not shown.
91 changes: 91 additions & 0 deletions Tests/Delphi.Mocks.Tests.InterfaceProxy.pas
@@ -0,0 +1,91 @@
{***************************************************************************}
{ }
{ Delphi.Mocks }
{ }
{ Copyright (C) 2011 Vincent Parrett }
{ }
{ http://www.finalbuilder.com }
{ }
{ }
{***************************************************************************}
{ }
{ Licensed under the Apache License, Version 2.0 (the "License"); }
{ you may not use this file except in compliance with the License. }
{ You may obtain a copy of the License at }
{ }
{ http://www.apache.org/licenses/LICENSE-2.0 }
{ }
{ Unless required by applicable law or agreed to in writing, software }
{ distributed under the License is distributed on an "AS IS" BASIS, }
{ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. }
{ See the License for the specific language governing permissions and }
{ limitations under the License. }
{ }
{***************************************************************************}

unit Delphi.Mocks.Tests.InterfaceProxy;

interface

uses
TestFramework;

type
{$M+}
ISimpleInterface = Interface
['{F1731F12-2453-4818-A785-997AF7A3D51F}']
End;

ISecondSimpleInterface = Interface
['{C7191239-2E89-4D3A-9D1B-F894BACBBB39}']
End;
{$M-}

TTestInterfaceProxy = class(TTestCase)
published
procedure Does_A_Proxy_Implement_Two_Interfaces_After_A_Cast;
procedure After_Destruction_Are_All_The_Interfaces_Cleaned_Up;
end;

//TODO: IProxy<T> will not allow a function of CastAs<I> on it, class does however.

implementation

uses
SysUtils,
Delphi.Mocks,
Delphi.Mocks.InterfaceProxy;

{ TTestInterfaceProxy }

procedure TTestInterfaceProxy.After_Destruction_Are_All_The_Interfaces_Cleaned_Up;
var
simpleInterface: TInterfaceProxy<ISimpleInterface>;
secondInterface: ISecondSimpleInterface;
begin
simpleInterface := TInterfaceProxy<ISimpleInterface>.Create;
secondInterface := simpleInterface.CastAs<ISecondSimpleInterface>;

CheckNotNull(secondInterface, 'The second interface is not implemented!');
end;

procedure TTestInterfaceProxy.Does_A_Proxy_Implement_Two_Interfaces_After_A_Cast;
var
simpleInterface: TInterfaceProxy<ISimpleInterface>;
secondInterface : ISecondSimpleInterface;
begin
simpleInterface := TInterfaceProxy<ISimpleInterface>.Create;
try
simpleInterface.CastAs<ISecondSimpleInterface>;

simpleInterface.QueryInterface(ISecondSimpleInterface, secondInterface);

CheckNotNull(secondInterface, 'The second interface is not implemented!');
finally
FreeAndNil(simpleInterface);
end;
end;

initialization
TestFramework.RegisterTest(TTestInterfaceProxy.Suite);
end.
2 changes: 1 addition & 1 deletion Tests/Delphi.Mocks.Tests.OpenArrayIntf.pas
Expand Up @@ -44,7 +44,7 @@ procedure TestIOpenArray.TestMyMethodDynamicArray;

Intf := Mock;

// privileged instruction :-(
//TODO: Fix the privileged instruction. Something to do with TValue not liking Dynamic Arrays
CheckEquals(3, Intf.MyMethod([Obj], 1));
end;

Expand Down
3 changes: 2 additions & 1 deletion Tests/Delphi.Mocks.Tests.dpr
Expand Up @@ -46,7 +46,8 @@ uses
Delphi.Mocks.Tests.Base in 'Delphi.Mocks.Tests.Base.pas',
Delphi.Mocks.Tests.ObjectProxy in 'Delphi.Mocks.Tests.ObjectProxy.pas',
Delphi.Mocks.Examples.Objects in 'Delphi.Mocks.Examples.Objects.pas',
Delphi.Mocks.ReturnTypePatch in '..\Delphi.Mocks.ReturnTypePatch.pas';
Delphi.Mocks.ReturnTypePatch in '..\Delphi.Mocks.ReturnTypePatch.pas',
Delphi.Mocks.Tests.InterfaceProxy in 'Delphi.Mocks.Tests.InterfaceProxy.pas';

{$R *.RES}

Expand Down
23 changes: 7 additions & 16 deletions Tests/Delphi.Mocks.Tests.dproj
Expand Up @@ -112,6 +112,13 @@
<DCCReference Include="Delphi.Mocks.Tests.TValue.pas"/>
<DCCReference Include="Delphi.Mocks.Tests.Interfaces.pas"/>
<DCCReference Include="Delphi.Mocks.Tests.OpenArrayIntf.pas"/>
<DCCReference Include="Delphi.Mocks.Tests.MethodData.pas"/>
<DCCReference Include="Delphi.Mocks.Tests.ProxyBase.pas"/>
<DCCReference Include="Delphi.Mocks.Tests.Base.pas"/>
<DCCReference Include="Delphi.Mocks.Tests.ObjectProxy.pas"/>
<DCCReference Include="Delphi.Mocks.Examples.Objects.pas"/>
<DCCReference Include="..\Delphi.Mocks.ReturnTypePatch.pas"/>
<DCCReference Include="Delphi.Mocks.Tests.InterfaceProxy.pas"/>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
Expand Down Expand Up @@ -178,19 +185,3 @@
<Import Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')" Project="$(BDS)\Bin\CodeGear.Delphi.Targets"/>
<Import Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')" Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj"/>
</Project>

<!-- EurekaLog First Line
[Exception Log]
EurekaLog Version=7001
Activate=0
atVCL=1
DeleteMapAfterCompile=0
dpJCL=1
Encrypt Password=""
idEurekaLog=1
idEurekaLogDetailed=1
idMSClassic=1
idStepsToReproduce=1
ProjectID="{CC1138A4-84AF-46ED-8D02-81B0C9B1C1C5}"
sndShowFailureMsg=1
EurekaLog Last Line -->
Binary file modified Tests/Delphi.Mocks.Tests.res
Binary file not shown.

0 comments on commit e838a8d

Please sign in to comment.