Lazy "Delphi" Project

http://www.lazyproject.info/

Прикольненько конечно.

Я правда последнее время старался двигаться в сторону "обратную RAD".

Yacc & Lexx для Delphi

http://roman.yankovsky.me/?p=577

Ну что ты будешь делать... Я это - ТОЖЕ портировал. Для "себя". Но большого практического применения - особенно не нашёл.

Куда сырцы выложить?

Ещё один единомышленник

http://roman.yankovsky.me/?p=467

Точно надо про FORTH писать...

Главное, что он с DSL угадал :-)

Если честно - не вкурил

http://keeper89.blogspot.ru/2011/07/embarcadero.html

О динамических массивах

http://keeper89.blogspot.ru/2013/02/blog-post_18.html?utm_source=feedburner&utm_medium=feed&utm_campaign=Feed:+Keeper89+(Keeper's+blog)

А я лично - динамическими массивами стараюсь вообще не пользоваться. В Delphi 7. Они источники излишней фрагментации памяти. Я использую свои велосипеды. На "шаблонах". Такой свой маленький STL для Delphi. (Про идею шаблонов я писал тут - http://18delphi.blogspot.com/2013/03/generic-generic.html).

А пример - как у нас кончалась память из-за использования динамических массивов и как всё стало хорошо при переходе на собственные структуры - я приведу чуть позже. :-) Как водится...

А вот в Delphi XE этот вопрос ещё надо исследовать. Там другой менеджер памяти. Там может быть и всё хорошо.

О тестах и оперативности

1. Гоняйте тесты КАЖДЫЙ день. Как минимум - перед и после коммитов.
2. Гоняйте тесты ночью в автоматическом режиме после ночной сборки.
3. Если тесты упали - это повод для ОПЕРАТИВНЫХ разборок - пока ещё все помнят "что вчера крутили".

Локализация проектов

Пока читаем, про родную локализацию:
http://www.gunsmoker.ru/2010/06/delphi-ite-integrated-translation.html

А позже я напишу - что я сам делал.

Делал конечно "на коленке". И конечно не сам придумал, но зато - до сих пор пользуемся.

Конечно на основе "ini-файла" в стиле "ключ-значение".

Многое близк'о

http://www.tdelphiblog.com/

Так вот читаешь - и думаешь - "ну почему - не я всё это придумал". А ещё порой думаешь - "ну ведь я же всё это УЖЕ придумал и реализовал - почему не описал" :-)

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

Уже лет 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 ...

Похоже - единомышленник

http://delphi.frantic.im/delphi-tdd-results/

Цитата оттуда:

Мне кажется, первая часть получилась намного интересней. Она была намного проще и не требовала много времени, фокусировалась на основном наборе навыков. Вторая часть более серьезная, особенно трудно было “заставить” участников писать код по-другому, не так как они привыкли. Вот одна из цитат из переписки:

Это у меня привычка такая, думать наперёд… тесты я выполнял последовательно.. и в конце уже начал понимать, что действительно, в тестах есть такой плюс. Ведь думая, а как оно будет в будущем: а) отвлекаешься б) чем больше объём, тем тяжелее это удержать в голове. Тесты рулят.

https://bitbucket.org/delphizen/simple-tests

"Added Polish calculator tests" :-) ;-) Это же зачатки FORTH.

Автору надо кооперироваться с - http://roman.yankovsky.me/?p=467

Хочется вспомнить...

Владислав Борисович Зернов  - СВЕТЛАЯ ему ПАМЯТЬ. Думать и РЕШАТЬ задачи - научил - ИМЕННО ОН.

Преподаватель из МИЭМ. В физ-мат классе школы №706.

Он учил нас физике, да и не только.

И умер на следующий день после нашего выпускного.

Раньше мы всем классом ездили к нему на место последнего пристанища. Около Зеленограда.

Теперь - не ездим... Выросли наверное... Некогда....

Ну и Фернандо Жозевич Вильф, с его ПРЕКРАСНЫМ - "как ВЫ учите физику, так ОНИ вас лечат". Хотелось бы надеяться, что он - здравствует.

Вообще - по-моему - стоит помнить учителей.

Рефакторинг!

Моя любимая тема...

Я - КРАЙНЕ ЛЮБЛЮ тасовать кусочки кода, чтобы "узорчик сошёлся", код стал "более красивым", стал удовлетворять "какому-нибудь шаблону из GoF", прошли ТЕСТЫ и я получил МОРАЛЬНОЕ УДОВЛЕТВОРЕНИЕ.

И меня всегда вдохновлял и вдохновляет Фаулер.

Но БЕЗ ТЕСТОВ - в эту тему (ИМХО) - лучше - не соваться. Лучше - "оставить всё как есть". Вреда - меньше.

... to be continued ...

P.S. Примите "как аксиому" - один простой факт - "за рефакторинг (сам по себе) - не платят".

Code Review

... и "говнокод"...

тут есть тоже много чего написать....

Говнокодом я с некоторых пор называю ТОЛЬКО СВОЙ СОБСТВЕННЫЙ код, ко всему остальному я применяю термин Фаулера - "код, который не очень здорово пахнет". Да и то - это не самый удачный термин.

Я раньше очень часто занимался CodeReview так, что оппонентам было это неприятно.

Это - большая ОШИБКА. Нельзя так делать.

Если кто-то из них прочитает меня - постарайтесь простить. Был молод и неопытен.

Задача CodeReview не в том, чтобы "укусить" оппонента. И побольнее. Задача - научиться. ОБОИМ.

Тем кто читает - хочу сказать. ПОЙМИТЕ это. Если вы хотите проводить CodeReview с пользой для дела - НЕ СТАРАЙТЕСЬ УКУСИТЬ.

Я постараюсь работать над собой. И чуть позже - постараюсь написать - как с моей точки зрения правильно проводить CodeReview.

Пока читаем вот что - http://keeper89.blogspot.ru/2010/01/blog-post.html :-) Только - РАДИ БОГА - не принимайте близко к сердцу.

О как...

http://www.delphikingdom.com/asp/talktopic.asp?ID=302&Order=0&Count=10&pNo=2

http://www.delphimaster.ru/cgi-bin/faq.pl?look=1&id=19-988623694

http://www.delphikingdom.com/asp/talktopic.asp?ID=366

Хочется узнать про DelphiKingdom.ru

Вот лет десять назад я туда писал/отвечал на вопросы. А теперь - зарегистрировался (старый логин/пароль - утеряны за давностью лет). И не могу ничего написать... У меня руки какие-то кривые? Или я не могу с интерфейсом разобраться? Или я уже ухитрился в бэк-лист попасть?

И ещё.. Антон Григорьев - это не тот, который рендеринг формул писал?

Objective-C и Delphi

Objective-C и Delphi.

Больше похожи чем различаются.

На самом деле. Мне не составило большого труда перенести часть своих разработок с Delphi на Objective-C.

Жаль только, что я поторопился. Delphi - похоже - возрождается.

Я потом продолжу этот пост. И напишу - чем они похожи.

Пока лишь:
1. Одиночное наследование.
2. Интерфейсы (протоколы).
3. Мета-классы. class и CLASS.
3. Общий базовый предок для всех объектов - TObject и NSObject.
4. Подсчёт ссылок.
5. TList и NSArray. Правда в первом - нет подсчёта ссылок.
6. Контролы и графические контексты. Есть там - МАССА общего.
7. Event'ы и selector'ы.
8. Виртуальные методы классов.
9. Создание объектов (наследников от TObject и NSObject) только в куче.
10. Возможность переопределения распределения объектов (NewInstance и alloc).
11. Категории в Objective-C и helper'ы в Delphi.

Но есть конечно вещи, по которым Objective-C - "делает" Delphi. Равно как и наоборот. Я тоже постараюсь об этом написать.

Пока лишь - NSOperation - вот что реально круто для мобильных устройств. Я пока не знаю - есть ли аналог в Delphi XE. Если нету - БОЛЬШОЙ минус Delphi.
NSDictionary и NSArray и их нативная сериализация - опять же.

Опять же - мне очень близка так концепция подсчёта ссылок на объекты, которая реализована в Objective-C. Я сам подобную концепцию "придумал". Не додумался только до autoreleasepool'а. Но он мне был и не нужен.

А вот если мы начинаем программировать не на Objective-C (.m), а на Objective-C++ (.mm) - То тут мы конечно попадаем в "стан врага" :-) Но зато нам становится доступен "великий и ужасный" STL. И многих велосипедов - нам уже не надо изобретать. И что "особенно вкусно" - это то, что Objective-C-классы и C++-классы - мешаются между собой - ПРОЗРАЧНО. Ну конечно только без кросс-наследования. Но оно и - НЕ НУЖНО. Агрегации - более, чем достаточно.

Про стандарт C++ 11 и его "вкусности" - так вообще молчу. Особенно в части - мета-программирования. auto и лямбды - одни чего стоят. (Лямбды (block) есть кстати и в Objective-C, в Delphi XE они тоже вроде есть, но я их честно - ещё не попробовал. Ничего не могу сказать).

А уж шаблоны с переменным количеством параметров - это вообще - что-то.

В общем - "хороша ложка к обеду". И каждый инструмент хорош для своего.

Мне лично - Delphi - сильно роднее. Я на нём 18-ть лет программирую. А начинал я вообще в Turbo Pascal 3.0 (далеко не все наверное это помнят).

Но и Objectvive-C - меня теперь не пугает. Наоборот - я нашёл в нём много знакомого.

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

Попробуйте. Может быть - вам понравится.

... to be continued ...

Можно вопрос про Grid'ы в FireMokey?

С ними сейчас существуют какие-нибудь проблемы? Или проблем нет? Очень интересно услышать.

Также есть вопрос - есть ли проблемы с ListBox. Опять же в FireMonkey. Там есть проблемы с количеством элементов? Если есть, то - какие?

Я был бы счастлив услышать ваше мнение.

Рекомендуемые книги

http://urss.ru/cgi-bin/db.pl?lang=Ru&blang=ru&page=Book&id=16680
http://urss.ru/cgi-bin/db.pl?lang=Ru&blang=ru&page=Book&id=132730
-- это вообще-то - букинистика, но они у меня есть. В бумажном виде. Если кто-то реально захочет - могу как-нибудь поделиться.

Ну и конечно - GoF, Джоэл, Мараско, "Как пасти котов", "Путь камикадзе", Фаулер "Рефакторинг", Брукс (да!) "Мифический человеко-месяц", "Deadline или роман об управлении проектами", "FORTH и его реализации" (если будет интересно - автора вспомню), Рей Лишнер "Delphi" (как ни странно - не теряет актуальности), Мак-Конел "Совершенный код".

Про тестирование - к сожалению ничего путного предложить не могу, разве, что только что-то про Fuzzing.

Страуструп и Керниган и Ричи - ну тут вопросов по-моему - нет.

И. Братко "Пролог".

Дж. У. Сичановски "Ассемблер и архитектура PDP-11".
 - можно понять - почему C-строки кончаются нулём и что такое while (*dest++ = *source++) ;

Джоэла - я лично - перечитываю в КАЖДЫЕ новогодние каникулы - для поднятия рабочего настроения.

Попробуйте. Может быть и вам - понравится.

Примеси и контролы с непрямоугольными краями

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


Контролы с непрямоугольными краями КОНЕЧНО лучше всего делать на FireMonkey. И забыть про VCL - по мере возможности.

Но понятное дело, что это в идеале. Но существуют суровые реалии жизни.

Потому - как делать такие контролы на VCL, да и не просто на VCL, а ещё и на примесях (иначе бы я даже не стал эту тему поднимать) - рассмотрим тут. Будем ОДНОЙ примесью скруглять края у TEdit и TButton. Сразу замечу - он разные по наследованию. Но примесь будет - ОДНА.

Ничто кстати не отменяет использования подобной техники и в FireMonley. Да и вообще - в невизуальных классах. Я про примеси. А не про скруглённые края.

Итак. Начнём с диаграмм:

и:

Код:
RegionableControl.imp.pas:

{$IfNDef RegionableControl_imp}
 
{$Define RegionableControl_imp}
 _RegionableControl_ = {mixin} class(_RegionableControl_Parent_)
  {* Контрол с поддержкой регионов }
 private
 // private fields
   f_Reg : Tl3Region;
 private
 // private methods
   procedure UpdateRegion;
   procedure ClearRegion;
   procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
 protected
 // overridden protected methods
   procedure Cleanup; override;
     {* Функция очистки полей объекта. }
   procedure CreateWnd; override;
   procedure DestroyWnd; override;
   procedure Resize; override;
   procedure VisibleChanging; override;
 protected
 // protected methods
   procedure TuneRegion(aRegion: Tl3Region); virtual;
 end;//_RegionableControl_
 
{$Else RegionableControl_imp}
 
// start class _RegionableControl_
 
procedure _RegionableControl_.UpdateRegion;
begin
 ClearRegion;
 if (f_Reg = nil) then
  f_Reg := Tl3Region.Create
 else
  f_Reg.FreeRgn;
 if (Width > 0) AND (Height > 0) AND Visible then
 begin
  if HandleAllocated then
  begin
   TuneRegion(f_Reg);
   if not f_Reg.Empty then
    SetWindowRgn(Handle, f_Reg.Rgn, true);
  end;//HandleAllocated
 end;//Visible
end;//_RegionableControl_.UpdateRegion
 
procedure _RegionableControl_.ClearRegion;
begin
 if HandleAllocated then
  SetWindowRgn(Handle, 0, false);
end;//_RegionableControl_.ClearRegion
 
procedure _RegionableControl_.TuneRegion(aRegion: Tl3Region);
begin
 // - ничего не делаем, полагаемся на потомков
end;//_RegionableControl_.TuneRegion
 
procedure _RegionableControl_.CMVisibleChanged(var Message: TMessage);
begin
 inherited;
 UpdateRegion;
end;//_RegionableControl_.CMVisibleChanged
 
procedure _RegionableControl_.Cleanup;
begin
 ClearRegion;
 FreeAndNil(f_Reg);
 inherited;
end;//_RegionableControl_.Cleanup
 
procedure _RegionableControl_.CreateWnd;
begin
 inherited;
 UpdateRegion;
end;//_RegionableControl_.CreateWnd
 
procedure _RegionableControl_.DestroyWnd;
begin
 ClearRegion;
 inherited;
end;//_RegionableControl_.DestroyWnd
 
procedure _RegionableControl_.Resize;
begin
 inherited;
 UpdateRegion;
end;//_RegionableControl_.Resize
 
procedure _RegionableControl_.VisibleChanging;
begin
 inherited;
 //UpdateRegion;
end;//_RegionableControl_.VisibleChanging
 
{$EndIf RegionableControl_imp}

RoundedControl.imp.pas:

{$IfNDef RoundedControl_imp}
 
{$Define RoundedControl_imp}
 _RegionableControl_Parent_ = _RoundedControl_Parent_;
 {$Include RegionableControl.imp.pas}
 _RoundedControl_ = {mixin} class(_RegionableControl_)
 protected
 // overridden protected methods
   procedure TuneRegion(aRegion: Tl3Region); override;
 end;//_RoundedControl_
 
{$Else RoundedControl_imp}
 
{$Include RegionableControl.imp.pas}
 
// start class _RoundedControl_
 
procedure _RoundedControl_.TuneRegion(aRegion: Tl3Region);
const
 cRad = 15;
var
 l_R : Tl3Region;
begin
 l_R := Tl3Region.Create;
 try
  l_R.Rgn := CreateRoundRectRgn(1, 0, Width + 1, Height, cRad, cRad);
  aRegion.Combine(l_R, RGN_OR);
  //aRegion.CombineRect(l3SRect(Width - cRad, 0, Width, Height), RGN_OR);
 finally
  FreeAndNil(l_R);
 end;//try..fianlly
end;//_RoundedControl_.TuneRegion
 
{$EndIf RoundedControl_imp}

RoundedButton.pas:

unit RoundedButton;
 
interface
 
uses
  StdCtrls,
  Messages,
  l3Region,
  Controls {a}
  ;
 
type
 _RefCounted_Parent_ = TButton;
 {$Include RefCounted.imp.pas}
 _RoundedControl_Parent_ = _RefCounted_;
 {$Include RoundedControl.imp.pas}
 TRoundedButton = class(_RoundedControl_)
 end;//TRoundedButton
 
implementation
 
uses
  Windows,
  SysUtils,
  Themes
  ;
 
{$Include RefCounted.imp.pas}
 
{$Include RoundedControl.imp.pas}
 
end.

RoundedEdit.pas:

unit RoundedEdit;
 
interface
 
uses
  StdCtrls,
  Messages,
  l3Region,
  Controls {a}
  ;
 
type
 _RefCounted_Parent_ = TEdit;
 {$Include RefCounted.imp.pas}
 _RoundedControl_Parent_ = _RefCounted_;
 {$Include RoundedControl.imp.pas}
 TRoundedEdit = class(_RoundedControl_)
 end;//TRoundedEdit
 
implementation
 
uses
  Windows,
  SysUtils,
  Themes
  ;
 
{$Include RefCounted.imp.pas}
 
{$Include RoundedControl.imp.pas}
 
end.

И тест к этому делу:

Код теста:

unit RoundedControlsTest;
 
interface
 
uses
  TestFrameWork
  ;
 
type
 TRoundedControlsTest = class(TTestCase)
 published
 // published methods
   procedure DoIt;
 end;//TRoundedControlsTest
 
implementation
 
uses
  RoundedButton,
  RoundedEdit,
  Forms
  ;
 
 
// start class TRoundedControlsTest
 
procedure TRoundedControlsTest.DoIt;
var
 l_Form : TCustomForm;
 l_E : TRoundedEdit;
 l_B : TRoundedButton;
begin
 l_Form := TCustomForm.CreateNew(Application);
 l_E := TRoundedEdit.Create(l_Form);
 l_B := TRoundedButton.Create(l_Form);
 
 l_Form.Height := 200;
 l_Form.Width := 200;
 l_E.Left := 10;
 l_B.Left := 10;
 l_E.Top := 20;
 l_B.Top := 50;
 
 l_E.Parent := l_Form;
 l_B.Parent := l_Form;
 l_Form.Show;
end;//TRoundedControlsTest.DoIt
 
initialization
 TestFramework.RegisterTest(TRoundedControlsTest.Suite);
 
end.

Код лежит тут - https://sourceforge.net/p/rumtmarc/code-0/HEAD/tree/trunk/Blogger/%D0%A2%D0%B5%D1%81%D1%82%D1%8B%20%D0%B8%20%D0%BF%D1%80%D0%B8%D0%BC%D0%B5%D1%81%D0%B8/RoundedControls/src

... to be continued ...

Шаблоны и тесты DUnit

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

Будем развивать идею тестирования TIntStack и TStringStack. Только сделаем это ОДНОЙ примесью. Убрав дубликаты вида:

procedure TIntStackTest.DoIt;
const
 cEtalons : array [0..3] of integer = (10, 20, 3, 5);
var
 l_S : TIntStack;
 l_I : Integer;
begin
 l_S := TIntStack.Create;
 try
  for l_I := Low(cEtalons) to High(cEtalons) do
   l_S.Push(cEtalons[l_I]);
  for l_I := High(cEtalons) downto Low(cEtalons) do
   Check(l_S.Pop = cEtalons[l_I]);
 finally
  FreeAndNil(l_S);
 end;//try..finally
end;//TIntStackTest.DoIt

и:

procedure TStringStackTest.DoIt;
const
 cEtalons : array [0..3] of String = ('мыма', 'мыла', 'раму', 'весело');
var
 l_S : TStringStack;
 l_I : Integer;
begin
 l_S := TStringStack.Create;
 try
  for l_I := Low(cEtalons) to High(cEtalons) do
   l_S.Push(cEtalons[l_I]);
  for l_I := High(cEtalons) downto Low(cEtalons) do
   Check(l_S.Pop = cEtalons[l_I]);
 finally
  FreeAndNil(l_S);
 end;//try..finally
end;//TStringStackTest.DoIt

Нарисуем следующую диаграмму:

Получаем следующий код:

SandBox.dpr:
 
program SandBoxTest;
 
uses
  TestFrameWork
  GUITestRunner,
  IntStack,
  IntStackTest,
  StringStack,
  StringStackTest,
  IntStackTestViaMixIn,
  StringStackTestViaMixIn
  ;
 
begin
 GUITestRunner.RunRegisteredTests;
end.

----------------------------------

StackTest.imp.pas:

{$IfNDef StackTest_imp}
 
{$Define StackTest_imp}
 TEtalonData = ItemsHolder;
 
 _StackTest_ = {mixin} class(TTestCase)
 published
   procedure DoIt;
 protected
 // protected methods
   function GetEtalonData: TEtalonData; virtual; abstract;
   function ArrayToEtalon(const aData: array of _ItemType_): TEtalonData;
     {* Вспомогательная функция появившаяся оттого, что динамические массивы умеет к открытым приводиться автоматом, а обратно - нет }
 end;//_StackTest_
 
{$Else StackTest_imp}
 
procedure _StackTest_.DoIt;
var
 l_Etalons : TEtalonData;
 l_S : _StackType_;
 l_I : Integer;
begin
 l_S := _StackType_.Create;
 try
  l_Etalons := GetEtalonData;
  for l_I := Low(l_Etalons) to High(l_Etalons) do
   l_S.Push(l_Etalons[l_I]);
  for l_I := High(l_Etalons) downto Low(l_Etalons) do
   Check(l_S.Pop = l_Etalons[l_I]);
 finally
  FreeAndNil(l_S);
 end;//try..finally
end;
 
function _StackTest_.ArrayToEtalon(const aData: array of _ItemType_): TEtalonData;
var
 l_I : Integer;
begin
 SetLength(Result, Length(aData));
 for l_I := Low(aData) to High(aData) do
  Result[l_I] := aData[l_I];
end;
 
{$EndIf StackTest_imp}

--------------------------------------

IntStackTestViaMixIn.pas:

unit IntStackTestViaMixIn;
 
interface
 
uses
  IntStack,
  TestFrameWork
  ;
 
type
 _StackType_ = TIntStack;
 {$Include StackTest.imp.pas}
 TIntStackTestViaMixIn = class(_StackTest_)
 protected
 // realized methods
   function GetEtalonData: TEtalonData; override;
 end;//TIntStackTestViaMixIn
 
implementation
 
uses
  SysUtils
  ;
 
{$Include StackTest.imp.pas}
 
function TIntStackTestViaMixIn.GetEtalonData: TEtalonData;
begin
 Result := ArrayToEtalon([10, 20, 3, 5, 6, 19, 21]);
end;
 
initialization
 TestFramework.RegisterTest(TIntStackTestViaMixIn.Suite);
 
end.

--------------------------------------

StringStackTestViaMixIn.pas:

unit StringStackTestViaMixIn;
 
interface
 
uses
  StringStack,
  TestFrameWork
  ;
 
type
 _StackType_ = TStringStack;
 {$Include StackTest.imp.pas}
 TStringStackTestViaMixIn = class(_StackTest_)
 protected
 // realized methods
   function GetEtalonData: TEtalonData; override;
 end;//TStringStackTestViaMixIn
 
implementation
 
uses
  SysUtils
  ;
 
{$Include StackTest.imp.pas}
 
function TStringStackTestViaMixIn.GetEtalonData: TEtalonData;
begin
 Result := ArrayToEtalon(['мама', 'мыла', 'раму', 'весело', 'и', 'споро']);
end;
 
initialization
 TestFramework.RegisterTest(TStringStackTestViaMixIn.Suite);
 
end.

---------------------------------

Получаем тесты:

По-моему - здорово :-)

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

Понятно, что то же самое можно проделать и с родными Generic'ами.

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