Refactoring in the key/value managers for X2UtHashes
- Improved code clarity - Solves an obscure access violation with large amounts of data
This commit is contained in:
parent
35a7e5f5fb
commit
5b05c3237c
@ -13,65 +13,65 @@ type
|
||||
private
|
||||
FHash: TX2CustomHash;
|
||||
protected
|
||||
procedure TearDown(); override;
|
||||
procedure FillTestItems(); virtual; abstract;
|
||||
procedure TearDown; override;
|
||||
procedure FillTestItems; virtual; abstract;
|
||||
published
|
||||
procedure testSet(); virtual; abstract;
|
||||
procedure testGet(); virtual; abstract;
|
||||
procedure testClear();
|
||||
procedure testDelete(); virtual; abstract;
|
||||
procedure testIterate(); virtual; abstract;
|
||||
procedure testEnumerator(); virtual; abstract;
|
||||
procedure testSet; virtual; abstract;
|
||||
procedure testGet; virtual; abstract;
|
||||
procedure testClear;
|
||||
procedure testDelete; virtual; abstract;
|
||||
procedure testIterate; virtual; abstract;
|
||||
procedure testEnumerator; virtual; abstract;
|
||||
end;
|
||||
|
||||
// Two test cases involving all value managers.
|
||||
// This should be sufficient for a realistic scenario.
|
||||
THashesSITest = class(THashesTest)
|
||||
private
|
||||
function GetHash(): TX2SIHash;
|
||||
function GetHash: TX2SIHash;
|
||||
|
||||
property Hash: TX2SIHash read GetHash;
|
||||
protected
|
||||
procedure SetUp(); override;
|
||||
procedure FillTestItems(); override;
|
||||
procedure SetUp; override;
|
||||
procedure FillTestItems; override;
|
||||
published
|
||||
procedure testSet(); override;
|
||||
procedure testGet(); override;
|
||||
procedure testDelete(); override;
|
||||
procedure testIterate(); override;
|
||||
procedure testEnumerator(); override;
|
||||
procedure testSet; override;
|
||||
procedure testGet; override;
|
||||
procedure testDelete; override;
|
||||
procedure testIterate; override;
|
||||
procedure testEnumerator; override;
|
||||
end;
|
||||
|
||||
THashesPOTest = class(THashesTest)
|
||||
private
|
||||
function GetHash(): TX2POHash;
|
||||
function GetHash: TX2POHash;
|
||||
|
||||
property Hash: TX2POHash read GetHash;
|
||||
protected
|
||||
procedure SetUp(); override;
|
||||
procedure FillTestItems(); override;
|
||||
procedure SetUp; override;
|
||||
procedure FillTestItems; override;
|
||||
published
|
||||
procedure testSet(); override;
|
||||
procedure testGet(); override;
|
||||
procedure testDelete(); override;
|
||||
procedure testIterate(); override;
|
||||
procedure testEnumerator(); override;
|
||||
procedure testSet; override;
|
||||
procedure testGet; override;
|
||||
procedure testDelete; override;
|
||||
procedure testIterate; override;
|
||||
procedure testEnumerator; override;
|
||||
end;
|
||||
|
||||
THashesVariantTest = class(THashesTest)
|
||||
private
|
||||
function GetHash(): TX2SVHash;
|
||||
function GetHash: TX2SVHash;
|
||||
|
||||
property Hash: TX2SVHash read GetHash;
|
||||
protected
|
||||
procedure SetUp(); override;
|
||||
procedure FillTestItems(); override;
|
||||
procedure SetUp; override;
|
||||
procedure FillTestItems; override;
|
||||
published
|
||||
procedure testSet(); override;
|
||||
procedure testGet(); override;
|
||||
procedure testDelete(); override;
|
||||
procedure testIterate(); override;
|
||||
procedure testEnumerator(); override;
|
||||
procedure testSet; override;
|
||||
procedure testGet; override;
|
||||
procedure testDelete; override;
|
||||
procedure testIterate; override;
|
||||
procedure testEnumerator; override;
|
||||
end;
|
||||
|
||||
THashesBugTest = class(TTestCase)
|
||||
@ -101,8 +101,8 @@ end;
|
||||
|
||||
procedure THashesTest.testClear;
|
||||
begin
|
||||
FillTestItems();
|
||||
FHash.Clear();
|
||||
FillTestItems;
|
||||
FHash.Clear;
|
||||
CheckEquals(0, FHash.Count);
|
||||
end;
|
||||
|
||||
@ -112,7 +112,7 @@ procedure THashesSITest.SetUp;
|
||||
begin
|
||||
inherited;
|
||||
|
||||
FHash := TX2SIHash.Create();
|
||||
FHash := TX2SIHash.Create;
|
||||
end;
|
||||
|
||||
procedure THashesSITest.FillTestItems;
|
||||
@ -124,13 +124,13 @@ end;
|
||||
|
||||
procedure THashesSITest.testSet;
|
||||
begin
|
||||
FillTestItems();
|
||||
FillTestItems;
|
||||
CheckEquals(3, Hash.Count);
|
||||
end;
|
||||
|
||||
procedure THashesSITest.testGet;
|
||||
begin
|
||||
FillTestItems();
|
||||
FillTestItems;
|
||||
CheckEquals(1, Hash['Key1']);
|
||||
CheckEquals(2, Hash['Key2']);
|
||||
CheckEquals(3, Hash['Key3']);
|
||||
@ -138,7 +138,7 @@ end;
|
||||
|
||||
procedure THashesSITest.testDelete;
|
||||
begin
|
||||
FillTestItems();
|
||||
FillTestItems;
|
||||
Hash.Delete('Key2');
|
||||
|
||||
CheckEquals(2, Hash.Count);
|
||||
@ -154,7 +154,7 @@ var
|
||||
|
||||
begin
|
||||
{$IFDEF D2006PLUS}
|
||||
FillTestItems();
|
||||
FillTestItems;
|
||||
FillChar(aPresent, SizeOf(aPresent), #0);
|
||||
|
||||
for sKey in Hash do
|
||||
@ -188,10 +188,10 @@ var
|
||||
aPresent: array[1..3] of Boolean;
|
||||
|
||||
begin
|
||||
FillTestItems();
|
||||
FillTestItems;
|
||||
FillChar(aPresent, SizeOf(aPresent), #0);
|
||||
Hash.First();
|
||||
while Hash.Next() do
|
||||
Hash.First;
|
||||
while Hash.Next do
|
||||
if ((Hash.CurrentKey = 'Key1') and (Hash.CurrentValue = 1)) or
|
||||
((Hash.CurrentKey = 'Key2') and (Hash.CurrentValue = 2)) or
|
||||
((Hash.CurrentKey = 'Key3') and (Hash.CurrentValue = 3)) then
|
||||
@ -203,7 +203,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function THashesSITest.GetHash(): TX2SIHash;
|
||||
function THashesSITest.GetHash: TX2SIHash;
|
||||
begin
|
||||
Result := TX2SIHash(FHash);
|
||||
end;
|
||||
@ -219,20 +219,20 @@ end;
|
||||
|
||||
procedure THashesPOTest.FillTestItems;
|
||||
begin
|
||||
Hash[Pointer(0)] := TObject0.Create();
|
||||
Hash[Pointer(1)] := TObject1.Create();
|
||||
Hash[Pointer(2)] := TObject2.Create();
|
||||
Hash[Pointer(0)] := TObject0.Create;
|
||||
Hash[Pointer(1)] := TObject1.Create;
|
||||
Hash[Pointer(2)] := TObject2.Create;
|
||||
end;
|
||||
|
||||
procedure THashesPOTest.testSet;
|
||||
begin
|
||||
FillTestItems();
|
||||
FillTestItems;
|
||||
CheckEquals(3, Hash.Count);
|
||||
end;
|
||||
|
||||
procedure THashesPOTest.testGet;
|
||||
begin
|
||||
FillTestItems();
|
||||
FillTestItems;
|
||||
CheckTrue(Hash[Pointer(0)] is TObject0);
|
||||
CheckTrue(Hash[Pointer(1)] is TObject1);
|
||||
CheckTrue(Hash[Pointer(2)] is TObject2);
|
||||
@ -240,7 +240,7 @@ end;
|
||||
|
||||
procedure THashesPOTest.testDelete;
|
||||
begin
|
||||
FillTestItems();
|
||||
FillTestItems;
|
||||
Hash.Delete(Pointer(1));
|
||||
|
||||
CheckEquals(2, Hash.Count);
|
||||
@ -256,7 +256,7 @@ var
|
||||
|
||||
begin
|
||||
{$IFDEF D2006PLUS}
|
||||
FillTestItems();
|
||||
FillTestItems;
|
||||
FillChar(aPresent, SizeOf(aPresent), #0);
|
||||
|
||||
for pKey in Hash do
|
||||
@ -273,10 +273,10 @@ var
|
||||
aPresent: array[0..2] of Boolean;
|
||||
|
||||
begin
|
||||
FillTestItems();
|
||||
FillTestItems;
|
||||
FillChar(aPresent, SizeOf(aPresent), #0);
|
||||
Hash.First();
|
||||
while Hash.Next() do
|
||||
Hash.First;
|
||||
while Hash.Next do
|
||||
if ((Hash.CurrentKey = Pointer(0)) and (Hash.CurrentValue is TObject0)) or
|
||||
((Hash.CurrentKey = Pointer(1)) and (Hash.CurrentValue is TObject1)) or
|
||||
((Hash.CurrentKey = Pointer(2)) and (Hash.CurrentValue is TObject2)) then
|
||||
@ -288,7 +288,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function THashesPOTest.GetHash(): TX2POHash;
|
||||
function THashesPOTest.GetHash: TX2POHash;
|
||||
begin
|
||||
Result := TX2POHash(FHash);
|
||||
end;
|
||||
@ -298,10 +298,10 @@ procedure THashesVariantTest.SetUp;
|
||||
begin
|
||||
inherited;
|
||||
|
||||
FHash := TX2SVHash.Create();
|
||||
FHash := TX2SVHash.Create;
|
||||
end;
|
||||
|
||||
function THashesVariantTest.GetHash(): TX2SVHash;
|
||||
function THashesVariantTest.GetHash: TX2SVHash;
|
||||
begin
|
||||
Result := TX2SVHash(FHash);
|
||||
end;
|
||||
@ -315,13 +315,13 @@ end;
|
||||
|
||||
procedure THashesVariantTest.testSet;
|
||||
begin
|
||||
FillTestItems();
|
||||
FillTestItems;
|
||||
CheckEquals(3, Hash.Count);
|
||||
end;
|
||||
|
||||
procedure THashesVariantTest.testGet;
|
||||
begin
|
||||
FillTestItems();
|
||||
FillTestItems;
|
||||
CheckTrue(Hash['Key1'] = 'String');
|
||||
CheckTrue(Hash['Key2'] = 5);
|
||||
CheckTrue(Hash['Key3'] = 40.4);
|
||||
@ -329,7 +329,7 @@ end;
|
||||
|
||||
procedure THashesVariantTest.testDelete;
|
||||
begin
|
||||
FillTestItems();
|
||||
FillTestItems;
|
||||
Hash.Delete('Key2');
|
||||
|
||||
CheckEquals(2, Hash.Count);
|
||||
@ -348,10 +348,10 @@ var
|
||||
aPresent: array[0..2] of Boolean;
|
||||
|
||||
begin
|
||||
FillTestItems();
|
||||
FillTestItems;
|
||||
FillChar(aPresent, SizeOf(aPresent), #0);
|
||||
Hash.First();
|
||||
while Hash.Next() do
|
||||
Hash.First;
|
||||
while Hash.Next do
|
||||
if ((Hash.CurrentKey = 'Key1') and (Hash.CurrentValue = 'String')) then
|
||||
aPresent[0] := True
|
||||
else if ((Hash.CurrentKey = 'Key2') and (Hash.CurrentValue = 5)) then
|
||||
|
||||
@ -7,7 +7,9 @@ uses
|
||||
BitsTest in 'Units\BitsTest.pas',
|
||||
HashesTest in 'Units\HashesTest.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',
|
||||
//IniParserTest in 'Units\IniParserTest.pas';
|
||||
|
||||
@ -42,53 +42,18 @@
|
||||
<Borland.Personality>Delphi.Personality</Borland.Personality>
|
||||
<Borland.ProjectType>VCLApplication</Borland.ProjectType>
|
||||
<BorlandProject>
|
||||
<BorlandProject xmlns=""> <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>
|
||||
<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>
|
||||
</ProjectExtensions>
|
||||
<ItemGroup />
|
||||
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
|
||||
<ItemGroup>
|
||||
<DelphiCompile Include="X2UtUnitTests.dpr">
|
||||
<MainSource>MainSource</MainSource>
|
||||
</DelphiCompile>
|
||||
<DCCReference Include="..\X2UtHashes.pas" />
|
||||
<DCCReference Include="..\X2UtHashesVariants.pas" />
|
||||
<DCCReference Include="..\X2UtSingleInstance.pas" />
|
||||
<DCCReference Include="Units\BitsTest.pas" />
|
||||
<DCCReference Include="Units\HashesTest.pas" />
|
||||
<DCCReference Include="Units\PersistTest.pas" />
|
||||
</ItemGroup>
|
||||
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
|
||||
</Project>
|
||||
1742
X2UtHashes.pas
1742
X2UtHashes.pas
File diff suppressed because it is too large
Load Diff
@ -13,244 +13,332 @@ uses
|
||||
|
||||
X2UtHashes;
|
||||
|
||||
|
||||
type
|
||||
{
|
||||
:$ Variant value class.
|
||||
}
|
||||
TX2HashVariantManager = class(TX2CustomHashManager)
|
||||
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 ToValue(const AData: Pointer): Variant; overload;
|
||||
|
||||
function Compare(const AData: Pointer; const AValue: Pointer;
|
||||
const ASize: Cardinal): Boolean; override;
|
||||
function Hash(ACookie: PX2HashCookie): Cardinal; override;
|
||||
function Compare(const ACookie1, ACookie2: PX2HashCookie): Boolean; override;
|
||||
function Clone(const ACookie: PX2HashCookie): PX2HashCookie; override;
|
||||
end;
|
||||
|
||||
|
||||
{
|
||||
:$ Pointer-to-Variant hash.
|
||||
}
|
||||
TX2PVHash = class(TX2CustomPointerHash)
|
||||
private
|
||||
function GetCurrentValue(): Variant;
|
||||
function GetCurrentValue: Variant;
|
||||
function GetValue(Key: Pointer): Variant;
|
||||
procedure SetValue(Key: Pointer; const Value: Variant);
|
||||
function GetValueManager: TX2HashVariantManager;
|
||||
protected
|
||||
function CreateValueManager(): TX2CustomHashManager; override;
|
||||
function CreateValueManager: TX2CustomHashManager; override;
|
||||
|
||||
property ValueManager: TX2HashVariantManager read GetValueManager;
|
||||
public
|
||||
property CurrentValue: Variant read GetCurrentValue;
|
||||
property Values[Key: Pointer]: Variant read GetValue write SetValue; default;
|
||||
end;
|
||||
|
||||
|
||||
{
|
||||
:$ Integer-to-Variant hash.
|
||||
}
|
||||
TX2IVHash = class(TX2CustomIntegerHash)
|
||||
private
|
||||
function GetCurrentValue(): Variant;
|
||||
function GetCurrentValue: Variant;
|
||||
function GetValue(Key: Integer): Variant;
|
||||
procedure SetValue(Key: Integer; const Value: Variant);
|
||||
function GetValueManager: TX2HashVariantManager;
|
||||
protected
|
||||
function CreateValueManager(): TX2CustomHashManager; override;
|
||||
function CreateValueManager: TX2CustomHashManager; override;
|
||||
|
||||
property ValueManager: TX2HashVariantManager read GetValueManager;
|
||||
public
|
||||
property CurrentValue: Variant read GetCurrentValue;
|
||||
property Values[Key: Integer]: Variant read GetValue write SetValue; default;
|
||||
end;
|
||||
|
||||
|
||||
{
|
||||
:$ Object-to-Variant hash.
|
||||
}
|
||||
TX2OVHash = class(TX2CustomObjectHash)
|
||||
private
|
||||
function GetCurrentValue(): Variant;
|
||||
function GetCurrentValue: Variant;
|
||||
function GetValue(Key: TObject): Variant;
|
||||
procedure SetValue(Key: TObject; const Value: Variant);
|
||||
function GetValueManager: TX2HashVariantManager;
|
||||
protected
|
||||
function CreateValueManager(): TX2CustomHashManager; override;
|
||||
function CreateValueManager: TX2CustomHashManager; override;
|
||||
|
||||
property ValueManager: TX2HashVariantManager read GetValueManager;
|
||||
public
|
||||
property CurrentValue: Variant read GetCurrentValue;
|
||||
property Values[Key: TObject]: Variant read GetValue write SetValue; default;
|
||||
end;
|
||||
|
||||
|
||||
{
|
||||
:$ String-to-Variant hash.
|
||||
}
|
||||
TX2SVHash = class(TX2CustomStringHash)
|
||||
private
|
||||
function GetCurrentValue(): Variant;
|
||||
function GetCurrentValue: Variant;
|
||||
function GetValue(Key: String): Variant;
|
||||
procedure SetValue(Key: String; const Value: Variant);
|
||||
function GetValueManager: TX2HashVariantManager;
|
||||
protected
|
||||
function CreateValueManager(): TX2CustomHashManager; override;
|
||||
function CreateValueManager: TX2CustomHashManager; override;
|
||||
|
||||
property ValueManager: TX2HashVariantManager read GetValueManager;
|
||||
public
|
||||
property CurrentValue: Variant read GetCurrentValue;
|
||||
property Values[Key: String]: Variant read GetValue write SetValue; default;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
uses
|
||||
SysUtils;
|
||||
|
||||
|
||||
{========================================
|
||||
TX2HashVariantManager
|
||||
========================================}
|
||||
function TX2HashVariantManager.DataSize(const AData: Pointer): Cardinal;
|
||||
begin
|
||||
Result := SizeOf(Variant);
|
||||
end;
|
||||
procedure TX2HashVariantManager.FreeCookie(var ACookie: PX2HashCookie);
|
||||
var
|
||||
variantCookie: PVariant;
|
||||
|
||||
procedure TX2HashVariantManager.Finalize(var AData: Pointer);
|
||||
begin
|
||||
if AData <> nil then
|
||||
Dispose(PVariant(AData));
|
||||
if Assigned(ACookie) then
|
||||
begin
|
||||
variantCookie := ACookie;
|
||||
VarClear(variantCookie^);
|
||||
|
||||
Dispose(variantCookie);
|
||||
end;
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TX2HashVariantManager.ToPointer(const AValue: Variant): Pointer;
|
||||
|
||||
function TX2HashVariantManager.CreateCookie(const AValue: Variant): PX2HashCookie;
|
||||
var
|
||||
variantCookie: PVariant;
|
||||
|
||||
begin
|
||||
New(PVariant(Result));
|
||||
PVariant(Result)^ := AValue;
|
||||
New(variantCookie);
|
||||
VarCopy(variantCookie^, AValue);
|
||||
|
||||
Result := variantCookie;
|
||||
end;
|
||||
|
||||
function TX2HashVariantManager.ToValue(const AData: Pointer): Variant;
|
||||
|
||||
function TX2HashVariantManager.GetValue(const ACookie: PX2HashCookie): Variant;
|
||||
begin
|
||||
Result := PVariant(AData)^;
|
||||
VarCopy(Result, PVariant(ACookie)^);
|
||||
end;
|
||||
|
||||
function TX2HashVariantManager.Compare(const AData, AValue: Pointer;
|
||||
const ASize: Cardinal): Boolean;
|
||||
|
||||
function TX2HashVariantManager.Hash(ACookie: PX2HashCookie): Cardinal;
|
||||
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;
|
||||
|
||||
|
||||
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
|
||||
========================================}
|
||||
function TX2PVHash.CreateValueManager(): TX2CustomHashManager;
|
||||
function TX2PVHash.CreateValueManager: TX2CustomHashManager;
|
||||
begin
|
||||
Result := TX2HashVariantManager.Create();
|
||||
Result := TX2HashVariantManager.Create;
|
||||
end;
|
||||
|
||||
function TX2PVHash.GetCurrentValue(): Variant;
|
||||
|
||||
function TX2PVHash.GetCurrentValue: Variant;
|
||||
begin
|
||||
CursorRequired();
|
||||
Result := TX2HashVariantManager(ValueManager).ToValue(Cursor.Current^.Value);
|
||||
CursorRequired;
|
||||
Result := ValueManager.GetValue(Cursor.Current^.Value);
|
||||
end;
|
||||
|
||||
|
||||
function TX2PVHash.GetValue(Key: Pointer): Variant;
|
||||
var
|
||||
pItem: PX2HashValue;
|
||||
item: PX2HashValue;
|
||||
|
||||
begin
|
||||
Result := Unassigned;
|
||||
pItem := Find(Key, False);
|
||||
if Assigned(pItem) then
|
||||
Result := TX2HashVariantManager(ValueManager).ToValue(pItem^.Value);
|
||||
Result := Unassigned;
|
||||
item := Find(Key, False);
|
||||
if Assigned(item) then
|
||||
Result := ValueManager.GetValue(item^.Value);
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2PVHash.SetValue(Key: Pointer; const Value: Variant);
|
||||
begin
|
||||
inherited SetValue(Find(Key, True),
|
||||
TX2HashVariantManager(ValueManager).ToPointer(Value));
|
||||
inherited SetValue(Find(Key, True), ValueManager.CreateCookie(Value));
|
||||
end;
|
||||
|
||||
|
||||
function TX2PVHash.GetValueManager: TX2HashVariantManager;
|
||||
begin
|
||||
Result := TX2HashVariantManager(inherited ValueManager);
|
||||
end;
|
||||
|
||||
|
||||
{========================================
|
||||
TX2IVHash
|
||||
========================================}
|
||||
function TX2IVHash.CreateValueManager(): TX2CustomHashManager;
|
||||
function TX2IVHash.CreateValueManager: TX2CustomHashManager;
|
||||
begin
|
||||
Result := TX2HashVariantManager.Create();
|
||||
Result := TX2HashVariantManager.Create;
|
||||
end;
|
||||
|
||||
function TX2IVHash.GetCurrentValue(): Variant;
|
||||
|
||||
function TX2IVHash.GetCurrentValue: Variant;
|
||||
begin
|
||||
CursorRequired();
|
||||
Result := TX2HashVariantManager(ValueManager).ToValue(Cursor.Current^.Value);
|
||||
CursorRequired;
|
||||
Result := ValueManager.GetValue(Cursor.Current^.Value);
|
||||
end;
|
||||
|
||||
|
||||
function TX2IVHash.GetValue(Key: Integer): Variant;
|
||||
var
|
||||
pItem: PX2HashValue;
|
||||
item: PX2HashValue;
|
||||
|
||||
begin
|
||||
Result := Unassigned;
|
||||
pItem := Find(Key, False);
|
||||
if Assigned(pItem) then
|
||||
Result := TX2HashVariantManager(ValueManager).ToValue(pItem^.Value);
|
||||
Result := Unassigned;
|
||||
item := Find(Key, False);
|
||||
if Assigned(item) then
|
||||
Result := ValueManager.GetValue(item^.Value);
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2IVHash.SetValue(Key: Integer; const Value: Variant);
|
||||
begin
|
||||
inherited SetValue(Find(Key, True),
|
||||
TX2HashVariantManager(ValueManager).ToPointer(Value));
|
||||
inherited SetValue(Find(Key, True), ValueManager.CreateCookie(Value));
|
||||
end;
|
||||
|
||||
|
||||
function TX2IVHash.GetValueManager: TX2HashVariantManager;
|
||||
begin
|
||||
Result := TX2HashVariantManager(inherited ValueManager);
|
||||
end;
|
||||
|
||||
|
||||
{========================================
|
||||
TX2OVHash
|
||||
========================================}
|
||||
function TX2OVHash.CreateValueManager(): TX2CustomHashManager;
|
||||
function TX2OVHash.CreateValueManager: TX2CustomHashManager;
|
||||
begin
|
||||
Result := TX2HashVariantManager.Create();
|
||||
Result := TX2HashVariantManager.Create;
|
||||
end;
|
||||
|
||||
function TX2OVHash.GetCurrentValue(): Variant;
|
||||
|
||||
function TX2OVHash.GetCurrentValue: Variant;
|
||||
begin
|
||||
CursorRequired();
|
||||
Result := TX2HashVariantManager(ValueManager).ToValue(Cursor.Current^.Value);
|
||||
CursorRequired;
|
||||
Result := ValueManager.GetValue(Cursor.Current^.Value);
|
||||
end;
|
||||
|
||||
|
||||
function TX2OVHash.GetValue(Key: TObject): Variant;
|
||||
var
|
||||
pItem: PX2HashValue;
|
||||
item: PX2HashValue;
|
||||
|
||||
begin
|
||||
Result := Unassigned;
|
||||
pItem := Find(Key, False);
|
||||
if Assigned(pItem) then
|
||||
Result := TX2HashVariantManager(ValueManager).ToValue(pItem^.Value);
|
||||
Result := Unassigned;
|
||||
item := Find(Key, False);
|
||||
if Assigned(item) then
|
||||
Result := ValueManager.GetValue(item^.Value);
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2OVHash.SetValue(Key: TObject; const Value: Variant);
|
||||
begin
|
||||
inherited SetValue(Find(Key, True),
|
||||
TX2HashVariantManager(ValueManager).ToPointer(Value));
|
||||
inherited SetValue(Find(Key, True), ValueManager.CreateCookie(Value));
|
||||
end;
|
||||
|
||||
|
||||
function TX2OVHash.GetValueManager: TX2HashVariantManager;
|
||||
begin
|
||||
Result := TX2HashVariantManager(inherited ValueManager);
|
||||
end;
|
||||
|
||||
|
||||
{========================================
|
||||
TX2SVHash
|
||||
========================================}
|
||||
function TX2SVHash.CreateValueManager(): TX2CustomHashManager;
|
||||
function TX2SVHash.CreateValueManager: TX2CustomHashManager;
|
||||
begin
|
||||
Result := TX2HashVariantManager.Create();
|
||||
Result := TX2HashVariantManager.Create;
|
||||
end;
|
||||
|
||||
function TX2SVHash.GetCurrentValue(): Variant;
|
||||
|
||||
function TX2SVHash.GetCurrentValue: Variant;
|
||||
begin
|
||||
CursorRequired();
|
||||
Result := TX2HashVariantManager(ValueManager).ToValue(Cursor.Current^.Value);
|
||||
CursorRequired;
|
||||
Result := ValueManager.GetValue(Cursor.Current^.Value);
|
||||
end;
|
||||
|
||||
|
||||
function TX2SVHash.GetValue(Key: String): Variant;
|
||||
var
|
||||
pItem: PX2HashValue;
|
||||
item: PX2HashValue;
|
||||
|
||||
begin
|
||||
Result := Unassigned;
|
||||
pItem := Find(Key, False);
|
||||
if Assigned(pItem) then
|
||||
Result := TX2HashVariantManager(ValueManager).ToValue(pItem^.Value);
|
||||
Result := Unassigned;
|
||||
item := Find(Key, False);
|
||||
if Assigned(item) then
|
||||
Result := ValueManager.GetValue(item^.Value);
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2SVHash.SetValue(Key: String; const Value: Variant);
|
||||
begin
|
||||
inherited SetValue(Find(Key, True),
|
||||
TX2HashVariantManager(ValueManager).ToPointer(Value));
|
||||
inherited SetValue(Find(Key, True), ValueManager.CreateCookie(Value));
|
||||
end;
|
||||
|
||||
|
||||
function TX2SVHash.GetValueManager: TX2HashVariantManager;
|
||||
begin
|
||||
Result := TX2HashVariantManager(inherited ValueManager);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user