Parallel.ForEach going CRAZY on memory about omnithreadlibrary HOT 11 CLOSED

An unexpected memory leak has occurred. The unexpected small block leaks are:

1 - 8 bytes: Unknown x 2
25 - 40 bytes: TBits x 2
73 - 88 bytes: TOmniIntegerSet x 2, TOTPWorkItem x 2
105 - 120 bytes: TOmniTask x 2

unit Unit_TBuilding;

interface

uses
  System.Math;

type
  TBuilding = record
    Index, Level, Panorama: Integer;
    Townhall: Boolean;
    X, Y: Double;
  end;

  TBuildingDynArray = array of TBuilding;

  TSolution = record
    Level, Panorama: Integer;
  end;

  TSolutionDynArray = array of TSolution;

const
  LEVEL_MAX = 5;
  LEVEL_MIN = 1;
  PANORAMA_MAX = 5;
  PANORAMA_MIN = 0;
  POPULATION_VIA_LEVEL: array [LEVEL_MIN .. LEVEL_MAX] of Integer = (197, 239,
      283, 331, 381);
  POPULATION_VIA_PANORAMA: array [PANORAMA_MIN .. PANORAMA_MAX] of Integer = (0,
      80, 139, 193, 253, 319);
  RADIUS_PANORAMA: array [LEVEL_MIN .. LEVEL_MAX] of Double = (4, 4.25,
      5, 6, 6.75);
  RADIUS_TOWNHALL = 20;

function Distance(const Building1, Building2: TBuilding): Double;
procedure Panorama(var Solutions: TSolutionDynArray);
procedure PertinentPanoramas(const Residences: TBuildingDynArray);

implementation

var
  FPertinentPanoramas: array of array [LEVEL_MIN .. LEVEL_MAX]
      of array of Integer;

function Distance(const Building1, Building2: TBuilding): Double;
begin
  Result := Sqrt(Power(Building1.X - Building2.X, 2) +
      Power(Building1.Y - Building2.Y, 2));
end;

procedure PertinentPanoramas(const Residences: TBuildingDynArray);
var
  I, Level, J: Integer;
begin
  SetLength(FPertinentPanoramas, Length(Residences));
  for I := Low(FPertinentPanoramas) to High(FPertinentPanoramas) do
    for Level := Low(FPertinentPanoramas[I]) to High(FPertinentPanoramas[I]) do
    begin
      SetLength(FPertinentPanoramas[I, Level], 0);
      for J := Low(Residences) to High(Residences) do
        if (I <> J) and (Distance(Residences[I], Residences[J]) <=
            RADIUS_PANORAMA[Level]) then begin
          SetLength(FPertinentPanoramas[I, Level],
              Length(FPertinentPanoramas[I, Level]) + 1);
          FPertinentPanoramas[I, Level,
              High(FPertinentPanoramas[I, Level])] := J;
        end;
    end;
end;

procedure Panorama(var Solutions: TSolutionDynArray);
var
  I, J: Integer;
begin
  for I := Low(Solutions) to High(Solutions) do
    with Solutions[I] do begin
      Panorama := Level;
      for J := Low(FPertinentPanoramas[I, Level])
          to High(FPertinentPanoramas[I, Level]) do
        if Level > Solutions[FPertinentPanoramas[I, Level, J]].Level then
          Panorama := Panorama + 1
        else
          Panorama := Panorama - 1;
    end;
end;

end.

unit Unit1;

interface

uses
  Winapi.Windows,
  System.Math,
  System.SysUtils,
  Vcl.Forms,
  Winapi.Messages,
  Vcl.StdCtrls,
  Vcl.Controls,
  System.Classes,
  System.Threading;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button2: TButton;
    Button4: TButton;
    Button5: TButton;
    procedure Button4Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  Unit_TBuilding,
  OtlParallel;

// --- MRE --- SINGLE THREAD ---------------------------------------------------
const
  GENERATIONS = 250;
  GUI_UPDATE_INTERVAL = 250;
  MININT = -2147483648;
  SOLUTIONS_POOL = 10000;
  UPPERBOUND_ABSENT_TOWNHALL = 4;

type
  TSolutionPoolDynArray = array of TSolutionDynArray;

var
  FSolutionsPool: TSolutionPoolDynArray;

function Evaluate(const Residences: TBuildingDynArray;
    const SolutionsPool: TSolutionPoolDynArray): Integer;
var
  I: Integer;
begin
  Result := -1;
  Parallel.ForEach(Low(SolutionsPool), High(SolutionsPool)).Execute(
    procedure(const I: Integer)
//     TParallel.For(Low(SolutionsPool), High(SolutionsPool),
//     procedure(I: Integer)
    begin
      Panorama(SolutionsPool[I]);
    end);
end;

procedure Optimize(const Residences: TBuildingDynArray);
var
  I: Integer;
begin
  RandSeed := 123; // MRE REPRODUCIBLE RANDOM
  for I := 0 to GENERATIONS do begin
    Evaluate(Residences, FSolutionsPool);
    if I mod 25 = 0 then // MRE
      with Form1.ListBox1 do begin
        Items.Add(String.Format('Generation %d', [I]));
        Update;
      end;
  end;
end;

procedure xExecute;
var
  I, J: Integer;
  Residences: TBuildingDynArray;
begin
  // MRE CREATE DUMMY INPUT
  SetLength(Residences, 290);
  for I := Low(Residences) to High(Residences) do
    with Residences[I] do begin
      Index := I;
      Level := RandomRange(1, 5 + 1);
      X := RandomRange(1, 100);
      Y := RandomRange(1, 100);
    end;
  SetLength(FSolutionsPool, SOLUTIONS_POOL, Length(Residences));
  for I := Low(FSolutionsPool) to High(FSolutionsPool) do
    for J := Low(FSolutionsPool[I]) to High(FSolutionsPool[I]) do
      FSolutionsPool[I, J].Level := RandomRange(1, 5 + 1);
  // PertinentPanoramas = COMPUTED ONCE THEN REMAINS CONSTANT (SO IRRELEVANT?)
  PertinentPanoramas(Residences);
  Optimize(Residences);
  Form1.ListBox1.Items.Add('Done');
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  xExecute;
  // MRE: MEMORY ***FREED***
end;

// --- MRE --- MULTI THREADS ---------------------------------------------------
type
  Tmre = class(TThread)
  strict protected
    procedure Execute; override;
  end;

procedure Tmre.Execute;
begin
  inherited;
  xExecute;
  // MRE: MEMORY *** NOT FREED***
end;

var
  blah: Tmre;

procedure TForm1.Button2Click(Sender: TObject);
begin
  blah := Tmre.Create;
  // MRE listbox access should be Synchnized, i know; NOT THE PROBLEM
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  blah.Free;
  // MRE: MEMORY *** STILL NOT FREED***
end;

end.

procedure mre;
var
  I: Integer;
  blah: array of integer;
begin
  SetLength(blah, 290);
  Parallel.ForEach(Low(blah), High(blah)).Execute(
    procedure(const I: Integer)
    begin
      blah[I] := 0;
    end);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
begin
  for I := 1 to 100 do begin
    sleep(100); // MRE: SO POSSIBLE TO SEE MEMORY USAGE IN TASK MANAGER
    mre;
  end;
  beep(40,40); // MRE: SIGNAL DONE
end;