Показаны сообщения с ярлыком MixIn. Показать все сообщения
Показаны сообщения с ярлыком MixIn. Показать все сообщения

пятница, 12 июля 2013 г.

Обобщаем тесты списков

Предыдущая серия была тут - http://18delphi.blogspot.com/2013/07/blog-post_8789.html

Теперь обобщим приведённые там тесты.

Как обычно.

Модель:

Тут добавился "примесный тест" - ListTest, а все остальные тесты от него - наследуются и определяют тип конкретного списка, который надо тестировать. Этот тест нам сильно пригодится, когда мы будем расширять функциональность контейнеров. Вместе с функциональностью абстрактных контейнеров будем расширять и функциональность примесного теста. Таким образом - КОНКРЕТНЫЕ тесты - "сами" будут расширяться.

Код:

ListTest.imp.pas:
{$IfNDef ListTest_imp}

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// Библиотека "SandBoxTest"
// Модуль: "ListTest.imp.pas"
// Родные Delphi интерфейсы (.pas)
// Generated from UML model, root element: TestCaseMixIn::Class Shared Delphi Sand Box::SandBoxTest::FinalContainersTests::ListTest
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

{$Define ListTest_imp}
{$If defined(nsTest)}
 _ListTest_ = class(TTestCase)
 published
 // published methods
   procedure DoIt;
   procedure TestTwoLists;
 end;//_ListTest_
{$IfEnd} //nsTest

{$Else ListTest_imp}

{$If defined(nsTest)}

// start class _ListTest_

procedure _ListTest_.DoIt;
//#UC START# *51DEB319037C_51E03FC80111_var*
const
 cCount = 1000;
var
 l_List : _ListType_;
 l_Count : IndexType;
 l_Index : IndexType;
//#UC END# *51DEB319037C_51E03FC80111_var*
begin
//#UC START# *51DEB319037C_51E03FC80111_impl*
 l_List := _ListType_.Create;
 try
  l_List.Count := cCount;
  Check(l_List.Count = cCount);
  Check(l_List.Capacity >= cCount);

  for l_Index := 0 to l_List.Count - 1 do
   Check(l_List[l_Index] = 0);

  l_Count := Random(cCount);
  l_List.Count := l_Count;
  Check(l_List.Count = l_Count, Format('Выделяли %d элементов. Count = %d', [l_Count, l_List.Count]));
  Check(l_List.Capacity >= l_Count, Format('Выделяли %d элементов. Capacity = %d', [l_Count, l_List.Capacity]));

  for l_Index := 0 to l_List.Count - 1 do
   Check(l_List[l_Index] = 0);
   
 finally
  FreeAndNil(l_List);
 end;//try..finally
//#UC END# *51DEB319037C_51E03FC80111_impl*
end;//_ListTest_.DoIt

procedure _ListTest_.TestTwoLists;
//#UC START# *51DED6FC03C1_51E03FC80111_var*
const
 cCount = 1000;
var
 l_A : _ListType_;
 l_B : _ListType_;
 l_Index : IndexType;
 l_Value : _ItemType_;
 l_Max   : _ItemType_;
//#UC END# *51DED6FC03C1_51E03FC80111_var*
begin
//#UC START# *51DED6FC03C1_51E03FC80111_impl*
 l_A := _ListType_.Create;
 try
  l_B := _ListType_.Create;
  try
   l_A.Count := cCount;
   for l_Index := 0 to l_A.Count - 1 do
   begin
    l_Value := Random(1000);
    l_A[l_Index] := l_Value;
    Check(l_A[l_Index] = l_Value);
   end;//for l_Index

   l_B.Count := l_A.Count;
   for l_Index := 0 to l_A.Count - 1 do
   begin
    l_B[l_Index] := l_A[l_Index];
   end;//for l_Index

   for l_Index := 0 to l_A.Count - 1 do
   begin
    Check(l_B[l_Index] = l_A[l_Index]);
   end;//for l_Index
  finally
   FreeAndNil(l_B);
  end;//try..finally
 finally
  FreeAndNil(l_A);
 end;//try..finally
//#UC END# *51DED6FC03C1_51E03FC80111_impl*
end;//_ListTest_.TestTwoLists

{$IfEnd} //nsTest

{$EndIf ListTest_imp}

IntegerListTest.pas:
unit IntegerListTest;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// Библиотека "SandBoxTest"
// Модуль: "IntegerListTest.pas"
// Родные Delphi интерфейсы (.pas)
// Generated from UML model, root element: TestCase::Class Shared Delphi Sand Box::SandBoxTest::FinalContainersTests::IntegerListTest
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

{$Include .\sbtDefine.inc}

interface

{$If defined(nsTest)}
uses
  TestFrameWork,
  IntegerList
  ;
{$IfEnd} //nsTest

{$If defined(nsTest)}
type
 _ListType_ = TIntegerList;
 {$Include .\ListTest.imp.pas}
 TIntegerListTest = class(_ListTest_)
 end;//TIntegerListTest
{$IfEnd} //nsTest

implementation

{$If defined(nsTest)}
uses
  SysUtils
  ;
{$IfEnd} //nsTest

{$If defined(nsTest)}

type _Instance_R_ = TIntegerListTest;
type _ListTest_R_ = TIntegerListTest;

{$Include .\ListTest.imp.pas}


{$IfEnd} //nsTest

initialization
 TestFramework.RegisterTest(TIntegerListTest.Suite);
end.

ByteListTest.pas:
unit ByteList;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// Библиотека "SandBox"
// Модуль: "ByteList.pas"
// Родные Delphi интерфейсы (.pas)
// Generated from UML model, root element: SimpleClass::Class Shared Delphi Sand Box::SandBox::FinalContainers::TByteList
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

{$Include .\sbDefine.inc}

interface

uses
  Refcounted,
  Classes,
  l3PtrLoc
  ;

type
 _ItemType_ = Byte;
 _AtomicList_Parent_ = TRefcounted;
 {$Include .\AtomicList.imp.pas}
 TByteList = class(_AtomicList_)
 end;//TByteList

implementation

uses
  RTLConsts,
  l3MemorySizeUtils
  ;

type _Instance_R_ = TByteList;
type _AtomicList_R_ = TByteList;

{$Include .\AtomicList.imp.pas}

end.

Int64ListTest.pas:
unit Int64ListTest;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// Библиотека "SandBoxTest"
// Модуль: "Int64ListTest.pas"
// Родные Delphi интерфейсы (.pas)
// Generated from UML model, root element: TestCase::Class Shared Delphi Sand Box::SandBoxTest::FinalContainersTests::Int64ListTest
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

{$Include .\sbtDefine.inc}

interface

{$If defined(nsTest)}
uses
  TestFrameWork,
  Int64List
  ;
{$IfEnd} //nsTest

{$If defined(nsTest)}
type
 _ListType_ = TInt64List;
 {$Include .\ListTest.imp.pas}
 TInt64ListTest = class(_ListTest_)
 end;//TInt64ListTest
{$IfEnd} //nsTest

implementation

{$If defined(nsTest)}
uses
  SysUtils
  ;
{$IfEnd} //nsTest

{$If defined(nsTest)}

type _Instance_R_ = TInt64ListTest;
type _ListTest_R_ = TInt64ListTest;

{$Include .\ListTest.imp.pas}


{$IfEnd} //nsTest

initialization
 TestFramework.RegisterTest(TInt64ListTest.Suite);
end.

Код тут - http://sourceforge.net/p/rumtmarc/code-0/19/tree/trunk/Blogger/SandBox и http://sourceforge.net/p/rumtmarc/code-0/19/tree/trunk/Blogger/SandBoxTest

пятница, 17 мая 2013 г.

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

Нет. Я конечно очень уважаю "Остап Ибрагимыча" (разработчиков 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. Подозреваю, что всё, что я описал - в каком-нибудь "экзотическом" языке программирования - УЖЕ есть. Мне вообще - пока не удалось - что-нибудь РЕАЛЬНО новое придумать.

суббота, 11 мая 2013 г.

Реализация Singleton'а на примеси

Пусть у нас есть класс. Реализующий какую-то функциональность.

И вдруг встаёт задача сделать из этого класса Singleton.

Как будем поступать? Делать наследника с глобальной переменной, классовым методом Instance и секцией finalization?

Идея - неплохая, но:

1. Секции finalization зовутся в негарантированном порядке и Singleton может убиться РАНЬШЕ, чем кто-то другой его использует, а мы узнаем об этом только по AV на выходе, или вообще не узнаем - если Singleton написан так, что создастся второй раз (тут бы подумать о чём-то типа AddExitProc).
2. Все подобные наследники будут запрограммированы методом Copy'n'Paste. Некрасиво по-моему.
3. Singleton по-моему должен "переживать" нормально многопоточность. Для этого кроме глобальной переменной - нам понадобится ещё и критическая секция. Будем размножать код по работе с критическими секциями во всех наследниках? По-моему - тоже не комильфо.

Давайте сделаем реализацию Singleton'а примесью?

Тут кстати есть о чём поразмыслить. Хотя бы о том же AddExitProc и гарантии повторного несоздания синглетона при завершении приложения. Или о методе Exists. Ведь нередки случаи (по крайней мере в моей практике), когда Singleton и не надо создавать, а надо лишь проверить его существование. Тут правда с многопоточностью есть проблемы.

Причём ещё сразу хочется отметить тот факт, что синглетоны бывают "объектные", а бывают "интерфейсные". Со вторыми - несколько сложнее. Посему начнём рассмотрение с первых.

... to be continued ...

Реализация IStream примесью

Пусть у нас есть поток (наследник от TStream). Кем-то уже написанный. Ну из стандартных библиотек например.

И пусть у нас вдруг встаёт задача передать этот поток в виде IStream.

Как это сделать? Использовать TStreamAdapter? Или делать наследника реализующего IStream?

Адаптер конечно - можно. Но... Лишний объект. И всё такое.

Потомка - неплохо конечно. Но... А если IStream надо реализовать на НЕСКОЛЬКИХ стандартных классах? Будем заниматься Copy'n'Paste? А потом синхронизировать код?

Давайте я расскажу вам как реализовать IStream на примесях.

Давайте?

... to be continued ...

четверг, 25 апреля 2013 г.

Один знакомый сделал на примесях юникодные контролы для Delphi 7

Один знакомый сделал на примесях юникодные контролы для Delphi 7. Хорошо сделал. Это кстати повод просить его опубликовать статью об этом. Хотя бы коротенькую. С диаграммами :-) Повод?

P.S. Это кстати круче, нагляднее и короче, чем "Примеси и контролы с непрямоугольными краями", который я обещал, но пока не выложил - http://18delphi.blogspot.com/2013/03/blog-post_8379.html

воскресенье, 21 апреля 2013 г.

BeforeRelease

Для того, чтобы избежать проблемы описанной тут - http://www.gunsmoker.ru/2013/04/plugins-9.html ("Двойное освобождение интерфейсов") - вводится виртуальный метод BeforeRelease.

Вот тут:

destructor _RefCountedPrim_.Destroy;
begin
  if (InterlockedDecrement(f_RefCount) = 0) then
  begin
   Inc(f_RefCount);
   try
    try
     BeforeRelease;
     Cleanup;
    finally
     inherited Destroy;
    end;//try..finally
   finally
    Dec(f_RefCount);
   end;{try..finally}
  end;//InterlockedDecrement(f_RefCount) = 0
end;//_RefCountedPrim_.Destroy


Его перекрываем в наследниках и делаем там всю "сохраняющую работу". И ГЛАВНОЕ - в этот момент объект находится ещё в СТАБИЛЬНОМ состоянии. Со всеми ЖИВЫМИ данными.

Позже я постараюсь привести более развёрнутый пример с тестами.

А предыдущая серия была тут - http://18delphi.blogspot.com/2013/04/iunknown.html

Про AfterRelease надо видимо отдельно написать.

среда, 17 апреля 2013 г.

Собственная реализация IUnknown и подсчёт ссылок. И примеси

У Борланда (теперь Embarcadero) конечно есть реализация IUnknown. TInterfacedObject называется.

Она неплоха.

Но она меня лично не устраивает своей несимметричностью. Если уж создал интерфейс, то и работай через интерфейс, а про объект - "будь любезен забудь". И в контейнеры клади как интерфейс. И дальше передавай как интерфейс. А интерфейс по сравнению с объектом - это лишние накладные расходы. На ту же лишнюю косвенность вызова методов (ну примерно как virtual) и на лишние AddRef/Release при присвоении локальным переменным. Тем более, что есть ещё тот факт, что у объекта бывают одни публичные методы, а у интерфейса - другие. И это - правильно. Публичность методов может зависеть от полномочий пользователя объектом (но это кстати тоже тема для отдельного поста, gunsmoker кстати этой темы немного касался - вот тут - http://www.gunsmoker.ru/2013/02/delphi-friendliness.html , ну если я конечно правильно его понял, а не интерпретировал его мысли так как мне хочется).

Меня это не устраивает в моих повседневных задачах. Тем более, что если уж рассматривать "в исторической перспективе" - моя реализация подсчёта ссылок появилась ещё в Delphi 1. ДО вообще введения понятия интерфейсов. Я и интерфейсы то - "эмулировал" путём хака VMT и использования message (gunsmoker по-моему про подобную технику - тоже пишет).

История появления моего собственного подсчёта ссылок - заслуживает отдельного поста. Пока кратко - редактор и Undo/Redo. Где у объектов нет ЦЕНТРАЛИЗОВАННОГО "папы" (Owner/Parent). Все объекты - равнозначно могут держать ссылку на другие объекты. И им ГАРАНТИРУЕТСЯ тот факт, что пока они корректным образом держат ссылку - объекты на которые они ссылаются - "живые".

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

Предыдущие серии были тут:
http://18delphi.blogspot.com/2013/03/blog-post_4606.html
http://18delphi.blogspot.com/2013/03/generic-generic.html

Теперь давайте на основе этих знаний сконструируем объект, реализующий IUnknown.

Нарисуем пару диаграмм:


- это собственно "примесная" реализация IUnknown.

А вот - конкретная реализация (унаследованная от TObject):
Код всего этого хозяйства такой:
RefCountedPrim.imp.pas:

{$IfNDef RefCountedPrim_imp}
 
//
// Библиотека "L3$Basic Concepts"
// Generated from UML model, root element: <<Impurity::Class>> Shared Delphi Требования к низкоуровневым библиотекам::L3$Basic Concepts::Ref Counting::RefCountedPrim
//
 
{$Define RefCountedPrim_imp}
 _RefCountedPrim_ = {mixin} class(_RefCountedPrim_Parent_)
 private
 // private fields
   f_RefCount : Integer;
    {* Поле для свойства RefCount}
 protected
 // overridden protected methods
   procedure FreeInstance; override;
 public
 // overridden public methods
   destructor Destroy; override;
   class function NewInstance: TObject; override;
 protected
 // protected methods
   procedure Cleanup; virtual;
     {* Функция очистки полей объекта. }
 public
 // public methods
   function Use: Pointer;
     {* увеличить счетчик ссылок на 1 и вернуть указатель на себя. }
   function SetRefTo(var F): Boolean;
 public
 // public properties
   property RefCount: Integer
     read f_RefCount;
 end;//_RefCountedPrim_
 
{$Else RefCountedPrim_imp}
 
// start class _RefCountedPrim_
 
procedure _RefCountedPrim_.Cleanup;
begin
end;//_RefCountedPrim_.Cleanup
 
function _RefCountedPrim_.Use: Pointer;
begin
 if (Self <> nil) then
  InterlockedIncrement(f_RefCount);
 Result := Self;
end;//_RefCountedPrim_.Use
 
function _RefCountedPrim_.SetRefTo(var F): Boolean;
begin
 if (Pointer(F) = Self) then
  Result := false
 else
 begin
  Result := true;
  TObject(F).Free;
  Pointer(F) := Self.Use;
 end;//Pointer(F) = V
end;//_RefCountedPrim_.SetRefTo
 
destructor _RefCountedPrim_.Destroy;
begin
  if (InterlockedDecrement(f_RefCount) = 0) then
  begin
   Inc(f_RefCount);
   try
    try
     Cleanup;
    finally
     inherited Destroy;
    end;//try..finally
   finally
    Dec(f_RefCount);
   end;{try..finally}
  end;//InterlockedDecrement(f_RefCount) = 0
end;//_RefCountedPrim_.Destroy
 
class function _RefCountedPrim_.NewInstance: TObject;
begin
 Result := inherited NewInstance;
 _RefCounted_(Result).Use;
end;//_RefCountedPrim_.NewInstance
 
procedure _RefCountedPrim_.FreeInstance;
begin
 if (f_RefCount = 0) then
  inherited FreeInstance;
end;//_RefCountedPrim_.FreeInstance
 
{$EndIf RefCountedPrim_imp}



-------------------------------
RefCounted.imp.pas:


{$IfNDef RefCounted_imp}
 
// Библиотека "L3$Basic Concepts"
// Generated from UML model, root element: <<Impurity::Class>> Shared Delphi Требования к низкоуровневым библиотекам::L3$Basic Concepts::Ref Counting::RefCounted
//
// В этом классе собираем методы, которые запрещено перекрывать и вызывать напрямую
//
 
{$Define RefCounted_imp}
 _RefCountedPrim_Parent_ = _RefCounted_Parent_;
 {$Include RefCountedPrim.imp.pas}
 _RefCounted_ = {mixin} class(_RefCountedPrim_)
  {* В этом классе собираем методы, которые запрещено перекрывать и вызывать напрямую }
 public
 // public methods
   destructor Destroy;
     {* Это чтобы не было соблазна перекрывать destroy. }
   class function NewInstance: TObject;
   procedure FreeInstance;
   procedure AfterConstruction;
   procedure BeforeDestruction;
 end;//_RefCounted_
 
{$Else RefCounted_imp}
 
{$Include RefCountedPrim.imp.pas}
 
// start class _RefCounted_
 
destructor _RefCounted_.Destroy;
begin
 assert(false, 'По идее мы попасть сюда не должны');
 inherited;
end;//_RefCounted_.Destroy
 
class function _RefCounted_.NewInstance: TObject;
begin
 Result := nil;
 assert(false);
end;//_RefCounted_.NewInstance
 
procedure _RefCounted_.FreeInstance;
begin
 assert(false);
end;//_RefCounted_.FreeInstance
 
procedure _RefCounted_.AfterConstruction;
begin
 assert(false);
end;//_RefCounted_.AfterConstruction
 
procedure _RefCounted_.BeforeDestruction;
begin
 assert(false);
end;//_RefCounted_.BeforeDestruction
 
{$EndIf RefCounted_imp}

-------------------------------------------------
UnknownImpl.imp.pas:


{$IfNDef UnknownImpl_imp}
 
// Библиотека "L3$Basic Concepts"
// Generated from UML model, root element: <<Impurity::Class>> Shared Delphi Требования к низкоуровневым библиотекам::L3$Basic Concepts::Ref Counting::UnknownImpl
//
 
{$Define UnknownImpl_imp}
 _RefCounted_Parent_ = _UnknownImpl_Parent_;
 {$Include RefCounted.imp.pas}
 _UnknownImpl_ = {mixin} class(_RefCounted_)
 public
 // realized methods
   function _AddRef: Integer; stdcall;
     {* Увеличивает счетчик ссылок. }
   function _Release: Integer; stdcall;
     {* Уменьшает счетчик ссылок. }
   function QueryInterface(const IID: TGUID;
    out Obj): HResult; stdcall;
     {* Приводит базовый интерфейс к запрашиваемому, если это возможно. }
 end;//_UnknownImpl_
 
{$Else UnknownImpl_imp}
 
{$Include RefCounted.imp.pas}
 
// start class _UnknownImpl_
 
function _UnknownImpl_._AddRef: Integer;
begin
 Use;
 Result := RefCount;
 // - тут есть проблемы с многопоточностью
end;//_UnknownImpl_._AddRef
 
function _UnknownImpl_._Release: Integer;
var
 l_RC : Integer;
begin
 l_RC := RefCount - 1;
 Free;
 Result := l_RC;
 // - тут есть проблемы с многопоточностью
end;//_UnknownImpl_._Release
 
function _UnknownImpl_.QueryInterface(const IID: TGUID;
  out Obj): HResult;
begin
 if TObject(Self).GetInterface(IID, Obj) then
  Result := S_Ok
 else
  Result := E_NoInterface;
end;//_UnknownImpl_.QueryInterface
 
{$EndIf UnknownImpl_imp}
---------------------------------
Unknown.imp.pas:


{$IfNDef Unknown_imp}
 
// Библиотека "L3$Basic Concepts"
// Generated from UML model, root element: <<Impurity::Class>> Shared Delphi Требования к низкоуровневым библиотекам::L3$Basic Concepts::Ref Counting::Unknown
//
 
{$Define Unknown_imp}
 _UnknownImpl_Parent_ = _Unknown_Parent_;
 {$Include UnknownImpl.imp.pas}
 _Unknown_ = {mixin} class(_UnknownImpl_, IUnknown)
 end;//_Unknown_
 
{$Else Unknown_imp}
 
{$Include UnknownImpl.imp.pas}
 
 
{$EndIf Unknown_imp}
---------------------------------
myInterfacedObject.pas:


 
unit myInterfacedObject;
 
// Библиотека "SandBox"
// Generated from UML model, root element: <<SimpleClass::Class>> Shared Delphi Sand Box::SandBox::Basic Interfaces::TmyInterfacedObject
//
interface
 
type
 _Unknown_Parent_ = TObject;
 {$Include Unknown.imp.pas}
 TmyInterfacedObject = class(_Unknown_)
 end;//TmyInterfacedObject
 
implementation
 
uses
  Windows
  ;
 
{$Include Unknown.imp.pas}
 
end.

Теперь диаграмма теста этого хозяйства:
И код теста:
unit myInterfacedObjectTest;
 
// Библиотека "SandBoxTest"
// Generated from UML model, root element: <<TestCase::Class>> Shared Delphi Sand Box::SandBoxTest::Core::TmyInterfacedObjectTest
//
//
 
interface
 
uses
  TestFrameWork
  ;
 
type
 TmyInterfacedObjectTest = class(TTestCase)
 published
 // published methods
   procedure DoIt;
 end;//TmyInterfacedObjectTest
 
implementation
 
uses
  myInterfacedObject,
  SysUtils
  ;
 
// start class TmyInterfacedObjectTest
 
procedure TmyInterfacedObjectTest.DoIt;
var
 l_O : TmyInterfacedObject;
 l_AnotherRef : TmyInterfacedObject;
 l_A : IUnknown;
 l_B : IUnknown;
begin
 l_AnotherRef := nil;
 try
  l_O := TmyInterfacedObject.Create;
  try
   Check(l_O.RefCount = 1);
   l_A := l_O;
   Check(l_O.RefCount = 2);
   l_A := nil;
   Check(l_O.RefCount = 1);
   l_AnotherRef := l_O.Use;
   Check(l_O.RefCount = 2);
   l_B := l_O;
   Check(l_O.RefCount = 3);
  finally
   FreeAndNil(l_O);
  end;//try..finally
  Check(l_AnotherRef.RefCount = 2);
  l_B := nil;
  Check(l_AnotherRef.RefCount = 1);
 finally
  FreeAndNil(l_AnotherRef);
 end;//try..finally
end;//TmyInterfacedObjectTest.DoIt
 
initialization
 TestFramework.RegisterTest(TmyInterfacedObjectTest.Suite);
 
end.


-- надеюсь, что "симметрия" подсчёта ссылок - понятна.

Движемся дальше.

Реализуем теперь объект, реализующий "реальный" интерфейс.

Нарисуем пару диаграмм:
-- диаграмма классов

-- диаграмма реализации.

И код:
myReferenceCountGuard.pas:

unit myReferenceCountGuard;
 
// Библиотека "SandBox"
// Generated from UML model, root element: <<SimpleClass::Class>> Shared Delphi Sand Box::SandBox::Basic Interfaces::TmyReferenceCountGuard
//
// Класс исключительно для примеров
//
 
interface
 
uses
  myInterfacedObject
  ;
 
type
 ImyReferenceCountGuard = interface(IUnknown)
  {* Интерфейс исключительно для примеров }
   ['{84AAAF31-F3AC-4BBC-A1B7-4E338748921F}']
   function GetRefCount: Integer;
 end;//ImyReferenceCountGuard
 
 TmyReferenceCountGuard = class(TmyInterfacedObject, ImyReferenceCountGuard)
  {* Класс исключительно для примеров }
 protected
 // realized methods
   function GetRefCount: Integer;
 public
 // public methods
   class function Make: ImyReferenceCountGuard; reintroduce;
     {* Фабрика TmyReferenceCountGuard.Make }
 end;//TmyReferenceCountGuard
 
implementation
 
// start class TmyReferenceCountGuard
 
class function TmyReferenceCountGuard.Make: ImyReferenceCountGuard;
var
 l_Inst : TmyReferenceCountGuard;
begin
 l_Inst := Create;
 try
  Result := l_Inst;
 finally
  l_Inst.Free;
 end;//try..finally
end;
 
function TmyReferenceCountGuard.GetRefCount: Integer;
begin
 Result := RefCount;
end;//TmyReferenceCountGuard.GetRefCount
 
end.



И тест к этому хозяйству:
И код:
myReferenceCountGuardTest.pas:

unit myReferenceCountGuardTest;
 
// Библиотека "SandBoxTest"
// Generated from UML model, root element: <<TestCase::Class>> Shared Delphi Sand Box::SandBoxTest::Core::TmyReferenceCountGuardTest
//
 
interface
 
uses
  TestFrameWork
  ;
 
type
 TmyReferenceCountGuardTest = class(TTestCase)
 published
 // published methods
   procedure DoIt;
   procedure CheckWithClause;
 end;//TmyReferenceCountGuardTest
 
implementation
 
uses
  SysUtils,
  myReferenceCountGuard
  ;
 
// start class TmyReferenceCountGuardTest
 
procedure TmyReferenceCountGuardTest.DoIt;
var
 l_G : ImyReferenceCountGuard;
 l_Another : ImyReferenceCountGuard;
begin
 l_G := TmyReferenceCountGuard.Make;
 Check(l_G.GetRefCount = 1);
 l_Another := l_G;
 Check(l_G.GetRefCount = 2);
 l_G := nil;
 Check(l_Another.GetRefCount = 1);
 l_Another := nil;
end;//TmyReferenceCountGuardTest.DoIt
 
procedure TmyReferenceCountGuardTest.CheckWithClause;
var
 l_G : ImyReferenceCountGuard;
begin
 // - тут я хотел показать, что внутри оператора with компилятор "паразитно" взводит счётчик ссылок на интерфейсе/объекте, но у меня этого не получилось, оказывается, что в тривиальных случаях он этого не делает, найду нетривиальный случай - покажу
 l_G := TmyReferenceCountGuard.Make;
 Check(l_G.GetRefCount = 1);
 with l_G do
 begin
  Check(GetRefCount = 1);
  Check(GetRefCount = 1);
 end;//with l_G
 Check(l_G.GetRefCount = 1);
end;//TmyReferenceCountGuardTest.CheckWithClause
 
initialization
 TestFramework.RegisterTest(TmyReferenceCountGuardTest.Suite);
 
end.


-- "вот собственно и всё, что я знаю о креветках"...

Следующей серией будет рассказ о реализации различных контейнеров.

P.S. ??? Понятно, что можно написать:

---------------------------------
myInterfacedPersistentObject.pas:


unit myInterfacedPersistentObject;
 
// Библиотека "SandBox"
// Generated from UML model, root element: <<SimpleClass::Class>> Shared Delphi Sand Box::SandBox::Basic Interfaces::TmyInterfacedPersistentObject
//
interface
 
type
 _Unknown_Parent_ = TPersistent;
 {$Include Unknown.imp.pas}
 TmyInterfacedPersistentObject = class(_Unknown_)
 end;//TmyInterfacedPersistentObject
 
implementation
 
uses
  Windows
  ;
 
{$Include Unknown.imp.pas}
 
end.

-- и получить TmyInterfacedPersistentObject наследующийся от TPersistent ???

С подобным наследованием от TComponent или TControl есть определённые проблемы связанные с RegisterClass. Я их позже - опишу. Но если RegisterClass для подобных классов не вызывается, то ВСЁ ХОРОШО. Можно использовать эту технику. А если вызывается, то я у себя - немного "подхачил" VCL. Позже - расскажу как. Я только одного не понимаю - зачем контроллировать в RegisterClass уникальность имён ClassParent. Я эту проверку отключил и всё работает. Лет десять как уже.

Да! Для TComponent (и его наследников, в частности - TControl) надо применять "условное инстанцирование примеси". Ибо там QueryInterface - УЖЕ - есть и его незачем (да и вредно) определять заново. Позже расскажу как. В двух словах - через IfDef конечно же.

Вообще "частичное примешивание" - это - весёлая тема :-) Когда примешивается не вся примесь, а лишь её часть. Попавшая под нужный IfDef.
------------------------------------
Описанная симметрия подсчёта ссылок позволяет избежать проблемы описанной тут - http://www.gunsmoker.ru/2013/04/plugins-9.html ("Смешивание ручного и автоматического управления временем жизни" и "Двойное освобождение интерфейсов").

четверг, 11 апреля 2013 г.

Примеси и агрегирование с implements

Агрегирование объекта с ключевым словом implements в принципе очень сильно похоже на примеси.

Т.е. агрегирующий объект "примешивает" к себе интерфейс и функционал агрегируемого.

Только там есть проблемы с виртуальным и частичным примешиванием.

А так - похоже.

Пример нужен?

понедельник, 8 апреля 2013 г.

Сабклассинг нативных виндовых контролов и примеси

Собственно включение кода нативных виндовых контролов (сабклассинг) в иерархию компонент того же VCL - и есть пример примесного наследования.

четверг, 4 апреля 2013 г.

Почему я так много внимания уделяю примесям и тестам

Потому, что примеси и АОП - это краеугольный камень МОЕЙ разработки. Я думаю в этих категориях.

Ну а тесты - позволяют поддерживать стабильность разработки не снижая её темпы.

Я планирую описать примеси и тесты и перейти к более сложным вещам. Например UML, кодогенерации и и метапрограммированию.

НО для этого надо понять суть примесей. Ну так как я их понимаю.

воскресенье, 31 марта 2013 г.

Реализация подсчёта ссылок

Уже лет 15-ть думал на тему того - почему Борланд не сделал подсчёт ссылок на уровне базовых классов. А лишь сделал класс-недоразумение - TInterfacedObject.

Я вот - сделал. Давно. И счастливо - пользуюсь.

При этом надо ЧЁТКО разделять для себя - "подсчёт ссылок" и IUnknown. Первое это - КОНЦЕПЦИЯ, второе - ЛИШЬ ОДНА из РЕАЛИЗАЦИЙ этой концепции.

У меня подсчёт ссылок устроен так, что нельзя написать:

List.Add(TItem.Create);


можно лишь написать:

Item := TItem.Create;
// колическтво ссылок рано 1
try
 List.Add(Item);
// количество ссылок равно 2
finally
 FreeAndNil(Item);
// количество ссылок равно 1
end;


- многим это не нравится. Мне же - наоборот. Я люблю симметрию. Кто владеет объектом, тот его и освобождает.

Есть правда и "ходунки" для любителей "краткой записи" и борцов за количество строк. Они подсмотрены у Objective-C:

List.Add(TItem.Create.Autorelease);


Дальше хочется рассказать, о реализации.

Для начала надо понять одну простую вещь. Что при создании/объектов присутствует compiler-magic.

Из кода:

A := TMyClass.Create;


компилируется что-то вроде:

A := TMyClass.NewInstance;
A.Create;


а из кода:

A.Destroy;


компилируется:

A.Destroy;
A.DestroyInstance


Т.е. код конструктора - это всего лишь код инициализации, а код деструктора - код деинициализации.

А память под объект распределяется в NewInstance, а освобождается в DestroyInstance. Это можно почерпнуть из документации, да только кто ж её читает :-)

Диаграммы:

Код:
RefCountedPrim.imp.pas:



{$IfNDef RefCountedPrim_imp}
 
{$Define RefCountedPrim_imp}
 _RefCountedPrim_ = {mixin} class(_RefCountedPrim_Parent_)
 private
 // private fields
   f_RefCount : Integer;
    {* Поле для свойства RefCount}
 protected
 // overridden protected methods
   procedure FreeInstance; override;
 public
 // overridden public methods
   destructor Destroy; override;
   class function NewInstance: TObject; override;
 protected
 // protected methods
   procedure Cleanup; virtual;
     {* Функция очистки полей объекта. }
 public
 // public methods
   function Use: Pointer;
     {* увеличить счетчик ссылок на 1 и вернуть указатель на себя. }
   function SetRefTo(var F): Boolean;
 public
 // public properties
   property RefCount: Integer
     read f_RefCount;
 end;//_RefCountedPrim_
 
{$Else RefCountedPrim_imp}
 
// start class _RefCountedPrim_
 
procedure _RefCountedPrim_.Cleanup;
begin
end;//_RefCountedPrim_.Cleanup
 
function _RefCountedPrim_.Use: Pointer;
begin
 if (Self <> nil) then
  InterlockedIncrement(f_RefCount);
 Result := Self;
end;//_RefCountedPrim_.Use
 
function _RefCountedPrim_.SetRefTo(var F): Boolean;
begin
 if (Pointer(F) = Self) then
  Result := false
 else
 begin
  Result := true;
  TObject(F).Free;
  Pointer(F) := Self.Use;
 end;//Pointer(F) = V
end;//_RefCountedPrim_.SetRefTo
 
destructor _RefCountedPrim_.Destroy;
begin
  if (InterlockedDecrement(f_RefCount) = 0) then
  begin
   Inc(f_RefCount);
   try
    try
     Cleanup;
    finally
     inherited Destroy;
    end;//try..finally
   finally
    Dec(f_RefCount);
   end;{try..finally}
  end;//InterlockedDecrement(f_RefCount) = 0
end;//_RefCountedPrim_.Destroy
 
class function _RefCountedPrim_.NewInstance: TObject;
begin
 Result := inherited NewInstance;
 _RefCounted_(Result).Use;
end;//_RefCountedPrim_.NewInstance
 
procedure _RefCountedPrim_.FreeInstance;
begin
 if (f_RefCount = 0) then
  inherited FreeInstance;
end;//_RefCountedPrim_.FreeInstance
 
{$EndIf RefCountedPrim_imp}


--------------------------------
RefCounted.imp.pas:



{$IfNDef RefCounted_imp}
 
{$Define RefCounted_imp}
 _RefCountedPrim_Parent_ = _RefCounted_Parent_;
 {$Include RefCountedPrim.imp.pas}
 _RefCounted_ = {mixin} class(_RefCountedPrim_)
 protected
 // protected methods
   destructor Destroy;
     {* Это чтобы не было соблазна перекрывать destroy. }
 end;//_RefCounted_
 
{$Else RefCounted_imp}
 
type _RefCountedPrim_R_ = _RefCounted_;
 
{$Include RefCountedPrim.imp.pas}
 
// start class _RefCounted_
 
destructor _RefCounted_.Destroy;
begin
 assert(false, 'По идее мы попасть сюда не должны');
 inherited;
end;//_RefCounted_.Destroy
 
{$EndIf RefCounted_imp}

-------------------------------
Refcounted.pas:


unit Refcounted;
 
interface
 
type
 _RefCounted_Parent_ = TObject;
 {$Include RefCounted.imp.pas}
 TRefcounted = class(_RefCounted_)
 end;//TRefcounted
 
implementation
 
uses
  Windows
  ;
 
{$Include RefCounted.imp.pas}
 
end.

Ну и тест:
RefcountedTest.pas:


unit RefcountedTest;
 
interface
 
uses
  BaseTest
  ;
 
type
 TRefcountedTest = class(TBaseTest)
 published
 // published methods
   procedure DoIt;
 end;//TRefcountedTest
 
implementation
 
uses
  Refcounted,
  SysUtils,
  TestFrameWork
  ;
 
// start class TRefcountedTest
 
procedure TRefcountedTest.DoIt;
var
 l_A : TRefcounted;
 l_B : TRefcounted;
begin
 l_A := TRefcounted.Create;
 try
  Check(l_A.RefCount = 1);
  l_B := l_A.Use;
  try
   Check(l_A.RefCount = 2);
   Check(l_B.RefCount = 2);
  finally
   FreeAndNil(l_B);
  end;//try..finally
  Check(l_A.RefCount = 1);
 finally
  FreeAndNil(l_A);
 end;//try..finally
end;//TRefcountedTest.DoIt
 
initialization
 TestFramework.RegisterTest(TRefcountedTest.Suite);
 
end.


... to be continued ...