mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-09 08:30:54 +02:00
Allow usage of other type kinds than only objects for keys and values for TObjectDictionaries constraints.
git-svn-id: trunk@38780 -
This commit is contained in:
parent
49caa8fcef
commit
487e01af79
@ -2179,7 +2179,7 @@ begin
|
||||
inherited;
|
||||
|
||||
if (doOwnsKeys in FOwnerships) and (ACollectionNotification = cnRemoved) then
|
||||
TObject(AKey).Free;
|
||||
TObject((@AKey)^).Free;
|
||||
end;
|
||||
|
||||
procedure TObjectDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.ValueNotify(constref AValue: TValue;
|
||||
@ -2188,7 +2188,7 @@ begin
|
||||
inherited;
|
||||
|
||||
if (doOwnsValues in FOwnerships) and (ACollectionNotification = cnRemoved) then
|
||||
TObject(AValue).Free;
|
||||
TObject((@AValue)^).Free;
|
||||
end;
|
||||
|
||||
constructor TObjectDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(
|
||||
@ -2227,7 +2227,7 @@ begin
|
||||
inherited;
|
||||
|
||||
if (doOwnsKeys in FOwnerships) and (ACollectionNotification = cnRemoved) then
|
||||
TObject(AKey).Free;
|
||||
TObject((@AKey)^).Free;
|
||||
end;
|
||||
|
||||
procedure TObjectOpenAddressingLP<OPEN_ADDRESSING_CONSTRAINTS>.ValueNotify(
|
||||
@ -2236,7 +2236,7 @@ begin
|
||||
inherited;
|
||||
|
||||
if (doOwnsValues in FOwnerships) and (ACollectionNotification = cnRemoved) then
|
||||
TObject(AValue).Free;
|
||||
TObject((@AValue)^).Free;
|
||||
end;
|
||||
|
||||
constructor TObjectOpenAddressingLP<OPEN_ADDRESSING_CONSTRAINTS>.Create(AOwnerships: TDictionaryOwnerships);
|
||||
|
@ -62,6 +62,8 @@ type
|
||||
procedure Test_OpenAddressingLP_TrimExcess;
|
||||
procedure Test_CuckooD2_TrimExcess;
|
||||
|
||||
procedure Test_ObjectDictionary;
|
||||
|
||||
procedure Test_TryAddOrSetOrGetValue;
|
||||
end;
|
||||
|
||||
@ -316,6 +318,12 @@ begin
|
||||
TEST_TRIMEXCESS;
|
||||
end;
|
||||
|
||||
procedure TTestHashMaps.Test_ObjectDictionary;
|
||||
begin
|
||||
with TObjectOpenAddressingLP<TGUID, TGUID>.Create do Free;
|
||||
with TObjectCuckooD2<TGUID, TGUID>.Create do Free;
|
||||
end;
|
||||
|
||||
procedure TTestHashMaps.Test_TryAddOrSetOrGetValue;
|
||||
// modified test from Castle Game Engine (https://castle-engine.sourceforge.io)
|
||||
var
|
||||
|
Loading…
Reference in New Issue
Block a user