18-ть лет с Delphi

воскресенье, 14 июля 2013 г.

Тесты "по-русски"

: K183337891

 "Открываем НК"
 75 раз ( "Перейти на параграф вниз" )
 "Дождаться переключения вкладок"
 СР
 "Вернуться в текст документа"
 "Выделить {(1)} параграфов"
 "Сравнить выделенный текст текущего редактора с эталоном"
;

K183337891

: K200085315

 : Действия
  "Открываем {(6086112)}"
  "Предварительный просмотр"
  "Нажать {('Esc')}"
  "Выполнить {(@ NOP)} с переключённой базой"
 ;

 ТБ24
 "Выставить форме размеры {(1456 1000)} и {(@ Действия)}"
;

K200085315

: K200085334

 "Открываем {(2008)}"
 "Предварительный просмотр"
 "Дать системе перерисоваться"
 "Нажать {('Esc')}"
 "Выполнить {(@ "Проверить, что удалось перевести фокус в оглавление")} с переключённой базой"
;

K200085334

: K216794957

 ТБ24
 ППР
 "Перевести фокус в поле 'Орган/Источник' в ППР"
 "в поле 'Орган/Источник' ввести {('Правительство России и СССР')}"
 "Выделить текст в поле"
 "Начинаем набирать {('Органы')}"
 "Сравнить абзац текущего редактора с эталоном"
 "Нажать {('Enter')}"
 "Сравнить абзац текущего редактора с эталоном"
 "Нажать Искать"
 "Проверить информацию о списке"
;

K216794957

http://delphi.frantic.im/y-u-no-test-code/

"Вероятно даже буду писать их – если выпадет какой нибудь новый и не спешный проект."

"неспешный проект" - вот это - ОШИБКА! БОЛЬШАЯ ОШИБКА! Тесты надо начинать с проекта "камикадзе"!!!

Если проект - НЕСПЕШНЫЙ, то и ТЕСТЫ - НЕЗАЧЕМ. Тесты нужны для проектов "камикадзе". Чтобы "спать спокойно".

Чужая статья. Запустить тесты и собрать проект – одной командой. Подписываюсь под КАЖДЫМ словом

http://delphi.frantic.im/build-script/

Подписываюсь под КАЖДЫМ словом.

P.S. У на тоже проекты СОБИРАЮТСЯ и ТЕСТИРУЮТСЯ - КАЖДЫЙ день. (Вспомнился эпизод из фильма К-2 с пакистанцем - "Ты как часто это делаешь? (когда он купается в ледяной воде) Ответ - КАЖДЫЙ день...)

суббота, 13 июля 2013 г.

Ещё смешное из VCL

В оконной процедуре там делается кое-что лишнее связанное с отрисовкой пунктов меню - WM_DRAWITEM и WM_MEASUREITEM. Если мы правильно всё поняли. Вот правки:

procedure Tl3Form.WndProc(var Message: TMessage);
  //override;
  {-}
var
  SaveIndex : Integer;
  MenuItem  : TMenuItem;
  DC        : HDC;
begin
  with Message do
    case Msg of
      WM_DRAWITEM:
       if (Message.wParam = 0) then {V - WM_DRAWITEM посылает не только Menu, Message.wParam = 0 это точно Меню}
        with PDrawItemStruct(Message.LParam)^ do
          if (CtlType = ODT_MENU) and Assigned(Menu) then
          begin
            MenuItem := Menu.FindItem(itemID, fkCommand);
            if (MenuItem <> nil) then
            begin
              if (f_Canvas = nil) then
               f_Canvas := TCanvas.Create;
              with f_Canvas do
              try
                SaveIndex := SaveDC(hDC);
                try
                  Handle := hDC;
                  Font := Screen.MenuFont;
                  Menus.DrawMenuItem(MenuItem, f_Canvas, rcItem,
                    TOwnerDrawState(LongRec(itemState).Lo));
                finally
                  Handle := 0;
                  RestoreDC(hDC, SaveIndex)
                end;
              finally
                //Free;
              end;//try..finally
              Exit;
            end;//MenuItem <> nil
          end;//CtlType = ODT_MENU..
      WM_MEASUREITEM:
       if (Message.wParam = 0) then {V - WM_DRAWITEM посылает не только Menu, Message.wParam = 0 это точно Меню}
        with PMeasureItemStruct(Message.LParam)^ do
          if (CtlType = ODT_MENU) and Assigned(Menu) then
          begin
            MenuItem := Menu.FindItem(itemID, fkCommand);
            if (MenuItem <> nil) then
            begin
              DC := GetWindowDC(Handle);
              try
                if (f_Canvas = nil) then
                 f_Canvas := TCanvas.Create;
                with f_Canvas do
                try
                  SaveIndex := SaveDC(DC);
                  try
                    Handle := DC;
                    Font := Screen.MenuFont;
                    TMenuItemAccess(MenuItem).MeasureItem(f_Canvas,
                      Integer(itemWidth), Integer(itemHeight));
                  finally
                    Handle := 0;
                    RestoreDC(DC, SaveIndex);
                  end;
                finally
                  //f_Canvas.Free;
                end;//try..finally
              finally
                ReleaseDC(Handle, DC);
              end;//try..finally
              Exit;
            end;//MenuItem <> nil
          end;//CtlType = ODT_MENU..
    end;//case Msg of
 inherited;
end;

пятница, 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

четверг, 11 июля 2013 г.

Дальше будем делать конкретные "неатомарные" контейнеры

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

Дальше будем делать конкретные "неатомарные" контейнеры.

Будем делать контейнеры интерфейсов. Строк. Записей.

Потом перейдём к сортированным контейнерам.

Потом будем обобщать тесты контейнеров через примеси.

Интересно?

Выводим конкретные атомарные контейнеры из абстрактных

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

Теперь выведем из абстрактных контейнеров предыдущей серии - конкретные. Пока - атомарные.

Итак. Как обычно.

Модель:

Код:
IntegerList.pas:

unit IntegerList;

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

// ! Полностью генерируется с модели. Править руками - нельзя. !

interface

uses
  Refcounted,
  Classes,
  l3PtrLoc
  ;

type
 _ItemType_ = Integer;
 _AtomicList_Parent_ = TRefcounted;
 {$Include AtomicList.imp.pas}
 TIntegerList = class(_AtomicList_)
  {* Список Integer'ов }
 end;//TIntegerList

implementation

uses
  RTLConsts,
  l3MemorySizeUtils
  ;

type _Instance_R_ = TIntegerList;
type _AtomicList_R_ = TIntegerList;

{$Include AtomicList.imp.pas}

end.

ByteList.pas:

unit ByteList;

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

// ! Полностью генерируется с модели. Править руками - нельзя. !

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.

Int64List.pas:

unit Int64List;

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

// ! Полностью генерируется с модели. Править руками - нельзя. !

interface

uses
  Refcounted,
  Classes,
  l3PtrLoc
  ;

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

implementation

uses
  RTLConsts,
  l3MemorySizeUtils
  ;

type _Instance_R_ = TInt64List;
type _AtomicList_R_ = TInt64List;

{$Include AtomicList.imp.pas}

end.

Тесты (взятые "от фонаря", но тем не менее они имеют право на жизнь).

Модель тестов:

Код тестов:
IntegerListTest.pas:

unit IntegerListTest;

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

// ! Полностью генерируется с модели. Править руками - нельзя. !

interface

uses
  TestFrameWork
  ;

type
 TIntegerListTest = class(TTestCase)
 published
 // published methods
   procedure DoIt;
   procedure TestTwoLists;
 end;//TIntegerListTest

implementation

uses
  IntegerList,
  SysUtils
  ;

// start class TIntegerListTest

procedure TIntegerListTest.DoIt;
//#UC START# *51DEB319037C_51DEB2FA00B0_var*
const
 cCount = 1000;
var
 l_List : TIntegerList;
 l_Count : IndexType;
 l_Index : IndexType;
//#UC END# *51DEB319037C_51DEB2FA00B0_var*
begin
//#UC START# *51DEB319037C_51DEB2FA00B0_impl*
 l_List := TIntegerList.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_51DEB2FA00B0_impl*
end;//TIntegerListTest.DoIt

procedure TIntegerListTest.TestTwoLists;
//#UC START# *51DED6FC03C1_51DEB2FA00B0_var*
const
 cCount = 1000;
var
 l_A : TIntegerList;
 l_B : TIntegerList;
 l_Index : IndexType;
 l_Value : Integer;
//#UC END# *51DED6FC03C1_51DEB2FA00B0_var*
begin
//#UC START# *51DED6FC03C1_51DEB2FA00B0_impl*
 l_A := TIntegerList.Create;
 try
  l_B := TIntegerList.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_51DEB2FA00B0_impl*
end;//TIntegerListTest.TestTwoLists

initialization
 TestFramework.RegisterTest(TIntegerListTest.Suite);

end.

ByteListTest.pas:

unit ByteListTest;

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

// ! Полностью генерируется с модели. Править руками - нельзя. !

interface

uses
  TestFrameWork
  ;

type
 TByteListTest = class(TTestCase)
 published
 // published methods
   procedure DoIt;
 end;//TByteListTest

implementation

uses
  ByteList,
  SysUtils
  ;

// start class TByteListTest

procedure TByteListTest.DoIt;
//#UC START# *51DEE6960378_51DEE67C003A_var*
const
 cCount = 1000;
var
 l_List : TByteList;
 l_Count : IndexType;
 l_Index : IndexType;
//#UC END# *51DEE6960378_51DEE67C003A_var*
begin
//#UC START# *51DEE6960378_51DEE67C003A_impl*
 l_List := TByteList.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# *51DEE6960378_51DEE67C003A_impl*
end;//TByteListTest.DoIt

initialization
 TestFramework.RegisterTest(TByteListTest.Suite);

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
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// ! Полностью генерируется с модели. Править руками - нельзя. !

interface

uses
  TestFrameWork
  ;

type
 TInt64ListTest = class(TTestCase)
 published
 // published methods
   procedure DoIt;
 end;//TInt64ListTest

implementation

uses
  Int64List,
  SysUtils
  ;

// start class TInt64ListTest

procedure TInt64ListTest.DoIt;
//#UC START# *51DEE90202A8_51DEE8E9025A_var*
const
 cCount = 1000;
var
 l_List : TInt64List;
 l_Count : IndexType;
 l_Index : IndexType;
//#UC END# *51DEE90202A8_51DEE8E9025A_var*
begin
//#UC START# *51DEE90202A8_51DEE8E9025A_impl*
 l_List := TInt64List.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# *51DEE90202A8_51DEE8E9025A_impl*
end;//TInt64ListTest.DoIt

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

Абстрактные контейнеры

Подготовительные серии были тут - http://18delphi.blogspot.com/2013/07/1.html

Теперь хочется рассказать о практике создания "шаблонных" контейнеров в "стиле STL".

ПОКА - БЕЗ "настоящих" Generic'ов (http://18delphi.blogspot.ru/2013/03/generic-generic.html). Но и их - ТОЖЕ можно использовать. Но ПОКА - есть МНОЖЕСТВО НЕЗАКРЫТЫХ ошибок, которые Embarcadero почему-то не спешит закрывать. Минус ребятам. Что сказать. Даже мою ошибку (http://18delphi.blogspot.com/2013/05/resolved.html http://18delphi.blogspot.com/2013/05/xe4.html) - "типа исправили", но не закрыли. Хотя там - "копейки". Если я своим умом - всё правильно понимаю...

Одна ремарка. Несмотря на то, что в STL подобные контейнеры называются vector - я решил сохранить преемственность с Delphi и назвал их List.

Итак. Как обычно.

Модель:

Код:

List.imp.pas:

{$IfNDef List_imp}

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// Библиотека "SandBox"
// Модуль: "List.imp.pas"
// Родные Delphi интерфейсы (.pas)
// Generated from UML model, root element: Impurity::Class Shared Delphi Sand Box::SandBox::STLLike::List
//
// Абстрактный список значений
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

{$Define List_imp}
 PItemType = ^_ItemType_;

const
  { Sizes }
 cItemSize = SizeOf(_ItemType_);

type
 IndexType = System.Integer;

 _List_ = {mixin} class(_List_Parent_)
  {* Абстрактный список значений }
 private
 // private fields
   f_Data : Tl3PtrLoc;
   f_Count : IndexType;
    {* Поле для свойства Count}
 private
 // private methods
   procedure ReAllocList(aNewCapacity: IndexType);
   procedure CheckIndex(anIndex: IndexType); // can raise EListError
     {* проверяет валидность индекса и поднимает исключение, если он неправильный }
   function ItemSlot(anIndex: IndexType): PItemType;
   function ExpandSize(aTargetSize: IndexType): Cardinal;
   procedure CheckSetItem(anIndex: IndexType); // can raise EListError
     {* Проверяет валидность индекса при вставке }
 protected
 // property methods
   procedure pm_SetCount(aValue: IndexType);
   function pm_GetCapacity: IndexType;
   procedure pm_SetCapacity(aValue: IndexType);
   function pm_GetItems(anIndex: IndexType): _ItemType_;
   procedure pm_SetItems(anIndex: IndexType; const aValue: _ItemType_);
 protected
 // overridden protected methods
   procedure Cleanup; override;
     {* Функция очистки полей объекта. }
 public
 // public properties
   property Count: IndexType
     read f_Count
     write pm_SetCount;
   property Capacity: IndexType
     read pm_GetCapacity
     write pm_SetCapacity;
   property Items[anIndex: IndexType]: _ItemType_
     read pm_GetItems
     write pm_SetItems;
     default;
     {* Элементы списка. }
 end;//_List_

{$Else List_imp}

// start class _List_

procedure _List_.ReAllocList(aNewCapacity: IndexType);
//#UC START# *51DEB8770017_51DEB07E03E4_var*
var
 l_Cap : Integer;
 l_Cnt : Integer;
//#UC END# *51DEB8770017_51DEB07E03E4_var*
begin
//#UC START# *51DEB8770017_51DEB07E03E4_impl*
 f_Data.SetSize(aNewCapacity * cItemSize);
 l_Cap := Self.Capacity;
 Assert(l_Cap >= aNewCapacity);
 l_Cnt := f_Count;
 if (l_Cap > l_Cnt) then
  System.FillChar(ItemSlot(l_Cnt)^, (l_Cap - l_Cnt) * cItemSize, 0);
//#UC END# *51DEB8770017_51DEB07E03E4_impl*
end;//_List_.ReAllocList

procedure _List_.CheckIndex(anIndex: IndexType); // can raise EListError
//#UC START# *51DEB95E00BD_51DEB07E03E4_var*

 procedure _Error;
 begin
  raise EListError.CreateFmt(SListIndexError + ' from (%d)', [anIndex, f_Count])
 end;

//#UC END# *51DEB95E00BD_51DEB07E03E4_var*
begin
//#UC START# *51DEB95E00BD_51DEB07E03E4_impl*
 if (anIndex < 0) or (anIndex >= f_Count) then
  _Error;
//#UC END# *51DEB95E00BD_51DEB07E03E4_impl*
end;//_List_.CheckIndex

function _List_.ItemSlot(anIndex: IndexType): PItemType;
//#UC START# *51DEBE2D008A_51DEB07E03E4_var*
//#UC END# *51DEBE2D008A_51DEB07E03E4_var*
begin
//#UC START# *51DEBE2D008A_51DEB07E03E4_impl*
 Result := PItemType(f_Data.AsPointer + anIndex * cItemSize);
 assert(Result <> nil);
//#UC END# *51DEBE2D008A_51DEB07E03E4_impl*
end;//_List_.ItemSlot

function _List_.ExpandSize(aTargetSize: IndexType): Cardinal;
//#UC START# *51DEC11F0058_51DEB07E03E4_var*
const
 cIncrArray : array [0..3] of Integer = (64 * 1024, 1024, 128, 4);
 cMaxForTwice : Integer = 1 * 1024 * 1024;
var
 I : Integer;
//#UC END# *51DEC11F0058_51DEB07E03E4_var*
begin
//#UC START# *51DEC11F0058_51DEB07E03E4_impl*
 Assert(aTargetSize > 0);

 Result := aTargetSize;
 if (Result > cMaxForTwice) then
 // большие массивы не удваиваем а подравниваем под 1мб
  Result := (aTargetSize div cMaxForTwice + 1) * cMaxForTwice
 else
 begin
  for I := 0 to High(cIncrArray) do
   if (aTargetSize > cIncrArray[I]) then
   begin
    Result := (aTargetSize div cIncrArray[I]) * cIncrArray[I] * 2;
    Break;
   end;//aTargetSize > cIncrArray[I]
 end;//Result > cMaxForTwic
//#UC END# *51DEC11F0058_51DEB07E03E4_impl*
end;//_List_.ExpandSize

procedure _List_.CheckSetItem(anIndex: IndexType); // can raise EListError
//#UC START# *51DECAA8035E_51DEB07E03E4_var*
//#UC END# *51DECAA8035E_51DEB07E03E4_var*
begin
//#UC START# *51DECAA8035E_51DEB07E03E4_impl*
 CheckIndex(anIndex);
//#UC END# *51DECAA8035E_51DEB07E03E4_impl*
end;//_List_.CheckSetItem

procedure _List_.pm_SetCount(aValue: IndexType);
//#UC START# *51DEB1ED0017_51DEB07E03E4set_var*

 procedure SayBadCount(aNewCount: LongInt);
 begin
  raise EListError.CreateFmt(sListIndexError, [aNewCount]);
 end;

var
 l_Ptr   : PItemType;
 {$IfNDef l3Items_IsUnrefcounted}
 l_Index : Integer;
 {$EndIf  l3Items_IsUnrefcounted}
//#UC END# *51DEB1ED0017_51DEB07E03E4set_var*
begin
//#UC START# *51DEB1ED0017_51DEB07E03E4set_impl*
 if (aValue < 0) then
  SayBadCount(aValue);
 if (aValue < f_Count) then
 begin
  l_Ptr := ItemSlot(aValue);
  {$IfDef l3Items_IsUnrefcounted}
  System.FillChar(l_Ptr^, (f_Count - 1 - aValue) * cItemSize, 0);
  {$Else  l3Items_IsUnrefcounted}
  for l_Index := aValue to f_Count - 1 do
  begin
   FreeItem(l_Ptr^);
   Inc(PMem(l_Ptr), cItemSize);
  end;//for i
  {$EndIf  l3Items_IsUnrefcounted}
 end//aValue < f_Count
 else
 if (aValue > Self.Capacity) then
  ReAllocList(ExpandSize(aValue));
 if (f_Count < aValue) then
  System.FillChar(ItemSlot(f_Count)^, (aValue - f_Count) * cItemSize, 0);
 f_Count := aValue;
//#UC END# *51DEB1ED0017_51DEB07E03E4set_impl*
end;//_List_.pm_SetCount

function _List_.pm_GetCapacity: IndexType;
//#UC START# *51DEB20E0130_51DEB07E03E4get_var*
//#UC END# *51DEB20E0130_51DEB07E03E4get_var*
begin
//#UC START# *51DEB20E0130_51DEB07E03E4get_impl*
 Result := f_Data.GetSize div cItemSize;
//#UC END# *51DEB20E0130_51DEB07E03E4get_impl*
end;//_List_.pm_GetCapacity

procedure _List_.pm_SetCapacity(aValue: IndexType);
//#UC START# *51DEB20E0130_51DEB07E03E4set_var*

 procedure SayBadCap(aNewCapacity: IndexType);
 begin
  raise EListError.CreateFmt(sListIndexError, [aNewCapacity]);
 end;

//#UC END# *51DEB20E0130_51DEB07E03E4set_var*
begin
//#UC START# *51DEB20E0130_51DEB07E03E4set_impl*
 if (aValue < 0) then
  SayBadCap(aValue);
 if (pm_GetCapacity <> aValue) then
 begin
  { If the list is shrinking, then update _Count for the smaller size. }
  if (aValue < f_Count) then
   Count := aValue;
  ReAllocList(aValue);
 end;//GetCapacity(Self) <> aValue
//#UC END# *51DEB20E0130_51DEB07E03E4set_impl*
end;//_List_.pm_SetCapacity

function _List_.pm_GetItems(anIndex: IndexType): _ItemType_;
//#UC START# *51DECA1202C5_51DEB07E03E4get_var*
//#UC END# *51DECA1202C5_51DEB07E03E4get_var*
begin
//#UC START# *51DECA1202C5_51DEB07E03E4get_impl*
 CheckIndex(anIndex);
 Result := ItemSlot(anIndex)^;
//#UC END# *51DECA1202C5_51DEB07E03E4get_impl*
end;//_List_.pm_GetItems

procedure _List_.pm_SetItems(anIndex: IndexType; const aValue: _ItemType_);
//#UC START# *51DECA1202C5_51DEB07E03E4set_var*
{$IfNDef l3Items_IsAtomic}
var
 l_P : PItemType;
{$EndIf  l3Items_IsAtomic}
//#UC END# *51DECA1202C5_51DEB07E03E4set_var*
begin
//#UC START# *51DECA1202C5_51DEB07E03E4set_impl*
 CheckSetItem(anIndex);
 {$IfDef l3Items_IsAtomic}
 PItemType(ItemSlot(anIndex))^ := aValue;
 {$Else  l3Items_IsAtomic}
 l_P := PItemType(ItemSlot(anIndex));
 if not IsSame(l_P^, aValue) then
 begin
  FreeItem(l_P^);
  FillItem(l_P^, aValue);
 end;//not IsSame(l_P^, anItem)
 {$EndIf l3Items_IsAtomic}
//#UC END# *51DECA1202C5_51DEB07E03E4set_impl*
end;//_List_.pm_SetItems

procedure _List_.Cleanup;
//#UC START# *479731C50290_51DEB07E03E4_var*
//#UC END# *479731C50290_51DEB07E03E4_var*
begin
//#UC START# *479731C50290_51DEB07E03E4_impl*
 Count := 0;
 f_Data.SetSize(0);
 inherited;
//#UC END# *479731C50290_51DEB07E03E4_impl*
end;//_List_.Cleanup

{$EndIf List_imp}

UnrefcountedListPrim.imp.pas:

{$IfNDef UnrefcountedListPrim_imp}

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// Библиотека "SandBox"
// Модуль: "UnrefcountedListPrim.imp.pas"
// Родные Delphi интерфейсы (.pas)
// Generated from UML model, root element: Impurity::Class Shared Delphi Sand Box::SandBox::STLLike::UnrefcountedListPrim
//
// Список значений без какого то бы ни было подсчёта ссылок
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

{$Define UnrefcountedListPrim_imp}
 {$Define l3Items_IsUnrefcounted}

 _List_Parent_ = _UnrefcountedListPrim_Parent_;
 {$Include List.imp.pas}
 _UnrefcountedListPrim_ = {mixin} class(_List_)
  {* Список значений без какого то бы ни было подсчёта ссылок }
 end;//_UnrefcountedListPrim_

{$Else UnrefcountedListPrim_imp}

// start class _UnrefcountedListPrim_

function IsSame(const A: _ItemType_;
  const B: _ItemType_): Boolean;
//#UC START# *51DECB820261_51DED02E0163_var*
//#UC END# *51DECB820261_51DED02E0163_var*
begin
//#UC START# *51DECB820261_51DED02E0163_impl*
 Result := (A = B);
//#UC END# *51DECB820261_51DED02E0163_impl*
end;//IsSame

type _List_R_ = _UnrefcountedListPrim_;

{$Include List.imp.pas}


{$EndIf UnrefcountedListPrim_imp}

AtomicList.imp.pas:

{$IfNDef AtomicList_imp}

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// Библиотека "SandBox"
// Модуль: "AtomicList.imp.pas"
// Родные Delphi интерфейсы (.pas)
// Generated from UML model, root element: Impurity::Class Shared Delphi Sand Box::SandBox::STLLike::AtomicList
//
// Список атомарных значений
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

{$Define AtomicList_imp}
 {$Define l3Items_IsAtomic}

 _UnrefcountedListPrim_Parent_ = _AtomicList_Parent_;
 {$Include UnrefcountedListPrim.imp.pas}
 _AtomicList_ = {mixin} class(_UnrefcountedListPrim_)
  {* Список атомарных значений }
 end;//_AtomicList_

{$Else AtomicList_imp}

// start class _AtomicList_

procedure FillItem(var thePlace: _ItemType_;
  const aFrom: _ItemType_); forward;

procedure FreeItem(var thePlace: _ItemType_);
//#UC START# *51DEC20B01D7_51DED48301D9_var*
//#UC END# *51DEC20B01D7_51DED48301D9_var*
begin
//#UC START# *51DEC20B01D7_51DED48301D9_impl*
 thePlace := _ItemType_(0);
//#UC END# *51DEC20B01D7_51DED48301D9_impl*
end;//FreeItem

procedure FillItem(var thePlace: _ItemType_;
  const aFrom: _ItemType_);
//#UC START# *51DECB440087_51DED48301D9_var*
//#UC END# *51DECB440087_51DED48301D9_var*
begin
//#UC START# *51DECB440087_51DED48301D9_impl*
 thePlace := aFrom;
//#UC END# *51DECB440087_51DED48301D9_impl*
end;//FillItem

type _UnrefcountedListPrim_R_ = _AtomicList_;

{$Include UnrefcountedListPrim.imp.pas}


{$EndIf AtomicList_imp}

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

Интересна ли кому-нибудь статистика распределения памяти?

Интересна ли кому-нибудь статистика распределения памяти после прогона комплекта из порядка 1000 тестов?

Я тут набрал статистику в виде: размер распределяемого куска - количество раз, которые данный кусок распределялся.

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

Могу опубликовать такую табличку.

18-ть лет с Delphi

воскресенье, 14 июля 2013 г.

Offtopic. Тесты.. Teсты...

Тесты "по-русски"

Ошибки.. ошибки... ошибки...

Чужая статья. Запустить тесты и собрать проект – одной командой. Подписываюсь под КАЖДЫМ словом

суббота, 13 июля 2013 г.

Ещё смешное из VCL

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

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

четверг, 11 июля 2013 г.

Дальше будем делать конкретные "неатомарные" контейнеры

Выводим конкретные атомарные контейнеры из абстрактных

Абстрактные контейнеры

Интересна ли кому-нибудь статистика распределения памяти?

воскресенье, 14 июля 2013 г.

суббота, 13 июля 2013 г.

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

четверг, 11 июля 2013 г.

воскресенье, 14 июля 2013 г.

суббота, 13 июля 2013 г.

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

четверг, 11 июля 2013 г.