Delphi 12: Using Any on sorted dictionary after assigning new value to existing key

[Remco Vorthoren]

Hello,

We just upgraded to the latest version of Spring4D. In a specific situation we encountered an access violation in the Any callback.

See attachments for DUnitx project with single test which will raise the access violation. See the comment which lines when commented resolves show of the access violation

UnitTest code:

unit SortedDictionaryTests;

interface

uses
  DUnitX.TestFramework,
  System.SysUtils,
  Spring,
  Spring.Collections;

type
{$SCOPEDENUMS ON}
  TTest = (First, Second);
{$SCOPEDENUMS OFF}

  [TestFixture]
  TSortedDictionaryTests = class
  private
    procedure DoTest<TKey, TValue>(const Keys: TArray<TKey>; const Values: TArray<TValue>);
  public
    [Test]
    procedure SimpleTypes;

    [Test]
    procedure AliasAndEnum;
  end;

implementation

{ TSortedDictionaryTests }

procedure TSortedDictionaryTests.SimpleTypes;
begin
  var Keys: TArray<string> := ['a', 'B', 'c'];
  var Values: TArray<Boolean> := [False, True, False];
  DoTest<string, Boolean>(Keys, Values);
end;

procedure TSortedDictionaryTests.AliasAndEnum;
begin
  var Keys: TArray<TFileName> := ['a', 'B', 'c'];
  var Values: TArray<TTest> := [TTest.First, TTest.Second, TTest.First];
  DoTest<TFileName, TTest>(Keys, Values);
end;

procedure TSortedDictionaryTests.DoTest<TKey, TValue>(const Keys: TArray<TKey>; const Values: TArray<TValue>);
begin
  var Dictionary: IDictionary<TKey, TValue> := TCollections.CreateSortedDictionary<TKey, TValue>;
  for var I := 0 to Length(Keys) - 1 do
  begin
    var Key := Keys[I];
    var Value := Values[I];

    Dictionary.Add(Key, Value);
  end;

  var ExpectedValue := Values[0];

  for var Key in Keys do
  begin

    var KeyToAddOrSet := Key;
    var KeyToAddOrSetExists := Dictionary.Any(
      function(const Dependency: TPair<TKey, TValue>): Boolean
      begin
        Result := Key = Dependency.Key;
        if Result then
          KeyToAddOrSet := Dependency.Key;
      end);

    if KeyToAddOrSetExists then
    begin
      // If this line is commented, than the access violation does not occur
      Dictionary[KeyToAddOrSet] := ExpectedValue;
    end
    else
    begin
      Dictionary.Add(KeyToAddOrSet, ExpectedValue);
    end;
  end;

  for var Key in Keys do
  begin
    Assert.AreEqual<TValue>(ExpectedValue, Dictionary[Key], 'Not same value');
  end;
end;

end.

‌

[Stefan Glienke]

The test can pretty much reduced to the following code:

procedure TSortedDictionaryTests.SimpleTypes;
var
  Dictionary: IDictionary<string, Boolean>;
begin
  Dictionary := TCollections.CreateSortedDictionary<string, Boolean>;
  Dictionary['a'] := False;
  Dictionary['B'] := True;

  Dictionary['a'] := False;
  Dictionary['B'] := False;

  Dictionary.Clear;
end;

FWIW - this has nothing to do with the issue but since the code in the unit test looks unnecessarily complicated and it obviously came from somewhere: in Spring4d you can just add new values with dict[key] := value

Now about the issue itself - that one is the result of a pretty embarrassing brainfart from myself - throughout the red-black tree, it assumes that the lowest bit of the node pointers is free to use because typically pointers returned from memory allocation are even and mostly 4 byte or more aligned. However, the tree uses some packed storage array to not spray the nodes all over the heap. Now if the size of the nodes is uneven due to containing Boolean or Byte every second node in that array will have an uneven pointer where the lowest bit is occupied and not free to use.

I already have an idea of how to solve this though.

[Stefan Glienke]

fixed #402

→ <<cset 5a05afe8d6ab>>

[Remco Vorthoren]

It is true that the testcase came from an existing piece of code.

Just tested it and it works again!

Thank you for your quick response!

[Stefan Glienke]

fixed #402

→ <<cset c1c246557575>>

[Stefan Glienke]

I just did a force push to remove some additional changes I had made that some older Delphi versions did not like. The changes that fixed this issue remain the same.