GitHub-Mirror/x2utils
1
0
Fork 0
mirror of synced 2024-12-22 09:13:07 +01:00
Code Issues Projects Releases Wiki Activity

Refactoring in the key/value managers for X2UtHashes

Browse Source 
- Improved code clarity
- Solves an obscure access violation with large amounts of data
This commit is contained in:
Mark van Renswoude 2010-03-12 12:27:49 +00:00
parent 35a7e5f5fb
commit 5b05c3237c
5 changed files with 1289 additions and 868 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

124
UnitTests/Units/HashesTest.pas
View File

@ -13,65 +13,65 @@ type
private private
FHash: TX2CustomHash; FHash: TX2CustomHash;
protected protected
procedure TearDown(); override; procedure TearDown; override;
procedure FillTestItems(); virtual; abstract; procedure FillTestItems; virtual; abstract;
published published
procedure testSet(); virtual; abstract; procedure testSet; virtual; abstract;
procedure testGet(); virtual; abstract; procedure testGet; virtual; abstract;
procedure testClear(); procedure testClear;
procedure testDelete(); virtual; abstract; procedure testDelete; virtual; abstract;
procedure testIterate(); virtual; abstract; procedure testIterate; virtual; abstract;
procedure testEnumerator(); virtual; abstract; procedure testEnumerator; virtual; abstract;
end; end;
// Two test cases involving all value managers. // Two test cases involving all value managers.
// This should be sufficient for a realistic scenario. // This should be sufficient for a realistic scenario.
THashesSITest = class(THashesTest) THashesSITest = class(THashesTest)
private private
function GetHash(): TX2SIHash; function GetHash: TX2SIHash;
property Hash: TX2SIHash read GetHash; property Hash: TX2SIHash read GetHash;
protected protected
procedure SetUp(); override; procedure SetUp; override;
procedure FillTestItems(); override; procedure FillTestItems; override;
published published
procedure testSet(); override; procedure testSet; override;
procedure testGet(); override; procedure testGet; override;
procedure testDelete(); override; procedure testDelete; override;
procedure testIterate(); override; procedure testIterate; override;
procedure testEnumerator(); override; procedure testEnumerator; override;
end; end;
THashesPOTest = class(THashesTest) THashesPOTest = class(THashesTest)
private private
function GetHash(): TX2POHash; function GetHash: TX2POHash;
property Hash: TX2POHash read GetHash; property Hash: TX2POHash read GetHash;
protected protected
procedure SetUp(); override; procedure SetUp; override;
procedure FillTestItems(); override; procedure FillTestItems; override;
published published
procedure testSet(); override; procedure testSet; override;
procedure testGet(); override; procedure testGet; override;
procedure testDelete(); override; procedure testDelete; override;
procedure testIterate(); override; procedure testIterate; override;
procedure testEnumerator(); override; procedure testEnumerator; override;
end; end;
THashesVariantTest = class(THashesTest) THashesVariantTest = class(THashesTest)
private private
function GetHash(): TX2SVHash; function GetHash: TX2SVHash;
property Hash: TX2SVHash read GetHash; property Hash: TX2SVHash read GetHash;
protected protected
procedure SetUp(); override; procedure SetUp; override;
procedure FillTestItems(); override; procedure FillTestItems; override;
published published
procedure testSet(); override; procedure testSet; override;
procedure testGet(); override; procedure testGet; override;
procedure testDelete(); override; procedure testDelete; override;
procedure testIterate(); override; procedure testIterate; override;
procedure testEnumerator(); override; procedure testEnumerator; override;
end; end;
THashesBugTest = class(TTestCase) THashesBugTest = class(TTestCase)
@ -101,8 +101,8 @@ end;
procedure THashesTest.testClear; procedure THashesTest.testClear;
begin begin
FillTestItems(); FillTestItems;
FHash.Clear(); FHash.Clear;
CheckEquals(0, FHash.Count); CheckEquals(0, FHash.Count);
end; end;
@ -112,7 +112,7 @@ procedure THashesSITest.SetUp;
begin begin
inherited; inherited;
FHash := TX2SIHash.Create(); FHash := TX2SIHash.Create;
end; end;
procedure THashesSITest.FillTestItems; procedure THashesSITest.FillTestItems;
@ -124,13 +124,13 @@ end;
procedure THashesSITest.testSet; procedure THashesSITest.testSet;
begin begin
FillTestItems(); FillTestItems;
CheckEquals(3, Hash.Count); CheckEquals(3, Hash.Count);
end; end;
procedure THashesSITest.testGet; procedure THashesSITest.testGet;
begin begin
FillTestItems(); FillTestItems;
CheckEquals(1, Hash['Key1']); CheckEquals(1, Hash['Key1']);
CheckEquals(2, Hash['Key2']); CheckEquals(2, Hash['Key2']);
CheckEquals(3, Hash['Key3']); CheckEquals(3, Hash['Key3']);
@ -138,7 +138,7 @@ end;
procedure THashesSITest.testDelete; procedure THashesSITest.testDelete;
begin begin
FillTestItems(); FillTestItems;
Hash.Delete('Key2'); Hash.Delete('Key2');
CheckEquals(2, Hash.Count); CheckEquals(2, Hash.Count);
@ -154,7 +154,7 @@ var
begin begin
{$IFDEF D2006PLUS} {$IFDEF D2006PLUS}
FillTestItems(); FillTestItems;
FillChar(aPresent, SizeOf(aPresent), #0); FillChar(aPresent, SizeOf(aPresent), #0);
for sKey in Hash do for sKey in Hash do
@ -188,10 +188,10 @@ var
aPresent: array[1..3] of Boolean; aPresent: array[1..3] of Boolean;
begin begin
FillTestItems(); FillTestItems;
FillChar(aPresent, SizeOf(aPresent), #0); FillChar(aPresent, SizeOf(aPresent), #0);
Hash.First(); Hash.First;
while Hash.Next() do while Hash.Next do
if ((Hash.CurrentKey = 'Key1') and (Hash.CurrentValue = 1)) or if ((Hash.CurrentKey = 'Key1') and (Hash.CurrentValue = 1)) or
((Hash.CurrentKey = 'Key2') and (Hash.CurrentValue = 2)) or ((Hash.CurrentKey = 'Key2') and (Hash.CurrentValue = 2)) or
((Hash.CurrentKey = 'Key3') and (Hash.CurrentValue = 3)) then ((Hash.CurrentKey = 'Key3') and (Hash.CurrentValue = 3)) then
@ -203,7 +203,7 @@ begin
end; end;
function THashesSITest.GetHash(): TX2SIHash; function THashesSITest.GetHash: TX2SIHash;
begin begin
Result := TX2SIHash(FHash); Result := TX2SIHash(FHash);
end; end;
@ -219,20 +219,20 @@ end;
procedure THashesPOTest.FillTestItems; procedure THashesPOTest.FillTestItems;
begin begin
Hash[Pointer(0)] := TObject0.Create(); Hash[Pointer(0)] := TObject0.Create;
Hash[Pointer(1)] := TObject1.Create(); Hash[Pointer(1)] := TObject1.Create;
Hash[Pointer(2)] := TObject2.Create(); Hash[Pointer(2)] := TObject2.Create;
end; end;
procedure THashesPOTest.testSet; procedure THashesPOTest.testSet;
begin begin
FillTestItems(); FillTestItems;
CheckEquals(3, Hash.Count); CheckEquals(3, Hash.Count);
end; end;
procedure THashesPOTest.testGet; procedure THashesPOTest.testGet;
begin begin
FillTestItems(); FillTestItems;
CheckTrue(Hash[Pointer(0)] is TObject0); CheckTrue(Hash[Pointer(0)] is TObject0);
CheckTrue(Hash[Pointer(1)] is TObject1); CheckTrue(Hash[Pointer(1)] is TObject1);
CheckTrue(Hash[Pointer(2)] is TObject2); CheckTrue(Hash[Pointer(2)] is TObject2);
@ -240,7 +240,7 @@ end;
procedure THashesPOTest.testDelete; procedure THashesPOTest.testDelete;
begin begin
FillTestItems(); FillTestItems;
Hash.Delete(Pointer(1)); Hash.Delete(Pointer(1));
CheckEquals(2, Hash.Count); CheckEquals(2, Hash.Count);
@ -256,7 +256,7 @@ var
begin begin
{$IFDEF D2006PLUS} {$IFDEF D2006PLUS}
FillTestItems(); FillTestItems;
FillChar(aPresent, SizeOf(aPresent), #0); FillChar(aPresent, SizeOf(aPresent), #0);
for pKey in Hash do for pKey in Hash do
@ -273,10 +273,10 @@ var
aPresent: array[0..2] of Boolean; aPresent: array[0..2] of Boolean;
begin begin
FillTestItems(); FillTestItems;
FillChar(aPresent, SizeOf(aPresent), #0); FillChar(aPresent, SizeOf(aPresent), #0);
Hash.First(); Hash.First;
while Hash.Next() do while Hash.Next do
if ((Hash.CurrentKey = Pointer(0)) and (Hash.CurrentValue is TObject0)) or if ((Hash.CurrentKey = Pointer(0)) and (Hash.CurrentValue is TObject0)) or
((Hash.CurrentKey = Pointer(1)) and (Hash.CurrentValue is TObject1)) or ((Hash.CurrentKey = Pointer(1)) and (Hash.CurrentValue is TObject1)) or
((Hash.CurrentKey = Pointer(2)) and (Hash.CurrentValue is TObject2)) then ((Hash.CurrentKey = Pointer(2)) and (Hash.CurrentValue is TObject2)) then
@ -288,7 +288,7 @@ begin
end; end;
function THashesPOTest.GetHash(): TX2POHash; function THashesPOTest.GetHash: TX2POHash;
begin begin
Result := TX2POHash(FHash); Result := TX2POHash(FHash);
end; end;
@ -298,10 +298,10 @@ procedure THashesVariantTest.SetUp;
begin begin
inherited; inherited;
FHash := TX2SVHash.Create(); FHash := TX2SVHash.Create;
end; end;
function THashesVariantTest.GetHash(): TX2SVHash; function THashesVariantTest.GetHash: TX2SVHash;
begin begin
Result := TX2SVHash(FHash); Result := TX2SVHash(FHash);
end; end;
@ -315,13 +315,13 @@ end;
procedure THashesVariantTest.testSet; procedure THashesVariantTest.testSet;
begin begin
FillTestItems(); FillTestItems;
CheckEquals(3, Hash.Count); CheckEquals(3, Hash.Count);
end; end;
procedure THashesVariantTest.testGet; procedure THashesVariantTest.testGet;
begin begin
FillTestItems(); FillTestItems;
CheckTrue(Hash['Key1'] = 'String'); CheckTrue(Hash['Key1'] = 'String');
CheckTrue(Hash['Key2'] = 5); CheckTrue(Hash['Key2'] = 5);
CheckTrue(Hash['Key3'] = 40.4); CheckTrue(Hash['Key3'] = 40.4);
@ -329,7 +329,7 @@ end;
procedure THashesVariantTest.testDelete; procedure THashesVariantTest.testDelete;
begin begin
FillTestItems(); FillTestItems;
Hash.Delete('Key2'); Hash.Delete('Key2');
CheckEquals(2, Hash.Count); CheckEquals(2, Hash.Count);
@ -348,10 +348,10 @@ var
aPresent: array[0..2] of Boolean; aPresent: array[0..2] of Boolean;
begin begin
FillTestItems(); FillTestItems;
FillChar(aPresent, SizeOf(aPresent), #0); FillChar(aPresent, SizeOf(aPresent), #0);
Hash.First(); Hash.First;
while Hash.Next() do while Hash.Next do
if ((Hash.CurrentKey = 'Key1') and (Hash.CurrentValue = 'String')) then if ((Hash.CurrentKey = 'Key1') and (Hash.CurrentValue = 'String')) then
aPresent[0] := True aPresent[0] := True
else if ((Hash.CurrentKey = 'Key2') and (Hash.CurrentValue = 5)) then else if ((Hash.CurrentKey = 'Key2') and (Hash.CurrentValue = 5)) then

4
UnitTests/X2UtUnitTests.dpr
View File

@ -7,7 +7,9 @@ uses
BitsTest in 'Units\BitsTest.pas', BitsTest in 'Units\BitsTest.pas',
HashesTest in 'Units\HashesTest.pas', HashesTest in 'Units\HashesTest.pas',
PersistTest in 'Units\PersistTest.pas', PersistTest in 'Units\PersistTest.pas',
X2UtSingleInstance in '..\X2UtSingleInstance.pas'; X2UtSingleInstance in '..\X2UtSingleInstance.pas',
X2UtHashes in '..\X2UtHashes.pas',
X2UtHashesVariants in '..\X2UtHashesVariants.pas';
//SettingsTest in 'Units\SettingsTest.pas', //SettingsTest in 'Units\SettingsTest.pas',
//IniParserTest in 'Units\IniParserTest.pas'; //IniParserTest in 'Units\IniParserTest.pas';

43
UnitTests/X2UtUnitTests.dproj
View File

@ -42,53 +42,18 @@
<Borland.Personality>Delphi.Personality</Borland.Personality> <Borland.Personality>Delphi.Personality</Borland.Personality>
<Borland.ProjectType>VCLApplication</Borland.ProjectType> <Borland.ProjectType>VCLApplication</Borland.ProjectType>
<BorlandProject> <BorlandProject>
<BorlandProject xmlns=""> <Delphi.Personality> <Parameters> <BorlandProject><Delphi.Personality><Parameters><Parameters Name="RunParams">ip-to-country.csv countries.csv geo.db</Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><VersionInfo><VersionInfo Name="IncludeVerInfo">False</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">1</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">0</VersionInfo><VersionInfo Name="Build">0</VersionInfo><VersionInfo Name="Debug">False</VersionInfo><VersionInfo Name="PreRelease">False</VersionInfo><VersionInfo Name="Special">False</VersionInfo><VersionInfo Name="Private">False</VersionInfo><VersionInfo Name="DLL">False</VersionInfo><VersionInfo Name="Locale">1043</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName"></VersionInfoKeys><VersionInfoKeys Name="FileDescription"></VersionInfoKeys><VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">X2UtUnitTests.dpr</Source></Source></Delphi.Personality></BorlandProject></BorlandProject>
<Parameters Name="RunParams">ip-to-country.csv countries.csv geo.db</Parameters>
<Parameters Name="UseLauncher">False</Parameters>
<Parameters Name="LoadAllSymbols">True</Parameters>
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
</Parameters>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">False</VersionInfo>
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">0</VersionInfo>
<VersionInfo Name="Build">0</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo>
<VersionInfo Name="Special">False</VersionInfo>
<VersionInfo Name="Private">False</VersionInfo>
<VersionInfo Name="DLL">False</VersionInfo>
<VersionInfo Name="Locale">1043</VersionInfo>
<VersionInfo Name="CodePage">1252</VersionInfo>
</VersionInfo>
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName"></VersionInfoKeys>
<VersionInfoKeys Name="FileDescription"></VersionInfoKeys>
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="InternalName"></VersionInfoKeys>
<VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys>
<VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys>
<VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys>
<VersionInfoKeys Name="ProductName"></VersionInfoKeys>
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="Comments"></VersionInfoKeys>
</VersionInfoKeys>
<Source>
<Source Name="MainSource">X2UtUnitTests.dpr</Source>
</Source>
</Delphi.Personality> </BorlandProject></BorlandProject>
</ProjectExtensions> </ProjectExtensions>
<ItemGroup /> <Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
<ItemGroup> <ItemGroup>
<DelphiCompile Include="X2UtUnitTests.dpr"> <DelphiCompile Include="X2UtUnitTests.dpr">
<MainSource>MainSource</MainSource> <MainSource>MainSource</MainSource>
</DelphiCompile> </DelphiCompile>
<DCCReference Include="..\X2UtHashes.pas" />
<DCCReference Include="..\X2UtHashesVariants.pas" />
<DCCReference Include="..\X2UtSingleInstance.pas" /> <DCCReference Include="..\X2UtSingleInstance.pas" />
<DCCReference Include="Units\BitsTest.pas" /> <DCCReference Include="Units\BitsTest.pas" />
<DCCReference Include="Units\HashesTest.pas" /> <DCCReference Include="Units\HashesTest.pas" />
<DCCReference Include="Units\PersistTest.pas" /> <DCCReference Include="Units\PersistTest.pas" />
</ItemGroup> </ItemGroup>
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
</Project> </Project>

1454
X2UtHashes.pas
View File

File diff suppressed because it is too large Load Diff

236
X2UtHashesVariants.pas
View File

@ -13,244 +13,332 @@ uses
X2UtHashes; X2UtHashes;
type type
{ {
:$ Variant value class. :$ Variant value class.
} }
TX2HashVariantManager = class(TX2CustomHashManager) TX2HashVariantManager = class(TX2CustomHashManager)
public public
procedure Finalize(var AData: Pointer); override; procedure FreeCookie(var ACookie: PX2HashCookie); override;
function DataSize(const AData: Pointer): Cardinal; override; function CreateCookie(const AValue: Variant): PX2HashCookie; overload;
function GetValue(const ACookie: PX2HashCookie): Variant; overload;
function ToPointer(const AValue: Variant): Pointer; overload; function Hash(ACookie: PX2HashCookie): Cardinal; override;
function ToValue(const AData: Pointer): Variant; overload; function Compare(const ACookie1, ACookie2: PX2HashCookie): Boolean; override;
function Clone(const ACookie: PX2HashCookie): PX2HashCookie; override;
function Compare(const AData: Pointer; const AValue: Pointer;
const ASize: Cardinal): Boolean; override;
end; end;
{ {
:$ Pointer-to-Variant hash. :$ Pointer-to-Variant hash.
} }
TX2PVHash = class(TX2CustomPointerHash) TX2PVHash = class(TX2CustomPointerHash)
private private
function GetCurrentValue(): Variant; function GetCurrentValue: Variant;
function GetValue(Key: Pointer): Variant; function GetValue(Key: Pointer): Variant;
procedure SetValue(Key: Pointer; const Value: Variant); procedure SetValue(Key: Pointer; const Value: Variant);
function GetValueManager: TX2HashVariantManager;
protected protected
function CreateValueManager(): TX2CustomHashManager; override; function CreateValueManager: TX2CustomHashManager; override;
property ValueManager: TX2HashVariantManager read GetValueManager;
public public
property CurrentValue: Variant read GetCurrentValue; property CurrentValue: Variant read GetCurrentValue;
property Values[Key: Pointer]: Variant read GetValue write SetValue; default; property Values[Key: Pointer]: Variant read GetValue write SetValue; default;
end; end;
{ {
:$ Integer-to-Variant hash. :$ Integer-to-Variant hash.
} }
TX2IVHash = class(TX2CustomIntegerHash) TX2IVHash = class(TX2CustomIntegerHash)
private private
function GetCurrentValue(): Variant; function GetCurrentValue: Variant;
function GetValue(Key: Integer): Variant; function GetValue(Key: Integer): Variant;
procedure SetValue(Key: Integer; const Value: Variant); procedure SetValue(Key: Integer; const Value: Variant);
function GetValueManager: TX2HashVariantManager;
protected protected
function CreateValueManager(): TX2CustomHashManager; override; function CreateValueManager: TX2CustomHashManager; override;
property ValueManager: TX2HashVariantManager read GetValueManager;
public public
property CurrentValue: Variant read GetCurrentValue; property CurrentValue: Variant read GetCurrentValue;
property Values[Key: Integer]: Variant read GetValue write SetValue; default; property Values[Key: Integer]: Variant read GetValue write SetValue; default;
end; end;
{ {
:$ Object-to-Variant hash. :$ Object-to-Variant hash.
} }
TX2OVHash = class(TX2CustomObjectHash) TX2OVHash = class(TX2CustomObjectHash)
private private
function GetCurrentValue(): Variant; function GetCurrentValue: Variant;
function GetValue(Key: TObject): Variant; function GetValue(Key: TObject): Variant;
procedure SetValue(Key: TObject; const Value: Variant); procedure SetValue(Key: TObject; const Value: Variant);
function GetValueManager: TX2HashVariantManager;
protected protected
function CreateValueManager(): TX2CustomHashManager; override; function CreateValueManager: TX2CustomHashManager; override;
property ValueManager: TX2HashVariantManager read GetValueManager;
public public
property CurrentValue: Variant read GetCurrentValue; property CurrentValue: Variant read GetCurrentValue;
property Values[Key: TObject]: Variant read GetValue write SetValue; default; property Values[Key: TObject]: Variant read GetValue write SetValue; default;
end; end;
{ {
:$ String-to-Variant hash. :$ String-to-Variant hash.
} }
TX2SVHash = class(TX2CustomStringHash) TX2SVHash = class(TX2CustomStringHash)
private private
function GetCurrentValue(): Variant; function GetCurrentValue: Variant;
function GetValue(Key: String): Variant; function GetValue(Key: String): Variant;
procedure SetValue(Key: String; const Value: Variant); procedure SetValue(Key: String; const Value: Variant);
function GetValueManager: TX2HashVariantManager;
protected protected
function CreateValueManager(): TX2CustomHashManager; override; function CreateValueManager: TX2CustomHashManager; override;
property ValueManager: TX2HashVariantManager read GetValueManager;
public public
property CurrentValue: Variant read GetCurrentValue; property CurrentValue: Variant read GetCurrentValue;
property Values[Key: String]: Variant read GetValue write SetValue; default; property Values[Key: String]: Variant read GetValue write SetValue; default;
end; end;
implementation implementation
uses
SysUtils;
{======================================== {========================================
TX2HashVariantManager TX2HashVariantManager
========================================} ========================================}
function TX2HashVariantManager.DataSize(const AData: Pointer): Cardinal; procedure TX2HashVariantManager.FreeCookie(var ACookie: PX2HashCookie);
begin var
Result := SizeOf(Variant); variantCookie: PVariant;
end;
procedure TX2HashVariantManager.Finalize(var AData: Pointer);
begin begin
if AData <> nil then if Assigned(ACookie) then
Dispose(PVariant(AData)); begin
variantCookie := ACookie;
VarClear(variantCookie^);
Dispose(variantCookie);
end;
inherited; inherited;
end; end;
function TX2HashVariantManager.ToPointer(const AValue: Variant): Pointer;
function TX2HashVariantManager.CreateCookie(const AValue: Variant): PX2HashCookie;
var
variantCookie: PVariant;
begin begin
New(PVariant(Result)); New(variantCookie);
PVariant(Result)^ := AValue; VarCopy(variantCookie^, AValue);
Result := variantCookie;
end; end;
function TX2HashVariantManager.ToValue(const AData: Pointer): Variant;
function TX2HashVariantManager.GetValue(const ACookie: PX2HashCookie): Variant;
begin begin
Result := PVariant(AData)^; VarCopy(Result, PVariant(ACookie)^);
end; end;
function TX2HashVariantManager.Compare(const AData, AValue: Pointer;
const ASize: Cardinal): Boolean; function TX2HashVariantManager.Hash(ACookie: PX2HashCookie): Cardinal;
begin begin
Result := (VarCompareValue(PVariant(AData)^, PVariant(AValue)^) = vrEqual); { For now, this manager is only used for Values, which aren't hashed. }
raise Exception.Create('Hash method is not supported for Variants');
end; end;
function TX2HashVariantManager.Compare(const ACookie1, ACookie2: PX2HashCookie): Boolean;
begin
Result := (VarCompareValue(PVariant(ACookie1)^, PVariant(ACookie2)^) = vrEqual);
end;
function TX2HashVariantManager.Clone(const ACookie: PX2HashCookie): PX2HashCookie;
begin
Result := CreateCookie(PVariant(ACookie)^);
end;
//
//function TX2HashVariantManager.ToValue(const AData: Pointer): Variant;
//begin
// Result := PVariant(AData)^;
//end;
//
//
//function TX2HashVariantManager.Compare(const AData, AValue: Pointer;
// const ASize: Cardinal): Boolean;
//begin
// Result := (VarCompareValue(PVariant(AData)^, PVariant(AValue)^) = vrEqual);
//end;
{======================================== {========================================
TX2PVHash TX2PVHash
========================================} ========================================}
function TX2PVHash.CreateValueManager(): TX2CustomHashManager; function TX2PVHash.CreateValueManager: TX2CustomHashManager;
begin begin
Result := TX2HashVariantManager.Create(); Result := TX2HashVariantManager.Create;
end; end;
function TX2PVHash.GetCurrentValue(): Variant;
function TX2PVHash.GetCurrentValue: Variant;
begin begin
CursorRequired(); CursorRequired;
Result := TX2HashVariantManager(ValueManager).ToValue(Cursor.Current^.Value); Result := ValueManager.GetValue(Cursor.Current^.Value);
end; end;
function TX2PVHash.GetValue(Key: Pointer): Variant; function TX2PVHash.GetValue(Key: Pointer): Variant;
var var
pItem: PX2HashValue; item: PX2HashValue;
begin begin
Result := Unassigned; Result := Unassigned;
pItem := Find(Key, False); item := Find(Key, False);
if Assigned(pItem) then if Assigned(item) then
Result := TX2HashVariantManager(ValueManager).ToValue(pItem^.Value); Result := ValueManager.GetValue(item^.Value);
end; end;
procedure TX2PVHash.SetValue(Key: Pointer; const Value: Variant); procedure TX2PVHash.SetValue(Key: Pointer; const Value: Variant);
begin begin
inherited SetValue(Find(Key, True), inherited SetValue(Find(Key, True), ValueManager.CreateCookie(Value));
TX2HashVariantManager(ValueManager).ToPointer(Value)); end;
function TX2PVHash.GetValueManager: TX2HashVariantManager;
begin
Result := TX2HashVariantManager(inherited ValueManager);
end; end;
{======================================== {========================================
TX2IVHash TX2IVHash
========================================} ========================================}
function TX2IVHash.CreateValueManager(): TX2CustomHashManager; function TX2IVHash.CreateValueManager: TX2CustomHashManager;
begin begin
Result := TX2HashVariantManager.Create(); Result := TX2HashVariantManager.Create;
end; end;
function TX2IVHash.GetCurrentValue(): Variant;
function TX2IVHash.GetCurrentValue: Variant;
begin begin
CursorRequired(); CursorRequired;
Result := TX2HashVariantManager(ValueManager).ToValue(Cursor.Current^.Value); Result := ValueManager.GetValue(Cursor.Current^.Value);
end; end;
function TX2IVHash.GetValue(Key: Integer): Variant; function TX2IVHash.GetValue(Key: Integer): Variant;
var var
pItem: PX2HashValue; item: PX2HashValue;
begin begin
Result := Unassigned; Result := Unassigned;
pItem := Find(Key, False); item := Find(Key, False);
if Assigned(pItem) then if Assigned(item) then
Result := TX2HashVariantManager(ValueManager).ToValue(pItem^.Value); Result := ValueManager.GetValue(item^.Value);
end; end;
procedure TX2IVHash.SetValue(Key: Integer; const Value: Variant); procedure TX2IVHash.SetValue(Key: Integer; const Value: Variant);
begin begin
inherited SetValue(Find(Key, True), inherited SetValue(Find(Key, True), ValueManager.CreateCookie(Value));
TX2HashVariantManager(ValueManager).ToPointer(Value)); end;
function TX2IVHash.GetValueManager: TX2HashVariantManager;
begin
Result := TX2HashVariantManager(inherited ValueManager);
end; end;
{======================================== {========================================
TX2OVHash TX2OVHash
========================================} ========================================}
function TX2OVHash.CreateValueManager(): TX2CustomHashManager; function TX2OVHash.CreateValueManager: TX2CustomHashManager;
begin begin
Result := TX2HashVariantManager.Create(); Result := TX2HashVariantManager.Create;
end; end;
function TX2OVHash.GetCurrentValue(): Variant;
function TX2OVHash.GetCurrentValue: Variant;
begin begin
CursorRequired(); CursorRequired;
Result := TX2HashVariantManager(ValueManager).ToValue(Cursor.Current^.Value); Result := ValueManager.GetValue(Cursor.Current^.Value);
end; end;
function TX2OVHash.GetValue(Key: TObject): Variant; function TX2OVHash.GetValue(Key: TObject): Variant;
var var
pItem: PX2HashValue; item: PX2HashValue;
begin begin
Result := Unassigned; Result := Unassigned;
pItem := Find(Key, False); item := Find(Key, False);
if Assigned(pItem) then if Assigned(item) then
Result := TX2HashVariantManager(ValueManager).ToValue(pItem^.Value); Result := ValueManager.GetValue(item^.Value);
end; end;
procedure TX2OVHash.SetValue(Key: TObject; const Value: Variant); procedure TX2OVHash.SetValue(Key: TObject; const Value: Variant);
begin begin
inherited SetValue(Find(Key, True), inherited SetValue(Find(Key, True), ValueManager.CreateCookie(Value));
TX2HashVariantManager(ValueManager).ToPointer(Value)); end;
function TX2OVHash.GetValueManager: TX2HashVariantManager;
begin
Result := TX2HashVariantManager(inherited ValueManager);
end; end;
{======================================== {========================================
TX2SVHash TX2SVHash
========================================} ========================================}
function TX2SVHash.CreateValueManager(): TX2CustomHashManager; function TX2SVHash.CreateValueManager: TX2CustomHashManager;
begin begin
Result := TX2HashVariantManager.Create(); Result := TX2HashVariantManager.Create;
end; end;
function TX2SVHash.GetCurrentValue(): Variant;
function TX2SVHash.GetCurrentValue: Variant;
begin begin
CursorRequired(); CursorRequired;
Result := TX2HashVariantManager(ValueManager).ToValue(Cursor.Current^.Value); Result := ValueManager.GetValue(Cursor.Current^.Value);
end; end;
function TX2SVHash.GetValue(Key: String): Variant; function TX2SVHash.GetValue(Key: String): Variant;
var var
pItem: PX2HashValue; item: PX2HashValue;
begin begin
Result := Unassigned; Result := Unassigned;
pItem := Find(Key, False); item := Find(Key, False);
if Assigned(pItem) then if Assigned(item) then
Result := TX2HashVariantManager(ValueManager).ToValue(pItem^.Value); Result := ValueManager.GetValue(item^.Value);
end; end;
procedure TX2SVHash.SetValue(Key: String; const Value: Variant); procedure TX2SVHash.SetValue(Key: String; const Value: Variant);
begin begin
inherited SetValue(Find(Key, True), inherited SetValue(Find(Key, True), ValueManager.CreateCookie(Value));
TX2HashVariantManager(ValueManager).ToPointer(Value)); end;
function TX2SVHash.GetValueManager: TX2HashVariantManager;
begin
Result := TX2HashVariantManager(inherited ValueManager);
end; end;
end. end.