Jump to content
t2000

Problem with memory leak

Recommended Posts

Hello

I have a command line program and a memory leak after closing
But not always. Only 10-15% of starts are ending with the memory leak.

 

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

41 - 56 bytes: TOmniCriticalSection x 1
137 - 152 bytes: TFixedCriticalSection x 1

 

This is the code of a unit that works like Application in VCL or FMX.
The important positions are:
constructor create : make Backgroundworker
from outside comes a call to the procedure TServerApp.Call
I put a record into the BlockingCollection and send a message

the message comes to ProcessMessage and I call CreateWorkItem for the BackgroundWorker

In my test, I start the program, I'm in the "Run" procedure, I send a call with WM_QUIT (from outside) and the program ends.

Where and how can I try to find the problem?

Has anybody an idea?

Many thanks, Thomas
 

unit sng.ServerApp;
interface
uses
  System.Classes, System.SysUtils, System.Generics.Collections, Winapi.Windows, Winapi.Messages,
  OtlCommon, OtlParallel, OtlCollections;

type
  TWorkItemCallRec = record
    ProcToCall: TProc<TOmniValue>;
    Data: TOmniValue;
  end;

  TModules = TList<TComponent>;
  TServerApp = class( TComponent)
  private
    FRunning: Boolean;
    FTerminate: Boolean;
    FServerAppName  : String;
    FServerModules  : TModules;

    FMsgDataColl   : TOmniBlockingCollection;
    FWorker        : IOmniBackgroundWorker;

    function ProcessMessage(var Msg: TMsg): Boolean;
    procedure ProcessMessages;

    procedure CreateWorkItem;
    procedure ProcessWorkItem(const workItem: IOmniWorkItem);
    procedure HandleRequestDone(const Sender: IOmniBackgroundWorker; const workItem: IOmniWorkItem);

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Run;
    procedure Shutdown;
    procedure SendQuit;
    procedure Call( AMsgCode: Cardinal; AProcToCall: TProc<TOmniValue>; AData: TOmniValue);

    property ServerAppName: String read FServerAppName;
    property Terminated: Boolean read FTerminate;
  end;

var
  ServerApp: TServerApp;

implementation

uses
  OtlTaskControl,
  OtlComm;

{ TServerApp }

function TServerApp.ProcessMessage(var Msg: TMsg): Boolean;
var
  Handled: Boolean;
begin
  Result := False;
  if PeekMessage(Msg, NativeUInt(-1), 0, 0, PM_REMOVE) then begin
    Result := True;
    if Msg.Message <> WM_QUIT then begin
      Handled := False;

      if Msg.Message > sms_OFFSET then
        CreateWorkItem;

      if not Handled then begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
    end else begin
      FTerminate := True;
    end;
  end;
end;

procedure TServerApp.ProcessMessages;
var
  Msg: TMsg;
begin
  while ProcessMessage(Msg) do {loop};
end;

procedure TServerApp.CreateWorkItem;
var
  LWorkItem  : IOmniWorkItem;
  LOmniValue : TOmniValue;
begin
  if not FMsgDataColl.Take( LOmniValue) then
    raise Exception.Create('Internal Error. ServerApp FMsgDataColl.Take');

  LWorkItem := FWorker.CreateWorkItem( LOmniValue);
  FWorker.Schedule( LWorkItem);
end;

procedure TServerApp.ProcessWorkItem(const workItem: IOmniWorkItem);
var
  CallRec: TWorkItemCallRec;
begin
  CallRec := workItem.Data.CastTo<TWorkItemCallRec>;
  CallRec.ProcToCall( CallRec.Data);
  workItem.Result := 0;
end;

procedure TServerApp.HandleRequestDone(const Sender: IOmniBackgroundWorker; const workItem: IOmniWorkItem);
var
  eClass: string;
  exc   : Exception;
begin
  if workItem.IsExceptional then begin
    eClass := workItem.FatalException.ClassName;
    exc := workItem.DetachException;
    DoLog( loaError, 'Exception: WorkItem: '+workItem.UniqueID.ToString+': '+eClass+':'+exc.Message);
    FreeAndNil(exc);
  end else
    DoLog( 'HandleRequestDone: '+workItem.UniqueID.ToString+': '+workItem.Result.AsString);
end;

constructor TServerApp.Create(AOwner: TComponent);
begin
  inherited;
  FServerModules := TModules.Create;

  FMsgDataColl   := TOmniBlockingCollection.Create;
  FWorker := Parallel.BackgroundWorker
                     .NumTasks( cServerAppBackgroundTasks)
                     .OnRequestDone( HandleRequestDone)
                     .TaskConfig( Parallel.TaskConfig.OnMessage( sms_Processing,
                                  procedure (const task: IOmniTaskControl; const msg: TOmniMessage)
                                  begin
                                    DoLog('OnMessage: '+msg.MsgData.AsString);
                                  end))
                     .Execute( ProcessWorkItem);
end;

destructor TServerApp.Destroy;
var
  i: Integer;
begin
  FMsgDataColl.Free;
  for i := FServerModules.Count-1 downto 0 do
    FServerModules[i].Free;
  FServerModules.Free;
  inherited;
end;

procedure TServerApp.Run;
var
  Msg: TMsg;
  v: TProc;
begin
  FRunning := True;
  try
    // evtl. Exitproc setzen
      repeat
        try
          if not ProcessMessage(Msg) then
            WaitMessage;
        except
          on e: Exception do
            writeln(e.Message);
        end;
      until Terminated;
  finally
    FRunning := False;
  end;
end;

procedure TServerApp.Shutdown;
begin
  // Stoppen aller Dienste
  FWorker.CancelAll;
end;

procedure TServerApp.SendQuit;
begin
  FWorker.CancelAll;
  PostThreadMessage( System.MainThreadID, WM_QUIT, 0, 0);
end;

procedure TServerApp.Call(AMsgCode: Cardinal; AProcToCall: TProc<TOmniValue>; AData: TOmniValue);
var
  CallRec : TWorkItemCallRec;
  oValue  : TOmniValue;
begin
  CallRec.ProcToCall := AProcToCall;
  CallRec.Data       := AData;
  oValue := TOmniValue.FromRecord(CallRec);

  FMsgDataColl.Add( oValue);
  PostThreadMessage( System.MainThreadID, AMsgCode, 0, 0);
end;


initialization
  ServerApp := TServerApp.Create(nil);
finalization
  ServerApp.Free;
end.

 

 

 

 

Share this post


Link to post

Check the stack trace to see where this critical section is allocated from.

 

If this is not possible with the FastMM that comes with Delphi (frankly, I don't use it and I have no idea), use FastMM from git and define FullDebugMode conditional.

Share this post


Link to post
2 hours ago, t2000 said:

if Msg.Message <> WM_QUIT then

This is not related to your problem, but you should PostQuitMessage if you remove a WM_QUIT from the message queue.

Share this post


Link to post
37 minutes ago, Primož Gabrijelčič said:

If this is not possible with the FastMM that comes with Delphi

It is not.

37 minutes ago, Primož Gabrijelčič said:

use FastMM from git and define FullDebugMode conditional.

That is what you will have to do.

Share this post


Link to post

I have used FastMM4. Pretty hard, but now I know the most important things about FastMM4.

I think, I have a side effect from my REST Server thread that works with TMS XData. I use a function with TJSONObject as parameter. (over REST). And there is a hidden Exception in a JSON converter. I haven't seen these exception before. If I change the (REST-) function result to an integer, I can't reproduce the memory leak.

With the build in tools, I couldn't get a stack trace.

Thanks for the first. I keep an eye on it.

The WM_QUIT. Thanks for the note. But I don't have windows here. This is a command line application and later I build a service. The messaging system is only for my own. Perhaps, I can use a WM_USER message number for quit the program internally.

Share this post


Link to post

My mistake. I have used a TJSONObject with another TJSONObject in it. In the create function I added the second TJSONObject instead of TJSONObject.Clone. The inner TJSONObject was releasd twice.
And then, and then, and then ... I thinkt there were all side effects.

Share this post


Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
×