cocoa: adding post event object destruction mechanism. To prevent crashes for objects destroyed during processing their events. #35706

git-svn-id: trunk@61386 -

lcl/interfaces/cocoa/cocoaint.pas

@@ -129,6 +129,11 @@ type
 
     // Clipboard
 
+    // collecting objects that needs to be released AFTER an event
+    // has been processed
+    ToCollect: TList;
+    procedure ReleaseAllToCollect;
+
     procedure SyncClipboard();
 
     function PromptUser(const DialogCaption, DialogMessage: String;
@@ -203,6 +208,9 @@ type
     {$I cocoawinapih.inc}
     // the extra LCL interface methods
     {$I cocoalclintfh.inc}
+    procedure AddToCollect(obj: TObject);
+    procedure RetainToCollect;
+    procedure ReleaseToCollect;
   end;
   
 var
@@ -457,35 +465,40 @@ var
   wnd: TCocoaWindow;
   allowcocoa : Boolean;
 begin
-  if (theEvent.type_ = NSKeyDown) or (theEvent.type_ = NSKeyUp) or
-     (theEvent.type_ = NSFlagsChanged) then begin
-    cb := self.keyWindow.firstResponder.lclGetCallback;
-    if Assigned(cb) then
-    begin
-      try
-        if self.keyWindow.isKindOfClass_(TCocoaWindow) then begin
-          wnd := TCocoaWindow(self.keyWindow);
-          wnd._keyEvCallback := cb;
-          wnd._calledKeyEvAfter := False;
-        end
-        else
-          wnd := nil;
-        cb.KeyEvBefore(theEvent, allowcocoa);
-        if allowcocoa then
-          inherited sendEvent(theEvent);
-        if (not Assigned(wnd)) or (not wnd._calledKeyEvAfter) then
-          cb.KeyEvAfter;
-      finally
-        if Assigned(wnd) then
-          wnd._keyEvCallback := nil;
+  CocoaWidgetSet.RetainToCollect;
+  try
+    if (theEvent.type_ = NSKeyDown) or (theEvent.type_ = NSKeyUp) or
+       (theEvent.type_ = NSFlagsChanged) then begin
+      cb := self.keyWindow.firstResponder.lclGetCallback;
+      if Assigned(cb) then
+      begin
+        try
+          if self.keyWindow.isKindOfClass_(TCocoaWindow) then begin
+            wnd := TCocoaWindow(self.keyWindow);
+            wnd._keyEvCallback := cb;
+            wnd._calledKeyEvAfter := False;
+          end
+          else
+            wnd := nil;
+          cb.KeyEvBefore(theEvent, allowcocoa);
+          if allowcocoa then
+            inherited sendEvent(theEvent);
+          if (not Assigned(wnd)) or (not wnd._calledKeyEvAfter) then
+            cb.KeyEvAfter;
+        finally
+          if Assigned(wnd) then
+            wnd._keyEvCallback := nil;
+        end;
+        Exit;
       end;
-      Exit;
     end;
+
+    inherited sendEvent(theEvent);
+
+    if (theEvent.type_ = NSMouseMoved) then ForwardMouseMove(Self, theEvent);
+  finally
+    CocoaWidgetSet.ReleaseToCollect;
   end;
-
-  inherited sendEvent(theEvent);
-
-  if (theEvent.type_ = NSMouseMoved) then ForwardMouseMove(Self, theEvent);
 end;
 
 function isMouseMoveEvent(tp: NSEventType): Boolean; inline;

lcl/interfaces/cocoa/cocoalclintf.inc

@@ -735,6 +735,86 @@ begin
   Result := True;
 end;
 
+type
+
+  { TToCollectItem }
+
+  TToCollectItem = class(TObject)
+    // reference count is needed, in case the event processing
+    // goes into a recursion (i.e. a modal window)
+    // Thus the object added at the start of event, should not be released
+    // until its "event loop" is actually finishing
+    refCount: Integer;
+    obj: TObject;
+    constructor Create(aobj: TObject);
+    destructor Destroy; override;
+  end;
+
+{ TToCollectItem }
+
+constructor TToCollectItem.Create(aobj: TObject);
+begin
+  inherited Create;
+  obj := aobj;
+  refCount := 1;
+end;
+
+destructor TToCollectItem.Destroy;
+begin
+  obj.Free;
+  inherited;
+end;
+
+procedure TCocoaWidgetSet.AddToCollect(obj: TObject);
+var
+  i : integer;
+begin
+  // let's try to find an object. Do not add a duplicate
+  for i := 0 to ToCollect.Count - 1 do
+    if TToCollectItem(ToCollect[i]).obj=obj then
+      Exit;
+  ToCollect.Add(TToCollectItem.Create(obj));
+end;
+
+procedure TCocoaWidgetSet.RetainToCollect;
+var
+  i  : Integer;
+  cl : TToCollectItem;
+begin
+  for i := 0 to ToCollect.Count - 1 do
+  begin
+    cl := TToCollectItem(ToCollect[i]);
+    inc(cl.refCount);
+  end;
+end;
+
+procedure TCocoaWidgetSet.ReleaseToCollect;
+var
+  cl : TToCollectItem;
+  i  : integer;
+begin
+  for i := 0 to ToCollect.Count - 1 do
+  begin
+    cl := TToCollectItem(ToCollect[i]);
+    dec(cl.refCount);
+    if cl.refCount = 0 then
+    begin
+      cl.Free;
+      ToCollect[i] := nil;
+    end;
+  end;
+  ToCollect.Pack;
+end;
+
+procedure TCocoaWidgetSet.ReleaseAllToCollect;
+var
+  i : integer;
+begin
+  for i := 0 to ToCollect.Count - 1 do
+    TToCollectItem(ToCollect[i]).Free;
+  ToCollect.Clear;
+end;
+
 {------------------------------------------------------------------------------
   Function: RawImage_QueryDescription
   Params: AFlags:

lcl/interfaces/cocoa/cocoaobject.inc

@@ -153,6 +153,7 @@ begin
   InitStockItems;
 
   fClipboard := TCocoaWSClipboard.Create; // must be here otherwise clipboard calls before Application.Initialize crash
+  ToCollect := TList.Create;
 end;
 
 {------------------------------------------------------------------------------
@@ -162,6 +163,7 @@ end;
  ------------------------------------------------------------------------------}
 destructor TCocoaWidgetSet.Destroy;
 begin
+  ReleaseAllToCollect;
   inherited Destroy;
 
   FreeStockItems;
@@ -198,6 +200,7 @@ begin
   // then it finalization of WS dependent objects would fail (suppressed AVs)
   // and would cause leaks. (see #35400)
   InternalFinal;
+  ToCollect.Free;
 
   CocoaWidgetSet := nil;
 end;

lcl/interfaces/cocoa/cocoawscommon.pas

@@ -1398,7 +1398,11 @@ begin
     CallbackObject := Callback.GetCallbackObject;
     Callback := nil;
     obj.lclClearCallback;
-    CallbackObject.Free;
+    // Do not free the callback object here. It might be processing an event
+    // and is performing a self destruction. Thus there might be a code performing
+    // even after DestroyHandle() was called. The destruction needs to be delayed
+    // until after the event processing is done
+    CocoaWidgetSet.AddToCollect(CallbackObject);
   end;
   obj.release;
 end;