Implementation through interface delegation not pass to descendant - interface

Consider this interfaces and its implementations.
unit utest;
interface
{$MODE OBJFPC}
type
IIntfA = interface
procedure writeA();
end;
IIntfB = interface(IIntfA)
procedure writeB();
end;
TADelegateClass = class(TInterfacedObject, IIntfA)
public
procedure writeA();
end;
TAClass = class(TInterfacedObject, IIntfA)
private
delegateA : IIntfA;
public
constructor create(const AInst : IIntfA);
destructor destroy(); override;
property A : IIntfA read delegateA implements IIntfA;
end;
TBClass = class(TAClass, IIntfB)
public
procedure writeB();
end;
implementation
procedure TADelegateClass.writeA();
begin
writeln('Implement IIntfA through delegation');
end;
constructor TAClass.create(const AInst : IIntfA);
begin
delegateA := AInst;
end;
destructor TAClass.destroy();
begin
inherited destroy();
delegateA := nil;
end;
procedure TBClass.writeB();
begin
writeln('Implement IIntfB');
end;
end.
Following program will not compile.
program test;
{$MODE OBJFPC}
uses
utest;
var b : IIntfB;
begin
b := TBClass.create(TADelegateClass.create());
b.writeA();
b.writeB();
end.
Free Pascal (version 3.0.4) complains
Error: No matching implementation for interface method "writeA;" found.
at line where TBClass is declared.
Of course, I can compile it successfully by implementing writeA either in TAClass or TBClass and call writeA method of TADelegateClass from there.
TAClass is concrete implementation of IIntfA interface through interface delegation but why TBClass, which is descendant of TAClass, is not considered a concrete implementation of IIntfA interface?

TAClass is concrete implementation of IIntfA interface through
interface delegation but why TBClass, which is descendant of TAClass,
is not considered a concrete implementation of IIntfA interface?
Short answer: it's not IIntfA that is the problem, it is IIntfB that is incomplete.
Long answer: Interface inheritance is C++ vtable inheritance, which is sometimes not intuitive.
In the example:
IIntfB = interface(IIntfA)
procedure writeB();
end;
could actually be written as
IIntfB = interface
procedure writeA();
procedure writeB();
end;
When implementing multiple interfaces, common parts are not reused. The compiler sets up individual tables from the implementing methods, such as:
TADelegateClass:
QueryInterface(IIntfA) = Self.vtable_IIntfA
vtable_IIntfA.writeA <- Self.writeA
TAClass:
QueryInterface(IIntfA) = delegateA.vtable_IIntfA
TBClass:
QueryInterface(IIntfA) = inherited delegateA.vtable_IIntfA
QueryInterface(IIntfB) = vtable_IIntfB
vtable_IIntfB.writeA <- (this is missing!)
vtable_IIntfB.writeB <- Self.writeB
TBClass does indeed not have an implementation of IIntfB.writeA.
This can be verified by manually assigning a method to the specific interface and observe the error disappearing:
TBClass = class(TAClass, IIntfB)
public
procedure IIntfB.writeA = writeB;
// dummy method, shows IIntfB.writeA is missing
Sadly, I don't know of any way to tell the compiler to access a mapping from another interface. FWIW, Delphi has the same bug/shortcoming.

Related

'GetCalcFields' not found in base class Error

type
TCDSWithRecalc = class(TClientDataset)
public
procedure GetCalcFields(Buffer: PChar); override;
end;
procedure TCDSWithRecalc.GetCalcFields(Buffer :PChar);
begin
inherited GetCalcFields(Buffer);
end;
E2137 Method 'GetCalcFields' not found in base class.
I don't understand what this error is. can you help?
You don't say which Delphi version you are using, but the type declaration of the Buffer parameter was changed from the original (D7 and before) PChar to TRecBuf in the modern (Unicode) versions. So, you you need to change your declaration of TCDSWithRecalc
to
type
TCDSWithRecalc = class(TCustomClientDataset)
public
procedure GetCalcFields(Buffer: TRecBuf); override;
end;
[...]
procedure TCDSWithRecalc.GetCalcFields(Buffer : TRecBuf);
begin
inherited GetCalcFields(Buffer);
end;
In Delphi 10.4.2, the compiler reports an additional error with your version of the declaration
[dcc32 Error] cds1u.pas(41): E2250 There is no overloaded version of 'GetCalcFields' that can be called with these arguments
which is true.

Is it possible to use a class declared in Implementation section from Interface section

If I understand correctly, the interface section is visible to other units, and the implementation section is visible only in the current .pas file.
I have two classes, class TA should be visible to the outside, other class TB should not, but I need a field of type TB in TA.
interface
type
TA = class
//something
B : TB;
end;
//something
implementation
type
TB = class
//something
end;
It doesn't work like that. I also cannot use a forward declaration. Is there a way?
Or, is there a way to declare TB in the interface section but make it kind-of private?
A type cannot be used before it is declared (in terms of line numbers). In particular, this means that you cannot use a type declared in the implementation section in the interface section.
However, consider the following example:
unit VisibilityTest;
interface
type
TFrog = class
strict private type
TFrogMetabolism = class
procedure DoAnabolismStuff;
procedure DoCatabolismStuff;
end;
strict private
FMetabolism: TFrogMetabolism;
public
procedure Croak;
procedure Walk;
procedure Jump;
end;
implementation
{ TFrog.TFrogMetabolism }
procedure TFrog.TFrogMetabolism.DoAnabolismStuff;
begin
end;
procedure TFrog.TFrogMetabolism.DoCatabolismStuff;
begin
end;
{ TFrog }
procedure TFrog.Jump;
begin
end;
procedure TFrog.Croak;
begin
end;
procedure TFrog.Walk;
begin
end;
end.
Here the TFrog class is visible to other units, as well as its Croak, Walk, and Jump methods.
And it does have a (strict private in this example) field of type TFrogMetabolism, a type which can only be used inside TFrog -- and therefore only inside this unit -- because of the preceding strict private specification.
This should give you some ideas. A few variants are possible:
If you remove strict from strict private type, the TFrogMetabolism class can be used everywhere inside this particular unit, and not only in TFrog.
If you replace private with protected, the class can also be used in classes that aren't TFrog but are derived from TFrog.
You can do it but with a price. In class TA, the variable referring to TB must be of type TObject. Let's name that variable B. You can assign an instance of class TB to the variable, for example from the constructor. Then when code in TA needs to use variable B, it must cast is to TB (Hard cast or use "As" operator).
You should also disable RTTI on that TB so that the outside cannot discover what is inside TB.
Here is the code:
unit Unit24;
interface
uses
System.SysUtils;
type
TA = class
B : TObject; // Will contain a TB instance
constructor Create;
destructor Destroy; override;
procedure Demo;
end;
implementation
type
TB = class
procedure SayHello;
end;
{ TA }
constructor TA.Create;
begin
inherited Create;
B := TB.Create;
end;
procedure TA.Demo;
begin
TB(B).SayHello;
end;
destructor TA.Destroy;
begin
FreeAndNil(B);
inherited Destroy;
end;
{ TB }
procedure TB.SayHello;
begin
WriteLn('Hello!');
end;
end.
An example of use:
program Project24;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
Unit24 in 'Unit24.pas';
var
A : TA;
begin
A := TA.Create;
try
A.Demo;
finally
A.Free;
end;
end.
One option might be to declare a public interface that TB implements, and then TA can have a field of that interface type.
interface
type
IB = interface
//something
end;
TA = class
public
B : IB;
constructor Create;
end;
//something
implementation
type
TB = class(TInterfacedObject, IB)
//something
end;
constructor TA.Create;
begin
B := TB.Create;
end;
Is it possible to use a class declared in Implementation section from Interface section?
No.
Or is there a way to declare TB in the Interface section but make it kinda private?
Yes,, if you make it a nested class, declare in a private section of the containing type.
A pointer and class can be declared forward, but must be declared in the same type block. The reason that this works is because they are reference types and even just the forward declaration fixates the offset of the fields after them. The type block bit is mainly compiler writer convenience (but as so often, also easier/better error message generation)
Pascal follow-up Modula2 allowed pointers to be more narrowly defined in the implementation, e.g. a pointer to a certain record(so called opaque types). Other units could only use it as a handle type (pass it along etc) and the implementation could access details without typecasts. In that way it is a language assisted way of doing what Fpiette suggests, tobject being the most basic subset of a class.
Another solution would be to make it a generic, and specialize it in the implementation with the generic TB type.

Destroy a class instance on creating the new instance

I am programming an MDIChild form in Delphi with the Action = caFree in OnClose event. Now I want that at one time there will only be one instance of a form. For this I used a class variable:
type
TMyForm = class(TForm)
...
class var CurInstance: TMyForm;
...
end;
constructor TMyForm.Create();
begin
inherited Create(nil);
if Assigned(TMyForm.CurInstance) then
TMyForm.CurInstance.Destroy
TMyForm.CurInstance := Self;
end;
destructor TMyForm.Destroy();
begin
TMyForm.CurInstance := nil;
inherited Destroy;
end;
The code above works pretty well and does what it should be. But I have a bad feeling about calling destructor from constructor, even through this is a different instance. Is this a correct way? Is there something else I need to consider about this?
Many thanks.

Polymorphism and inheritance using class reference (part 2)?

The console application below gives "Runtime error"...
Why would this happen ? Many thanks !
PS: Related SO post
program Project2;
{$APPTYPE CONSOLE}
type
TParent = class;
TParentClass = class of TParent;
TParent = class
public
procedure Work; virtual; abstract;
end;
TChild1 = class(TParent)
public
procedure Work; override;
end;
TChild2 = class(TParent)
public
procedure Work; override;
end;
procedure TChild1.Work;
begin
WriteLn('Child1 Work');
end;
procedure TChild2.Work;
begin
WriteLn('Child2 Work');
end;
procedure Test(ImplClass: TParentClass);
var
ImplInstance: TParent;
begin
ImplInstance := ImplClass.Create;
ImplInstance.Work;
ImplInstance.Free;
end;
begin
Test(TParent);
Test(TChild1);
Test(TChild2);
Readln;
end.
The TParent.Work method is declared as abstract. The documentation says:
You can call an abstract method only in a class or instance of a class in which the method has been overridden.
When you call TParent.Work you break that rule and so encounter a runtime error.

How to make in Object Pascal "class of interface" (or "interface of interface") type

Look at this sample:
//----------------------------------------------------------------------------
type
ISomeInterface = interface
procedure SomeMethod;
end;
// this is wrong, but illustrates that, what i need:
TSomeClassWhichImplementsSomeInterface = class of ISomeInterface;
var
gHardCodedPointer: Pointer; // no matter
procedure Dummy(ASomeClassToWorkWith: TSomeClassWhichImplementsSomeInterface);
begin
// actually, type of ASomeClassToWorkWith is unknown (at least TObject), but it
// must implement SomeMethod, so i can make something like this:
ASomeClassToWorkWith(gHardCodedPointer).SomeMethod;
end;
...
type
TMyClass = class(TInterfacedObject, ISomeInterface)
end;
...
// TMyClass implements ISomeInterface, so i can pass it into Dummy:
Dummy(TMyClass);
//----------------------------------------------------------------------------
Of course i can inherit TMyClass and use it childs, but I don't need this. I want to use another classes with their own hierarchy, just adding into them implementation of ISomeInterface (because there are no multiple-inheritance avaiable in Object Pascal, like in C++).
I know it may be looked crazy, don't ask me why I need this, just say - it is possibly to implement or not. Thanks a lot!
I think what you are looking for is this:
procedure Dummy;
var Intf : ISomeInterface;
begin
if Assigned(gHardCodedPointer) and Supports(gHardCodedPointer,ISomeInterface,Intf) then
Intf.SomeMethod
end;
If it's not, I have no clue about what you are trying to achieve there...
You can declare metaclasses, but you cannot define them in terms of what interfaces the base class implements. Interface implementation can only be checked at run time.
You can pass your Dummy function a metaclass, but you cannot use that metaclass to type-cast your plain pointer to a more specific type. Type-casting is a compile-time operation, but the actual value of the metaclass parameter isn't known until run time. The best you can do is type-cast it to the metaclass's base class. Then you can call all the methods that are defined in that base class.
But it seems you don't actually care what the base class is, as long as the class implements your interface. In that case, you can ignore the metaclass parameter. Type-cast your pointer to be a TObject (or, better yet, declare gHardCodedPointer to be a TObject in the first place), and then use the Supports function to get the interface reference.
var
SupportsInterface: Boolean;
Some: ISomeInterface;
begin
SupportsInterface := Supports(TObject(gHardCodedPointer), ISomeInterface, Some);
Assert(SupportsInterface, 'Programmer stored bad class instance in gHardCodedPointer');
Some.SomeMethod;
end;
If you really care about the metaclass parameter, you can add some enforcement for it, too. You can check whether the given class implements your interface, and you can check whether the object in gHardCodedPointer is an instance of that class:
Assert(ASomeClassToWorkWith.GetInterfaceEntry(ISomeInterface) <> nil);
Assert(TObject(gHardCodedPointer).InheritsFrom(ASomeClassToWorkWith));
But notice that you don't need to check either of those results to be able to call SomeMethod on gHardCodedPointer. They don't really matter.
By the way, the only hard-coded pointer value you can hope to have in Delphi is nil. All other pointer values are addresses that are very hard to predict at compile time because the compiler, the linker, and the loader all determine where everything really goes in memory. I suggest you come up with some other name for that variable that more accurately describes what it really holds.
Why can't you use the interface reference?
But, assuming there is a good reason for that, this might help.
As you have found out, you can't do class of on an interface.
What's more you can't use a variable value to cast anything to anything else. Casting is hardwired telling the compiler that you know the reference you are casting is of a specific type. Trying to do that with a var such as your ASomeClassToWorkWith parameter is going to produce errors as it goes against the very nature of casting.
Code below is not something I'd recommend, but it compiles and I think it does what you want. What it does is use a "dummy" ancestor and employs polymorfism to get the compiler to call the method on the correct type. If you do not mark SomeMethod as virtual, you will get the dummy ancestor's message on both button clicks.
The Instance function in the interface is there to show you a means of getting to the implementing instance of an interface without using RTTI. Just be aware of the caveat of this when using interface delegation: you may not get the instance you are expecting.
type
TForm1 = class(TForm)
TSomethingBtn: TButton;
TMyClassBtn: TButton;
procedure FormCreate(Sender: TObject);
procedure TSomethingBtnClick(Sender: TObject);
procedure TMyClassBtnClick(Sender: TObject);
private
{ Private declarations }
FSomething: TObject;
FMyClass: TObject;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
TSomething = class; // forward;
TSomethingClass = class of TSomething;
ISomeInterface = interface
procedure SomeMethod;
function Instance: TSomething;
end;
TSomething = class(TInterfacedObject, ISomeInterface)
procedure SomeMethod; virtual;
function Instance: TSomething;
end;
var
gHardCodedPointer: Pointer; // no matter
procedure Dummy(aSomething: TSomething);
begin
// actually, type of ASomeClassToWorkWith is unknown (at least TObject), but it
// must implement SomeMethod, so i can make something like this:
aSomething.SomeMethod;
end;
type
TMyClass = class(TInterfacedObject, ISomeInterface)
procedure SomeMethod; virtual;
function Instance: TSomething;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FSomething := TSomething.Create;
FMyClass := TMyClass.Create;
end;
{ TMyClass }
function TMyClass.Instance: TSomething;
begin
Result := TSomething(Self);
end;
procedure TMyClass.SomeMethod;
begin
ShowMessage('This comes from TMyClass');
end;
{ TSomething }
function TSomething.Instance: TSomething;
begin
Result := Self;
end;
procedure TSomething.SomeMethod;
begin
ShowMessage('This comes from the "dummy" ancestor TSomething');
end;
procedure TForm1.TMyClassBtnClick(Sender: TObject);
begin
// Presume this has been set elsewhere
gHardCodedPointer := FMyClass;
Dummy(TSomething(gHardCodedPointer));
end;
procedure TForm1.TSomethingBtnClick(Sender: TObject);
begin
// Presume this has been set elsewhere
gHardCodedPointer := FSomething;
Dummy(TSomething(gHardCodedPointer));
end;
It seems I see what you want to do. You just have to use what MS and partners implemented in the core of interfaces, use guids. Below is the example, but you should definitely use your own guid with CTRL+SHIFT+G in IDE
...
type
ITestInterface = interface
['{2EA2580F-E5E5-4F3D-AF90-2BBCD65B917B}']
procedure DoSomething;
end;
TTestObject = class(TInterfacedObject, ITestInterface)
procedure DoSomething;
end;
TTestObject2 = class(TInterfacedObject, ITestInterface)
procedure DoSomething;
end;
...
procedure TestMethod(Obj: TInterfacedObject);
var
Intf: ITestInterface;
begin
if (Obj as IUnknown).QueryInterface(ITestInterface, Intf) = S_OK then
Intf.DoSomething;
end;
{ TTestObject }
procedure TTestObject.DoSomething;
begin
MessageDlg('This is TTestObject showing something', mtInformation, [mbOk], 0)
end;
{ TTestObject2 }
procedure TTestObject2.DoSomething;
begin
MessageDlg('This is TTestObject2 showing something', mtInformation, [mbOk], 0)
end;
procedure TForm2.Button1Click(Sender: TObject);
var
Obj1, Obj2: TInterfacedObject;
begin
Obj1:=TTestObject.Create;
Obj2:=TTestObject2.Create;
TestMethod(Obj1);
TestMethod(Obj2);
end;
Even if you could, you couldn't typecast the interface with a interface-var anyway.
Same as with classes when you typecast a pointer to a metaclass, you'll get something of type metaclass (class of), not something of the type that is in metaclass.
With classes you solve this by typecast to the lowest common class in the hierachy. You can do the same with interfaces. ... If they inherit from eachother.
I think you have to use the interface, not the class:
procedure Dummy(ASomeClassToWorkWith: ISomeInterface);
begin
// actually, type of ASomeClassToWorkWith is unknown (at least TObject), but it
// must implement SomeMethod, so i can make something like this:
ASomeClassToWorkWith.SomeMethod;
end;
You just have to think amout reference counting
If you realy want the object instance you could change the interface like this:
type
ISomeInterface = interface
procedure SomeMethod;
function ImplementedInObject: TObject;
end;
procedure Dummy(ASomeInterfaceToWorkWith: ISomeInterface);
var
ASomeObjectToWorkWith: TObject;
begin
ASomeInterfaceToWorkWith.SomeMethod;
ASomeObjectToWorkWith := ASomeInterfaceToWorkWith.ImplementedInObject;
// Do what is needed with object
end;
...
type
TMyClass = class(TInterfacedObject, ISomeInterface)
function ImplementedInObject: TObject;
end;
function TMyClass.ImplementedInObject: TObject;
begin
Result := Self;
end;
The difference when calling code via interface variable or via variable pointing to an instance of a class that implements methods of the same interface is that different virtual method tables (VMT) are used, i.e. in a VMTs of an interface there will be only interface methods (plus AddRef, Release and QI, of course), in a VMT of a class there will be all virtual methods of that class.
That means that your code
ASomeClassToWorkWith(gHardCodedPointer).SomeMethod;
will be compiled to call TSomeClassWhichImplementsSomeInterface.SomeMethod directly instead of virtual method in VMT of ISomeInterface through interface pointer.
Even more, since interfaces cannot declare class methods and class attributes, an interface type is not a object (while class is an object), therefore "class of interface" does not make any sence.
You can add intermediate abstract class and declare you "class of interface" as class of the intermediate class:
type
TInterfacedObjectWithISomeInterface = class(TInterfacedObject, ISomeInterface)
procedure SomeMethod; virtual; abstract;
end;
TSomeClassWhichImplementsSomeInterface = class of TInterfacedObjectWithISomeInterface;
procedure Dummy(ASomeClassToWorkWith: TSomeClassWhichImplementsSomeInterface);
...
type
TMyClass = class(TInterfacedObjectWithISomeInterface)
procedure SomeMethod; override;
end;