[SOLVED] Fixing memory leaks in function RenderWinControl

[lagprogramming]

lcl/interfaces/customdrawn/customdrawnproc.pas has function RenderWinControl(var AImage: TLazIntfImage; var ACanvas: TLazCanvas; ACDWinControl: TCDWinControl; ACDForm: TCDForm): Boolean;
A simple form with a TEdit on it run for a couple of seconds in Linux-customdrawn. The application ran with heaptrc unit, which made the console window print lots of memory leaks. One of them was related to line: lRegion := TLazRegionWithChilds.Create; The memory allocated for lRegion is never freed.
As long as customdrawn is selected, the memory leak should be detectable on all operating systems.

This is the original code

Code: Pascal  [Select][+][-]

1. function RenderWinControl(var AImage: TLazIntfImage; var ACanvas: TLazCanvas;
2.   ACDWinControl: TCDWinControl; ACDForm: TCDForm): Boolean;
3. var
4.   lWinControl, lParentControl: TWinControl;
5.   struct : TPaintStruct;
6.   lCanvas: TCanvas;
7.   lControlCanvas: TLazCanvas;
8.   lBaseWindowOrg: TPoint;
9.   lControlStateEx: TCDControlStateEx;
10.   lDrawControl: Boolean;
11.   lRegion:TLazRegionWithChilds;
12. begin
13.   Result := False;
14.  
15.   lWinControl := ACDWinControl.WinControl;
16.  
17.   {$ifdef VerboseCDWinControl}
18.   DebugLn(Format('[RenderWinControl] lWinControl=%x Name=%s:%s Left=%d'
19.     + ' Top=%d Width=%d Height=%d', [PtrInt(lWinControl), lWinControl.Name, lWinControl.ClassName,
20.     lWinControl.Left, lWinControl.Top, lWinControl.Width, lWinControl.Height]));
21.   {$endif}
22.  
23.   if lWinControl.Visible = False then Exit;
24.  
25.   // Disable the drawing itself, but keep the window org and region operations
26.   // or else clicking and other things are broken
27.   lDrawControl := ACDWinControl.IsControlBackgroundVisible();
28.  
29.   // Save the Canvas state
30.   ACanvas.SaveState;
31.   ACanvas.ResetCanvasState;
32.  
33.   // lBaseWindowOrg makes debugging easier
34.   // Iterate to find the appropriate BaseWindowOrg relative to the parent control
35.   lBaseWindowOrg := FindControlPositionRelativeToTheForm(lWinControl);
36.   ACanvas.BaseWindowOrg := Point(lBaseWindowOrg.X, lBaseWindowOrg.Y - ACDForm.ScrollY);
37.   ACanvas.WindowOrg := Point(0, 0);
38.  
39.   // Prepare the clippping relative to the form
40.   ACanvas.Clipping := True;
41.   ACDWinControl.Region.Rect := Bounds(lBaseWindowOrg.X, lBaseWindowOrg.Y - ACDForm.ScrollY,
42.     lWinControl.Width, lWinControl.Height);
43.   lRegion := TLazRegionWithChilds.Create;
44.   lRegion.Assign(ACDWinControl.Region);
45.   ACanvas.ClipRegion := lRegion;
46.  
47.   lControlCanvas := ACanvas;
48.  
49.   if (ACDWinControl.InvalidateCount > 0) and lDrawControl then
50.   begin
51.     ACDWinControl.UpdateImageAndCanvas();
52.     lControlCanvas := ACDWinControl.ControlCanvas;
53.     ACDWinControl.InvalidateCount := 0;
54.  
55.     // Special drawing for some native controls
56.     if (lWinControl is TCustomPanel) or (lWinControl is TTabSheet)
57.      or (lWinControl is TCustomPage) or (lWinControl is TNotebook)  then
58.     begin
59.       // Erase the background of TPanel controls, since it can draw it's own border, but fails to draw it's own background
60.       // and also erase the background for TTabSheet (children of TPageControl) and TCustomPage (children of TNotebook)
61.       lControlCanvas.SaveState;
62.       lControlCanvas.Brush.FPColor := TColorToFPColor(lWinControl.GetRGBColorResolvingParent());
63.       lControlCanvas.Pen.FPColor := lControlCanvas.Brush.FPColor;
64.       lControlCanvas.Rectangle(Bounds(0, 0, lWinControl.Width, lWinControl.Height));
65.       lControlCanvas.RestoreState(-1);
66.     end
67.     else if lWinControl is TCustomGroupBox then
68.     begin
69.       lControlCanvas.SaveState;
70.       lControlStateEx := TCDControlStateEx.Create;
71.       try
72.         lControlStateEx.Font := lWinControl.Font;
73.         lControlStateEx.Caption := lWinControl.Caption;
74.         lControlStateEx.ParentRGBColor := lWinControl.GetRGBColorResolvingParent();
75.         GetDefaultDrawer().DrawGroupBox(lControlCanvas, Point(0,0),
76.           Size(lWinControl.Width, lWinControl.Height), [], lControlStateEx);
77.       finally
78.         lControlStateEx.Free;
79.         lControlCanvas.RestoreState(-1);
80.       end;
81.     end;
82.  
83.     // Send the drawing message
84.     {$ifdef VerboseCDWinControl}
85.     DebugLn('[RenderWinControl] before LCLSendPaintMsg');
86.     {$endif}
87.     FillChar(struct, SizeOf(TPaintStruct), 0);
88.     struct.hdc := HDC(lControlCanvas);
89.     LCLSendEraseBackgroundMsg(lWinControl, struct.hdc);
90.     LCLSendPaintMsg(lWinControl, struct.hdc, @struct);
91.     {$ifdef VerboseCDWinControl}
92.     DebugLn('[RenderWinControl] after LCLSendPaintMsg');
93.     {$endif}
94.   end;
95.  
96.   // Here we actually blit the control to the form canvas
97.   if lDrawControl then
98.   ACanvas.CanvasCopyRect(ACDWinControl.ControlCanvas, 0, 0, 0, 0,
99.     lWinControl.Width, lWinControl.Height);
100.  
101.   // Now restore it
102.   ACanvas.RestoreState(-1);
103.  
104.   Result := True;
105. end;

The patch adds "lRegion.Free;" before the last "ACanvas.RestoreState(-1);"

Code: Pascal  [Select][+][-]

1. diff --git a/lcl/interfaces/customdrawn/customdrawnproc.pas b/lcl/interfaces/customdrawn/customdrawnproc.pas
2. index 5170ddc72b..aeb36771b2 100644
3. --- a/lcl/interfaces/customdrawn/customdrawnproc.pas
4. +++ b/lcl/interfaces/customdrawn/customdrawnproc.pas
5. @@ -563,6 +563,8 @@ begin
6.    ACanvas.CanvasCopyRect(ACDWinControl.ControlCanvas, 0, 0, 0, 0,
7.      lWinControl.Width, lWinControl.Height);
8.  
9. +  lRegion.Free;
10. +
11.    // Now restore it
12.    ACanvas.RestoreState(-1);
13.  

[wp]

The memory allocated for lRegion is never freed.

Are you sure? The newly created region is assigned to the canvas' ClipRegion. Maybe the canvas takes care of it? In TFPCustomCanvas.Destroy, at least, there is a "FreeAndNil(FClipRegion)". Maybe there should be a setter for TFPCustomCanvas.SetClipRegion to destroy the previous clip region before assigning the new one, e.g. something like this:

Code: Pascal  [Select][+][-]

1. procedure TFPCustomCanvas.SetClipRegion(AValue: TFPCustomRegion);
2. begin
3.   if AValue = FClipRegion then exit;
4.   FClipRegion.Free;
5.   FClipRegion := AValue;
6. end;

[EDIT]
I was able to verify this kind of memory leak by means of a simple TFPMemoryImage and TFPImageCanvas, and reported a bug in the FPC bug tracker (https://gitlab.com/freepascal.org/fpc/source/-/issues/40232). Hopefully somebody takes care of it...

[AlexTP]

Posted to bugtracker:
https://gitlab.com/freepascal.org/lazarus/lazarus/-/issues/40203

[wp]

My patch for issue #40203 has been applied now.