Destructor of TLazCanvas ignores FAssignedFont

[lagprogramming]

lcl/lazcanvas.pas has the following lines:

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

1. FAssignedBrush: TFPCustomBrush;
2. FAssignedFont: TFPCustomFont;
3. FAssignedPen: TFPCustomPen;

and

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

1. destructor TLazCanvas.destroy;
2. var
3.   i: Integer;
4. begin
5.   for i := 0 to GraphicStateList.Count-1 do
6.     TLazCanvasState(GraphicStateList[i]).Free;
7.   GraphicStateList.Free;
8.   FAssignedBrush.Free;
9.   FAssignedPen.Free;
10.   inherited destroy;
11. end;

   
The destructor doesn't free FAssignedFont. The following patch adds a FAssignedFont.Free; line.

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

1. diff --git a/lcl/lazcanvas.pas b/lcl/lazcanvas.pas
2. index 33d5d0e382..057e7fea51 100644
3. --- a/lcl/lazcanvas.pas
4. +++ b/lcl/lazcanvas.pas
5. @@ -555,6 +555,7 @@ begin
6.      TLazCanvasState(GraphicStateList[i]).Free;
7.    GraphicStateList.Free;
8.    FAssignedBrush.Free;
9. +  FAssignedFont.Free;
10.    FAssignedPen.Free;
11.    inherited destroy;
12.  end;

[AlexTP]

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

[AlexTP]

Juha Manninen commented:

Do you have an example project that leaks memory because of this?

[lagprogramming]

I can't provide an example. The idea is to treat FAssignedFont same as FAssignedBrush and FAssignedPen. Either all three of them should be freed, either none. Why!? Because in other places they are treated similar.

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

1. // These properties are utilized to implement LCLIntf.SelectObject
2. // to keep track of which brush handle was assigned to this canvas
3. // They are not utilized by TLazCanvas itself
4. property AssignedPen: TFPCustomPen read GetAssignedPen write FAssignedPen;
5. property AssignedBrush: TFPCustomBrush read GetAssignedBrush write FAssignedBrush;
6. property AssignedFont: TFPCustomFont read GetAssignedFont write FAssignedFont;

   

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

1. function TLazCanvas.GetAssignedBrush: TFPCustomBrush;
2. begin
3.   if FAssignedBrush = nil then
4.     Result := TFPEmptyBrush.Create
5.   else
6.     Result := FAssignedBrush;
7. end;
8.  
9. function TLazCanvas.GetAssignedPen: TFPCustomPen;
10. begin
11.   if FAssignedPen = nil then
12.     Result := TFPEmptyPen.Create
13.   else
14.     Result := FAssignedPen;
15. end;
16.  
17. function TLazCanvas.GetAssignedFont: TFPCustomFont;
18. begin
19.   if FAssignedFont = nil then
20.     Result := TFPEmptyFont.Create
21.   else
22.     Result := FAssignedFont;
23. end;

[wp]

All this sounds reasonable. But without an example it is risky. While you immediately can use the canvas' Pen or Brush for drawing, the Font needs a special treatment: it is created outside the canvas: https://wiki.freepascal.org/fcl-image#Drawing_text. Not sure if this is good example and applies also to the FAssignedFont. But I'd be careful... Do you remember the similar case with the regions?

[lagprogramming]

All this sounds reasonable. But without an example it is risky. While you immediately can use the canvas' Pen or Brush for drawing, the Font needs a special treatment: it is created outside the canvas: https://wiki.freepascal.org/fcl-image#Drawing_text. Not sure if this is good example and applies also to the FAssignedFont. But I'd be careful... Do you remember the similar case with the regions?

I don't remember, but that's ok. It's great that you remember because you have the opportunity to fix the following bugs. 
1/2

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

1.   TLazCanvasState = class
2.   public
3.     Brush: TFPCustomBrush;
4.     Pen: TFPCustomPen;
5.     Font: TFPCustomFont;
6.     BaseWindowOrg: TPoint;
7.     WindowOrg: TPoint;
8.     Clipping: Boolean;
9.     ClipRegion: TFPCustomRegion;
10.     destructor Destroy; override;
11.   end;

 

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

1. destructor TLazCanvasState.Destroy;
2. begin
3.   Brush.Free;
4.   Pen.Free;
5.   Font.Free;
6.   inherited Destroy;
7. end;

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

1. function TLazCanvas.SaveState: Integer;
2. var
3.   lState: TLazCanvasState;
4. begin
5.   lState := TLazCanvasState.Create;
6.  
7.   lState.Brush := Brush.CopyBrush;
8.   lState.Pen := Pen.CopyPen;
9.   lState.Font := Font.CopyFont;
10.   lState.BaseWindowOrg := BaseWindowOrg;
11.   lState.WindowOrg := WindowOrg;
12.   lState.Clipping := Clipping;
13.  
14.   Result := GraphicStateList.Add(lState);
15. end;

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

1. procedure TLazCanvas.RestoreState(AIndex: Integer);
2. var
3.   lState: TLazCanvasState;
4. begin
5.   if AIndex < 0 then AIndex := AIndex + GraphicStateList.Count;
6.   lState := TLazCanvasState(GraphicStateList.Items[AIndex]);
7.   GraphicStateList.Delete(AIndex);
8.   if lState = nil then Exit;
9.  
10.   AssignPenData(lState.Pen);
11.   AssignBrushData(lState.Brush);
12.   AssignFontData(lState.Font);
13.   BaseWindowOrg := lState.BaseWindowOrg;
14.   WindowOrg := lState.WindowOrg;
15.   Clipping := lState.Clipping;
16.  
17.   lState.Free;
18. end;

Notice that SaveState and RestoreState ignore TLazCanvasState.ClipRegion. Saving/Restoring the Clipping value and ignoring the ClipRegion can't be good.

2/2 Regarding the addition of the FAssignedFont.Free line in destructor TLazCanvas.destroy, let's wait until:
a) FPC issue regarding DoCopyProps routines in fcl-image package is fixed. This bug is also related to the LazCanvas comment:

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

1.     // Utilized by LCLIntf.SelectObject and by RestoreState
2.     // This needed to be added because Pen/Brush.Assign raises exceptions

https://gitlab.com/freepascal.org/fpc/source/-/issues/40362
b) Somebody will do something about Saving/Restoring the Clipping value in TLazCanvas, as was written at the beginning of this reply.
c) TCDWidgetSet.RectVisible always returns true, which is a bug. The function should mimic TQtWidgetSet.RectVisible, but it appears that the qt function might also be buggy when QtDC.getClipping returns false. I don't have qt installed so I can't check to see if TQtWidgetSet.RectVisible returns the same results as TGtk2WidgetSet.RectVisible.
d) Fix procedure TLazCanvas.ResetCanvasState, because this procedure is expected to be very important for customdrawn.
After the above four fixes, we'll see if variables have been included in TLazCanvas just as workarounds for "// Routines broken/unimplemented/incompatible in FPC", that's another comment found in the same file, regarding TLazCanvas.
Looking at the code of GetAssignedBrush/Pen/Font, I'm sure there are bugs. A recommended practice is that the entity that creates or allocates a block of memory should be responsible with freeing it. TLazCanvas creates brushes, pens and fonts without keeping accountability, and also tries to free a single instance of pen and brush, ignoring completely the fonts.

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

1. procedure TForm1.Button1Click(Sender: TObject);
2. //add to uses lazcanvas and fpcanvas and then notice the 100*3 memory leaks
3. var
4.   lc:TLazCanvas;
5.   i:integer;
6.   fb: TFPCustomBrush;
7.   ff: TFPCustomFont;
8.   fp: TFPCustomPen;
9. begin
10.   lc := TLazCanvas.create(nil);
11.   for i:=0 to 99 do
12.   begin
13.     fb := lc.AssignedBrush;
14.     ff := lc.AssignedFont;
15.     fp := lc.AssignedPen;
16.   end;
17.   lc.Free;
18. {Using Heaptrc unit (-gh)
19. 1256 memory blocks allocated : 1610996/1612008
20. 956 memory blocks freed     : 1566196/1567208
21. 300 unfreed memory blocks : 44800
22. True heap size : 1605632
23. True free heap : 1496832
24. Should be : 1503232}
25. end;