И снова про вызовы функций-членов

← →
Толик (2002-03-27 16:11) [0]

В догонку к своему вопросу про вызовы ф-й членов от 26.03. А как быть в том случае, если надо через указатель вызывать виртуальные функции? Например:

TParent = class(TObject)
private
i: longint;
public
functon Mem_fnc(): longint; virtual; abstract;
end;
TChild_1 = class(TParent)
public
function Mem_fnc(): longint; override; //одна реализация
end;
TChild_2 = class(TParent)
public
function Mem_fnc(): longint; override; //другая реализация
end;

Что бы хотелось сделать:
- получить указатель на ф-ю Mem_fnc класса TParent (именно
РОДИТЕЛЬСКОГО класса, чтобы использовать разные реализации
этой ф-и в разных потомках)
- вызвать её для объектов типа TChild_1 и TChild_2
соответственно в СВОЕЙ РЕАЛИЗАЦИИ (а не получить AbstractError
как в случае использования TMethod).

TProc = procedure()of object;
var
Proc: TProc;
Par, Ch1, Ch2: TParent;
begin
Par := TParent.Create(0); //понятно, что будет warning, но меня интересует только указатель на ф-ю и ничего более...
Ch1 := TChild_1.Create(1);
Ch2 := TChild_2.Create(2);

Proc := Par.mem_fnc;
TMethod(Proc).Data := Ch1;
ShowMessage(IntToStr(Proc())); {вызов Mem_fnc, реализованной в
TParent (отсюла и AbstractError), но с данными Ch2, а
хотелось бы, чтобы для объекта каждого типа вызывалась своя
реализация ф-и Mem_fnc}

Par.Free();
Ch1.Free();
Ch2.Free();
end;

Причём в С++"ном примере от 26.03 всё работает замечательно...
Возможно ли вообще такое реализовать в Делфях???

← →
vuk (2002-03-27 16:31) [1]

type
TFunc = function : longint;

var
func : TFunc;
.....
func := Par.mem_munc;
...
func := Ch1.mem_func;
....
func := Ch2.mem_func;

← →
reonid (2002-03-27 17:08) [2]

Такая задача, насколько я её понял, стандартными языковыми средствами не предусмотрена.
Но можно найти положение виртуального метода в VMT и соответственно получить его адрес для любого производного класса:

type
PPtrArray = ^TPtrArray;
TPtrArray = array[0..MaxInd div 16] of Pointer;

TBase = class
function F; virtual; abstract;
end;

var vmt, pf: Pointer;
i, vmtIdx: Integer;
meth: TMethod;
derived: TBase;// Потомок

pf := @TBase.F;

vmtIdx := -1; // Ищем позицию метода в VMT
i := 0;
vmt := TBase;
repeat
if PPtrArray(vmt)^[i] = pf then
begin
vmtIdx := i;
Break;
end;
Inc(i);
until False;

meth.data := derived;
meth.code := PPtrArray(derived.ClassType)^[vmtIdx]; // находждениее адреса метода по индексу в VMT

meth(); // Выполнение

← →
vuk (2002-03-27 17:21) [3]

То ли я все не правильно понимаю, то ли куда-то обсуждение не в ту сторону уходит...

to Толик:
Это случайно не то, что Вы хотели?

program Project1; uses SysUtils; {$APPTYPE CONSOLE} type TFunc = function : longint of object; TParent = class(TObject) private i: longint; public function Mem_fnc(): longint; virtual; abstract; end; TChild_1 = class(TParent) public constructor Create; function Mem_fnc(): longint; override; end; TChild_2 = class(TParent) public constructor Create; function Mem_fnc(): longint; override; end; { TChild_1 } constructor TChild_1.Create; begin inherited Create; i := 1; end; function TChild_1.Mem_fnc: longint; begin Result := $FF000000 + i; //от балды end; { TChild_2 } constructor TChild_2.Create; begin inherited Create; i := 2; end; function TChild_2.Mem_fnc: longint; begin Result := i; end; var c1, c2 : TParent; F : TFunc; begin c1 := TChild_1.Create; c2 := TChild_2.Create; F := c1.Mem_fnc; writeln( Format( "%x", [F]) ); F := c2.Mem_fnc; writeln( Format( "%x", [F]) ); C1.Free; C2.Free; readln; //созерцаем результаты end.

← →
MBo (2002-03-27 17:37) [4]

трудно бывает Сишников понять :)
мне кажется, что имеется в виду тривиальное наследование с перекрытием вирт. методов

TAnimal=class
constructor create;
function Say:string;virtual;abstract;
end;
TBird=class(TAnimal)
function Say:string;virtual;override;
end;
TMouse=class(TAnimal)
function Say:string;virtual;override;
end;

function TBird.Say;
begin
Result:="KuKu";
end;

function TMouse.Say;
begin
Result:="PiPi";
end;

var Animal:TAnimal;

if edit1.text="Mouse"
then Animal:=TMouse.Create
else Animal:=TBird.Create;
Animal.Say;// KuKu или PiPi

← →
MBo (2002-03-27 17:39) [5]

ага, и Vuk то же пишет

← →
Толик (2002-03-27 17:45) [6]

to reonid:
похоже что и правда придётся работать через vmt, я сам склоняюсь к такому решению, спасибо за пример.

to vuk:
это не совсем то, что я хотел. Допустим, есть массив неких объектов, причём разных типов, но унаследованных от некоего класса TMyClass. Я хочу написать ф-ю, которая бы пробегала в цикле по этому массиву и вызывала бы их виртуальную функцию-член, полученную в качестве параметра типа "указатель на ф-ю класса". Т.к. эта ф-я для каждого унаследованного класса реализована по своему, то и действия для каждого оюъекта будут свои. Например на С++ это делается так:

typedef void (TMyClass::*pmf)();
pmf p = &TMyClass::mem_fnc;
call_member(p);

/*Здесь я хочу заметить, что получаю адрес ф-и члена без создания экземпляра объекта, причём это НЕ СТАТИЧЕСКАЯ ф-я член, ну или выражаясь языком Делфей не class function!!!*/

void call_member(pmf p){
TMyClass1* pMC1 = new TMyClass1(1);
/*вызов через указатель ф-и mem_fnc для pMC1*/
(pMC1->*p)();
delete pMC1;
TMyClass2* pMC2 = new TMyClass2(2);
/*вызов через указатель ф-и mem_fnc для pMC2*/
(pMC2->*p)();
delete pMC2;
}

← →
reonid (2002-03-27 18:08) [7]

>Толик ©
Я сейчас проверил - с абстракнными методами такое не пройдёт.
В VMT они все имеют одинаковый адрес.
(То, что дает взятие адреса @TBase.F - это какая-то фикция).

А не с абстрактными - вполне проходит.

Кстати, тот примерчик я писал с ходу и он не совсем корректен
Вот работающий пример:

TFunc = function: Integer of object;
PPtrArray = ^TPtrArray;
TPtrArray = array[0..MaxInt div 16] of Pointer;

TVirtMethod = record
BaseClass: TClass;
Index: Integer;
end;

TBase = class
function F: Integer; virtual;
end;

TDerived = class (TBase)
function F: Integer; override;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

function TBase.F: Integer;
begin
Result := 0;
end;

function TDerived.F: Integer;
begin
Result := 123;
end;

function AddressToVMTIndex(VMT, Meth: Pointer): Integer;
var i: Integer;
begin
Result := -1;
i := 0;
repeat
if PPtrArray(vmt)^[i] = Meth then
begin
Result := i;
Exit;
end;
Inc(i);
until i = 100000;
end;

function VMTIndexToAddress(VMT: Pointer; Index: Integer): Pointer;
begin
Result := PPtrArray(VMT)^[Index];
end;

function GetVirtMethod(VMT, Meth: Pointer): TVirtMethod;
begin
Result.BaseClass := TClass(VMT);
Result.Index := AddressToVMTIndex(VMT, Meth);
end;

function GetStaticMethod(Instance: TObject; VirtMethod: TVirtMethod): TMethod;
begin
Result.Code := nil;
Result.Data := nil;
if Instance.InheritsFrom(VirtMethod.BaseClass) then
begin
Result.Data := Instance;
Result.Code := VMTIndexToAddress(Instance.ClassType, VirtMethod.Index);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var vmt, pf: Pointer;
VirtMeth: TVirtMethod;
meth: TFunc;
derived: TBase;// Потомок
begin
pf := @TBase.F;

VirtMeth := GetVirtMethod(TBase, pf);

derived := TDerived.Create;
try
TMethod(meth) := GetStaticMethod(derived, VirtMeth);
if Assigned(meth) then Caption := IntToStr(meth);
finally
derived.Free;
end;
end;

← →
vuk (2002-03-27 18:15) [8]

При решении подобной задачи я пошел бы другим путем.

Допустим, что
TBase = class procedure A; procedure B; end; type TActionProc = ptocedure( Instance : TBase ); procedure WalkAray( A: array of TBase; ActionProc : TActionProc ); var i : integer; begin if Assigned( ActionProc ) then for i := Low( A ) to High(A) do ActionProc( a[i] ); end;

И потом уже

procedure CallA( Instance : TBase ); begin if instance <> nil then Instance.A; end; procedure CallB( Instance : TBase ); begin if instance <> nil then Instance.B; end; var ar : array of TBase; .... WalkArray( ar, CallA ); WalkArray( ar, CallB );

← →
Набережных С. (2002-03-27 20:04) [9]

> Толик © (27.03.02 17:45)

Это как раз то, что написали MBo © (27.03.02 17:37) и vuk © (27.03.02 17:21).
TMyClass = class... function MyFunction...;virtual;abstract;
Наследуешь классы от него и в них перекрываешь MyFunction. Массив, например, такой(или любой другой):
MyObjArray : array of TMyClass;
Заполняешь массив потомками TMyClass и вызываешь такую процедуры:
procedure MyEnumProc(A: array of TMyClass); var n:integer; begin for n:=0 to Length(A)-1 do A[n].MyFunction... end;
Для каждого объекта будет вызван метод именно его класса или унаследованный, если в классе он не переопределен. В этом и состоит смысл виртуальных и динамических методов.
А создавать экземпляры классов с абстрактными методами не следует. Никогда.

← →
Толик (2002-03-28 10:01) [10]

for all:
Меня интересует не то как вызывать виртуальные функции-члены, а то как их вызывать через УКАЗАТЕЛИ!!! Улавливаете разницу? Не важно на какую ф-ю указывает указатель, главное, чтобы принимаемые и возвращаемые параметры совпадали. А вот с этим-то и проблема: невозможно (пожалуй кроме как через vmt) имея указатель на ф-ю в классе-родителе вызвать её реализацию для класса-потомка.

← →
vuk (2002-03-28 11:08) [11]

to Толик:
Я понял Вашу проблему еще вчера. У меня вызывает сомнение надежность такго подхода. Потому как придется копаться в VMT, и при этом если вруг окажется, что в одном из элементов массива находится экземпляр какого-то не того класса, то о последствиях можно будет только догадываться. Я Вам предложил технику, которая является компромиссом - для каждого элемента вызывается callback функция, которая может варьироваться.

← →
Shaman_Naydak (2002-03-28 11:58) [12]

Мда, любит у нас народ создавать себе трудности, чтобы потом их с восторгом преодолевать...

← →
Набережных С. (2002-03-28 16:09) [13]

> Толик © (28.03.02 10:01)

Я просто полагал, что остальное понятно и без слов. Не нужно так делать. Такой подход корректен на низком уровне, но он в корне противоречит принципам и полиморфизма, и инкапсуляции, а среда делфи строго их придерживается, и проблемы не заставят себя долго ждать. Тем более что задачу можно решить множеством нормальных способов. Например, передачей в качестве параметра не метода, а условия, по которому он выбирается. Ну и т.д.

← →
Толик (2002-03-28 17:47) [14]

to Набережных С.
Ну насчёт строгого соответствия требованиям инкапсуляции в Делфях я бы не был столь категоричен. Вы ни когда не пробовали присваивать значение св-ву, которое объявлено readonly???

TForm((@Application.MainForm)^) := Form2;
так и константе значения можно присваивать!!!
const
i: string = "Это константа?";
begin
string((@i)^) := "Ну и что это за константа после этого???";
ShowMessage(i);
end;
Я конечно никого не призываю так писать, но факт остаётся фактом.

А вот нормальный вызов функции-члена-класса (виртуальной) через указатель в Делфях не реализован. Да, конечно, как вариант можно в каждом классе создать массив указателей на ф-и-члены, заполнять его в конструкторе, а в свой алгоритм передавать номер эл-та массива. Но ведь это получается копирование vmt, некий свой аналог. Причём если кто-то будет наследоваться от моего класса, он должен помнить, что ему необходимо заполнить этот массив указателями на свои ф-и-члены.
Ну, или как предложил vuk © писать отдельно ф-ю для вызова соответствующей ф-и-члена. А будет у меня 100 таких функций? И каждый раз их дублировать только потому, что где-то в недрах своего алгоритма она использует вызов ф-и-члена?
Тоскливо становится...

← →
MBo (2002-03-28 18:24) [15]

MethodAddress?

← →
Толик (2002-03-28 18:40) [16]

to MBo ©
К сожалению это не решает проблему вызова своей реализации виртуальной ф-и для классов-наследников при получении адреса ф-и класса-родителя:

TChild = class(TParent)

var
P: TParent;
Child: TChild;
mtd: TMethod;
begin
mtd.Code := P.MethodAddress("MyFnc");
mtd.Data := Child;
MyFnc(mtd)(); //вызов MyFnc, реализованной в TParent - потенциальная возможность получить AbstractError
end;

← →
vuk (2002-03-28 19:02) [17]

to Толик:
>так и константе значения можно присваивать!!!
>const
> i: string = "Это константа?";
А кто сказал, что это настоящая константа? Это же обычная переменная. Можно, конечно, заставить компилятор ругаться на явное присвоение ей значения, но переменной она от этого быть не перестанет. А у каждой переменной, как водится, адрес есть...

>А будет у меня 100 таких функций? И каждый раз их дублировать
Зачем же каждый раз дублировать-то?

А вообще говоря, уже неоднократно писали о том, что для каждого языка нужно решать задачи естественными для него методами, а не переписыванием алгоритмов с других языков один в один.

И снова про вызовы функций-членов Найти похожие ветки