суббота, 28 февраля 2015 г.
четверг, 26 февраля 2015 г.
Containers 10. About patterns and mixins
Original in Russian: http://18delphi.blogspot.ru/2013/03/blog-post_29.html
About containers. Table of contents
Now let’s talk about mixins a bit.
The theory can be read here:
https://en.wikipedia.org/wiki/Mixin
Instead, we’ll go in for practice.
Let’s look at the definition:
In object-oriented programming languages, a mixin is a class that contains a combination of methods from other classes. How such a combination is done depends on the language, but it is not by inheritance. If a combination contains all methods of combined classes, it is equivalent tomultiple inheritance.
Mixins encourage code reuse and can be used to avoid the inheritance ambiguity that multiple inheritance can cause (the "diamond problem"), or to work around lack of support for multiple inheritance in a language.
A mixin can also be viewed as an interface with implemented methods. When a class includes a mixin, the class implements the interface and includes, rather than inherits, all the mixin's attributes (fields, properties) and methods. They become part of the class during compilation.
A mixin can defer definition and binding of methods untilruntime, though attributes and instantiation parameters are still defined at compile time. This differs from the most widely used approach (which originated in the programming language Simula) of defining all attributes, methods and initialization at compile time.
Those who code on C++ are lucky, because they have multiple inheritance and the question “how to add mixin to the existing class hierarchy” does not arise. Delphi programmers are not lucky. There is no multiple inheritance. Actually, thank God – mixins are far more highly specialized tool then multiple inheritance.
I will write separately about the particular examples of using the mixins in life. And now let’s consider a purely abstract example illustrating only the technique of embedding the mixin class to the hierarchy of inheritance of designed classes.
In the previous article we had an example:
Let’s redraw the diagram in this way:
We can see that functionality of Stack'а has completely moved to StackPrim.
And two more classes have appeared – TintStackFromPersisten, inherited from TPersistent and StackPrim, and class TIntStackFromComponent, inherited from TComponent and StackPrim.
Multiple inheritance – you’d ask. Logically – yes. At the level of the diagrams arrows.
Let’s see how it all looks on Delphi:
StackPrim.imp.pas:
---------------------------------------------
Stack.imp.pas:
---------------------------------------------
StringStack.pas:
---------------------------------------------
IntStack.pas:
---------------------------------------------
!!! And there are two NEW classes:
---------------------------------------------
IntStackFromPersistent.pas:
---------------------------------------------
IntStackFromComponent.pas:
---------------------------------------------
As for me, it is fun :-) There is only ONE mixin, but it is added to FOUR different classes and even different places in the hierarchy of the inheritance.
Try it. May be you will like it.
In the next series I will try to tell WHY do I use it.
About containers. Table of contents
Now let’s talk about mixins a bit.
The theory can be read here:
https://en.wikipedia.org/wiki/Mixin
Instead, we’ll go in for practice.
Let’s look at the definition:
In object-oriented programming languages, a mixin is a class that contains a combination of methods from other classes. How such a combination is done depends on the language, but it is not by inheritance. If a combination contains all methods of combined classes, it is equivalent tomultiple inheritance.
Mixins encourage code reuse and can be used to avoid the inheritance ambiguity that multiple inheritance can cause (the "diamond problem"), or to work around lack of support for multiple inheritance in a language.
A mixin can also be viewed as an interface with implemented methods. When a class includes a mixin, the class implements the interface and includes, rather than inherits, all the mixin's attributes (fields, properties) and methods. They become part of the class during compilation.
A mixin can defer definition and binding of methods untilruntime, though attributes and instantiation parameters are still defined at compile time. This differs from the most widely used approach (which originated in the programming language Simula) of defining all attributes, methods and initialization at compile time.
Those who code on C++ are lucky, because they have multiple inheritance and the question “how to add mixin to the existing class hierarchy” does not arise. Delphi programmers are not lucky. There is no multiple inheritance. Actually, thank God – mixins are far more highly specialized tool then multiple inheritance.
I will write separately about the particular examples of using the mixins in life. And now let’s consider a purely abstract example illustrating only the technique of embedding the mixin class to the hierarchy of inheritance of designed classes.
In the previous article we had an example:
Let’s redraw the diagram in this way:
We can see that functionality of Stack'а has completely moved to StackPrim.
And two more classes have appeared – TintStackFromPersisten, inherited from TPersistent and StackPrim, and class TIntStackFromComponent, inherited from TComponent and StackPrim.
Multiple inheritance – you’d ask. Logically – yes. At the level of the diagrams arrows.
Let’s see how it all looks on Delphi:
StackPrim.imp.pas:
{$IfNDef StackPrim_imp}
{$Define StackPrim_imp}
ItemsHolder = array of _ItemType_;
_StackPrim_ = {mixin} class(_StackPrim_Parent_)
private
// private fields
f_Items : ItemsHolder;
public
// public methods
procedure Push(const anItem: _ItemType_);
function Pop: _ItemType_;
end;//_StackPrim_
{$Else StackPrim_imp}
// start class _StackPrim_
procedure _StackPrim_.Push(const anItem: _ItemType_);
var
l_L : Integer;
begin
l_L := Length(f_Items);
SetLength(f_Items, l_L + 1);
f_Items[l_L] := anItem;
end;//_StackPrim_.Push
function _StackPrim_.Pop: _ItemType_;
var
l_L : Integer;
begin
l_L := Length(f_Items) - 1;
Result := f_Items[l_L];
SetLength(f_Items, l_L);
end;//_StackPrim_.Pop
{$EndIf StackPrim_imp}
---------------------------------------------
Stack.imp.pas:
{$IfNDef Stack_imp}
{$Define Stack_imp}
_StackPrim_Parent_ = TObject;
{$Include StackPrim.imp.pas}
_Stack_ = {mixin} class(_StackPrim_)
end;//_Stack_
{$Else Stack_imp}
{$Include StackPrim.imp.pas}
{$EndIf Stack_imp}
---------------------------------------------
StringStack.pas:
unit StringStack;
interface
type
_ItemType_ = AnsiString;
{$Include Stack.imp.pas}
TStringStack = class(_Stack_)
end;//TStringStack
implementation
{$Include Stack.imp.pas}
end.
---------------------------------------------
IntStack.pas:
unit IntStack;
interface
type
_ItemType_ = Integer;
{$Include Stack.imp.pas}
TIntStack = class(_Stack_)
end;//TIntStack
implementation
{$Include Stack.imp.pas}
end
---------------------------------------------
!!! And there are two NEW classes:
---------------------------------------------
IntStackFromPersistent.pas:
unit IntStackFromPersistent;
interface
uses
Classes
;
type
_ItemType_ = Integer;
_StackPrim_Parent_ = TPersistent;
{$Include StackPrim.imp.pas}
TIntStackFromPersistent = class(_StackPrim_)
end;//TIntStackFromPersistent
implementation
{$Include StackPrim.imp.pas}
end.
---------------------------------------------
IntStackFromComponent.pas:
unit IntStackFromComponent;
interface
uses
Classes
;
type
_ItemType_ = Integer;
_StackPrim_Parent_ = TComponent;
{$Include StackPrim.imp.pas}
TIntStackFromComponent = class(_StackPrim_)
end;//TIntStackFromComponent
implementation
{$Include StackPrim.imp.pas}
end.
---------------------------------------------
As for me, it is fun :-) There is only ONE mixin, but it is added to FOUR different classes and even different places in the hierarchy of the inheritance.
Try it. May be you will like it.
In the next series I will try to tell WHY do I use it.
Containers 9. Special containers. Part 2
Original in Russian: http://18delphi.blogspot.ru/2013/07/2_18.html
About containers. Table of contents
The previous series was here - http://18delphi.blogspot.com/2015/02/containers-8-deriving-of-specific.html
And here - http://18delphi.blogspot.com/2015/02/containers-7-abstract-containers-part-2.html
Now let’s look how special containers have changed.
The model:
The code:
StandardAtomicList.imp.pas:
IUnknownRefListTest.pas:
About containers. Table of contents
The previous series was here - http://18delphi.blogspot.com/2015/02/containers-8-deriving-of-specific.html
And here - http://18delphi.blogspot.com/2015/02/containers-7-abstract-containers-part-2.html
Now let’s look how special containers have changed.
The model:
The code:
StandardAtomicList.imp.pas:
StandardAtomicList.imp.pas:
{$IfNDef StandardAtomicList_imp}
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBox"
// The unit: "StandardAtomicList.imp.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: Impurity::Class Shared Delphi Sand Box::SandBox::FinalContainers::StandardAtomicList
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$Define StandardAtomicList_imp}
_AtomicList_Parent_ = TRefcounted;
{$Include ..\SandBox\AtomicList.imp.pas}
_StandardAtomicList_ = {mixin} class(_AtomicList_)
end;//_StandardAtomicList_
{$Else StandardAtomicList_imp}
{$Include ..\SandBox\AtomicList.imp.pas}
{$EndIf StandardAtomicList_imp}
IntegerList.pas:
unit IntegerList;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBox"
// The unit: "IntegerList.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: SimpleClass::Class Shared Delphi Sand Box::SandBox::FinalContainers::TIntegerList
//
// The list of Integer's
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$Include ..\SandBox\sbDefine.inc}
interface
uses
Refcounted,
Classes,
l3PtrLoc
;
type
_ItemType_ = Integer;
{$Include ..\SandBox\StandardAtomicList.imp.pas}
TIntegerList = class(_StandardAtomicList_)
{* The list of Integer's }
end;//TIntegerList
implementation
uses
RTLConsts,
l3MemorySizeUtils
;
{$Include ..\SandBox\StandardAtomicList.imp.pas}
end.
Int64List.pas:
unit Int64List;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBox"
// The unit: "Int64List.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: SimpleClass::Class Shared Delphi Sand Box::SandBox::FinalContainers::TInt64List
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$Include ..\SandBox\sbDefine.inc}
interface
uses
Refcounted,
Classes,
l3PtrLoc
;
type
_ItemType_ = Int64;
{$Include ..\SandBox\StandardAtomicList.imp.pas}
TInt64List = class(_StandardAtomicList_)
end;//TInt64List
implementation
uses
RTLConsts,
l3MemorySizeUtils
;
{$Include ..\SandBox\StandardAtomicList.imp.pas}
end.
ByteList.pas:
unit ByteList;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBox"
// The unit: "ByteList.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: SimpleClass::Class Shared Delphi Sand Box::SandBox::FinalContainers::TByteList
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$Include ..\SandBox\sbDefine.inc}
interface
uses
Refcounted,
Classes,
l3PtrLoc
;
type
_ItemType_ = Byte;
{$Include ..\SandBox\StandardAtomicList.imp.pas}
TByteList = class(_StandardAtomicList_)
end;//TByteList
implementation
uses
RTLConsts,
l3MemorySizeUtils
;
{$Include ..\SandBox\StandardAtomicList.imp.pas}
end.
IUnknownRefList.pas:
unit IUnknownRefList;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBox"
// The unit: "IUnknownRefList.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: SimpleClass::Class Shared Delphi Sand Box::SandBox::FinalContainers::TIUnknownRefList
//
// The list of the REFERENCES to IUnknown
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$Include ..\SandBox\sbDefine.inc}
interface
uses
Refcounted,
Classes,
l3PtrLoc
;
type
_ItemType_ = IUnknown;
_InterfaceRefList_Parent_ = TRefcounted;
{$Include ..\SandBox\InterfaceRefList.imp.pas}
TIUnknownRefList = class(_InterfaceRefList_)
{* The list of the REFERENCES to IUnknown }
end;//TIUnknownRefList
implementation
uses
RTLConsts,
l3MemorySizeUtils
;
{$Include ..\SandBox\InterfaceRefList.imp.pas}
end.
IUnknownPtrList.pas:
unit IUnknownPtrList;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBox"
// The unit: "IUnknownPtrList.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: SimpleClass::Class Shared Delphi Sand Box::SandBox::FinalContainers::TIUnknownPtrList
//
// The list of the POINTERS to IUnknown
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$Include ..\SandBox\sbDefine.inc}
interface
uses
Refcounted,
Classes,
l3PtrLoc
;
type
_ItemType_ = IUnknown;
_InterfacePtrList_Parent_ = TRefcounted;
{$Include ..\SandBox\InterfacePtrList.imp.pas}
TIUnknownPtrList = class(_InterfacePtrList_)
{* The list of the POINTERS to IUnknown }
end;//TIUnknownPtrList
implementation
uses
RTLConsts,
l3MemorySizeUtils
;
{$Include ..\SandBox\InterfacePtrList.imp.pas}
end.
And the tests.
The model:
pic2
pic3
The code:
ListTest.imp.pas:
{$IfNDef ListTest_imp}
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBoxTest"
// The unit: "ListTest.imp.pas"
// Native Delphi interfaces (.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)
protected
// protected methods
function CreateList: _ListType_;
{* Creates the list for testing }
end;//_ListTest_
{$IfEnd} //nsTest
{$Else ListTest_imp}
{$If defined(nsTest)}
// start class _ListTest_
function _ListTest_.CreateList: _ListType_;
//#UC START# *51E80E0D030D_51E80DD30125_var*
//#UC END# *51E80E0D030D_51E80DD30125_var*
begin
//#UC START# *51E80E0D030D_51E80DD30125_impl*
Result := _ListType_.Create;
//#UC END# *51E80E0D030D_51E80DD30125_impl*
end;//_ListTest_.CreateList
{$IfEnd} //nsTest
{$EndIf ListTest_imp}
AtomicListTest.imp.pas:
{$IfNDef AtomicListTest_imp}
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBoxTest"
// The unit: "AtomicListTest.imp.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: TestCaseMixIn::Class Shared Delphi Sand Box::SandBoxTest::FinalContainersTests::AtomicListTest
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$Define AtomicListTest_imp}
{$If defined(nsTest)}
{$Include ..\SandBox\ListTest.imp.pas}
_AtomicListTest_ = class(_ListTest_)
private
// private methods
function RandomItem: _ItemType_;
published
// published methods
procedure DoIt;
procedure TestTwoLists;
procedure TestInsert;
procedure TestInsertAt0;
procedure DeleteTest;
{* The test of item deleting }
procedure AddTest;
{* The test of item adding }
procedure RemoveTest;
{* The test of item deleting by the value }
end;//_AtomicListTest_
{$IfEnd} //nsTest
{$Else AtomicListTest_imp}
{$If defined(nsTest)}
{$Include ..\SandBox\ListTest.imp.pas}
// start class _AtomicListTest_
function _AtomicListTest_.RandomItem: _ItemType_;
//#UC START# *51E6ADE0016E_51E03FC80111_var*
var
l_V : Cardinal;
//#UC END# *51E6ADE0016E_51E03FC80111_var*
begin
//#UC START# *51E6ADE0016E_51E03FC80111_impl*
l_V := Random(1000);
if (l_V > High(_ItemType_)) then
Result := High(_ItemType_)
else
Result := l_V;
//#UC END# *51E6ADE0016E_51E03FC80111_impl*
end;//_AtomicListTest_.RandomItem
procedure _AtomicListTest_.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 := CreateList;
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('We’ve allocated %d items. Count = %d', [l_Count, l_List.Count]));
Check(l_List.Capacity >= l_Count, Format('We’ve allocated %d items. 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;//_AtomicListTest_.DoIt
procedure _AtomicListTest_.TestTwoLists;
//#UC START# *51DED6FC03C1_51E03FC80111_var*
const
cCount = 1000;
var
l_A : _ListType_;
l_B : _ListType_;
l_Index : IndexType;
l_Value : _ItemType_;
//#UC END# *51DED6FC03C1_51E03FC80111_var*
begin
//#UC START# *51DED6FC03C1_51E03FC80111_impl*
l_A := CreateList;
try
l_B := CreateList;
try
l_A.Count := cCount;
for l_Index := 0 to l_A.Count - 1 do
begin
l_Value := RandomItem;
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;//_AtomicListTest_.TestTwoLists
procedure _AtomicListTest_.TestInsert;
//#UC START# *51E6AC74038B_51E03FC80111_var*
const
cCount = 1000;
var
l_List : _ListType_;
l_Value : _ItemType_;
l_Index : IndexType;
//#UC END# *51E6AC74038B_51E03FC80111_var*
begin
//#UC START# *51E6AC74038B_51E03FC80111_impl*
l_List := CreateList;
try
for l_Index := 0 to cCount do
begin
l_Value := RandomItem;
l_List.Insert(l_Index, l_Value);
Check(l_List.Count = l_Index + 1);
Check(l_List[l_Index] = l_Value);
end;//for l_Index
finally
FreeAndNil(l_List);
end;//try..finally
//#UC END# *51E6AC74038B_51E03FC80111_impl*
end;//_AtomicListTest_.TestInsert
procedure _AtomicListTest_.TestInsertAt0;
//#UC START# *51E6B4260008_51E03FC80111_var*
const
cCount = 1000;
var
l_List : _ListType_;
l_Value : _ItemType_;
l_Index : IndexType;
//#UC END# *51E6B4260008_51E03FC80111_var*
begin
//#UC START# *51E6B4260008_51E03FC80111_impl*
l_List := CreateList;
try
for l_Index := 0 to cCount do
begin
l_Value := RandomItem;
l_List.Insert(0, l_Value);
Check(l_List.Count = l_Index + 1);
Check(l_List[0] = l_Value);
end;//for l_Index
finally
FreeAndNil(l_List);
end;//try..finally
//#UC END# *51E6B4260008_51E03FC80111_impl*
end;//_AtomicListTest_.TestInsertAt0
procedure _AtomicListTest_.DeleteTest;
//#UC START# *51E7F6EF0285_51E03FC80111_var*
const
cCount = 1000;
var
l_List : _ListType_;
l_Value : _ItemType_;
l_Index : IndexType;
l_Prev : _ItemType_;
//#UC END# *51E7F6EF0285_51E03FC80111_var*
begin
//#UC START# *51E7F6EF0285_51E03FC80111_impl*
l_List := CreateList;
try
for l_Index := 0 to cCount do
begin
l_Value := RandomItem;
l_List.Insert(l_Index, l_Value);
Check(l_List.Count = l_Index + 1);
Check(l_List[l_Index] = l_Value);
end;//for l_Index
while not l_List.Empty do
begin
l_Index := Random(l_List.Count - 1);
if (l_Index < l_List.Count - 1) then
begin
l_Prev := l_List[l_Index + 1];
l_List.Delete(l_Index);
if l_List.Empty then
break;
Check(l_List[l_Index] = l_Prev);
end//l_Index < l_List.Count - 1
else
begin
if (l_Index = 0) then
l_List.Delete(l_Index)
else
begin
l_Prev := l_List[l_Index - 1];
l_List.Delete(l_Index);
if l_List.Empty then
break;
Check(l_List[l_Index - 1] = l_Prev);
end;//l_Index = 0
end;//l_Index < l_List.Count - 1
end;//while l_List.Count
finally
FreeAndNil(l_List);
end;//try..finally
//#UC END# *51E7F6EF0285_51E03FC80111_impl*
end;//_AtomicListTest_.DeleteTest
procedure _AtomicListTest_.AddTest;
//#UC START# *51E80DC50154_51E03FC80111_var*
const
cCount = 1000;
var
l_List : _ListType_;
l_Value : _ItemType_;
l_Index : IndexType;
//#UC END# *51E80DC50154_51E03FC80111_var*
begin
//#UC START# *51E80DC50154_51E03FC80111_impl*
l_List := CreateList;
try
for l_Index := 0 to cCount do
begin
l_Value := RandomItem;
l_List.Add(l_Value);
Check(l_List.Last = l_Value);
end;//for l_Index
finally
FreeAndNil(l_List);
end;//try..finally
//#UC END# *51E80DC50154_51E03FC80111_impl*
end;//_AtomicListTest_.AddTest
procedure _AtomicListTest_.RemoveTest;
//#UC START# *51E8127802AF_51E03FC80111_var*
const
cCount = 1000;
var
l_List : _ListType_;
l_Value : _ItemType_;
l_Index : IndexType;
//#UC END# *51E8127802AF_51E03FC80111_var*
begin
//#UC START# *51E8127802AF_51E03FC80111_impl*
l_List := CreateList;
try
for l_Index := 0 to cCount do
begin
l_Value := RandomItem;
l_List.Add(l_Value);
Check(l_List.Last = l_Value);
end;//for l_Index
while not l_List.Empty do
begin
l_Value := RandomItem;
l_List.Remove(l_Value);
end;//while not
finally
FreeAndNil(l_List);
end;//try..finally
//#UC END# *51E8127802AF_51E03FC80111_impl*
end;//_AtomicListTest_.RemoveTest
{$IfEnd} //nsTest
{$EndIf AtomicListTest_imp}
IUnknownRefListTest.pas:
unit IUnknownRefListTest;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBoxTest"
// The unit: "IUnknownRefListTest.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: TestCase::Class Shared Delphi Sand Box::SandBoxTest::FinalContainersTests::IUnknownRefListTest
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$Include ..\SandBox\sbtDefine.inc}
interface
{$If defined(nsTest)}
uses
TestFrameWork,
IUnknownRefList
;
{$IfEnd} //nsTest
{$If defined(nsTest)}
type
_ListType_ = TIUnknownRefList;
{$Include ..\SandBox\ListTest.imp.pas}
TIUnknownRefListTest = class(_ListTest_)
published
// published methods
procedure DoIt;
end;//TIUnknownRefListTest
{$IfEnd} //nsTest
implementation
{$If defined(nsTest)}
uses
SysUtils
;
{$IfEnd} //nsTest
{$If defined(nsTest)}
{$Include ..\SandBox\ListTest.imp.pas}
// start class TIUnknownRefListTest
procedure TIUnknownRefListTest.DoIt;
//#UC START# *51E80B2F02CF_51E80B08039E_var*
var
l_List : _ListType_;
//#UC END# *51E80B2F02CF_51E80B08039E_var*
begin
//#UC START# *51E80B2F02CF_51E80B08039E_impl*
l_List := CreateList;
try
// - For now we do nothing
finally
FreeAndNil(l_List);
end;//try..finally
//#UC END# *51E80B2F02CF_51E80B08039E_impl*
end;//TIUnknownRefListTest.DoIt
{$IfEnd} //nsTest
initialization
TestFramework.RegisterTest(TIUnknownRefListTest.Suite);
end.
Containers 8. Deriving of specific atomic containers from abstract ones
Original in Russian: http://18delphi.blogspot.ru/2013/07/blog-post_8789.html
About containers. Table of contents
The previous series was here - http://18delphi.blogspot.com/2015/02/containers-7-abstract-containers-part-2.html
Now let us derive from abstract containers of the previous series – the specific ones. As yet – atomic ones.
So. As usual.
The model:
The code:
IntegerList.pas:
The tests (picked out of the thin air, nevertheless they have the right to live).
The model of the tests:
The code of the tests:
IntegerListTest.pas:
The code is here - http://sourceforge.net/p/rumtmarc/code-0/19/tree/trunk/Blogger/SandBox and http://sourceforge.net/p/rumtmarc/code-0/19/tree/trunk/Blogger/SandBoxTest
About containers. Table of contents
The previous series was here - http://18delphi.blogspot.com/2015/02/containers-7-abstract-containers-part-2.html
Now let us derive from abstract containers of the previous series – the specific ones. As yet – atomic ones.
So. As usual.
The model:
The code:
IntegerList.pas:
unit IntegerList;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBox"
// The unit: "IntegerList.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: SimpleClass::Class Shared Delphi Sand Box::SandBox::FinalContainers::TIntegerList
//
// The list of Integer's
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// ! Fully generated from the model. It is not allowed to edit manually. !
interface
uses
Refcounted,
Classes,
l3PtrLoc
;
type
_ItemType_ = Integer;
_AtomicList_Parent_ = TRefcounted;
{$Include AtomicList.imp.pas}
TIntegerList = class(_AtomicList_)
{* The list of Integer's }
end;//TIntegerList
implementation
uses
RTLConsts,
l3MemorySizeUtils
;
type _Instance_R_ = TIntegerList;
type _AtomicList_R_ = TIntegerList;
{$Include AtomicList.imp.pas}
end.
ByteList.pas:
unit ByteList;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBox"
// The unit: "ByteList.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: SimpleClass::Class Shared Delphi Sand Box::SandBox::FinalContainers::TByteList
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// ! Fully generated from the model. It is not allowed to edit manually. !
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;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBox"
// The unit: "Int64List.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: SimpleClass::Class Shared Delphi Sand Box::SandBox::FinalContainers::TInt64List
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// ! Fully generated from the model. It is not allowed to edit manually. !
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.
The tests (picked out of the thin air, nevertheless they have the right to live).
The model of the tests:
The code of the tests:
IntegerListTest.pas:
unit IntegerListTest;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBoxTest"
// The unit: "IntegerListTest.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: TestCase::Class Shared Delphi Sand Box::SandBoxTest::FinalContainersTests::IntegerListTest
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// ! Fully generated from the model. It is not allowed to edit manually. !
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('We’ve allocated %d items. Count = %d', [l_Count, l_List.Count]));
Check(l_List.Capacity >= l_Count, Format('We’ve allocated %d items. 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;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBoxTest"
// The unit: "ByteListTest.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: TestCase::Class Shared Delphi Sand Box::SandBoxTest::FinalContainersTests::ByteListTest
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// ! Fully generated from the model. It is not allowed to edit manually. !
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('We’ve allocated %d items. Count = %d', [l_Count, l_List.Count]));
Check(l_List.Capacity >= l_Count, Format('We’ve allocated %d items. 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;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBoxTest"
// The unit: "Int64ListTest.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: TestCase::Class Shared Delphi Sand Box::SandBoxTest::FinalContainersTests::Int64ListTest
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// ! Fully generated from the model. It is not allowed to edit manually. !
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('We’ve allocated %d items. Count = %d', [l_Count, l_List.Count]));
Check(l_List.Capacity >= l_Count, Format('We’ve allocated %d items. 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.
The code is here - http://sourceforge.net/p/rumtmarc/code-0/19/tree/trunk/Blogger/SandBox and http://sourceforge.net/p/rumtmarc/code-0/19/tree/trunk/Blogger/SandBoxTest
Containers 7. Abstract containers. Part 2
Original in Russian: http://18delphi.blogspot.ru/2013/07/2.html
About containers. Table of contents
The previous series was here - http://18delphi.blogspot.com/2015/02/containers-6-abstract-containers.html
Let’s extend the functionality of the container by adding the “standard” container operations.
As usual we’ll start with the model:
And the code:
List.imp.pas:
InterfacePtrList.imp.pas:
InterfaceRefList.imp.pas:
About containers. Table of contents
The previous series was here - http://18delphi.blogspot.com/2015/02/containers-6-abstract-containers.html
Let’s extend the functionality of the container by adding the “standard” container operations.
As usual we’ll start with the model:
And the code:
List.imp.pas:
{$IfNDef List_imp}
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBox"
// The unit: "List.imp.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: Impurity::Class Shared Delphi Sand Box::SandBox::STLLike::List
//
// The abstract list of values
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$Define List_imp}
PItemType = ^_ItemType_;
const
{ Sizes }
cItemSize = SizeOf(_ItemType_);
type
IndexType = System.Integer;
_List_ = {mixin} class(_List_Parent_)
{* The abstract list of values }
private
// private fields
f_Data : Tl3PtrLoc;
{* That is actually the place to store data }
f_Count : IndexType;
{* Field for the property Count}
private
// private methods
procedure ReAllocList(aNewCapacity: IndexType);
procedure CheckIndex(anIndex: IndexType); // can raise EListError
{* checks the validity of the index and raises an exception if it is incorrect }
function ItemSlot(anIndex: IndexType): PItemType;
function ExpandSize(aTargetSize: IndexType): Cardinal;
procedure CheckSetItem(anIndex: IndexType); // can raise EListError
{* Checks the validity of the index upon insert }
procedure DirectInsert(anIndex: IndexType;
const anItem: _ItemType_);
{* Direct adding of the item. Without checking the validity of the index }
procedure MoveItems(aDst: IndexType;
aSrc: IndexType;
aSize: Cardinal);
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_);
function pm_GetEmpty: Boolean;
function pm_GetFirst: _ItemType_;
function pm_GetLast: _ItemType_;
protected
// overridden protected methods
procedure Cleanup; override;
{* The function of object fields cleaning. }
public
// public methods
procedure Delete(anIndex: IndexType); // can raise EListError
{* delete the item with index anIndex }
procedure Insert(anIndex: IndexType;
const anItem: _ItemType_); // can raise EListError
{* Adding of the item }
procedure Add(const anItem: _ItemType_);
{* Adds an item of the list }
function IndexOf(const anItem: _ItemType_): IndexType;
{* Returns the index of the list item or -1, if there is no item in the list }
procedure Remove(const anIndex: _ItemType_);
{* Deletes an item from the list }
procedure Clear;
{* Clears the list }
public
// public properties
property Count: IndexType
read f_Count
write pm_SetCount;
{* The number of items in the list }
property Capacity: IndexType
read pm_GetCapacity
write pm_SetCapacity;
{* The capacity of the list }
property Items[anIndex: IndexType]: _ItemType_
read pm_GetItems
write pm_SetItems;
default;
{* The items of the list. }
property Empty: Boolean
read pm_GetEmpty;
{* The list is empty }
property First: _ItemType_
read pm_GetFirst;
{* The first item of the list }
property Last: _ItemType_
read pm_GetLast;
{* The last item of the list }
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
// we do not double large arrays, but even them to 1 Mb
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_.DirectInsert(anIndex: IndexType;
const anItem: _ItemType_);
//#UC START# *51E6A2AA02E4_51DEB07E03E4_var*
var
l_Cap : Integer;
l_Count : Integer;
//#UC END# *51E6A2AA02E4_51DEB07E03E4_var*
begin
//#UC START# *51E6A2AA02E4_51DEB07E03E4_impl*
l_Count := f_Count;
l_Cap := Self.Capacity;
if (l_Count >= l_Cap) then
ReAllocList(ExpandSize(l_Cap + 1));
{ Make room for the inserted item. }
Dec(l_Count, anIndex);
if (l_Count > 0) then
begin
MoveItems(anIndex + 1, anIndex + 0, l_Count);
{$If not defined(l3Items_IsAtomic)}
FillChar(PMem(ItemSlot(anIndex))^, cItemSize, 0);
// - To ensure that there is no odd reference to the lines and/or the interfaces
{$IfEnd}
end;//l_Count > 0
FillItem(ItemSlot(anIndex)^, anItem);
Inc(f_Count);
{$IfDef l3Items_IsAtomic}
Assert(ItemSlot(anIndex)^ = anItem);
{$Else l3Items_IsAtomic}
{$If (SizeOf(_ItemType_) <= 4) AND not Defined(l3Items_IsProcedured)}
Assert(ItemSlot(anIndex)^ = anItem);
{$IfEnd}
{$EndIf l3Items_IsAtomic}
//#UC END# *51E6A2AA02E4_51DEB07E03E4_impl*
end;//_List_.DirectInsert
procedure _List_.MoveItems(aDst: IndexType;
aSrc: IndexType;
aSize: Cardinal);
//#UC START# *51E6A8190252_51DEB07E03E4_var*
type
PInteger = ^Integer;
var
l_Sz : Integer;
l_S : Integer;
l_D : Integer;
l_B : PMem;
//#UC END# *51E6A8190252_51DEB07E03E4_var*
begin
//#UC START# *51E6A8190252_51DEB07E03E4_impl*
if (aSize > 0) then
begin
l_B := f_Data.AsPointer;
l_S := aSrc * cItemSize;
l_D := aDst * cItemSize;
l_Sz := aSize * cItemSize;
if (l_Sz = SizeOf(Integer)) then
begin
PInteger(l_B + l_D)^ := PInteger(l_B + l_S)^;
Exit;
end//l_Sz = SizeOf(Integer)
else
Move((l_B + l_S)^, (l_B + l_D)^, l_Sz);
end;//aSize > 0
//#UC END# *51E6A8190252_51DEB07E03E4_impl*
end;//_List_.MoveItems
procedure _List_.Delete(anIndex: IndexType); // can raise EListError
//#UC START# *51E6A2660270_51DEB07E03E4_var*
var
l_P : PItemType;
//#UC END# *51E6A2660270_51DEB07E03E4_var*
begin
//#UC START# *51E6A2660270_51DEB07E03E4_impl*
CheckIndex(anIndex);
l_P := ItemSlot(anIndex);
Dec(f_Count);
FreeItem(l_P^);
if (anIndex <> f_Count) then
MoveItems(anIndex, Succ(anIndex), f_Count-anIndex);
//#UC END# *51E6A2660270_51DEB07E03E4_impl*
end;//_List_.Delete
procedure _List_.Insert(anIndex: IndexType;
const anItem: _ItemType_); // can raise EListError
//#UC START# *51E6A3140016_51DEB07E03E4_var*
procedure _Error;
begin
raise EListError.CreateFmt(SListIndexError, [anIndex]);
end;
//#UC END# *51E6A3140016_51DEB07E03E4_var*
begin
//#UC START# *51E6A3140016_51DEB07E03E4_impl*
if (anIndex < 0) or (anIndex > f_Count) then
_Error;
DirectInsert(anIndex, anItem)
//#UC END# *51E6A3140016_51DEB07E03E4_impl*
end;//_List_.Insert
procedure _List_.Add(const anItem: _ItemType_);
//#UC START# *51E80192036C_51DEB07E03E4_var*
//#UC END# *51E80192036C_51DEB07E03E4_var*
begin
//#UC START# *51E80192036C_51DEB07E03E4_impl*
DirectInsert(f_Count, anItem);
//#UC END# *51E80192036C_51DEB07E03E4_impl*
end;//_List_.Add
function _List_.IndexOf(const anItem: _ItemType_): IndexType;
//#UC START# *51E801D503C5_51DEB07E03E4_var*
var
l_Index : IndexType;
//#UC END# *51E801D503C5_51DEB07E03E4_var*
begin
//#UC START# *51E801D503C5_51DEB07E03E4_impl*
Result := -1;
// - let’s be pessimistic
for l_Index := 0 to f_Count - 1 do
begin
if IsSame(ItemSlot(l_Index)^, anItem) then
begin
Result := l_Index;
break;
end;//IsSame(ItemSlot(l_Index)^, anItem)
end;//for l_Index
//#UC END# *51E801D503C5_51DEB07E03E4_impl*
end;//_List_.IndexOf
procedure _List_.Remove(const anIndex: _ItemType_);
//#UC START# *51E802290167_51DEB07E03E4_var*
var
l_Index : IndexType;
//#UC END# *51E802290167_51DEB07E03E4_var*
begin
//#UC START# *51E802290167_51DEB07E03E4_impl*
l_Index := IndexOf(anIndex);
if (l_Index >= 0) then
Delete(l_Index);
//#UC END# *51E802290167_51DEB07E03E4_impl*
end;//_List_.Remove
procedure _List_.Clear;
//#UC START# *51E8026302B4_51DEB07E03E4_var*
//#UC END# *51E8026302B4_51DEB07E03E4_var*
begin
//#UC START# *51E8026302B4_51DEB07E03E4_impl*
Count := 0;
//#UC END# *51E8026302B4_51DEB07E03E4_impl*
end;//_List_.Clear
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
function _List_.pm_GetEmpty: Boolean;
//#UC START# *51E7FDAC023D_51DEB07E03E4get_var*
//#UC END# *51E7FDAC023D_51DEB07E03E4get_var*
begin
//#UC START# *51E7FDAC023D_51DEB07E03E4get_impl*
Result := (Count = 0);
//#UC END# *51E7FDAC023D_51DEB07E03E4get_impl*
end;//_List_.pm_GetEmpty
function _List_.pm_GetFirst: _ItemType_;
//#UC START# *51E8070603AC_51DEB07E03E4get_var*
//#UC END# *51E8070603AC_51DEB07E03E4get_var*
begin
//#UC START# *51E8070603AC_51DEB07E03E4get_impl*
Result := Items[0];
//#UC END# *51E8070603AC_51DEB07E03E4get_impl*
end;//_List_.pm_GetFirst
function _List_.pm_GetLast: _ItemType_;
//#UC START# *51E8074101B5_51DEB07E03E4get_var*
//#UC END# *51E8074101B5_51DEB07E03E4get_var*
begin
//#UC START# *51E8074101B5_51DEB07E03E4get_impl*
Result := Items[f_Count - 1];
//#UC END# *51E8074101B5_51DEB07E03E4get_impl*
end;//_List_.pm_GetLast
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}
InterfacePtrList.imp.pas:
{$IfNDef InterfacePtrList_imp}
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBox"
// The unit: "InterfacePtrList.imp.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: Impurity::Class Shared Delphi Sand Box::SandBox::STLLike::InterfacePtrList
//
// The list of the pointers to the interfaces. Does not have its items
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$Define InterfacePtrList_imp}
_List_Parent_ = _InterfacePtrList_Parent_;
{$Include ..\SandBox\List.imp.pas}
_InterfacePtrList_ = {mixin} class(_List_)
{* The list of the pointers to the interfaces. Does not have its items }
end;//_InterfacePtrList_
{$Else InterfacePtrList_imp}
// start class _InterfacePtrList_
procedure FillItem(var thePlace: _ItemType_;
const aFrom: _ItemType_); forward;
function IsSame(const A: _ItemType_;
const B: _ItemType_): Boolean; forward;
procedure FreeItem(var thePlace: _ItemType_);
//#UC START# *51DEC20B01D7_51E8098001DC_var*
//#UC END# *51DEC20B01D7_51E8098001DC_var*
begin
//#UC START# *51DEC20B01D7_51E8098001DC_impl*
!!! Needs to be implemented !!!
//#UC END# *51DEC20B01D7_51E8098001DC_impl*
end;//FreeItem
procedure FillItem(var thePlace: _ItemType_;
const aFrom: _ItemType_);
//#UC START# *51DECB440087_51E8098001DC_var*
//#UC END# *51DECB440087_51E8098001DC_var*
begin
//#UC START# *51DECB440087_51E8098001DC_impl*
!!! Needs to be implemented !!!
//#UC END# *51DECB440087_51E8098001DC_impl*
end;//FillItem
function IsSame(const A: _ItemType_;
const B: _ItemType_): Boolean;
//#UC START# *51DECB820261_51E8098001DC_var*
//#UC END# *51DECB820261_51E8098001DC_var*
begin
//#UC START# *51DECB820261_51E8098001DC_impl*
!!! Needs to be implemented !!!
//#UC END# *51DECB820261_51E8098001DC_impl*
end;//IsSame
{$Include ..\SandBox\List.imp.pas}
{$EndIf InterfacePtrList_imp}
InterfaceRefList.imp.pas:
{$IfNDef InterfaceRefList_imp}
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBox"
// The unit: "InterfaceRefList.imp.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: Impurity::Class Shared Delphi Sand Box::SandBox::STLLike::InterfaceRefList
//
// The list of the references to the interfaces. It has its items
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$Define InterfaceRefList_imp}
_List_Parent_ = _InterfaceRefList_Parent_;
{$Include ..\SandBox\List.imp.pas}
_InterfaceRefList_ = {mixin} class(_List_)
{* The list of the references to the interfaces. It has its items }
end;//_InterfaceRefList_
{$Else InterfaceRefList_imp}
// start class _InterfaceRefList_
procedure FillItem(var thePlace: _ItemType_;
const aFrom: _ItemType_); forward;
function IsSame(const A: _ItemType_;
const B: _ItemType_): Boolean; forward;
procedure FreeItem(var thePlace: _ItemType_);
//#UC START# *51DEC20B01D7_51E809AD001D_var*
//#UC END# *51DEC20B01D7_51E809AD001D_var*
begin
//#UC START# *51DEC20B01D7_51E809AD001D_impl*
thePlace := nil;
//#UC END# *51DEC20B01D7_51E809AD001D_impl*
end;//FreeItem
procedure FillItem(var thePlace: _ItemType_;
const aFrom: _ItemType_);
//#UC START# *51DECB440087_51E809AD001D_var*
//#UC END# *51DECB440087_51E809AD001D_var*
begin
//#UC START# *51DECB440087_51E809AD001D_impl*
thePlace := afrom;
//#UC END# *51DECB440087_51E809AD001D_impl*
end;//FillItem
function IsSame(const A: _ItemType_;
const B: _ItemType_): Boolean;
//#UC START# *51DECB820261_51E809AD001D_var*
//#UC END# *51DECB820261_51E809AD001D_var*
begin
//#UC START# *51DECB820261_51E809AD001D_impl*
Result := (A = B);
//#UC END# *51DECB820261_51E809AD001D_impl*
end;//IsSame
{$Include ..\SandBox\List.imp.pas}
{$EndIf InterfaceRefList_imp}
Containers 6. Abstract containers
Original in Russian: http://18delphi.blogspot.ru/2013/07/blog-post_3683.html
About containers. Table of contents
Now I want to tell about the practice of creating “pattern” container in “STL style”.
FOR NOW – WITHOUT the “true” Generics (http://18delphi.blogspot.com/2015/02/containers-3-generics-and-without.html). They ALSO can be used. But FOR NOW – there is a NUMBER OF UNCLOSED errors, which for some reason Embarcadero does not hurry to close. That is a weak point. What to say. Even my error (http://qc.embarcadero.com/wc/qcmain.aspx?d=116040 http://18delphi.blogspot.com/2013/05/xe4.html) - has been "kind of corrected", but not closed. Even so that was a minor matter. If I get it my way right...
One remark. Despite the fact that in STL such containers are called vector, I’ve decided to keep continuity with Delphi and name it List.
So. As usual.
The model:
The code:
List.imp.pas:
{$IfNDef List_imp}
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBox"
// The unit: "List.imp.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: Impurity::Class Shared Delphi Sand Box::SandBox::STLLike::List
//
// The abstract list of values
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$Define List_imp}
PItemType = ^_ItemType_;
const
{ Sizes }
cItemSize = SizeOf(_ItemType_);
type
IndexType = System.Integer;
_List_ = {mixin} class(_List_Parent_)
{* The abstract list of values }
private
// private fields
f_Data : Tl3PtrLoc;
f_Count : IndexType;
{* The field for the property Count}
private
// private methods
procedure ReAllocList(aNewCapacity: IndexType);
procedure CheckIndex(anIndex: IndexType); // can raise EListError
{* checks the validity of the index and raises an exception if it is incorrect }
function ItemSlot(anIndex: IndexType): PItemType;
function ExpandSize(aTargetSize: IndexType): Cardinal;
procedure CheckSetItem(anIndex: IndexType); // can raise EListError
{* Checks the validity of the index upon insert }
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;
{* The function of object fields cleaning. }
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;
{* The items of the list. }
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
// we do not double large arrays, but even them to 1 Mb
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}
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBox"
// The unit: "UnrefcountedListPrim.imp.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: Impurity::Class Shared Delphi Sand Box::SandBox::STLLike::UnrefcountedListPrim
//
// The list of values without any reference counting
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$Define UnrefcountedListPrim_imp}
{$Define l3Items_IsUnrefcounted}
_List_Parent_ = _UnrefcountedListPrim_Parent_;
{$Include List.imp.pas}
_UnrefcountedListPrim_ = {mixin} class(_List_)
{* The list of values without any reference counting }
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}
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBox"
// The unit: "AtomicList.imp.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: Impurity::Class Shared Delphi Sand Box::SandBox::STLLike::AtomicList
//
// The list of atomic values
//
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$Define AtomicList_imp}
{$Define l3Items_IsAtomic}
_UnrefcountedListPrim_Parent_ = _AtomicList_Parent_;
{$Include UnrefcountedListPrim.imp.pas}
_AtomicList_ = {mixin} class(_UnrefcountedListPrim_)
{* The list of atomic values }
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}
The code is here - http://sourceforge.net/p/rumtmarc/code-0/19/tree/trunk/Blogger/SandBox and http://sourceforge.net/p/rumtmarc/code-0/19/tree/trunk/Blogger/SandBoxTest
Containers 5. Encapsulation of the work with the memory. Part 1
Original in Russian: http://18delphi.blogspot.ru/2013/07/1.html
About containers. Table of contents
Now we shall allocate the work with the memory to a separate object - Tl3PtrLoc.
The model:
l3MemUtils.pas:
l3PtrLoc.pas:
The source code - https://sourceforge.net/p/rumtmarc/code-0/17/tree/trunk/Blogger/STL.2/
About containers. Table of contents
Now we shall allocate the work with the memory to a separate object - Tl3PtrLoc.
The model:
The code:
unit l3MemUtils;
//
// The library "L3$Basic Concepts"
// Generated from UML model, root element: SimpleClass::Class Shared Delphi Requirements to the low-level libraries::L3$Basic Concepts::MemoryUtils::Tl3MemUtils
//
interface
uses
Refcounted
;
type
Rl3MemUtils = class of Tl3MemUtils;
Tl3MemUtils = class(TRefcounted)
protected
// protected methods
class procedure CheckMaxes; virtual;
{* The signature of the method CheckMaxes }
class procedure StatMemAlloc(aSize: Integer;
aL3: Boolean); virtual;
public
// public methods
class procedure ReallocLocalMem(var P;
NewSize: Cardinal);
{* reallocate the piece of the local memory }
class procedure FreeLocalMem(var P);
{* free the piece of the local memory }
end;//Tl3MemUtils
var
l3MemU : Rl3MemUtils = Tl3MemUtils;
var
f_LocalMemUsed : Integer;
implementation
uses
l3MemorySizeUtils
;
// start class Tl3MemUtils
class procedure Tl3MemUtils.ReallocLocalMem(var P;
NewSize: Cardinal);
//#UC START# *51DD561502D9_51DD554C0205_var*
//#UC END# *51DD561502D9_51DD554C0205_var*
begin
//#UC START# *51DD561502D9_51DD554C0205_impl*
Dec(f_LocalMemUsed, l3MemorySize(Pointer(P)));
{$IfDef l3DirectUseSystemMemManager}
if (Pointer(P) = nil) then
begin
l3MemU.StatMemAlloc(NewSize, true);
Pointer(P) := SysGetMem(NewSize)
end//Pointer(P) = nil
else
if (NewSize > 0) then
begin
l3MemU.StatMemAlloc(NewSize, true);
Pointer(P) := SysReallocMem(Pointer(P), NewSize);
end//NewSize > 0
else
begin
SysFreeMem(Pointer(P));
Pointer(P) := nil;
end;//NewSize > 0
{$Else l3DirectUseSystemMemManager}
System.ReallocMem(Pointer(P), NewSize);
{$EndIf l3DirectUseSystemMemManager}
Inc(f_LocalMemUsed, l3MemorySize(Pointer(P)));
l3MemU.CheckMaxes;
//#UC END# *51DD561502D9_51DD554C0205_impl*
end;//Tl3MemUtils.ReallocLocalMem
class procedure Tl3MemUtils.FreeLocalMem(var P);
//#UC START# *51DD62110253_51DD554C0205_var*
//#UC END# *51DD62110253_51DD554C0205_var*
begin
//#UC START# *51DD62110253_51DD554C0205_impl*
if (Pointer(P) <> nil) then
begin
Dec(f_LocalMemUsed, l3MemorySize(Pointer(P)));
{$IfDef l3DirectUseSystemMemManager}
SysFreeMem(Pointer(P));
{$Else l3DirectUseSystemMemManager}
System.FreeMem(Pointer(P));
{$EndIf l3DirectUseSystemMemManager}
end;//Pointer(P) <> nil
Pointer(P) := nil;
//#UC END# *51DD62110253_51DD554C0205_impl*
end;//Tl3MemUtils.FreeLocalMem
class procedure Tl3MemUtils.CheckMaxes;
//#UC START# *51DD686A03A3_51DD554C0205_var*
//#UC END# *51DD686A03A3_51DD554C0205_var*
begin
//#UC START# *51DD686A03A3_51DD554C0205_impl*
// - for now we do nothing
//#UC END# *51DD686A03A3_51DD554C0205_impl*
end;//Tl3MemUtils.CheckMaxes
class procedure Tl3MemUtils.StatMemAlloc(aSize: Integer;
aL3: Boolean);
//#UC START# *51DD6DCE00DF_51DD554C0205_var*
//#UC END# *51DD6DCE00DF_51DD554C0205_var*
begin
//#UC START# *51DD6DCE00DF_51DD554C0205_impl*
// - or now we do nothing
//#UC END# *51DD6DCE00DF_51DD554C0205_impl*
end;//Tl3MemUtils.StatMemAlloc
end.
l3PtrLoc.pas:
unit l3PtrLoc;
//
// The library "L3$Basic Concepts"
// Generated from UML model, root element: UtilityPack::Class Shared Delphi Requirements to the low-level libraries::L3$Basic Concepts::MemoryUtils::l3PtrLoc
//
interface
uses
l3MemorySizeUtils
;
type
Tl3PtrLoc = {$IfDef XE4}record{$Else}object{$EndIf}
private
f_AsPointer : PMem;
public
function Init(aSize: Integer): Boolean;
function GetSize: Integer;
procedure SetSize(aSize: Integer);
procedure Clear;
function Read(anOfs: Integer;
aBuf: PMem;
aBufSize: Integer): Integer;
function Write(anOfs: Integer;
aBuf: PMem;
aBufSize: Integer): Integer;
public
property AsPointer: PMem
read f_AsPointer;
end;//Tl3PtrLoc
implementation
uses
l3MemUtils
;
// start class Tl3PtrLoc
function Tl3PtrLoc.Init(aSize: Integer): Boolean;
//#UC START# *51DD5D1903C3_51DD567A01B5_var*
//#UC END# *51DD5D1903C3_51DD567A01B5_var*
begin
//#UC START# *51DD5D1903C3_51DD567A01B5_impl*
f_AsPointer := nil;
SetSize(aSize);
Result := (f_AsPointer <> nil);
//#UC END# *51DD5D1903C3_51DD567A01B5_impl*
end;//Tl3PtrLoc.Init
function Tl3PtrLoc.GetSize: Integer;
//#UC START# *51DD5D3800F3_51DD567A01B5_var*
//#UC END# *51DD5D3800F3_51DD567A01B5_var*
begin
//#UC START# *51DD5D3800F3_51DD567A01B5_impl*
Result := l3MemorySize(f_AsPointer);
//#UC END# *51DD5D3800F3_51DD567A01B5_impl*
end;//Tl3PtrLoc.GetSize
procedure Tl3PtrLoc.SetSize(aSize: Integer);
//#UC START# *51DD5D4F004A_51DD567A01B5_var*
//#UC END# *51DD5D4F004A_51DD567A01B5_var*
begin
//#UC START# *51DD5D4F004A_51DD567A01B5_impl*
if (aSize = 0) then
l3MemU.FreeLocalMem(f_AsPointer)
else
if (GetSize < aSize) then
begin
// - previously it was <> - now I’ve decided to try not to reduce the size of the memory
// so that not to produce defragmentation.
if (aSize < 10) then
l3MemU.ReallocLocalMem(f_AsPointer, aSize)
else
l3MemU.ReallocLocalMem(f_AsPointer, (aSize + $F) and $FFFFFFF0);
end;//GetSize < aSize
//#UC END# *51DD5D4F004A_51DD567A01B5_impl*
end;//Tl3PtrLoc.SetSize
procedure Tl3PtrLoc.Clear;
//#UC START# *51DD5D6F0304_51DD567A01B5_var*
//#UC END# *51DD5D6F0304_51DD567A01B5_var*
begin
//#UC START# *51DD5D6F0304_51DD567A01B5_impl*
SetSize(0);
//#UC END# *51DD5D6F0304_51DD567A01B5_impl*
end;//Tl3PtrLoc.Clear
function Tl3PtrLoc.Read(anOfs: Integer;
aBuf: PMem;
aBufSize: Integer): Integer;
//#UC START# *51DD5E2203B0_51DD567A01B5_var*
//#UC END# *51DD5E2203B0_51DD567A01B5_var*
begin
//#UC START# *51DD5E2203B0_51DD567A01B5_impl*
Result := 0;
Assert(false, 'Not implemented yet');
(* Result := Min(GetSize - anOfs, aBufSize);
if (Result > 0) then
l3Move((P + anOfs)^, aBuf^, Result)
else
Result := 0;*)
//#UC END# *51DD5E2203B0_51DD567A01B5_impl*
end;//Tl3PtrLoc.Read
function Tl3PtrLoc.Write(anOfs: Integer;
aBuf: PMem;
aBufSize: Integer): Integer;
//#UC START# *51DD5E5F02E1_51DD567A01B5_var*
(*var
OldSize : Integer;
NewSize : Integer;*)
//#UC END# *51DD5E5F02E1_51DD567A01B5_var*
begin
//#UC START# *51DD5E5F02E1_51DD567A01B5_impl*
Result := 0;
Assert(false, 'Not implemented yet');
(* OldSize := GetSize;
NewSize := Ofs + BufSize;
if (NewSize > OldSize) then SetSize(NewSize);
Result := BufSize;
l3Move(Buf^, (P + Ofs)^, Result);*)
//#UC END# *51DD5E5F02E1_51DD567A01B5_impl*
end;//Tl3PtrLoc.Write
end.
The source code - https://sourceforge.net/p/rumtmarc/code-0/17/tree/trunk/Blogger/STL.2/
Containers 4. Encapsulation of the work with the memory. Part 0
Original in Russian: http://18delphi.blogspot.ru/2013/07/0.html
About containers. Table of contents
I’d like to continue describing the containers in “STL style”.
Tthere I have used dynamic arrays.
In my REAL “micro-STL” I use direct work with the memory - GetMem/FreeMem.
That is why I want to start with how I work with the memory directly. Or rather how I’ve encapsulated the work with the memory in different facade functions/objects.
The first example is receiving the size of the memory piece. I have already told a bit here - http://18delphi.blogspot.ru/2015/02/how-to-find-out-true-size-of-memory.html
And now I want to show how it is drawn on UML and how it is encapsulated in a separate unit.
So.
At first – the model:
And the test.
The model:
The code:
Next, I hope, I’ll tell about the encapsulation GetMem/FreeMem/ReallocMem in "object" Tl3Ptr.
All sources are here - https://sourceforge.net/p/rumtmarc/code-0/15/tree/trunk/Blogger/STL.1/
About containers. Table of contents
I’d like to continue describing the containers in “STL style”.
Tthere I have used dynamic arrays.
In my REAL “micro-STL” I use direct work with the memory - GetMem/FreeMem.
That is why I want to start with how I work with the memory directly. Or rather how I’ve encapsulated the work with the memory in different facade functions/objects.
The first example is receiving the size of the memory piece. I have already told a bit here - http://18delphi.blogspot.ru/2015/02/how-to-find-out-true-size-of-memory.html
And now I want to show how it is drawn on UML and how it is encapsulated in a separate unit.
So.
At first – the model:
And the code:
l3MemorySizeUtilsPrim.pas:
unit l3MemorySizeUtilsPrim;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "L3$Basic Concepts"
// The unit: "w:/common/components/rtl/L3/l3MemorySizeUtilsPrim.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: UtilityPack::Class Shared Delphi Requirements to the low-level libraries::L3$Basic Concepts::MemoryUtils::l3MemorySizeUtilsPrim
//
//
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// ! Fully generated from the model. It is not allowed to edit manually. !
interface
type
Tl3MemorySizeFunc = function (aPtr: Pointer): Integer;
{$If not defined(XE)}
function L3MemorySizeDelphi7(aPtr: Pointer): Integer;
{* function to get the size of the memory piece }
{$IfEnd} //not XE
{$If defined(XE)}
function L3MemorySizeXE(aPtr: Pointer): Integer;
{* function to get the size of the memory piece }
{$IfEnd} //XE
implementation
uses
l3MemorySizeUtils
;
// unit methods
{$If not defined(XE)}
function L3MemorySizeDelphi7(aPtr: Pointer): Integer;
//#UC START# *51DAD8DC00B2_51DADE55035E_var*
const
cThisUsedFlag = 2;
cPrevFreeFlag = 1;
cFillerFlag = Integer($80000000);
cFlags = cThisUsedFlag or cPrevFreeFlag or cFillerFlag;
type
PUsed = ^TUsed;
TUsed = packed record
sizeFlags: Integer;
end;//TUsed
//#UC END# *51DAD8DC00B2_51DADE55035E_var*
begin
//#UC START# *51DAD8DC00B2_51DADE55035E_impl*
if (aPtr = nil) then
Result := 0
else
Result := PUsed(PMem(aPtr)-SizeOf(TUsed)).sizeFlags and not cFlags - sizeof(TUsed);
// Result := (PLong(Long(aP) - 4)^ AND not cFlags) - 4;
//#UC END# *51DAD8DC00B2_51DADE55035E_impl*
end;//L3MemorySizeDelphi7
{$IfEnd} //not XE
{$If defined(XE)}
function L3MemorySizeXE(aPtr: Pointer): Integer;
//#UC START# *51DADA9600F9_51DADE55035E_var*
const
{----------------------------Block type flags---------------------------}
{The lower 3 bits in the dword header of small blocks (4 bits in medium and
large blocks) are used as flags to indicate the state of the block}
{Set if the block is not in use}
IsFreeBlockFlag = 1;
{Set if this is a medium block}
IsMediumBlockFlag = 2;
{Set if it is a medium block being used as a small block pool. Only valid if
IsMediumBlockFlag is set.}
IsSmallBlockPoolInUseFlag = 4;
{Set if it is a large block. Only valid if IsMediumBlockFlag is not set.}
IsLargeBlockFlag = 4;
{Is the medium block preceding this block available?}
PreviousMediumBlockIsFreeFlag = 8;
{Is this large block segmented? I.e. is it actually built up from more than
one chunk allocated through VirtualAlloc? (Only used by large blocks.)}
LargeBlockIsSegmented = 8;
{The flags masks for small blocks}
DropSmallFlagsMask = -8;
ExtractSmallFlagsMask = 7;
{The flags masks for medium and large blocks}
DropMediumAndLargeFlagsMask = -16;
ExtractMediumAndLargeFlagsMask = 15;
{------------------------------Private types------------------------------}
type
{Move procedure type}
TMoveProc = procedure(const ASource; var ADest; ACount: NativeInt);
{-----------------------Small block structures--------------------------}
{Pointer to the header of a small block pool}
PSmallBlockPoolHeader = ^TSmallBlockPoolHeader;
{Small block type (Size = 32 bytes for 32-bit, 64 bytes for 64-bit).}
PSmallBlockType = ^TSmallBlockType;
TSmallBlockType = record
{True = Block type is locked}
BlockTypeLocked: Boolean;
{Bitmap indicating which of the first 8 medium block groups contain blocks
of a suitable size for a block pool.}
AllowedGroupsForBlockPoolBitmap: Byte;
{The block size for this block type}
BlockSize: Word;
{The minimum and optimal size of a small block pool for this block type}
MinimumBlockPoolSize: Word;
OptimalBlockPoolSize: Word;
{The first partially free pool for the given small block. This field must
be at the same offset as TSmallBlockPoolHeader.NextPartiallyFreePool.}
NextPartiallyFreePool: PSmallBlockPoolHeader;
{The last partially free pool for the small block type. This field must
be at the same offset as TSmallBlockPoolHeader.PreviousPartiallyFreePool.}
PreviousPartiallyFreePool: PSmallBlockPoolHeader;
{The offset of the last block that was served sequentially. The field must
be at the same offset as TSmallBlockPoolHeader.FirstFreeBlock.}
NextSequentialFeedBlockAddress: Pointer;
{The last block that can be served sequentially.}
MaxSequentialFeedBlockAddress: Pointer;
{The pool that is current being used to serve blocks in sequential order}
CurrentSequentialFeedPool: PSmallBlockPoolHeader;
{$ifdef UseCustomFixedSizeMoveRoutines}
{The fixed size move procedure used to move data for this block size when
it is upsized. When a block is downsized (which usually does not occur
that often) the variable size move routine is used.}
UpsizeMoveProcedure: TMoveProc;
{$else}
Reserved1: Pointer;
{$endif}
{$if SizeOf(Pointer) = 8}
{Pad to 64 bytes for 64-bit}
Reserved2: Pointer;
{$ifend}
end;
{Small block pool (Size = 32 bytes for 32-bit, 48 bytes for 64-bit).}
TSmallBlockPoolHeader = record
{BlockType}
BlockType: PSmallBlockType;
{$if SizeOf(Pointer) <> 8}
{Align the next fields to the same fields in TSmallBlockType and pad this
structure to 32 bytes for 32-bit}
Reserved1: Cardinal;
{$ifend}
{The next and previous pool that has free blocks of this size. Do not
change the position of these two fields: They must be at the same offsets
as the fields in TSmallBlockType of the same name.}
NextPartiallyFreePool: PSmallBlockPoolHeader;
PreviousPartiallyFreePool: PSmallBlockPoolHeader;
{Pointer to the first free block inside this pool. This field must be at
the same offset as TSmallBlockType.NextSequentialFeedBlockAddress.}
FirstFreeBlock: Pointer;
{The number of blocks allocated in this pool.}
BlocksInUse: Cardinal;
{Small block pool signature. Used by the leak checking mechanism to
determine whether a medium block is a small block pool or a regular medium
block.}
SmallBlockPoolSignature: Cardinal;
{The pool pointer and flags of the first block}
FirstBlockPoolPointerAndFlags: NativeUInt;
end;
{Small block layout:
At offset -SizeOf(Pointer) = Flags + address of the small block pool.
At offset BlockSize - SizeOf(Pointer) = Flags + address of the small block
pool for the next small block.
}
{------------------------Medium block structures------------------------}
{The medium block pool from which medium blocks are drawn. Size = 16 bytes
for 32-bit and 32 bytes for 64-bit.}
PMediumBlockPoolHeader = ^TMediumBlockPoolHeader;
TMediumBlockPoolHeader = record
{Points to the previous and next medium block pools. This circular linked
list is used to track memory leaks on program shutdown.}
PreviousMediumBlockPoolHeader: PMediumBlockPoolHeader;
NextMediumBlockPoolHeader: PMediumBlockPoolHeader;
{Padding}
Reserved1: NativeUInt;
{The block size and flags of the first medium block in the block pool}
FirstMediumBlockSizeAndFlags: NativeUInt;
end;
{Medium block layout:
Offset: -2 * SizeOf(Pointer) = Previous Block Size (only if the previous block is free)
Offset: -SizeOf(Pointer) = This block size and flags
Offset: 0 = User data / Previous Free Block (if this block is free)
Offset: SizeOf(Pointer) = Next Free Block (if this block is free)
Offset: BlockSize - 2*SizeOf(Pointer) = Size of this block (if this block is free)
Offset: BlockSize - SizeOf(Pointer) = Size of the next block and flags
{A medium block that is unused}
PMediumFreeBlock = ^TMediumFreeBlock;
TMediumFreeBlock = record
PreviousFreeBlock: PMediumFreeBlock;
NextFreeBlock: PMediumFreeBlock;
end;
{-------------------------Large block structures------------------------}
{Large block header record (Size = 16 for 32-bit, 32 for 64-bit)}
PLargeBlockHeader = ^TLargeBlockHeader;
TLargeBlockHeader = record
{Points to the previous and next large blocks. This circular linked
list is used to track memory leaks on program shutdown.}
PreviousLargeBlockHeader: PLargeBlockHeader;
NextLargeBlockHeader: PLargeBlockHeader;
{The user allocated size of the Large block}
UserAllocatedSize: NativeUInt;
{The size of this block plus the flags}
BlockSizeAndFlags: NativeUInt;
end;
{---------------------------Private constants-----------------------------}
const
{The size of the block header in front of small and medium blocks}
BlockHeaderSize = SizeOf(Pointer);
{The size of a small block pool header}
SmallBlockPoolHeaderSize = SizeOf(TSmallBlockPoolHeader);
{The size of a medium block pool header}
MediumBlockPoolHeaderSize = SizeOf(TMediumBlockPoolHeader);
{The size of the header in front of Large blocks}
LargeBlockHeaderSize = SizeOf(TLargeBlockHeader);
(*
{This memory manager}
ThisMemoryManager: TMemoryManagerEx = (
GetMem: SysGetMem;
FreeMem: SysFreeMem;
ReallocMem: SysReallocMem;
AllocMem: SysAllocMem;
RegisterExpectedMemoryLeak: SysRegisterExpectedMemoryLeak;
UnregisterExpectedMemoryLeak: SysUnregisterExpectedMemoryLeak);
*)
var
lBlockHeader: Cardinal;
LPSmallBlockType: PSmallBlockType;
LOldAvailableSize: Cardinal;
//#UC END# *51DADA9600F9_51DADE55035E_var*
begin
//#UC START# *51DADA9600F9_51DADE55035E_impl*
if (aPtr = nil) then
Result := 0
else
begin
{Get the block header: Is it actually a small block?}
LBlockHeader := PNativeUInt(PByte(aPtr) - BlockHeaderSize)^;
{Is it a small block that is in use?}
if LBlockHeader and (IsFreeBlockFlag or IsMediumBlockFlag or IsLargeBlockFlag) = 0 then
begin
{----------------------------Small block------------------------------}
{The block header is a pointer to the block pool: Get the block type}
LPSmallBlockType := PSmallBlockPoolHeader(LBlockHeader).BlockType;
{Get the available size inside blocks of this type.}
Result := LPSmallBlockType.BlockSize - BlockHeaderSize;
end
else
begin
{Is this a medium block or a large block?}
if LBlockHeader and (IsFreeBlockFlag or IsLargeBlockFlag) = 0 then
begin
Result:= (LBlockHeader and DropMediumAndLargeFlagsMask) - BlockHeaderSize;
end
else
begin
{Is this a valid large block?}
if LBlockHeader and (IsFreeBlockFlag or IsMediumBlockFlag) = 0 then
begin
{-----------------------Large block------------------------------}
{Get the block header}
//LBlockHeader := PNativeUInt(PByte(aP) - BlockHeaderSize)^;
{Subtract the overhead to determine the useable size in the large block.}
Result := (LBlockHeader and DropMediumAndLargeFlagsMask) - (LargeBlockHeaderSize + BlockHeaderSize);
end
else
begin
{-----------------------Invalid block------------------------------}
{Bad pointer: probably an attempt to reallocate a free memory block.}
Result := 0;
assert(false);
end;
end;
end;
end;
//#UC END# *51DADA9600F9_51DADE55035E_impl*
end;//L3MemorySizeXE
{$IfEnd} //XE
end.
------
l3MemorySizeUtils.pas:
unit l3MemorySizeUtils;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "L3$Basic Concepts"
// The unit: "w:/common/components/rtl/L3/l3MemorySizeUtils.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: UtilityPack::Class Shared Delphi Requirements to the low-level libraries::L3$Basic Concepts::MemoryUtils::l3MemorySizeUtils
//
//
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// ! Fully generated from the model. It is not allowed to edit manually. !
interface
uses
l3MemorySizeUtilsPrim
;
type
PMem = System.PANSIChar;
{$If not defined(XE)}
var l3MemorySize : Tl3MemorySizeFunc = L3MemorySizeDelphi7;
{* function to get the size of the memory piece}
{$IfEnd} //not XE
{$If defined(XE)}
var l3MemorySize : Tl3MemorySizeFunc = L3MemorySizeXE;
{* function to get the size of the memory piece}
{$IfEnd} //XE
implementation
end.
And the test.
The model:
The code:
unit MemorySizeTest;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// The library "SandBoxTest"
// The unit: "w:/common/components/rtl/SandBox/MemorySizeTest.pas"
// Native Delphi interfaces (.pas)
// Generated from UML model, root element: TestCase::Class Shared Delphi Sand Box::SandBoxTest::Memory::MemorySizeTest
//
//
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// ! Fully generated from the model. It is not allowed to edit manually. !
interface
{$If defined(nsTest)}
uses
BaseTest
;
{$IfEnd} //nsTest
{$If defined(nsTest)}
type
TMemorySizeTest = class(TBaseTest)
protected
// overridden protected methods
function GetFolder: AnsiString; override;
{* The folder containing the test }
function GetModelElementGUID: AnsiString; override;
{* The model element identifier that describes the test }
published
// published methods
procedure DoIt;
end;//TMemorySizeTest
{$IfEnd} //nsTest
implementation
{$If defined(nsTest)}
uses
l3MemorySizeUtils,
SysUtils,
TestFrameWork
;
{$IfEnd} //nsTest
{$If defined(nsTest)}
// start class TMemorySizeTest
procedure TMemorySizeTest.DoIt;
//#UC START# *51DAE7030012_51DAE6E20300_var*
var
l_Index : Integer;
l_Size : Integer;
l_RealSize : Integer;
l_P : Pointer;
//#UC END# *51DAE7030012_51DAE6E20300_var*
begin
//#UC START# *51DAE7030012_51DAE6E20300_impl*
for l_Index := 1 to 4 * 1024 do
begin
l_Size := l_Index * 2;
System.GetMem(l_P, l_Size);
try
l_RealSize := l3MemorySize(l_P);
Check(l_RealSize >= l_Size, Format('We have allocated %d. It has been allocated %d.', [l_Size, l_RealSize]));
finally
System.FreeMem(l_P);
end;//try..finally
end;//form l_Index
//#UC END# *51DAE7030012_51DAE6E20300_impl*
end;//TMemorySizeTest.DoIt
function TMemorySizeTest.GetFolder: AnsiString;
{-}
begin
Result := 'Memory';
end;//TMemorySizeTest.GetFolder
function TMemorySizeTest.GetModelElementGUID: AnsiString;
{-}
begin
Result := '51DAE6E20300';
end;//TMemorySizeTest.GetModelElementGUID
{$IfEnd} //nsTest
initialization
TestFramework.RegisterTest(TMemorySizeTest.Suite);
end.
Next, I hope, I’ll tell about the encapsulation GetMem/FreeMem/ReallocMem in "object" Tl3Ptr.
All sources are here - https://sourceforge.net/p/rumtmarc/code-0/15/tree/trunk/Blogger/STL.1/