Прошу прощения у почтенной публики, в
своём посте я написал чушь из-за тотального непонимания того, как работает VMT в объектах. Код перестанет работать, если в TAnimal добавить какие-то дополнительные поля.
Сейчас в Free Pascal у объектов ссылка на VMT размещается после всех полей. (В том случае, когда виртуальных методов нет, ссылки на VMT тоже не будет.) Не знаю зачем так сделано, возможно, для большей совместимости с обычными записями (и для совместимости в тех случаях, когда объект без виртуальных методов переписывается на объект с виртуальными методами). Поэтому, предполагаю, что чтобы корректно изменить VMT объекта, нужно (1) знать тот тип его предка, в котором VMT впервые появляется (2) используя какую-то магию с SizeOf(…) поменять ссылку.
Таким образом, я предлагаю такой рабочий код для изменения VMT вместо того, что в указанном посте:
- Код: Выделить всё
[doj@korica ~/temp]$ cat switch.pas
type
TFlexible = object
destructor Done; virtual;
{function GetVMT: Pointer; inline;}
procedure SetVMT(_VMT: Pointer); inline;
property VMT: Pointer {read GetVMT} write SetVMT;
end;
TAnimal = object(TFlexible)
FName: AnsiString;
constructor Init(const Name: AnsiString);
procedure TellAboutYourSelf; virtual; abstract;
end;
TCat = object(TAnimal)
procedure TellAboutYourSelf; virtual;
end;
TDog = object(TAnimal)
procedure TellAboutYourSelf; virtual;
end;
destructor TFlexible.Done;
begin
end;
procedure TFlexible.SetVMT(_VMT: Pointer);
begin
PPointer(@Self)^ := _VMT;
end;
constructor TAnimal.Init(const Name: AnsiString);
begin
FName := Name;
end;
procedure TCat.TellAboutYourSelf;
begin
Writeln('Я кот по имени ', FName, '.');
end;
procedure TDog.TellAboutYourSelf;
begin
Writeln('Я ', FName, ', гав-гав!');
end;
var
Pet: TAnimal;
begin
Pet.Init('Бусик');
Pet.VMT := TypeOf(TCat);
Pet.TellAboutYourSelf;
Pet.VMT := TypeOf(TDog);
Pet.TellAboutYourSelf;
Pet.Done;
end.
[doj@korica ~/temp]$ fpc switch.pas && ./switch
Я кот по имени Бусик.
Я Бусик, гав-гав!