Есть у меня ПОДОЗРЕНИЕ, пока только ПОДОЗРЕНИЕ

(Беспочвенные подозрения у меня кстати ОДИН раз были уже - http://18delphi.blogspot.com/2013/04/delphi-xe.html) (а проблемы на самом деле были вот в этом "хоккее" - http://18delphi.blogspot.com/2013/04/getmem.html)

Что в Delphi XE4 - "пустые интерфейсы" иногда - "глючат".

Типа

IA = interface
 SomeMethod
end;

IB = interface(IA)
end;

TA = class(TInterfacedObject, IA)
end;

TB = class(TA, IB)
end;

Так вот если получать TB - как IA - то ВСЁ хорошо. А если получать как IB. Который в общем "по сути" такой же как IA, то наблюдаем проблемы при присвоении интерфейсным переменным (которое генерирует компилятор). ПАДАЕТ на _IntfCopy. К сожалению - JEDI - стек НЕ ПОКАЗЫВАЕТ. (Кстати - а есть ли всё ТАКИ УЖЕ АВТОРСКИЙ JEDI под XE4? http://18delphi.blogspot.com/2013/05/jedi-xe4.html) Проблемы - РЕДКИЕ. Но что характерно под XE3 - НЕ ПРОЯВЛЯЮЩИЕСЯ. Может быть это - СУГУБО НАШИ проблемы. И если я их найду - я обязательно напишу про них.

Я к чему? Если - ВДРУГ у кого-то проявляются ПОДОБНЫЕ непонятные. И нестабильно повторяющиеся проблемы. С похожими симптомами - может быть вы будете так любезны, что напишете мне про них? Ну вдруг?

Ещё раз напомню - "в моём случае" - проблемы есть ТОЛЬКО под XE4. По XE3 - НИ ОДНОГО случая - ДОКУМЕНТАЛЬНО зафиксировано не было.

Ничего пока не УТВЕРЖДАЮ. Но "вдруг"...

P.S. Падения под XE4. На НАШЕМ КОДЕ (прямо скажем непростом) - зафиксированы ДОКУМЕНТАЛЬНО. В логах тестов. К сожалению - пока БЕЗ стека. Может быть - это и СУГУБО наши (тогда уж - МОИ) проблемы. Но странно мне как-то. Что под XE3 - не вылезло. Не найду "хвостов" - буду тщательнее под XE3 гонять. Может какие мысли появятся.

Коллега сегодня разбирался с нашими непроходящими тестами под XE4

Коллега сегодня разбирался с нашими непроходящими тестами под XE4. Которые ПРОХОДЯТ (стабильно !!! и "МНОГИЕ годы") под Delphi 7. И нашёл ОЧЕНЬ странный баг. Наш. Где мы "заложились" на стратегию работы менеджера памяти. На самом деле сами того не подозревая. Баг был поправлен. Тесты заработали.

Баг на самом деле - очень показательный. Правда - не знаю - с какого конца его бы начать описывать.

В двух словах. "Совсем на пальцах". Брался указатель на объект. И "зачем-то" он считался его уникальным идентификатором. И со сменой стратегии менеджера памяти - ЗНАЧЕНИЕ этого указателя - СТАЛО вести себя ПО-ДРУГОМУ.

Почему? История уходит в глубь времён. "Говнокод" - спросите вы? "Ну наверное" - скажу я. Если бы это был МОЙ код, то я бы так и сказал. Но поскольку код чужой - скажу осторожнее. "Наверное на то были веские причины".

Суть истории пока такова - смена стратегии распределения памяти - может принести "сюрпризы", о которых многие даже не задумываются.

ОЧЕНЬ хотелось бы описать - суть РЕАЛЬНОЙ проблемы, но я пока думаю - как это правильнее сделать.

P.S. Под XE3 такое кстати "меньше" проявляется. Но это правда пока ни о чём не говорит.

P.P.S. Я как собака - "понимать - понимаю, а сказать - не могу".

!!! Падает простейший пример под XE4 !!!

http://qc.embarcadero.com/wc/qcmain.aspx?d=116040

Access Violation при запуске:

unit evFormats;

interface

type
  Tl3ClipboardFormat = Cardinal;
  Tl3ClipboardFormats = array of Tl3ClipboardFormat;

var
  evPlainTextFormats : Tl3ClipboardFormats = nil;
  evAllFormats : Tl3ClipboardFormats = nil;

implementation

uses
  Windows
  ;

function l3FormatArray(const anArray: array of Tl3ClipboardFormat): Tl3ClipboardFormats;
  {-}
var
 l_Len   : Integer;
 l_Index : Integer;
begin
 l_Len := Length(anArray);
 SetLength(Result, l_Len); // - вот тут ПАДАЕТ, да и отладчик показывает, что Result - Invalid
(* for l_Index := 0 to Pred(l_Len) do
  Result[l_Index] := anArray[l_Index];*)
end;

var
 cf_EverestBin : Tl3ClipboardFormat = 1;
 cf_EverestTxt : Tl3ClipboardFormat = 1;
 cf_RTF : Tl3ClipboardFormat = 1;
 cf_RTFLite : Tl3ClipboardFormat = 1;

initialization
 evPlainTextFormats := l3FormatArray([cf_UnicodeText, cf_Text, cf_OEMText]);
 evAllFormats := l3FormatArray([cf_EverestBin, cf_EverestTxt,
                                cf_RTF, cf_RTFLite,
                                cf_Bitmap,
                                cf_UnicodeText, cf_Text, cf_OEMText,
                                cf_hDrop]);

finalization
 evPlainTextFormats := nil;
 evAllFormats := nil;

end.


program tstXE4;

uses
  evFormats;

begin
end.

-------------------------------------
Достаточно даже вот так:


unit evFormats;

interface

type
  Tl3ClipboardFormat = Cardinal;
  Tl3ClipboardFormats = array of Tl3ClipboardFormat;

var
  evAllFormats : Tl3ClipboardFormats = nil;

implementation

uses
  Windows
  ;

function l3FormatArray(const anArray: array of Tl3ClipboardFormat): Tl3ClipboardFormats;
  {-}
var
 l_Len   : Integer;
 l_Index : Integer;
begin
 l_Len := Length(anArray);
 SetLength(Result, l_Len);
 for l_Index := 0 to Pred(l_Len) do
  Result[l_Index] := anArray[l_Index];
end;

var
 cf_EverestBin : Tl3ClipboardFormat = 1;
 cf_EverestTxt : Tl3ClipboardFormat = 1;

initialization
 evAllFormats := l3FormatArray([cf_EverestBin, cf_EverestTxt,
                                cf_UnicodeText, cf_Text, cf_OEMText,
                                cf_hDrop]);

finalization
 evAllFormats := nil;

end.

------------------------------------
!!!!

cf_EverestBin, cf_EverestTxt

заменяем на 1, 1

и - ВСЁ хорошо

по памяти ездят, когда "открытый массив" конструируют

Портят Result в l3FormatArray
---------
Даже вот так не падает:

 evAllFormats := l3FormatArray([cf_EverestBin, cf_EverestTxt,
                                cf_UnicodeText, cf_Text, cf_OEMText]);

P.S. мне кажется, что если были бы тесты - они бы это показали бы. Не такая уж редкая ситуация. Дарю Embarcadero - "первый тест". И в свою базу тестов это внесу.

P.P.S. Пока Embarcadero не поправит ошибку - буду окучивать XE3. Так что про XE4 видимо пока ничего не расскажу.

Чудесный ужас (или - все допускают ошибки)...

Нет. Я конечно очень уважаю "Остап Ибрагимыча" (разработчиков Borland'а). И это не пустые слова. Мне до их уровня - ещё расти и расти. Но у меня в голове всё никак не укладывается вот это:

  TControlActionLink = class(TActionLink)
  protected
    FClient: TControl;

...

  TWinControlActionLink = class(TControlActionLink)
  protected
    FClient: TWinControl;

....

- может быть я чего не понимаю или "не так воспитан".

По мне - одноимённые protected поля в соседних классах - это не комильфо. Особенно если они выполняют ОЧЕНЬ СХОДНЫЕ функции. Куда лучше было бы хотя бы назвать одно поле FClientControl, а другое - FClientWinControl. На мой вкус. Не говоря уж о ненужном дублировании данных.  Всегда вообще-то можно приведение типов написать. И проверку в момент присвоения (AssignClient). Не говоря уж о то, что эта ссылка - НИГДЕ не чистится. А тут имеем БОЛЬШИЕ проблемы с Detsroy. Я правда пока ещё не нащупал - какие именно. Нащупаю - обязательно напишу.

Но по мне этот код и производные от него - "дурно пахнут". Простите уж.

Я думал - хоть под XE это переделали... Ничего подобного :-(

(+)

  TToolbarButton97ActionLink = class(TControlActionLink)
  protected
    FClient: TCustomToolbarButton97;

- получается, что Borland "задал дурной тон", а другие его - банально подхватили. Без критической оценки.

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

Update. И беда как раз не в том, что "Borland сделал криво", в конце-концов - у них "всего пара классов", а в том, что сотни разработчиков эту кривизну подхватили. Ну или я чего-то недопонимаю.

Хотя не перестаю уважать разработчиков Delphi. Хорошее дело делают.

P.S. К коду FireMonkey - у меня тоже есть ряд претензий. Я их позже озвучу. Когда глубже вникну в проблему. Ну или напишу, что их нет, если пойму, что это так или убежу себя в том, что их нет.

P.P.S. Я объяснил свою позицию вроде. Буду рад, если кто-то объяснит её ошибочность.

P.P.P.S. Тут кстати явно в языке бы добавить "шаблонную типизацию с наследованием". Как-то так:

  TControlActionLink = class(TActionLink)
  template type TClientType = TControl;
  protected
    FClient: <TClientType>;
  private
    procedure AssignClient(aClient : <TClientType>);

...

  TWinControlActionLink = class(TControlActionLink)
  override template type TClientType = TWinControl;

....

С контролем всего этого хозяйства компилятором. У меня кстати подобное есть. В скриптовой машине. Правда там не статически, а в run-time это проверяется. Ну хотя бы в run-time - сейчас-то ведь не лучше. Сейчас по сути в run-time и происходит.

А ещё я бы TActionLink - сделал бы вложенным классом. Тоже с "шаблонной типизацией с наследованием". И различал бы abstract class и не abstract class. И требовал бы типизацию для неабстракных классов.

TControl = class(TCompenent)
 template type TControlActionLink = class(TActionLink)
  template type TClientType = TControl;
  protected
    FClient: <TClientType>;
  private
    procedure AssignClient(aClient : <TClientType>);
 ...
 end;
 ...
end;
 
 
TWinControl = class(TControl)
 reimplement template type TControlActionLink = class(TControl.TControlActionLink)
  override template type TClientType = TWinControl;
 end;
...
end;

-- как-то так. Сродни примесям где-то. Это можно кстати сделать через введение "скрытых виртуальных функций". То есть на уровне "препроцессора".

Ввести
function TClientType_Class: TControl; virtual;

Определять её в КАЖДОМ классе, где переопределён TClientType:

class function TControl.TControlActionLink.TClientType_Class: class of TControl; virtual;
begin
 Result := TControl;
end;
 
class function TWinControl.TControlActionLink.TClientType_Class: class of TControl; override;
begin
 Result := TWinControl;
end;
 
class function TControl.TControlActionLink_Class: class of TControl.TControlActionLink; virtual;
begin
 Result := TControl.TControlActionLink;
end;
 
class function TWinControl.TControlActionLink_Class: class of TControl.TControlActionLink; override;
begin
 Result := TWinControl.TControlActionLink;
end;

Вместо:
 FClient := aValue;
компилировать:
 FClient := aValue As TClientType_Class;

Вместо:
 FActionLink := TControlActionLink.Create(Self);
компилировать:
 FActionLink := ControlActionLink_Class.Create(Self);

Ну как-то так. Ну и по рекурсии конечно.

Ну и при статическом обращению к полю FClient и FActionLink - раскрывать их тип в зависимости уже от контекста. Для TControl подставлять одно, для TWinControl - другое. Всё кстати - срастается.


СЛОЖНО - да. Но не невозможно. У себя в скриптах - я пожалуй такое сделаю. Не вижу там препятствий.

Это конечно тоже - "Чудесный ужас". Но из другой оперы. Разрыв шаблонов.

В шаблонах кодогенерации я кстати уже сделал подобное. В шаблонах VCM (не путать с MVC, хотя это из той же оперы, только View->Controller->Model(->Data)). А я то и смотрю, что что-то - знакомое. Когда я до конца это расписал. Привести пример с картинками и кодом?

P.P.P.S. Подозреваю, что всё, что я описал - в каком-нибудь "экзотическом" языке программирования - УЖЕ есть. Мне вообще - пока не удалось - что-нибудь РЕАЛЬНО новое придумать.

А ещё есть модуль с DockTree в котором поправлены утечки и проезды по памяти

Живёт тут - https://www.box.com/s/p97j0zo8y3zw8puruo2k
Или тут - https://sourceforge.net/p/rumtmarc/code-0/HEAD/tree/trunk/l3DockTree.pas

Если у кого-то не скомпилируется, но заинтересует - буду рад ответить на вопросы.

Проблемы с докингом в VCL

destructor TControl.Destroy;
begin
  Application.ControlDestroyed(Self);
  if (FHostDockSite <> nil) 
      and not (csDestroying in FHostDockSite.ComponentState) // - это я добавил
  then
  begin
    FHostDockSite.Perform(CM_UNDOCKCLIENT, 0, Integer(Self));
    SetParent(nil);
    Dock(NullDockSite, BoundsRect);
    FHostDockSite := nil;
  end else
    SetParent(nil);

...

end;

Без этого падало на Delphi 7 и продолжает падать на Delphi XE3. Если просто сделать конструкцию из нескольких панелей и вдоченных форм. А потом попытаться одну из вдоченных форм убить. Честными средствами.

Это тоже был долгий разбор лет 10-ть назад. Примеры повторения - есть. Но рафинированный - пока не выделил.

Но опять же - никакого "хоккея" - там не было. Просто чистое использование VCL.

Проезд по памяти в VCL

procedure TControlCanvas.CreateHandle;
...
 
  if FControl = nil then
    inherited CreateHandle
  else
  begin
    // Creation of a window could trigger messages that require
    // the canvas to have a valid handle. Prevents creating two DCs.
    if (FDeviceContext = 0) and (FControl is TWinControl) then
      TWinControl(FControl).HandleNeeded;
    if FDeviceContext = 0 then
    begin
      with CanvasList.LockList do
      try
        if Count >= CanvasListCacheSize then FreeDeviceContext;
        FDeviceContext := FControl.GetDeviceContext(FWindowHandle);
        if (IndexOf(Self) < 0) then {V} // - это я добавил
         Add(Self);
      finally
        CanvasList.UnlockList;
      end;
    end;
    Handle := FDeviceContext;
    UpdateTextFlags;
  end;
...
end;

Без этого падает тут:

// Free the first available device context
procedure FreeDeviceContext;
var
  I: Integer;
begin
  with CanvasList.LockList do
  try
    for I := 0 to Count-1 do
      with TControlCanvas(Items[I]) do
        if TryLock then
        try
          FreeHandle; // - тут
          Exit;
        finally
          Unlock;
        end;
  finally
    CanvasList.UnlockList;
  end;
end;

Или тут:

procedure FreeDeviceContexts;
var
  I: Integer;
begin
  with CanvasList.LockList do
  try
    for I := Count-1 downto 0 do
      with TControlCanvas(Items[I]) do
        if TryLock then
        try
          FreeHandle; // - тут
        finally
          Unlock;
        end;
  finally
    CanvasList.UnlockList;
  end;
end;

Как повезёт.

Что в общем-то и понятно - одна канва может несколько раз попасть в CanvasList.

Сейчас попробую найти рафинированный сценарий повторения ошибки.

Поправил я эту ошибку 18 апреля 2002 года. 11-ть лет назад. Я тогда искал её ДВЕ НЕДЕЛИ. Выпуск даже затягивался. Весь мозг себе сломал. В Delphi XE3 - она до сих пор присутствует.

Вот в частности для этого и нужны автоматические тесты. Чтобы за повторяемостью таких непростых ошибок следить.

Сегодня эту ошибку под XE3 показали именно - автоматические тесты.