Merge branch 'lcl/cocoa/leak'

This commit is contained in:
rich2014 2023-08-27 01:20:57 +08:00
commit 935e7edaff
6 changed files with 70 additions and 24 deletions

View File

@ -416,13 +416,20 @@ end;
TApplication ProcesssMessages "Enter the messageloop and process until empty" TApplication ProcesssMessages "Enter the messageloop and process until empty"
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
procedure TApplication.ProcessMessages; procedure TApplication.ProcessMessages;
var
context: TLCLHandle;
begin begin
if Self=nil then begin if Self=nil then begin
// when the programmer did a mistake, avoid getting strange errors // when the programmer did a mistake, avoid getting strange errors
raise Exception.Create('Application=nil'); raise Exception.Create('Application=nil');
end; end;
WidgetSet.AppProcessMessages; context := WidgetSet.BeginMessageProcess;
ProcessAsyncCallQueue; try
WidgetSet.AppProcessMessages;
ProcessAsyncCallQueue;
finally
WidgetSet.EndMessageProcess(context);
end;
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -1267,9 +1274,16 @@ end;
Handles all messages first then the Idle Handles all messages first then the Idle
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
procedure TApplication.HandleMessage; procedure TApplication.HandleMessage;
var
context: TLCLHandle;
begin begin
WidgetSet.AppProcessMessages; // process all events context := WidgetSet.BeginMessageProcess;
if not Terminated then Idle(true); try
WidgetSet.AppProcessMessages; // process all events
if not Terminated then Idle(true);
finally
WidgetSet.EndMessageProcess(context);
end;
end; end;
function TApplication.HelpContext(Context: THelpContext): Boolean; function TApplication.HelpContext(Context: THelpContext): Boolean;

View File

@ -84,6 +84,15 @@ procedure TWidgetSet.AppSetupMainForm(AMainForm: TObject); //e.g. handle widge
begin begin
end; end;
function TWidgetSet.BeginMessageProcess: TLCLHandle;
begin
Result := 0;
end;
procedure TWidgetSet.EndMessageProcess(context: TLCLHandle);
begin
end;
function TWidgetSet.GetLCLCapability(ACapability: TLCLCapability): PtrUInt; function TWidgetSet.GetLCLCapability(ACapability: TLCLCapability): PtrUInt;
begin begin
case ACapability of case ACapability of

View File

@ -147,7 +147,14 @@ type
function AppRestoreStayOnTopFlags(const ASystemTopAlso: Boolean = False): Boolean; virtual; function AppRestoreStayOnTopFlags(const ASystemTopAlso: Boolean = False): Boolean; virtual;
procedure AppSetMainFormOnTaskBar(const DoSet: Boolean); virtual; procedure AppSetMainFormOnTaskBar(const DoSet: Boolean); virtual;
procedure AppSetupMainForm(AMainForm: TObject); virtual; procedure AppSetupMainForm(AMainForm: TObject); virtual;
// Begin/End processing messages, which can be used to acquire/release
// resources during message processing.
// for example, on Cocoa, it needs to be used to release AutoReleasePool
// to avoid resource leaks.
function BeginMessageProcess: TLCLHandle; virtual;
procedure EndMessageProcess(context: TLCLHandle); virtual;
function LCLPlatform: TLCLPlatform; virtual; abstract; function LCLPlatform: TLCLPlatform; virtual; abstract;
function GetLCLCapability(ACapability: TLCLCapability): PtrUInt; virtual; function GetLCLCapability(ACapability: TLCLCapability): PtrUInt; virtual;

View File

@ -201,6 +201,9 @@ type
procedure AppSetIcon(const Small, Big: HICON); override; procedure AppSetIcon(const Small, Big: HICON); override;
procedure AppSetTitle(const ATitle: string); override; procedure AppSetTitle(const ATitle: string); override;
function BeginMessageProcess: TLCLHandle; override;
procedure EndMessageProcess(context: TLCLHandle); override;
function GetLCLCapability(ACapability: TLCLCapability): PtrUInt; override; function GetLCLCapability(ACapability: TLCLCapability): PtrUInt; override;
function CreateTimer(Interval: integer; TimerFunc: TWSTimerProc): TLCLHandle; override; function CreateTimer(Interval: integer; TimerFunc: TWSTimerProc): TLCLHandle; override;
@ -296,6 +299,22 @@ const
// Lack of documentation, provisional definition // Lack of documentation, provisional definition
LazarusApplicationDefinedSubtypeWakeup = 13579; LazarusApplicationDefinedSubtypeWakeup = 13579;
procedure InternalInit;
begin
// MacOSX 10.6 reports a lot of warnings during initialization process
// adding the autorelease pool for the whole Cocoa widgetset
MainPool := NSAutoreleasePool.alloc.init;
end;
procedure InternalFinal;
begin
if Assigned(MainPool) then
begin
MainPool.release;
MainPool := nil;
end;
end;
procedure wakeupEventLoop; procedure wakeupEventLoop;
var var
ev: NSevent; ev: NSevent;
@ -476,6 +495,8 @@ end;
{$ifdef COCOALOOPOVERRIDE} {$ifdef COCOALOOPOVERRIDE}
procedure TCocoaApplication.run; procedure TCocoaApplication.run;
begin begin
InternalFinal; // MainPool Stage 1 final
InternalInit; // MainPool Stage 2 init
{$ifdef COCOAPPRUNNING_SETINTPROPERTY} {$ifdef COCOAPPRUNNING_SETINTPROPERTY}
setValue_forKey(NSNumber.numberWithBool(true), NSSTR('_running')); setValue_forKey(NSNumber.numberWithBool(true), NSSTR('_running'));
{$endif} {$endif}
@ -743,22 +764,6 @@ begin
end; end;
{$endif} {$endif}
procedure InternalInit;
begin
// MacOSX 10.6 reports a lot of warnings during initialization process
// adding the autorelease pool for the whole Cocoa widgetset
MainPool := NSAutoreleasePool.alloc.init;
end;
procedure InternalFinal;
begin
if Assigned(MainPool) then
begin
MainPool.release;
MainPool := nil;
end;
end;
type type
AppClassMethod = objccategory external (NSObject) AppClassMethod = objccategory external (NSObject)
function sharedApplication: NSApplication; message 'sharedApplication'; function sharedApplication: NSApplication; message 'sharedApplication';
@ -939,9 +944,10 @@ begin
end; end;
initialization initialization
InternalInit; // MainPool Stage 1 init
// {$I Cocoaimages.lrs} // {$I Cocoaimages.lrs}
finalization finalization
InternalFinal; InternalFinal; // MainPool Stage 2 Final
end. end.

View File

@ -31,8 +31,6 @@ begin
{$IFDEF VerboseObject} {$IFDEF VerboseObject}
DebugLn('TCocoaWidgetSet.AppInit'); DebugLn('TCocoaWidgetSet.AppInit');
{$ENDIF} {$ENDIF}
InternalInit;
WakeMainThread := @OnWakeMainThread; WakeMainThread := @OnWakeMainThread;
ScreenInfo.PixelsPerInchX := CocoaBasePPI; ScreenInfo.PixelsPerInchX := CocoaBasePPI;
ScreenInfo.PixelsPerInchY := CocoaBasePPI; ScreenInfo.PixelsPerInchY := CocoaBasePPI;
@ -124,6 +122,17 @@ begin
AppRunMessages(true, NSDate.distantFuture); AppRunMessages(true, NSDate.distantFuture);
end; end;
function TCocoaWidgetSet.BeginMessageProcess: TLCLHandle;
begin
Result := TLCLHandle(NSAutoreleasePool.alloc.init);
end;
procedure TCocoaWidgetSet.EndMessageProcess(context: TLCLHandle);
begin
NSAutoreleasePool(context).release;
end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Method: TCocoaWidgetSet.Create Method: TCocoaWidgetSet.Create

View File

@ -852,6 +852,7 @@ begin
// it should be removed from "parentWindow" // it should be removed from "parentWindow"
if Assigned(win.parentWindow) then if Assigned(win.parentWindow) then
win.parentWindow.removeChildWindow(win); win.parentWindow.removeChildWindow(win);
win.setLevel(NSNormalWindowLevel);
win.close; win.close;
win.setContentView(nil); win.setContentView(nil);
cb := win.lclGetCallback(); cb := win.lclGetCallback();