Глюки и наследование от MyInterface

[Stargazer]

Вообще, бред какой-то.

Создал тестовую переменную типа IAimInterface, сделал ей Create и попробовал вызвать интерфейсные методы. Всё работает прекрасно.
Подставляю старый вариант - при вызове интерфейсного метода падает. Хотя - что интересно - экземпляр существует, и даже его остальные, неинтерфейсные методы, прекрасно отрабатывают.
Такое ощущение, что интерфейсный "кусок" просто "отвалился" где-то в пути.

[Sergei I. Gorelkin]

Код в студию. Целиком, с объявлениями, созданием и вызовами...

[Stargazer]

Код в студию. Целиком, с объявлениями, созданием и вызовами...

Э-эх, 500 кил исходников...
Я воспроизвёл код - в пробирке... Но в пробирке всё работает ОК
В настоящее время пытаюсь найти способ воссоздать ситуацию падения в пробирке.


Начал копаться в интерфейсе. GetInterfaceTable говорит, что у объекта в таблице интерфейсов есть одна запись (параметр "EntryCount" = 1) - так оно и должно быть. Параметры "VTable", "IOffset" и пр. - хранят какие-то числа, но я их не понимаю пока.

Наверное, тут можно как-то определить валидность адреса интерфейсной процедуры, при обращении к которой происходит падение.

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

[Stargazer]

Код в студию. Целиком, с объявлениями, созданием и вызовами...

Ура, эврика! Я нашёл! Спасибо Вам за моральную поддержку!

Дело в приведении типов. Когда в эту мясорубку попал мой интерфейс, он тут же был кастрирован. Попытаюсь описать ситуацию словами.

Есть базовый класс TAgeClass, от него порождён класс CSemanticBlock. Далее появляется интерфейс IAimInterface, и возникает новый класс CSB_Aim(CSemanticBlock, IAimInterface).
После чего я завожу переменную типа CSB_Aim и пытаюсь в неё загрузить ссылку на свежесозданный объект этого же типа.
Но!
Моя процедура загрузки работает с объектами типа TAgeClass. Всё, что она делает, это по имени объекта находит его ссылку и возвращает её.
Вот её объявление:

Код: Выделить всё

LoadLinkName(name,AttrName : Domstring; var obj : TAgeClass);

Тут начинается интересное. Компилятор не пропускает присваивание объектов типа TAgeClass, или CSemanticBlock, в переменную, тип которой (CSB_Aim) порождён от интерфейса. И это правильно.

Но я запросто смог подставить мою интерфейсную переменную в мою процедуру, с помощью приведения типов, вот так:

Код: Выделить всё

STORE.LoadLinkName(self.name, STORE_LINK_AIM, TAgeClass(self.aim));

Я так делал раньше, и всё работало. А когда добавил интерфейс в тип переменной aim, то выходит, что такое приведение типов "убивает" интерфейс. Что и приводит к падению.

Как из этого выйти, пока не придумал. Если есть интерес, могу состряпать демку, но думаю, и так всё понятно.

С уважением.

[Sergei I. Gorelkin]

Мда, теперь понятно. Приводить интерфейсы к классам уж явно не следует. Наоборот (класс привести к интерфейсу) - допустимо, если класс непосредственно реализует этот интерфейс.
Как выйти - наверное, сначала грузить класс, а потом брать от него интерфейс с помощью as, GetInterface или Supports и записывать в переменную типа интерфейс...

[Stargazer]

Я воспроизвёл ситуацию. У меня есть хранилище объектов, которое работает с типами CBaseClass. Но в хранилище теперь могут храниться и интерфейсные объекты, поэтому вытаскивать объекты из хранилища можно при помощи специальной процедурки (как проиллюстрировано в нижеследующем примере), после чего интерфейс "отваливается".

Код: Выделить всё

{$INTERFACES CORBA}
program demo;
uses classes, sysutils;

type
    CBaseClass = class end;

    IMyInterface = Interface
        procedure Hello;
    end;

    CHello = class(CBaseClass, IMyInterface)
        procedure Hello;
    end;

    CHi = class(CHello);

procedure CHello.Hello;
begin
     writeln('Hello!');
end;

var
   hi : CHi;
   b  : CBaseClass;
   i  : IMyInterface;

procedure GetClass(var baseclass : CBaseClass);
begin
     baseclass := b;
end;
   
begin
     hi := CHi.Create;
     b := hi;
     //i := b; // Так компилятор не пропускает,
     GetClass(CBaseClass(i)); // а это пропускает, естественно..
     i.Hello; // ... и в рантайме падает.
     hi.Free;
     readln;
end.

Дело в том, что в рантайме я не знаю, какой именно объект попадёт в интерфейсную переменную. Поэтому приведение типа

Код: Выделить всё

   i := CHi(b);

просто невозможно, так как идея полиморфизма при таком приведении "идёт лесом".

[Sergei I. Gorelkin]

Вместо i := b нужно писать

Код: Выделить всё

if Supports(b, IMyInterface, i) then ...

При этом, если объект b поддерживает интерфейс IMyInterface, то в переменную i будет помещен правильный указатель на этот интерфейс, иначе функция вернет false.

Но - я не знаю, работает ли это с corba-интерфейсами (я с ними никогда не работал). По идее, должно. С обычными - точно работает.

[Stargazer]

Да, с COM-интерфейсами работает, с CORBA-интерфейсами не работает. Вот этот код (проверен на FPC 2.0.4):

Код: Выделить всё

{$DEFINE CORBA}
{$IFDEF CORBA}{$INTERFACES CORBA}{$ENDIF}  
program demo;
uses classes, sysutils;

type
{$IFDEF CORBA}
    CBaseClass = class end;
{$ELSE}
    CBaseClass = class(TInterfacedObject) end;
{$ENDIF}
    IMyInterface = Interface
        procedure Hello;
    end;

    CHello = class(CBaseClass, IMyInterface)
        procedure Hello;
    end;

    CHi = class(CHello);

procedure CHello.Hello;
begin writeln('Hello!'); end;

var
   hi : CHi;
   b  : CBaseClass;
   i  : IMyInterface;

begin
     hi := CHi.Create;
     b := hi;
     if Supports(b, IMyInterface, i) then
         i.Hello
     else
         writeln('This is not an interfaced object!');
{$IFDEF CORBA}
     hi.Free;
{$ENDIF}
     readln;
end.

[Sergei I. Gorelkin]

Похоже, что я погорячился, порекомендовав это решение. Не работают ни в какую с этой CORBA привычные методы...
Тогда делаем так: используем старый добрый COM, но базовый класс (от которого наследуются все остальные) наследуем не от TInterfacedObject, а просто от TObject, и самостоятельно реализуем в нем интерфейс IUnknown. Это три процедуры. QueryInterface копируем из TInterfacedObject, а _AddRef и _Release просто возвращают -1. При этом подсчет ссылок идет лесом, а полиморфизм сохраняется.

И еще: так, как я написал, сделано в классе TComponent, так что теоретически можно унаследоваться и от него. Однако при этом возможно появление других граблей, т.к. TComponent поддерживают механизм владения, и тоже могут автоматически уничтожаться при уничтожении владельца.

[Stargazer]

Тогда делаем так: используем старый добрый COM, но базовый класс (от которого наследуются все остальные) наследуем не от TInterfacedObject, а просто от TObject, и самостоятельно реализуем в нем интерфейс IUnknown.

Я нашёл в исходниках FPC модуль src\fcl\fpcunit\testutils.pp, так в нём реализован именно такой TNoRefCountObject.

Всё, этот вариант заработал как надо. Жалко, что через "костыли" - в режиме {$interface CORBA} было бы изящнее Кстати, интересно -может ли ситуация с CORBA и нерабочей Supports считаться багом FPC, или это такая фича? Я облазил freepascal.org, но ничего специфического для CORBA не нашёл.

[Sergei I. Gorelkin]

Кстати, интересно -может ли ситуация с CORBA и нерабочей Supports считаться багом FPC, или это такая фича? Я облазил freepascal.org, но ничего специфического для CORBA не нашёл.

Смесь багов, фич и отсутствия фич... Чтобы точнее утверждать, что есть что, надо бы сначала поподробнее изучить устройство CORBA.