I get an internal compile error with Delphi XE3 Update 2 when I execute the following code:
unit Unit1;
interface
type
IHasValueR<T> = interface
function GetValue: T;
end;
IHasValueRw<T> = interface(IHasValueR<T>)
procedure SetValue(NewValue: T);
end;
TDummy = class(TInterfacedObject)
end;
TRefObj = class(TInterfacedObject, IHasValueR<Boolean>, IHasValueRw<Boolean>)
strict private
Value: Boolean;
public
constructor Create(Init_: Boolean);
function GetValue: Boolean;
procedure SetValue(NewValue: Boolean);
end;
TValueProviderFct<T, V> = reference to function(Input: T): V;
TBar<T; V: IHasValueRw<Boolean>> = class
strict private
FValueProviderFct: TValueProviderFct<T, V>;
public
constructor Create(ValueProviderFct_: TValueProviderFct<T, V>);
function GetValue(Input: T): Boolean;
end;
procedure TestIt();
implementation
procedure TestIt();
var
Foo: TRefObj;
Bar: TBar<TRefObj, IHasValueRw<Boolean>>;
begin
Foo := TRefObj.Create(true);
Bar := TBar<TRefObj, IHasValueRw<Boolean>>.Create(
function (Input: TRefObj): IHasValueRw<Boolean>
begin
Result := Input;
end
);
Bar.GetValue(Foo);
end;
{ TSetupDefinitionItemBoolean }
constructor TRefObj.Create(Init_: Boolean);
begin
Value := Init_;
end;
function TRefObj.GetValue: Boolean;
begin
Result := Value;
end;
procedure TRefObj.SetValue(NewValue: Boolean);
begin
Value := NewValue;
end;
{ TBar<T, V> }
constructor TBar<T, V>.Create(ValueProviderFct_: TValueProviderFct<T, V>);
begin
FValueProviderFct := ValueProviderFct_;
end;
function TBar<T, V>.GetValue;
begin
Result := FValueProviderFct(Input).GetValue;
end;
end.
error-message:
[dcc32 Fatal Error] Unit1.pas(83): F2084 Internal Error: C13823
The solution is simply to add GUIDs to the interfaces.
Can anyone verify this?
Is it maybe already fixed in a newer Delphi version?
Where can we file a bugreport?
Can anyone verify this? Is it maybe already fixed in a newer Delphi version?
For the record:
This is fixed in Delphi XE4.
It also compiles just fine in XE2, so it seems to be specific to your version.
Where can we file a bugreport?
http://qc.embarcadero.com/wc/qcmain.aspx
Misses GUID, in the interface, key CTRL + SHIFT + G, as below :
IHasValueR<T> = interface
['{45609E3B-D9A6-40FB-B9E8-86E3FE0D20EF}']
function GetValue: T;
end;
Related
I am using Delphi Pro 10.2.3 Tokyo. I want to create a TDataset wrapper class which I can use to enumerate through a list of IData descendants with a for-in loop. When I try to compile the code below, I get the following error message.
[dcc32 Error] Core.Data.DatasetAdapter.pas(25): E2291 Missing implementation of interface method IEnumerator.GetCurrent
Clearly, GetCurrent is implemented. Any idea how to fix this?
unit Core.Data.DatasetAdapter;
interface
uses
Data.Db
;
type
IData = interface
['{15D1CF4F-B9E1-4525-B035-24B9A6584325}']
end;
IDataList<T: IData> = interface
['{9FEE9BB1-A983-4FEA-AEBF-4D3AF5219444}']
function GetCount: Integer;
function GetCurrent: T;
procedure Load;
procedure Unload;
property Count: Integer read GetCount;
property Current: T read GetCurrent;
end;
TDatasetAdapter<T: IData> = class(
TInterfacedObject
, IData, IDataList<T>
, IEnumerator<T>
)
private
FBof: Boolean;
FDataset: TDataset;
FIntf: T;
function GetCount: Integer;
function GetCurrent: T;
function GetEof: Boolean;
function GetInterface: T;
function MoveNext: Boolean;
procedure Reset;
protected
function FieldByName(const FieldName: string): TField;
procedure MapFields; virtual;
property Dataset: TDataset read FDataset;
public
constructor Create(ADataset: TDataset); virtual;
function GetEnumerator: IEnumerator<T>;
procedure Cancel;
procedure Close;
procedure Delete;
procedure Edit;
procedure First;
procedure Insert;
procedure Load;
procedure Next;
procedure Open;
procedure Post;
procedure UnLoad;
property Count: Integer read GetCount;
property Eof: Boolean read GetEof;
end;
implementation
uses
System.SysUtils
, System.TypInfo
;
{ TDatasetAdapter<T> }
{
****************************** TDatasetAdapter<T> ******************************
}
constructor TDatasetAdapter<T>.Create(ADataset: TDataset);
begin
FDataset := ADataset;
FIntf := GetInterface;
end;
procedure TDatasetAdapter<T>.Cancel;
begin
FDataset.Cancel;
end;
procedure TDatasetAdapter<T>.Close;
begin
FDataset.Close;
end;
procedure TDatasetAdapter<T>.Delete;
begin
FDataset.Delete;
end;
procedure TDatasetAdapter<T>.Edit;
begin
FDataset.Edit;
end;
function TDatasetAdapter<T>.FieldByName(const FieldName: string): TField;
begin
Result := FDataset.FieldByName(FieldName);
end;
procedure TDatasetAdapter<T>.First;
begin
FDataset.First;
end;
function TDatasetAdapter<T>.GetCount: Integer;
begin
Result := FDataset.RecordCount;
end;
function TDatasetAdapter<T>.GetCurrent: T;
begin
Result := FIntf;
end;
function TDatasetAdapter<T>.GetEnumerator: IEnumerator<T>;
begin
Reset;
Result := Self;
end;
function TDatasetAdapter<T>.GetEof: Boolean;
begin
Result := FDataset.Eof;
end;
function TDatasetAdapter<T>.GetInterface: T;
var
LGuid: TGuid;
begin
LGuid := GetTypeData(TypeInfo(T))^.Guid;
if not Supports(Self, LGuid, Result) then
Result := nil;
end;
procedure TDatasetAdapter<T>.Insert;
begin
FDataset.Insert;
end;
procedure TDatasetAdapter<T>.Load;
begin
Open;
MapFields;
end;
procedure TDatasetAdapter<T>.MapFields;
begin
//Stub procedure
end;
function TDatasetAdapter<T>.MoveNext: Boolean;
begin
if FBof then FBof := False
else Next;
Result := not Eof;
end;
procedure TDatasetAdapter<T>.Next;
begin
FDataset.Next;
end;
procedure TDatasetAdapter<T>.Open;
begin
FDataset.Open;
end;
procedure TDatasetAdapter<T>.Post;
begin
FDataset.Post;
end;
procedure TDatasetAdapter<T>.Reset;
begin
FBof := True;
First;
end;
procedure TDatasetAdapter<T>.UnLoad;
begin
Close;
end;
end.
You need to resolve function GetCurrent: T twice: for IDataList<T> and for Enumerator<T>. But you also need one for the non-generic ancestor of IEnumerator<T>: IEnumerator. Apparently that is not hidden by the GetCurrent method of IEnumerator<T>.
Try method resolution clauses:
function GetGenericCurrent: T; // implement this
function IDataList<T>.GetCurrent = GetGenericCurrent;
function IEnumerator<T>.GetCurrent = GetGenericCurrent;
function GetCurrent: TObject; // implement this -- can return nil.
The implementation of both can be the same, but you will have to make two methods. The one for the non-generic IEnumerator can return nil.
Update
I had to modify the code above. Now it should work. It is not necessary to have two implementations for GetCurrent returning T, but you must have one returning TObject.
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.
I have a Delphi generic class that exposes a function with an argument of the generic type. Inside this function, I need to pass an instance of the generic type on to another object expecting a Variant type. Similar to this:
type
IMyInterface = interface
DoStuff(Value: Variant);
end;
TMyClass<T> = class
FMyIntf: IMyInterface
procedure DoStuff(SomeValue: T);
end;
[...]
procedure MyClass<T>.DoStuff(SomeValue: T);
begin
FMyIntf.DoStuff((*convert SomeValue to Variant here*));
end;
I tried using Rtti.TValue.From(SomeValue).AsVariant. This worked for integral types, but blew up for Booleans. I don't quite see why, since normally I'd be able to assign a Boolean value to a Variant...
Is there a better way to make this conversion? I only need it to work for simple built-in types (excluding enumerations and records)
I think there is no direct way to convert generic type to variant because variant cannot hold all the possible types. You must write your specific conversion routine. E.g.:
interface
//...
type
TDemo = class
public
class function GetAsVariant<T>(const AValue: T): Variant;
end;
//...
implementation
uses
Rtti,
TypInfo;
//...
{ TDemo}
class function TDemo.GetAsVariant<T>(const AValue: T): Variant;
var
val: TValue;
bRes: Boolean;
begin
val := TValue.From<T>(AValue);
case val.Kind of
tkInteger: Result := val.AsInteger;
tkInt64: Result := val.AsInt64;
tkEnumeration:
begin
if val.TryAsType<Boolean>(bRes) then
Result := bRes
else
Result := val.AsOrdinal;
end;
tkFloat: Result := val.AsExtended;
tkString, tkChar, tkWChar, tkLString, tkWString, tkUString:
Result := val.AsString;
tkVariant: Result := val.AsVariant
else
begin
raise Exception.Create('Unsupported type');
end;
end;
end;
Because TValue.AsVariant handles most of the type conversions internally, this function can be simplified. I will handle enumerations in case you could need them later:
class function TDemo.GetAsVariant<T>(const AValue: T): Variant;
var
val: TValue;
begin
val := TValue.From<T>(AValue);
case val.Kind of
tkEnumeration:
begin
if val.TypeInfo = TypeInfo(Boolean) then
Result := val.AsBoolean
else
Result := val.AsOrdinal;
end
else
begin
Result := val.AsVariant;
end;
end;
Possible usage:
var
vValue: Variant;
begin
vValue := TDemo.GetAsVariant<Boolean>(True);
Assert(vValue = True); //now vValue is a correct Boolean
Looks like in my Delphi version 10.2 the Boolean problem is gone and TValue.From<T>(FValue).AsVariant is enough.
Here an example with some other helpful things like comparing the generic type:
TMyValue<T> = class(TPersistent)
private
FValue: T;
procedure SetValue(const AValue: T);
function GetAsVariant: Variant; override;
public
procedure Assign(Source: TPersistent); override;
property Value: T read FValue write SetValue;
property AsVariant: Variant read GetAsVariant;
end;
function TMyValue<T>.GetAsVariant: Variant;
begin
Result:= TValue.From<T>(FValue).AsVariant;
end;
procedure TMyValue<T>.SetValue(const AValue: T);
begin
if TEqualityComparer<T>.Default.Equals(AValue, FValue) then Exit;
FValue:= AValue;
//do something
end;
procedure TMyValue<T>.Assign(Source: TPersistent);
begin
if Source is TMyValue<T> then Value:= (Source as TMyValue<T>).Value
else inherited;
end;
Another way (tested XE10)
Var
old : variant;
val : TValue;
Begin
val := TValue.FromVariant(old);
End;
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.
I'm checking out the Delphi 2009 Trial, but run into problems with the generics stuff right away.
The following code does not compile, and I haven't the slightest idea why it's giving me E2015 for the Equals() method:
type
TPrimaryKey<T> = class(TObject)
strict private
fValue: T;
public
constructor Create(AValue: T);
function Equals(Obj: TObject): boolean; override;
function GetValue: T;
end;
constructor TPrimaryKey<T>.Create(AValue: T);
begin
inherited Create;
fValue := AValue;
end;
function TPrimaryKey<T>.Equals(Obj: TObject): boolean;
begin
Result := (Obj <> nil) and (Obj is TPrimaryKey<T>)
and (TPrimaryKey<T>(Obj).GetValue = fValue);
end;
function TPrimaryKey<T>.GetValue: T;
begin
Result := fValue;
end;
Why does the compiler think that fValue and the result of GetValue() can not be compared?
What if T is a string? What if it's a TSize record?
Without constraining T (e.g. with <T :class>), you can't be sure that the comparison will be meaningful.
If, instead, you wanted to compare two values of type T, you can use the Generics.Defaults unit and use:
TEqualityComparer<T>.Default.Equals(x, y)
to compare values x and y of type T.
You can't use operators with untyped generics. See here for a discussion.
It compiles if you change it to:
TPrimaryKey<T: class> = class(TObject)
I think the original poster is trying to create an object wrapper around simple types (Integer, double etc etc), so constraining T to Class would perhaps not work for what he wants.
The compiler has trouble in determining that both "T"'s are the same. But with a little trick you can make it work:
type
TPrimaryKey<T> = class(TObject)
public
type
TCompare<T1> = reference to function(const A1, A2: TPrimaryKey<T1>): Boolean;
private
fValue: T;
fCompare : TCompare<T>;
public
constructor Create(AValue: T; ACompare: TCompare<T>);
function Equals(Obj: TPrimaryKey<T>): Boolean; reintroduce;
function GetValue: T;
function CreateNew(const AValue: T): TPrimaryKey<T>;
end;
constructor TPrimaryKey<T>.Create(AValue: T; ACompare: TCompare<T>);
begin
inherited Create;
fValue := AValue;
fCompare := ACompare;
end;
function TPrimaryKey<T>.Equals(Obj: TPrimaryKey<T>): Boolean;
begin
Result := FCompare(self, Obj);
end;
function TPrimaryKey<T>.GetValue: T;
begin
Result := fValue;
end;
function TPrimaryKey<T>.CreateNew(const AValue: T): TPrimaryKey<T>;
begin
Result := TPrimaryKey<T>.Create(AValue, FCompare);
end;
You instantiate it with:
var
p1, p2 : TPrimaryKey<Integer>;
begin
p1 := TPrimaryKey<Integer>.Create(10,
function(const A1, A2: TPrimaryKey<Integer>): Boolean
begin
Result := (A1<>nil) and (A2<>nil) and (A1.GetValue=A2.GetValue);
end);
p2 := p1.CreateNew(10);
p1.Equals(p2);
end;