Crash after enabling ScanForCorruptionBeforeEveryOperation in a multithreaded application

[myonlylonely]

Hello,

After enabling ScanForCorruptionBeforeEveryOperation, the following application shows 'A memory block header has been corrupted.'. Is that something similar to https://github.com/pleriche/FastMM5/issues/19 due to race condition?

ScanForCorruptionBug.zip

program ScanForCorruptionBug;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  FastMM5,
  System.Classes,
  System.SysUtils,
  Winapi.Windows,
  System.SyncObjs;

type

  PLogNode = ^TLogNode;
  TLogNode = record
    msg: string;
    Next: PLogNode;
  end;

  TLogThread = class(TThread)
  private
    FFirst, FLast: PLogNode;
    FSection: TCriticalSection;

    procedure ProcessLogs;
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;
    procedure WriteLog(const AMsg: string);
  end;

constructor TLogThread.Create;
begin
  inherited Create(True);
  FSection := TCriticalSection.Create;
end;

procedure TLogThread.WriteLog(const AMsg: string);
var
  Node: PLogNode;
begin
  New(Node);
  Node.msg := AMsg;
  node.Next := nil;
  FSection.Enter;
  try
    if Assigned(FLast) then
      FLast.Next := Node
    else
      FFirst := Node;
    FLast := Node;
  finally
    FSection.Leave;
  end;
end;

destructor TLogThread.Destroy;
begin
  FreeAndNil(FSection);
  inherited;
end;

procedure TLogThread.Execute;
begin
  while not Terminated do
  begin
    ProcessLogs;
    Sleep(10);
  end;
  ProcessLogs;
end;

procedure TLogThread.ProcessLogs;
var
  Node, Next: PLogNode;
  nLogStr: UTF8String;
begin
  FSection.Enter;
  try
    Node := FFirst;
    FFirst := nil;
    FLast := nil;
  finally
    FSection.Leave;
  end;

  if not Assigned(Node) then
    Exit;

  while Assigned(Node) do
  begin
    Next := Node.Next;
    nLogStr := UTF8String(Format('%s: %s', [FormatDateTime('YY-MM-dd hh:mm:ss', Now), Node.msg]));
    nLogStr := nLogStr + sLineBreak;

    Dispose(Node);
    Node := Next;
  end;
end;

procedure Test;
var
  i: Integer;
  nLogThread: TLogThread;
begin
  nLogThread := TLogThread.Create;
  nLogThread.Start;
  for i := 1 to 1000 do
  begin
    nLogThread.WriteLog('Hello');
  end;
  nLogThread.WaitFor;
  FreeAndNil(nLogThread);
end;

begin
  FastMM_DebugMode_ScanForCorruptionBeforeEveryOperation := True;
  FastMM_EnterDebugMode;
  try
    Test;
  finally
    FastMM_ExitDebugMode;
  end;
end.

[pleriche]

Thank you for the bug report, and in particular for the test case. It made it possible to possible to track down the issue. It was indeed a race condition: If the memory pool is being scanned and a debug block is encountered that is in the process of being freed by another thread then it is possible for that block to be reported as corrupted, even though it is not actually the case.

I have pushed a fix for it.

[myonlylonely]

I have tested your fix and it works. https://github.com/pleriche/FastMM5/commit/65ec01f9b9629a90652b344384fb2a477abb7609 Thank you very much. I'll close this issue.

Best regards