I tried this in Delphi XE SP 1, see comment in code.
Never tried in newer revisions, have not installed them now, is somebody familiar with this bug? Didn't find anything in their QC either...
unit Testing;
interface
uses
Generics.Collections;
type
TBaseObjectList<T: class> = class(TObjectList<T>)
private
FUpdateLock: Integer;
public
constructor Create; virtual;
procedure LockUpdate;
procedure UnlockUpdate;
function UpdateUnlocked: Boolean;
property UpdateLock: Integer read FUpdateLock;
end;
TAdvObject = class(TObject)
end;
TAdvObjectList = class(TBaseObjectList<TAdvObject>)
private
FHelper: Integer;
public
constructor Create;
property Helper: Integer read Fhelper;
end;
implementation
{ TBaseObjectList<T> }
constructor TBaseObjectList<T>.Create;
begin
inherited Create;
FUpdateLock := 0;
end;
procedure TBaseObjectList<T>.LockUpdate;
begin
Inc(FUpdateLock);
end;
procedure TBaseObjectList<T>.UnlockUpdate;
begin
if FUpdateLock > 0 then
Dec(FUpdateLock);
end;
function TBaseObjectList<T>.UpdateUnlocked: Boolean;
begin
Result := FUpdateLock = 0;
end;
{ TAdvObjectList }
constructor TAdvObjectList.Create;
begin
LockUpdate;
try
// this increments FUpdateLock as well because FHelper and FUpdateLock are mapped to same memory location, it can be seen in debugger watches, it seems to me to be a bug
Inc(FHelper);
finally
UnlockUpdate;
end;
end;
begin
TAdvObjectList.Create;
end.
Thank you TK
Just copying answer from the comments above:
qc.embarcadero.com/wc/qcmain.aspx?d=101308
Bug resolved in Delphi XE4.
Related
I have a class TMyClass, on which I inject interface IFileManager. In this interface there is a method GetCompanyWorkbook(const ACompanyId: System.Integer; const AStream: TStream). This method fills AStream depend from ACompanyId. Everything works fine on real code, but when I run unit tests for class TMyClass and mocked IFileManager via framework Spring4D, FastMM reports for memory leak 13-20 bytes: TIndexWrapper x 1. I used last Spring4D version 1.26 from repository(branch main/master)
unit Unit1.pas
interface
DUnitX.TestFramework,
Spring.Mocking;
type
IFileManager = interface (IInvokable)
procedure GetCompanyWorkbook(const ACompanyId: System.Integer; const AStream: TStream);
end;
TMyClass = class
strict private
FFileManager: IFileManager;
public
constructor Create(const AFileManager: IFileManager);
procedure GenerateInvoice(const ACompanyId: System.Integer);
end;
[TestFixture]
TMyClassTests = class
strict private
FMockStream: TStream;
FMyClass: TMyClass;
FFileManager: Mock<IFileManager>;
procedure SetupFileManagerMock();
procedure InitMockStream(const AMockFile: string);
public
[Setup]
procedure Setup();
[TearDown]
procedure TearDown();
[TestCase('Test invoice generation', '2|invoice_2023.xls', '|')]
procedure TestGenerateInvoice(const ACompanyId: System.Integer; const AMockFile: string);
end;
implementation
uses
System.Classes,
Spring;
constructor TMyClass.Create(const AFileManager: IFileManager);
begin
Guard.CheckNotNull(AFileManager, 'AFileManager');
inherited Create();
Self.FFileManager := AFileManager;
end;
procedure TMyClass.GenerateInvoice(const ACompanyId: System.Integer);
begin
var sTmpFile := Self.GetTempInvoiceFile(ACompanyId);
var fs := TFileStream.Create(sTmpFile, fmCreate);
try
Self.FFileManager.GetComparyWorkbook(ACompanyId, fs);
// Do some operations with stream
finally
fs.Free();
end;
end;
procedure TMyClassTests.Setup();
begin
Self.FMockStream := nil;
Self.FMyClass := TMyClass.Create(Self.FFileManager);
end;
procedure TMyClassTests.TearDown();
begin
Self.FMyClass.Free();
Self.FMockStream.Free();
end;
procedure TMyClassTests.InitMockStream(const AMockFile: string);
begin
Self.FMockStream := TFileStream.Create(AMockFile, fmOpenRead);
end;
procedure TMyClassTests.SetupFileManagerMock();
begin
Self.FFileManager.Setup.Executes(
function(const callInfo: TCallInfo): TValue
begin
callInfo.Args[1].AsType<TStream>.CopyFrom(Self.FMockStream);
end)
.When(Args.Any)
.GetCompanyWorkbook(Arg.IsAny<System.Integer>, Arg.IsAny<TStream>);
end;
procedure TMyClassTests.TestGenerateInvoice(const ACompanyId: System.Integer; const AMockFile: string);
begin
Self.InitMockStream(AMockFile);
Self.SetupFileManagerMock();
Assert.WillNotRaiseAny(
procedure
begin
Self.FMyClass.GenerateInvoice(ACompanyId);
end
);
end;
The issue is that you are using this construct which is redundant:
.When(Args.Any)
.GetCompanyWorkbook(Arg.IsAny<System.Integer>, Arg.IsAny<TStream>);
Either pass Args.Any to When or use individual Arg matching on the parameters.
Passing Args.Any causes the mock internally to ignore the individual parameter matching. That causes the temporarily constructed object for the parameter matching to be leaked which is not trivial to be fixed.
Update: I was able to fix the memory leak in develop branch
I have a code (Singleton- Pattern) which works with Delphi RAD 10.1
type
TSharedData = class
private
FPOL: integer;
class var FUniqueInstance: TSharedData;
procedure SetFPol(const Value: integer);
constructor Create;
public
class function GetInstance: TSharedData;
property POL: integer read FPOL write SetFPol;
end;
var
Key: TObject;
implementation
{ TSharedData }
constructor TSharedData.Create;
begin
SetFPol(1);
end;
class function TSharedData.GetInstance: TSharedData;
begin
TMonitor.Enter(Key); // <-- error here
try
if FUniqueInstance = nil then
begin
FUniqueInstance := TSharedData.Create;
end;
finally
TMonitor.Exit(Key);
end;
Result := FUniqueInstance;
end;
procedure TSharedData.SetFPol(const Value: integer);
begin
FPOL := Value;
end;
initialization
Key:= TObject.Create;
finalization
Key.Free;
I need now the same code in Delphi 7. But the compiler said, "TMonitor isn't known".
Where can I find TMonitor or how can I replace it with an alternative function?
I thank you in advance for any information.
You can use TCriticalSection from SyncObjs unit.
The approach changes just a little bit. The critical section should be used as an object. So if you want to protect an area of you object on can do something like:
type
TSafeCounter = class(TObject)
private
FValue: Integer;
FCriticalSection: TCriticalSection;
public
constructor Create;
destructor Destroy; override;
procedure SafeInc;
procedure SafeDec;
function CurValue: Integer;
end;
implementation
{ TSafeCounter }
constructor TSafeCounter.Create;
begin
FCriticalSection := TCriticalSection.Create;
end;
function TSafeCounter.CurValue: Integer;
begin
FCriticalSection.Acquire;
try
Result := FValue;
finally
FCriticalSection.Release;
end;
end;
procedure TSafeCounter.SafeDec;
begin
FCriticalSection.Acquire;
try
Dec(FValue);
finally
FCriticalSection.Release;
end;
end;
destructor TSafeCounter.Destroy;
begin
FCriticalSection.Free;
inherited;
end;
procedure TSafeCounter.SafeInc;
begin
FCriticalSection.Acquire;
try
Inc(FValue);
finally
FCriticalSection.Release;
end;
end;
If you are facing very extreme scenario (performance), you can work another kinds of implementations of critical sections, but them will also increase the complexity of working with it like the read/write critical section.
When working with lists of items where the lists just serve as a temporary container - which list types would you recommend me to use?
I
don't want to destroy the list manually
would like to use a built-in list type (no frameworks, libraries, ...)
want generics
Something which would make this possible without causing leaks:
function GetListWithItems: ISomeList;
begin
Result := TSomeList.Create;
// add items to list
end;
var
Item: TSomeType;
begin
for Item in GetListWithItems do
begin
// do something
end;
end;
What options do I have? This is about Delphi 2009 but for the sake of knowledge please also mention if there is something new in this regard in 2010+.
An (somehow ugly) workaround for this is to create an 'autodestroy' interface along with the list. It must have the same scope so that when the interface is released, your list is destroyed too.
type
IAutoDestroyObject = interface
end;
TAutoDestroyObject = class(TInterfacedObject, IAutoDestroyObject)
strict private
FValue: TObject;
public
constructor Create(obj: TObject);
destructor Destroy; override;
end;
constructor TAutoDestroyObject.Create(obj: TObject);
begin
inherited Create;
FValue := obj;
end;
destructor TAutoDestroyObject.Destroy;
begin
FreeAndNil(FValue);
inherited;
end;
function CreateAutoDestroyObject(obj: TObject): IAutoDestroyObject;
begin
Result := TAutoDestroyObject.Create(obj);
end;
FList := TObjectList.Create;
FListAutoDestroy := CreateAutoDestroyObject(FList);
Your usage example gets more complicated, too.
type
TSomeListWrap = record
List: TSomeList;
AutoDestroy: IAutoDestroyObject;
end;
function GetListWithItems: TSomeListWrap;
begin
Result.List := TSomeList.Create;
Result.AutoDestroy := CreateAutoDestroyObject(Result.List);
// add items to list
end;
var
Item: TSomeItem;
begin
for Item in GetListWithItems.List do
begin
// do something
end;
end;
Inspired by Barry Kelly's blog post here you could implement smart pointers for your purpose like this :
unit Unit80;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Generics.Collections;
type
TMyList =class( TList<Integer>)
public
destructor Destroy; override;
end;
TLifetimeWatcher = class(TInterfacedObject)
private
FWhenDone: TProc;
public
constructor Create(const AWhenDone: TProc);
destructor Destroy; override;
end;
TSmartPointer<T: class> = record
strict private
FValue: T;
FLifetime: IInterface;
public
constructor Create(const AValue: T); overload;
class operator Implicit(const AValue: T): TSmartPointer<T>;
property Value: T read FValue;
end;
TForm80 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
function getList : TSmartPointer<TMyList>;
{ Public declarations }
end;
var
Form80: TForm80;
implementation
{$R *.dfm}
{ TLifetimeWatcher }
constructor TLifetimeWatcher.Create(const AWhenDone: TProc);
begin
FWhenDone := AWhenDone;
end;
destructor TLifetimeWatcher.Destroy;
begin
if Assigned(FWhenDone) then
FWhenDone;
inherited;
end;
{ TSmartPointer<T> }
constructor TSmartPointer<T>.Create(const AValue: T);
begin
FValue := AValue;
FLifetime := TLifetimeWatcher.Create(procedure
begin
AValue.Free;
end);
end;
class operator TSmartPointer<T>.Implicit(const AValue: T): TSmartPointer<T>;
begin
Result := TSmartPointer<T>.Create(AValue);
end;
procedure TForm80.Button1Click(Sender: TObject);
var i: Integer;
begin
for I in getList.Value do
Memo1.Lines.Add(IntToStr(i));
end;
{ TMyList }
destructor TMyList.Destroy;
begin
ShowMessage('Kaputt');
inherited;
end;
function TForm80.getList: TSmartPointer<TMyList>;
var
x: TSmartPointer<TMyList>;
begin
x := TMyList.Create;
Result := x;
with Result.Value do
begin
Add(1);
Add(2);
Add(3);
end;
end;
end.
Look at getList and Button1click to see its usage.
To fully support what you're after the language would need to support 2 things:
Garbage collector. That's the only thing that gives you the freedom to USE something without bothering with freeing it. I'd welcome a change in Delphi that gave us even partial support for this.
The possibility to define local, initialized variables. Again, I'd really love to see something along those lines.
Meanwhile, the closest you can get is to use Interfaces in place of garbage collection (because interfaces are reference-counted, once they go out of scope they'll be released). As for initialized local variables, you could use a trick similar to what I'm describing here: Declaring block level variables for branches in delphi
And for the sake of fun, here's a Console application that demonstrates the use of "fake" local variables and Interfaces to obtain temporary lists that are readily initialized will be automatically freed:
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils, Generics.Collections;
type
ITemporaryLocalVar<T:constructor> = interface
function GetL:T;
property L:T read GetL;
end;
TTemporaryLocalVar<T:constructor> = class(TInterfacedObject, ITemporaryLocalVar<T>)
public
FL: T;
constructor Create;
destructor Destroy;override;
function GetL:T;
end;
TTempUse = class
public
class function L<T:constructor>: ITemporaryLocalVar<T>;
end;
{ TTemporaryLocalVar<T> }
constructor TTemporaryLocalVar<T>.Create;
begin
FL := T.Create;
end;
destructor TTemporaryLocalVar<T>.Destroy;
begin
TObject(FL).Free;
inherited;
end;
function TTemporaryLocalVar<T>.GetL: T;
begin
Result := FL;
end;
{ TTempUse }
class function TTempUse.L<T>: ITemporaryLocalVar<T>;
begin
Result := TTemporaryLocalVar<T>.Create;
end;
var i:Integer;
begin
try
with TTempUse.L<TList<Integer>> do
begin
L.Add(1);
L.Add(2);
L.Add(3);
for i in L do
WriteLn(i);
end;
ReadLn;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
The standard list classes, like TList, TObjectList, TInterfaceList, etc, do not implement automated lifecycles, so you have to free them manually when you are done using them. If you want a list class that is accessible via an interface, you have to implement that yourself, eg:
type
IListIntf = interface
...
end;
TListImpl = class(TInterfacedObject, IListIntf)
private
FList: TList;
...
public
constructor Create; override;
destructor Destroy; override;
...
end;
constructor TListImpl.Create;
begin
inherited;
FList := TList.Create;
end;
destructor TListImpl.Destroy;
begin
FList.Free;
inherited;
end;
function GetListWithItems: IListIntf;
begin
Result := TListImpl.Create;
// add items to list
end;
Another option is to implement a generic IEnumerable adapter (as one of the ways to satisfy the for .. in compiler requirement) and rely on reference counting of the interface. I don't know if the following works in Delphi 2009, it seems to work in Delphi XE:
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils, Classes,
Generics.Collections;
type
// IEnumerator adapter for TEnumerator
TInterfacedEnumerator<T> = class(TInterfacedObject, IEnumerator<T>)
private
FEnumerator: TEnumerator<T>;
public
constructor Create(AEnumerator: TEnumerator<T>);
destructor Destroy; override;
function IEnumerator<T>.GetCurrent = GetCurrent2;
{ IEnumerator }
function GetCurrent: TObject;
function MoveNext: Boolean;
procedure Reset;
{ IEnumerator<T> }
function GetCurrent2: T;
end;
// procedure used to fill the list
TListInitProc<T> = reference to procedure(List: TList<T>);
// IEnumerable adapter for TEnumerable
TInterfacedEnumerable<T> = class(TInterfacedObject, IEnumerable<T>)
private
FEnumerable: TEnumerable<T>;
public
constructor Create(AEnumerable: TEnumerable<T>);
destructor Destroy; override;
class function Construct(InitProc: TListInitProc<T>): IEnumerable<T>;
function IEnumerable<T>.GetEnumerator = GetEnumerator2;
{ IEnumerable }
function GetEnumerator: IEnumerator; overload;
{ IEnumerable<T> }
function GetEnumerator2: IEnumerator<T>; overload;
end;
{ TInterfacedEnumerator<T> }
constructor TInterfacedEnumerator<T>.Create(AEnumerator: TEnumerator<T>);
begin
inherited Create;
FEnumerator := AEnumerator;
end;
destructor TInterfacedEnumerator<T>.Destroy;
begin
FEnumerator.Free;
inherited Destroy;
end;
function TInterfacedEnumerator<T>.GetCurrent: TObject;
begin
Result := TObject(GetCurrent2);
end;
function TInterfacedEnumerator<T>.GetCurrent2: T;
begin
Result := FEnumerator.Current;
end;
function TInterfacedEnumerator<T>.MoveNext: Boolean;
begin
Result := FEnumerator.MoveNext;
end;
procedure TInterfacedEnumerator<T>.Reset;
begin
// ?
end;
{ TInterfacedEnumerable<T> }
class function TInterfacedEnumerable<T>.Construct(InitProc: TListInitProc<T>): IEnumerable<T>;
var
List: TList<T>;
begin
List := TList<T>.Create;
try
if Assigned(InitProc) then
InitProc(List);
Result := Create(List);
except
List.Free;
raise;
end;
end;
constructor TInterfacedEnumerable<T>.Create(AEnumerable: TEnumerable<T>);
begin
inherited Create;
FEnumerable := AEnumerable;
end;
destructor TInterfacedEnumerable<T>.Destroy;
begin
FEnumerable.Free;
inherited Destroy;
end;
function TInterfacedEnumerable<T>.GetEnumerator: IEnumerator;
begin
Result := GetEnumerator2;
end;
function TInterfacedEnumerable<T>.GetEnumerator2: IEnumerator<T>;
begin
Result := TInterfacedEnumerator<T>.Create(FEnumerable.GetEnumerator);
end;
type
TSomeType = record
X, Y: Integer;
end;
function GetList(InitProc: TListInitProc<TSomeType>): IEnumerable<TSomeType>;
begin
Result := TInterfacedEnumerable<TSomeType>.Construct(InitProc);
end;
procedure MyInitList(List: TList<TSomeType>);
var
NewItem: TSomeType;
I: Integer;
begin
for I := 0 to 9 do
begin
NewItem.X := I;
NewItem.Y := 9 - I;
List.Add(NewItem);
end;
end;
procedure Main;
var
Item: TSomeType;
begin
for Item in GetList(MyInitList) do // you could also use an anonymous procedure here
Writeln(Format('X = %d, Y = %d', [Item.X, Item.Y]));
Readln;
end;
begin
try
ReportMemoryLeaksOnShutdown := True;
Main;
except
on E: Exception do
begin
ExitCode := 1;
Writeln(Format('[%s] %s', [E.ClassName, E.Message]));
end;
end;
end.
No, not 'out of the box' in Delphi.
I know that you don't need a library but you may be interessed by the principle of TDynArray.
In Jedi Code Library, exist the Guard function that already implements what
Gabr's code does.
TMyBaseClass=class
constructor(test:integer);
end;
TMyClass=class(TMyBaseClass);
TClass1<T: TMyBaseClass,constructor>=class()
public
FItem: T;
procedure Test;
end;
procedure TClass1<T>.Test;
begin
FItem:= T.Create;
end;
var u: TClass1<TMyClass>;
begin
u:=TClass1<TMyClass>.Create();
u.Test;
end;
How do I make it to create the class with the integer param. What is the workaround?
Just typecast to the correct class:
type
TMyBaseClassClass = class of TMyBaseClass;
procedure TClass1<T>.Test;
begin
FItem:= T(TMyBaseClassClass(T).Create(42));
end;
Also it's probably a good idea to make the constructor virtual.
You might consider giving the base class an explicit method for initialization instead of using the constructor:
TMyBaseClass = class
public
procedure Initialize(test : Integer); virtual;
end;
TMyClass = class(TMyBaseClass)
public
procedure Initialize(test : Integer); override;
end;
procedure TClass1<T>.Test;
begin
FItem:= T.Create;
T.Initialize(42);
end;
Of course this only works, if the base class and all subclasses are under your control.
Update
The solution offered by #TOndrej is far superior to what I wrote below, apart from one situation. If you need to take runtime decisions as to what class to create, then the approach below appears to be the optimal solution.
I've refreshed my memory of my own code base which also deals with this exact problem. My conclusion is that what you are attempting to achieve is impossible. I'd be delighted to be proved wrong if anyone wants to rise to the challenge.
My workaround is for the generic class to contain a field FClass which is of type class of TMyBaseClass. Then I can call my virtual constructor with FClass.Create(...). I test that FClass.InheritsFrom(T) in an assertion. It's all depressingly non-generic. As I said, if anyone can prove my belief wrong I will upvote, delete, and rejoice!
In your setting the workaround might look like this:
TMyBaseClass = class
public
constructor Create(test:integer); virtual;
end;
TMyBaseClassClass = class of TMyBaseClass;
TMyClass = class(TMyBaseClass)
public
constructor Create(test:integer); override;
end;
TClass1<T: TMyBaseClass> = class
private
FMemberClass: TMyBaseClassClass;
FItem: T;
public
constructor Create(MemberClass: TMyBaseClassClass); overload;
constructor Create; overload;
procedure Test;
end;
constructor TClass1<T>.Create(MemberClass: TMyBaseClassClass);
begin
inherited Create;
FMemberClass := MemberClass;
Assert(FMemberClass.InheritsFrom(T));
end;
constructor TClass1<T>.Create;
begin
Create(TMyBaseClassClass(T));
end;
procedure TClass1<T>.Test;
begin
FItem:= T(FMemberClass.Create(666));
end;
var
u: TClass1<TMyClass>;
begin
u:=TClass1<TMyClass>.Create(TMyClass);
u.Test;
end;
Another more elegant solution, if it is possible, is to use a parameterless constructor and pass in the extra information in a virtual method of T, perhaps called Initialize.
What seems to work in Delphi XE, is to call T.Create first, and then call the class-specific Create as a method afterwards. This is similar to Rudy Velthuis' (deleted) answer, although I don't introduce an overloaded constructor. This method also seems to work correctly if T is of TControl or classes like that, so you could construct visual controls in this fashion.
I can't test on Delphi 2010.
type
TMyBaseClass = class
FTest: Integer;
constructor Create(test: integer);
end;
TMyClass = class(TMyBaseClass);
TClass1<T: TMyBaseClass, constructor> = class
public
FItem: T;
procedure Test;
end;
constructor TMyBaseClass.Create(test: integer);
begin
FTest := Test;
end;
procedure TClass1<T>.Test;
begin
FItem := T.Create; // Allocation + 'dummy' constructor in TObject
try
TMyBaseClass(FItem).Create(42); // Call actual constructor as a method
except
// Normally this is done automatically when constructor fails
FItem.Free;
raise;
end;
end;
// Calling:
var
o: TClass1<TMyClass>;
begin
o := TClass1<TMyClass>.Create();
o.Test;
ShowMessageFmt('%d', [o.FItem.FTest]);
end;
type
TBase = class
constructor Create (aParam: Integer); virtual;
end;
TBaseClass = class of TBase;
TFabric = class
class function CreateAsBase (ConcreteClass: TBaseClass; aParam: Integer): TBase;
class function CreateMyClass<T: TBase>(aParam: Integer): T;
end;
TSpecial = class(TBase)
end;
TSuperSpecial = class(TSpecial)
constructor Create(aParam: Integer); override;
end;
class function TFabric.CreateAsBase(ConcreteClass: TBaseClass; aParam: Integer): TBase;
begin
Result := ConcreteClass.Create (aParam);
end;
class function TFabric.CreateMyClass<T>(aParam: Integer): T;
begin
Result := CreateAsBase (T, aParam) as T;
end;
// using
var
B: TBase;
S: TSpecial;
SS: TSuperSpecial;
begin
B := TFabric.CreateMyClass <TBase> (1);
S := TFabric.CreateMyClass <TSpecial> (1);
SS := TFabric.CreateMyClass <TSuperSpecial> (1);
I guess this should be an easy one cause I must be doing something wrong.
this is my code, I'm trying to do a Strategy pattern in Delphi:
unit Pattern;
interface
type
TContext = class;
IStrategy = interface
function Move(c: TContext): integer;
end;
TStrategy1 = class(TInterfacedObject, IStrategy)
public
function Move(c: TContext): integer;
end;
TStrategy2 = class(TInterfacedObject, IStrategy)
public
function Move(c: TContext): integer;
end;
TContext = class
const
START = 5;
private
FStrategy: IStrategy;
public
FCounter: integer;
constructor Create;
function Algorithm(): integer;
procedure SwitchStrategy();
end;
implementation
{ TStrategy1 }
function TStrategy1.Move(c: TContext): integer;
begin
c.FCounter := c.FCounter + 1;
Result := c.FCounter;
end;
{ TStrategy2 }
function TStrategy2.Move(c: TContext): integer;
begin
c.FCounter := c.FCounter - 1;
Result := c.FCounter;
end;
{ TContext }
function TContext.Algorithm: integer;
begin
Result := FStrategy.Move(Self)
end;
constructor TContext.Create;
begin
FCounter := 5;
FStrategy := TStrategy1.Create();
end;
procedure TContext.SwitchStrategy;
begin
if FStrategy is TStrategy1 then
FStrategy := TStrategy2.Create()
else
FStrategy := TStrategy1.Create();
end;
end.
And the if FStrategy is TStrategy1 then is giving me: Operator not applicable to this operand type.
What am I doing wrong here cause this should work as I understand from a lot of Delphi language references?
You have omitted the GUID from your interface. is can't work without it.
Edit: On second glance, it still won't work. You can't use is to test an interface reference for its implementing object typein Delphi (well, not directly, anyway). You should change your design. For example, you could either alter the interface or add another interface to return a description of the implementation.
You could make this work by adding the IID/GUID as Craig states, and then changing SwitchStrategy to:
procedure TContext.SwitchStrategy;
begin
if (FStrategy as TObject) is TStrategy1 then
FStrategy := TStrategy2.Create()
else
FStrategy := TStrategy1.Create();
end;
This only works with more modern versions of Delphi. I think Delphi 2010 was where the ability to cast an interface to its implementing object was added.
However, I'd be inclined to avoid this solution and go for something like this:
type
IStrategy = interface
function Move(c: TContext): integer;
function Switch: IStrategy;
end;
TStrategy1 = class(TInterfacedObject, IStrategy)
public
function Move(c: TContext): integer;
function Switch: IStrategy;
end;
TStrategy2 = class(TInterfacedObject, IStrategy)
public
function Move(c: TContext): integer;
function Switch: IStrategy;
end;
function TStrategy1.Switch: IStrategy;
begin
Result := TStrategy2.Create;
end;
function TStrategy2.Switch: IStrategy;
begin
Result := TStrategy1.Create;
end;
procedure TContext.SwitchStrategy;
begin
FStrategy := FStrategy.Switch;
end;
When you find yourself asking an object what type it is, that's usually indicative of a design weakness.