Watch, Follow, &
Connect with Us

For forums, blogs and more please visit our
Developer Tools Community.


Welcome, Guest
Guest Settings
Help

Thread: Sometimes Singleton class created in a Delphi package is never freed


This question is not answered. Helpful answers available: 2. Correct answers available: 1.


Permlink Replies: 8 - Last Post: Oct 7, 2016 11:00 AM Last Post By: Jean-Milost Rey...
Jean-Milost Rey...

Posts: 20
Registered: 11/4/10
Sometimes Singleton class created in a Delphi package is never freed  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Sep 26, 2016 8:43 AM
Hello,

I'm creating a Delphi package (using RAD Studio XE7) that contains several Singleton classes, that I use as a kind of services, e.g. to synchronize all animations on an unique timer.

My code works well, however I noticed that in some circumstances my Singleton classes are never freed. The Free function is called, however the Self pointer of my class is already nil at this moment, that's why this function simply do nothing (see code below). But using a memory tool like madExcept, I can notice that the objects contained in my Singleton class are never freed, and their memory is never released.

To dispel any doubts, I tried to make a specific task, like e.g. showing a popup dialog or logging a message to the debugger console with the OutputDebugString function while my Singleton class is destroyed, and I noticed that the Destroy functions of all my Singletons are never executed at all during the execution time of my target application (the one who uses the package). This seems very strange, sounds like if the construction and the destruction of my Singletons happened in 2 different pools of memory (e.g. as if the Singleton was built on the package side and tried to be freed on the application side).

However, I also noticed that, when I change the following option:
Packages->Runtime Packages->Link with runtime packages
to False in my target application project, all the destructors in all my Singleton classes work as expected.

So, my question is: What am I doing wrong in my code?

NOTE I initially supposed that the memory leak could have a relation with the usage of an interface in my class, but this seems not the case, because some other Singletons that not use an interface have the same issue.

Below the complete Unit containing the code of one of my Singleton classes

unit UTQRVCLAnimationTimer;
 
interface
 
uses System.Classes,
     UTQRDesignPatterns,
     Vcl.ExtCtrls,
     Winapi.Windows;
 
type
    {**
    * VCL animation timer messages that can be sent to observers
    *@note Begins to 0 to not interfere with other messages. The allowed range for a new message
    *      of type animation is between 0 and 99
    *}
    EQRVCLAnimationTimerMessages =
    (
        EQR_AM_Animate = 0,
        EQR_AM_Destroying
    );
 
    {**
    * VCL animation timer message info
    *}
    TQRVCLAnimationTimerMsgInfo = record
        m_ElapsedTime: Double;
    end;
 
    {**
    * Global animation timer based on the VCL TTimer control
    *}
    TQRVCLAnimationTimer = class sealed (TInterfacedObject, IQRSubject)
        private
            class var m_pInstance:    TQRVCLAnimationTimer;
                      m_pTimer:       TTimer;
                      m_pObservers:   TList;
                      m_PreviousTime: Double;
                      m_Info:         TQRVCLAnimationTimerMsgInfo;
 
            { Construction/Destruction }
            constructor Create();  reintroduce;
            destructor  Destroy(); reintroduce;
            procedure   Free();    reintroduce;
 
            {**
            * Called when animation should be rendered
            *@param pSender - event sender
            *}
            procedure OnAnimate(pSender: TObject);
 
        public
            {**
            * Gets animation timer instance, creates one if still not created
            *@return model cache instance
            *}
            class function GetInstance(): TQRVCLAnimationTimer; static;
 
            {**
            * Deletes animation timer instance
            *@note This function is automatically called when unit is released
            *}
            class procedure DeleteInstance(); static;
 
            {**
            * Attaches observer
            *@param pObserver - observer to attach
            *}
            procedure Attach(pObserver: IQRObserver);
 
            {**
            * Detaches observer
            *@param pObserver - observer to detach
            *}
            procedure Detach(pObserver: IQRObserver);
 
            {**
            * Notifies all observers about an occurred event
            *@param message - notification message
            *}
            procedure Notify(message: TQRMessage);
    end;
 
implementation
//--------------------------------------------------------------------------------------------------
// TQRVCLAnimationTimer
//--------------------------------------------------------------------------------------------------
constructor TQRVCLAnimationTimer.Create();
begin
    inherited Create;
 
    // configure internal variables
    m_pObservers   := TList.Create;
    m_PreviousTime := GetTickCount();
 
    // configure animation timer (an interval of 20 means ~50 fps)
    m_pTimer          := TTimer.Create(nil);
    m_pTimer.Interval := 20;
    m_pTimer.OnTimer  := OnAnimate;
    m_pTimer.Enabled  := True;
end;
//--------------------------------------------------------------------------------------------------
destructor TQRVCLAnimationTimer.Destroy();
var
    message: TQRMessage;
begin
    // configure destruction message
    message.m_Type  := NativeUInt(EQR_AM_Destroying);
    message.m_pInfo := nil;
 
    // notify all observers about destruction
    Notify(message);
 
    // clear memory
    m_pTimer.Free;
    m_pObservers.Free;
 
    inherited Destroy;
end;
//--------------------------------------------------------------------------------------------------
procedure TQRVCLAnimationTimer.Free();
begin
    // check if self is already deleted, delete itself if not
    if (Assigned(Self)) then
        Destroy;
end;
//--------------------------------------------------------------------------------------------------
procedure TQRVCLAnimationTimer.OnAnimate(pSender: TObject);
var
    now:     NativeUInt;
    message: TQRMessage;
begin
    // calculate time interval
    now                  :=  GetTickCount();
    m_Info.m_ElapsedTime := (now - m_PreviousTime);
    m_PreviousTime       :=  now;
 
    // configure animation message
    message.m_Type  := NativeUInt(EQR_AM_Animate);
    message.m_pInfo := @m_Info;
 
    // notify all observers about animation
    Notify(message);
end;
//--------------------------------------------------------------------------------------------------
class function TQRVCLAnimationTimer.GetInstance(): TQRVCLAnimationTimer;
var
    pInstance: TQRVCLAnimationTimer;
begin
    // is singleton instance already initialized?
    if (Assigned(m_pInstance)) then
    begin
        // get it
        Result := m_pInstance;
        Exit;
    end;
 
    // create new singleton instance
    pInstance := TQRVCLAnimationTimer.Create;
 
    // another thread already created the singleton instance?
    if (InterlockedCompareExchangePointer(Pointer(m_pInstance), pInstance, nil) <> nil) then
        // only one instance is allowed, and another instance was already created by another
        // thread, so delete above created one and use the available instance
        pInstance.Free
    else
        // still not created, set the newly created instance
        m_pInstance := pInstance;
 
    // get newly created instance
    Result := m_pInstance;
end;
//--------------------------------------------------------------------------------------------------
class procedure TQRVCLAnimationTimer.DeleteInstance();
begin
    m_pInstance.Free;
    m_pInstance := nil;
end;
//--------------------------------------------------------------------------------------------------
procedure TQRVCLAnimationTimer.Attach(pObserver: IQRObserver);
begin
    // observer already exists in observers list?
    if (m_pObservers.IndexOf(Pointer(pObserver)) <> -1) then
        Exit;
 
    // add observer to observers list
    m_pObservers.Add(Pointer(pObserver));
end;
//--------------------------------------------------------------------------------------------------
procedure TQRVCLAnimationTimer.Detach(pObserver: IQRObserver);
begin
    // remove observer from observers list. NOTE observer list will check if observer exists before
    // trying to remove it, so this check isn't necessary here
    m_pObservers.Remove(Pointer(pObserver));
end;
//--------------------------------------------------------------------------------------------------
procedure TQRVCLAnimationTimer.Notify(message: TQRMessage);
var
    i:     NativeInt;
    pItem: IQRObserver;
begin
    // nothing to do?
    if (m_pObservers.Count = 0) then
        Exit;
 
    // iterate through observers to notify
    for i := 0 to m_pObservers.Count - 1 do
    begin
        // get observer to notify
        pItem := IQRObserver(m_pObservers[i]);
 
        // found it?
        if (not Assigned(pItem)) then
            continue;
 
        // notify observer about message
        pItem.OnNotified(message);
    end;
end;
//--------------------------------------------------------------------------------------------------
 
initialization
//--------------------------------------------------------------------------------------------------
// TQRVCLAnimationTimer
//--------------------------------------------------------------------------------------------------
begin
    // initialize instance to default when application opens
    TQRVCLAnimationTimer.m_pInstance := nil;
end;
//--------------------------------------------------------------------------------------------------
 
finalization
//--------------------------------------------------------------------------------------------------
// TQRVCLAnimationTimer
//--------------------------------------------------------------------------------------------------
begin
    // free instance when application closes
    TQRVCLAnimationTimer.DeleteInstance();
end;
//--------------------------------------------------------------------------------------------------
 
end.


Regards
Remy Lebeau (Te...


Posts: 9,447
Registered: 12/23/01
Re: Sometimes Singleton class created in a Delphi package is never freed  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Sep 26, 2016 12:25 PM   in response to: Jean-Milost Rey... in response to: Jean-Milost Rey...
Jean-Milost wrote:

Below the complete Unit containing the code of one of my Singleton
classes

Why are you implementing Free() manually? TObject handles that for you.
But since you should be accessing TQRVCLAnimationTimer via IQRSubject, you
should never be calling Free() on it anyway.

Why are you reintroducing Destroy() instead of overriding the virtual destructor
from TObject?

You are not managing the object's reference count correctly at all. Your
m_pInstance variable should be IQRSubject instead of TQRVCLAnimationTimer,
and your GetInstance() method should be returning IQRSubject instead of TQRVCLAnimationTimer
(assuming Attach() and Detach() are methods of IQRSubject).

Try something more like this:

unit UTQRVCLAnimationTimer;
 
interface
 
uses
  System.Classes,
  UTQRDesignPatterns,
  Vcl.ExtCtrls,
  Winapi.Windows;
 
type
  {**
  * VCL animation timer messages that can be sent to observers
  *@note Begins to 0 to not interfere with other messages. The allowed range 
for a new message
  * of type animation is between 0 and 99
  *}
  EQRVCLAnimationTimerMessages =
  (
  EQR_AM_Animate = 0,
  EQR_AM_Destroying
  );
 
  {**
  * VCL animation timer message info
  *}
  TQRVCLAnimationTimerMsgInfo = record
    m_ElapsedTime: Double;
  end;
 
  {**
  * Global animation timer based on the VCL TTimer control
  *}
  TQRVCLAnimationTimer = class sealed (TInterfacedObject, IQRSubject)
  private
    class var m_pInstance: IQRSubject;
    m_pTimer: TTimer;
    m_pObservers: TList;
    m_PreviousTime: Double;
    m_Info: TQRVCLAnimationTimerMsgInfo;
 
    {**
    * Called when animation should be rendered
    *@param pSender - event sender
    *}
    procedure OnAnimate(pSender: TObject);
 
  public
    { Construction/Destruction }
    constructor Create;
    destructor Destroy; override;
 
    {**
    * Gets animation timer instance, creates one if still not created
    *@return model cache instance
    *}
    class function GetInstance: IQRSubject; static;
 
    {**
    * Attaches observer
    *@param pObserver - observer to attach
    *}
    procedure Attach(pObserver: IQRObserver);
 
    {**
    * Detaches observer
    *@param pObserver - observer to detach
    *}
    procedure Detach(pObserver: IQRObserver);
 
    {**
    * Notifies all observers about an occurred event
    *@param message - notification message
    *}
    procedure Notify(message: TQRMessage);
  end;
 
implementation
 
//--------------------------------------------------------------------------------------------------
// TQRVCLAnimationTimer
//--------------------------------------------------------------------------------------------------
constructor TQRVCLAnimationTimer.Create;
begin
  inherited Create;
 
  // configure internal variables
  m_pObservers := TList.Create;
  m_PreviousTime := GetTickCount;
 
  // configure animation timer (an interval of 20 means ~50 fps)
  m_pTimer := TTimer.Create(nil);
  m_pTimer.Interval := 20;
  m_pTimer.OnTimer := OnAnimate;
  m_pTimer.Enabled := True;
end;
//--------------------------------------------------------------------------------------------------
destructor TQRVCLAnimationTimer.Destroy;
var
  message: TQRMessage;
begin
  // configure destruction message
  message.m_Type := NativeUInt(EQR_AM_Destroying);
  message.m_pInfo := nil;
 
  // notify all observers about destruction
  Notify(message);
 
  // clear memory
  m_pTimer.Free;
  m_pObservers.Free;
 
  inherited Destroy;
end;
//--------------------------------------------------------------------------------------------------
procedure TQRVCLAnimationTimer.OnAnimate(pSender: TObject);
var
  now: NativeUInt;
  message: TQRMessage;
begin
  // calculate time interval
  now := GetTickCount;
  m_Info.m_ElapsedTime := (now - m_PreviousTime);
  m_PreviousTime := now;
 
  // configure animation message
  message.m_Type := NativeUInt(EQR_AM_Animate);
  message.m_pInfo := @m_Info;
 
  // notify all observers about animation
  Notify(message);
end;
//--------------------------------------------------------------------------------------------------
class function TQRVCLAnimationTimer.GetInstance: IQRSubject;
var
  pNewInstance, pExistingInstance: IQRSubject;
begin
  // is singleton instance already initialized?
  if not Assigned(m_pInstance) then
  begin
    // create new singleton instance
    pNewInstance := TQRVCLAnimationTimer.Create;
 
    // has another thread already created the singleton instance? only one 
instance is
    // allowed, so if another instance has already been created by another 
thread then
    // delete the above created one and use the available instance
 
    pNewInstance._AddRef;
    pExistingInstance := IQRSubject(InterlockedCompareExchangePointer(Pointer(m_pInstance), 
Pointer(pNewInstance), nil));
    if Pointer(pExistingInstance) <> nil then
      pNewInstance._Release;
  end;
 
  // get instance
  Result := m_pInstance;
end;
//--------------------------------------------------------------------------------------------------
procedure TQRVCLAnimationTimer.Attach(pObserver: IQRObserver);
begin
  // observer already exists in observers list?
  if (m_pObservers.IndexOf(Pointer(pObserver)) <> -1) then
    Exit;
 
  // add observer to observers list
  m_pObservers.Add(Pointer(pObserver));
end;
//--------------------------------------------------------------------------------------------------
procedure TQRVCLAnimationTimer.Detach(pObserver: IQRObserver);
begin
  // remove observer from observers list. NOTE observer list will check if 
observer exists before
  // trying to remove it, so this check isn't necessary here
  m_pObservers.Remove(Pointer(pObserver));
end;
//--------------------------------------------------------------------------------------------------
procedure TQRVCLAnimationTimer.Notify(message: TQRMessage);
var
  i: NativeInt;
  pItem: IQRObserver;
begin
  // nothing to do?
  if (m_pObservers.Count = 0) then
    Exit;
 
  // iterate through observers to notify
  for i := 0 to m_pObservers.Count - 1 do
  begin
    // get observer to notify
    pItem := IQRObserver(m_pObservers[i]);
 
    // found it?
    if Assigned(pItem) then
    begin
      // notify observer about message
      pItem.OnNotified(message);
    end;
  end;
end;
//--------------------------------------------------------------------------------------------------
 
end.


I worry about your Notify() implementation. If you are concerned about thread
safely in GetInstance(), that suggests multiple threads can access the timer
object at the same time, so Attach(), Detach() and Notify() should likely
need to be thread-safe as well, such as by using TThreadList instead of TList.
And do you really want weak references to your observers? If not, then
consider using TInterfaceList instead of TList (and wrap it with a TCriticalSection
if you need thread-safe access). What if an observer is freed but forgets
to call Detach()? Notify() would crash the next time it tries to send a
message to that observer.

--
Remy Lebeau (TeamB)
Jean-Milost Rey...

Posts: 20
Registered: 11/4/10
Re: Sometimes Singleton class created in a Delphi package is never freed  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Sep 27, 2016 6:40 PM   in response to: Remy Lebeau (Te... in response to: Remy Lebeau (Te...
Hi Remy,

First of all, thank you very much for your response, that will really help me to improve my code.

Wow! There are still many things I have to learn with Delphi! (normally I'm a c++ coder) First, I did not understood that the interface will do the cleanup job for me, through the reference counter mechanism. When I wrote my interface, my primary idea was to provide a kind of "contract", like writing an class containing only pure virtual functions, as I have done in c++, nothing more :-)

Remy Lebeau (TeamB) wrote:
Why are you implementing Free() manually? TObject handles that for you.
But since you should be accessing TQRVCLAnimationTimer via IQRSubject, you
should never be calling Free() on it anyway.

Why are you reintroducing Destroy() instead of overriding the virtual destructor
from TObject?

My idea was to create a singleton class. Doing that, I wished to prevent the user to invoke the constructor/destructor outside the strict GetInstance and DeleteInstance functions. I reintroduced them because the compiler didn't stop to complain otherwise. However I realize that this way is absolutely wrong. I corrected that in my classes

Remy Lebeau (TeamB) wrote:
I worry about your Notify() implementation. If you are concerned about thread
safely in GetInstance(), that suggests multiple threads can access the timer
object at the same time, so Attach(), Detach() and Notify() should likely
need to be thread-safe as well, such as by using TThreadList instead of TList.

Effectively that was completely incorrect. This class has nothing to do with threading. I removed the thread-specific code and simplified the GetInstance function.

However, and unfortunately, the basic issue remains: When I activate the option "Packages->Runtime Packages->Link with runtime packages" in my target project, the TQRVCLAnimationTimer.Destroy() destructor is never called, although it is called without problems when the option is deactivated. Any idea why?

Below is a new version of my class, in which the suggested modifications were applied:
unit UTQRVCLAnimationTimer;
 
interface
 
uses System.Classes,
     System.SysUtils,
     UTQRDesignPatterns,
     Vcl.ExtCtrls,
     Winapi.Windows;
 
type
    {**
    * VCL animation timer messages that can be sent to observers
    *@note Begins to 0 to not interfere with other messages. The allowed range for a new message
    *      of type animation is between 0 and 99
    *}
    EQRVCLAnimationTimerMessages =
    (
        EQR_AM_Animate = 0,
        EQR_AM_Destroying
    );
 
    {**
    * VCL animation timer message info
    *}
    TQRVCLAnimationTimerMsgInfo = record
        m_ElapsedTime: Double;
    end;
 
    {**
    * Global animation timer based on the VCL TTimer control
    *}
    TQRVCLAnimationTimer = class sealed (TInterfacedObject, IQRSubject)
        private
            class var m_pInstance:    IQRSubject;
                      m_pTimer:       TTimer;
                      m_pObservers:   TList;
                      m_PreviousTime: Double;
                      m_Info:         TQRVCLAnimationTimerMsgInfo;
 
            {**
            * Called when animation should be rendered
            *@param pSender - event sender
            *}
            procedure OnAnimate(pSender: TObject);
 
        public
            { Construction/Destruction }
            constructor Create();
            destructor  Destroy(); override;
 
            {**
            * Gets animation timer instance, creates one if still not created
            *@return model cache instance
            *}
            class function GetInstance(): IQRSubject; static;
 
            {**
            * Attaches observer
            *@param pObserver - observer to attach
            *}
            procedure Attach(pObserver: IQRObserver);
 
            {**
            * Detaches observer
            *@param pObserver - observer to detach
            *}
            procedure Detach(pObserver: IQRObserver);
 
            {**
            * Notifies all observers about an occurred event
            *@param message - notification message
            *}
            procedure Notify(message: TQRMessage);
    end;
 
implementation
//--------------------------------------------------------------------------------------------------
// TQRVCLAnimationTimer
//--------------------------------------------------------------------------------------------------
constructor TQRVCLAnimationTimer.Create();
begin
    // singleton was already initialized?
    if (Assigned(m_pInstance)) then
        raise Exception.Create('Cannot create many instances of a singleton class');
 
    inherited Create;
 
    // configure internal variables
    m_pObservers   := TList.Create;
    m_PreviousTime := GetTickCount();
 
    // configure animation timer (an interval of 20 means ~50 fps)
    m_pTimer          := TTimer.Create(nil);
    m_pTimer.Interval := 20;
    m_pTimer.OnTimer  := OnAnimate;
    m_pTimer.Enabled  := True;
end;
//--------------------------------------------------------------------------------------------------
destructor TQRVCLAnimationTimer.Destroy();
var
    message: TQRMessage;
begin
    // configure destruction message
    message.m_Type  := NativeUInt(EQR_AM_Destroying);
    message.m_pInfo := nil;
 
    // notify all observers about destruction
    Notify(message);
 
    // clear memory
    m_pTimer.Free;
    m_pObservers.Free;
 
    inherited Destroy;
 
    m_pInstance := nil;
end;
//--------------------------------------------------------------------------------------------------
procedure TQRVCLAnimationTimer.OnAnimate(pSender: TObject);
var
    now:     NativeUInt;
    message: TQRMessage;
begin
    // calculate time interval
    now                  :=  GetTickCount();
    m_Info.m_ElapsedTime := (now - m_PreviousTime);
    m_PreviousTime       :=  now;
 
    // configure animation message
    message.m_Type  := NativeUInt(EQR_AM_Animate);
    message.m_pInfo := @m_Info;
 
    // notify all observers about animation
    Notify(message);
end;
//--------------------------------------------------------------------------------------------------
class function TQRVCLAnimationTimer.GetInstance(): IQRSubject;
begin
    // is singleton instance already initialized?
    if (Assigned(m_pInstance)) then
    begin
        // get it
        Result := m_pInstance;
        Exit;
    end;
 
    // create new singleton instance
    m_pInstance := TQRVCLAnimationTimer.Create;
    Result      := m_pInstance;
end;
//--------------------------------------------------------------------------------------------------
procedure TQRVCLAnimationTimer.Attach(pObserver: IQRObserver);
begin
    // observer already exists in observers list?
    if (m_pObservers.IndexOf(Pointer(pObserver)) <> -1) then
        Exit;
 
    // add observer to observers list
    m_pObservers.Add(Pointer(pObserver));
end;
//--------------------------------------------------------------------------------------------------
procedure TQRVCLAnimationTimer.Detach(pObserver: IQRObserver);
begin
    // remove observer from observers list. NOTE observer list will check if observer exists before
    // trying to remove it, so this check isn't necessary here
    m_pObservers.Remove(Pointer(pObserver));
end;
//--------------------------------------------------------------------------------------------------
procedure TQRVCLAnimationTimer.Notify(message: TQRMessage);
var
    i:     NativeInt;
    pItem: IQRObserver;
begin
    // nothing to do?
    if (m_pObservers.Count = 0) then
        Exit;
 
    // iterate through observers to notify
    for i := 0 to m_pObservers.Count - 1 do
    begin
        // get observer to notify
        pItem := IQRObserver(m_pObservers[i]);
 
        // found it?
        if (not Assigned(pItem)) then
            continue;
 
        // notify observer about message
        pItem.OnNotified(message);
    end;
end;
//--------------------------------------------------------------------------------------------------
 
end.


Regards
Remy Lebeau (Te...


Posts: 9,447
Registered: 12/23/01
Re: Sometimes Singleton class created in a Delphi package is neverfreed  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Sep 27, 2016 8:00 PM   in response to: Jean-Milost Rey... in response to: Jean-Milost Rey...
Jean-Milost wrote:

(normally I'm a c++ coder)

Same here.

First, I did not understood that the interface will do the cleanup job
for me,
through the reference counter mechanism.

Yes, Delphi interfaces are reference counted, and Delphi manages the reference
counting automatically. In C++, you have to be explicit about the reference
counting, but you can use wrapper classes to automate it, such as DelphiInterface,
TComInterface, CComPtr, etc.

When I wrote my interface, my primary idea was to provide a kind of "contract",
like writing an class containing only pure virtual functions, as I have
done in c++,
nothing more :-)

Delphi interfaces are not like C++ interfaces. However, you can disable
the reference count itself (but not the compiler codegen that manages the
reference count) by overriding the virtual _AddRef() and _Release() methods
to behave like no-ops. TComponent does exactly this, for instance (as it
implements several interfaces).

My idea was to create a singleton class. Doing that, I wished to
prevent the user to invoke the constructor/destructor outside the
strict GetInstance and DeleteInstance functions.

Well, you do that by not exposing access to the implementing class in the
first place. Since you expose a "contract" interface, that should be all
they have access to.

However, and unfortunately, the basic issue remains: When I activate
the option "Packages->Runtime Packages->Link with runtime packages"
in my target project, the TQRVCLAnimationTimer.Destroy() destructor is
never called, although it is called without problems when the option
is deactivated. Any idea why?

The thing about reference counting is that the destructor is not called until
the reference count falls to 0. That has nothing to do with compiler options.
You likely have an active reference to your timer object somewhere in your
code.

--
Remy Lebeau (TeamB)
Jean-Milost Rey...

Posts: 20
Registered: 11/4/10
Re: Sometimes Singleton class created in a Delphi package is neverfreed  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Sep 28, 2016 12:04 PM   in response to: Remy Lebeau (Te... in response to: Remy Lebeau (Te...
Hi Remy,

Once again thank you for your valuable response.

Remy Lebeau (TeamB) wrote:
The thing about reference counting is that the destructor is not called until
the reference count falls to 0. That has nothing to do with compiler options.
You likely have an active reference to your timer object somewhere in your
code.
So I observed what happens in _AddRef and _Release, and I noticed that, effectively, there is one more call to _AddRef than calls to _Release. I also noticed that these lines:
    // create new singleton instance
    m_pInstance := TQRVCLAnimationTimer.Create;
    Result      := m_pInstance;

in the TQRVCLAnimationTimer.GetInstance() class seems to call the __AddRef function twice, and so it's one of these reference that is never released. However I don't understand why the counter is increased twice, and why the _Release function is never called after the m_pInstance variable is explicitely set to nil or is going out of scope. Can you please explain me why my class behaves this way, and how to be sure that all the references are released in this case?

Regards
Remy Lebeau (Te...


Posts: 9,447
Registered: 12/23/01
Re: Sometimes Singleton class created in a Delphi package is neverfreed  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Sep 28, 2016 1:12 PM   in response to: Jean-Milost Rey... in response to: Jean-Milost Rey...
Jean-Milost wrote:

So I observed what happens in _AddRef and _Release, and I noticed
that, effectively, there is one more call to _AddRef than calls to
_Release.

Well, there you go then. Like I said, you have an outstanding active reference
to the object, that is why it is not being destroyed. So either you are
not releasing all of your references, or one of them is bypassing reference
counting, or something like that. You should debug the code and trace each
_AddRef() call to see where the references are coming from.

I also noticed that these lines:

// create new singleton instance
m_pInstance := TQRVCLAnimationTimer.Create;
Result      := m_pInstance;


in the TQRVCLAnimationTimer.GetInstance() class seems to call the
__AddRef function twice, and so it's one of these reference that is
never released.

As it should be, since you don't want the reference count to fall to 0 before
the object is returned to the caller. m_pInstance is a reference, and Result
is a reference, so the reference count is 2. When the function exits, the
Result reference gets released, so the reference count is 1. When the caller
then assigns the Result to a variable, the reference count becomes 2 again.

However I don't understand why the counter is increased twice

Because there are 2 references.

and why the _Release function is never called after the m_pInstance
variable is explicitely set to nil or is going out of scope.

m_pInstance does not go out of scope until the unit is finalized. But assigning
nil to it explicitly does release it immediately. _Release() decrements
the reference count, and then destroys the object only if the reference count
is 0.

Can you please explain me why my class behaves this way, and
how to be sure that all the references are released in this case?

Not without seeing the rest of your code that uses the IQRSubject that GetInstance()
returns.

--
Remy Lebeau (TeamB)
Jean-Milost Rey...

Posts: 20
Registered: 11/4/10
Re: Sometimes Singleton class created in a Delphi package is neverfreed  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Sep 29, 2016 8:39 PM   in response to: Remy Lebeau (Te... in response to: Remy Lebeau (Te...
Hi Remy,

Remy Lebeau (TeamB) wrote:

m_pInstance does not go out of scope until the unit is finalized. But assigning
nil to it explicitly does release it immediately. _Release() decrements
the reference count, and then destroys the object only if the reference count
is 0.
That's what I thought, but this is where the weird things start. Whenever I place a breakpoint on the finalize block of my unit, I notice that the m_pInstance was already set to nil, and my singleton class seems to be already deleted. However the destructor was never called before, nor the _Release() function, and memory tools like CodeGuard or madExcept notify me about a memory leak. I tried to set m_pInstance explicitly to nil, but nothing more happen. I tried to call (just to see what would happen) the Free function explicitly, but I gained the same result: Free do nothing because Self is already nil. Once again, none of this happen when the "Link with dynamic packages" option is deactivated.

I posted below the other part of my code, the one who calls the singleton, and also my interface declaration. Hope this will help.

unit UTQRDesignPatterns;
 
interface
 
type
    {$REGION 'Observers'}
 
    {**
    * Generic message, e.g. sent from a subject to an observer
    *}
    TQRMessage = record
        public
            m_Type:  NativeUInt; // generic type, meaning is left to discretion of the child classes implementation
            m_pInfo: Pointer     // generic info, in case a subject should send additional specific info to his observer
    end;
 
    {**
    * Generic observer
    *}
    IQRObserver = interface['{FA76EFFE-27CD-488D-B5E3-94CCE68AF113}']
        {**
        * Called when subject has sent a notification to the observer
        *@param message - notification message
        *}
        procedure OnNotified(message: TQRMessage);
    end;
 
    {**
    * Generic subject
    *}
    IQRSubject = interface['{7541DE6F-48A4-42B6-90A2-18A2B24D2F07}']
        {**
        * Attaches observer
        *@param pObserver - observer to attach
        *}
        procedure Attach(pObserver: IQRObserver);
 
        {**
        * Detaches observer
        *@param pObserver - observer to detach
        *}
        procedure Detach(pObserver: IQRObserver);
 
        {**
        * Notifies all observers about an occurred event
        *@param message - notification message
        *}
        procedure Notify(message: TQRMessage);
    end;
 
    {$ENDREGION}
 
implementation
 
end.


//--------------------------------------------------------------------------------------------------
constructor TQRVCLFramedModelComponentGL.Create(pOwner: TComponent);
begin
    inherited Create(pOwner);
 
    // initialize values
    m_ElapsedTime                    := 0.0;
    m_NoAnimation                    := False;
    m_fDrawSceneFramedModelItemEvent := nil;
 
    // attach to animation timer to receive time notifications (runtime only)
    if (not(csDesigning in ComponentState)) then
        TQRVCLAnimationTimer.GetInstance().Attach(Self);
end;
//--------------------------------------------------------------------------------------------------
destructor TQRVCLFramedModelComponentGL.Destroy;
begin
    // detach from animation timer and stop to receive time notifications (runtime only)
    if (not(csDesigning in ComponentState)) then
        TQRVCLAnimationTimer.GetInstance().Detach(Self);
 
    inherited Destroy;
end;
//--------------------------------------------------------------------------------------------------


Regards
Remy Lebeau (Te...


Posts: 9,447
Registered: 12/23/01
Re: Sometimes Singleton class created in a Delphi package is neverfreed  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Sep 30, 2016 12:49 PM   in response to: Jean-Milost Rey... in response to: Jean-Milost Rey...
Jean-Milost wrote:

Whenever I place a breakpoint on the finalize block of my unit, I
notice that the m_pInstance was already set to nil, and my singleton
class seems to be already deleted. However the destructor was never
called before, nor the _Release() function, and memory tools like
CodeGuard or madExcept notify me about a memory leak.

That is simply not possible under normal conditions. Perhaps your app is
corrupting random memory and happens to be setting that particular variable
back to zeros. After creating your singleton object for the first time,
put a Data Breakpoint on the variable and see if any code tries to change
its value in memory. If the breakpoint is triggered, you can then examine
the call stack to figure out why it is being changed.

I tried to set m_pInstance explicitly to nil, but nothing more happen.

Of course not, since it is already nil, so assigning another nil to it is
a no-op.

I tried to call (just to see what would happen) the Free function
explicitly, but I gained the same result: Free do nothing because
Self is already nil.

You can't call Free() on an interface variable, only an object pointer.

--
Remy Lebeau (TeamB)
Jean-Milost Rey...

Posts: 20
Registered: 11/4/10
Re: Sometimes Singleton class created in a Delphi package is neverfreed  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Oct 7, 2016 11:00 AM   in response to: Remy Lebeau (Te... in response to: Remy Lebeau (Te...
Hi Remy,

Remy Lebeau (TeamB) wrote:
That is simply not possible under normal conditions. Perhaps your app is
corrupting random memory and happens to be setting that particular variable
back to zeros
So I tried your suggestions, unfortunately I found nothing new. I tried to reproduce the issue in a simpler project, that contains only one package with my class and an app with a form that uses this package, and the only thing I can confirm is that the issue does not appear in this context, pointing thus a possible memory corruption issue, as you suggested. This is the direction I will try to follow now.

One more time, I really appreciated your help, which allowed me to learn many things on the way. Thank you for that.

Regards
Legend
Helpful Answer (5 pts)
Correct Answer (10 pts)

Server Response from: ETNAJIVE02