Recent

Author Topic: Destructor of TLazCanvas ignores FAssignedFont  (Read 2571 times)

lagprogramming

  • Sr. Member
  • ****
  • Posts: 407
Destructor of TLazCanvas ignores FAssignedFont
« on: July 26, 2023, 10:13:44 am »
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

  • Hero Member
  • *****
  • Posts: 2488
    • UVviewsoft
Re: Destructor of TLazCanvas ignores FAssignedFont
« Reply #2 on: July 27, 2023, 10:27:50 am »
Juha Manninen commented:

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

lagprogramming

  • Sr. Member
  • ****
  • Posts: 407
Re: Destructor of TLazCanvas ignores FAssignedFont
« Reply #3 on: July 27, 2023, 10:28:59 am »
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

  • Hero Member
  • *****
  • Posts: 12476
Re: Destructor of TLazCanvas ignores FAssignedFont
« Reply #4 on: July 27, 2023, 10:54:17 am »
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

  • Sr. Member
  • ****
  • Posts: 407
Re: Destructor of TLazCanvas ignores FAssignedFont
« Reply #5 on: July 27, 2023, 06:17:34 pm »
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.  :D :D
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;

 

TinyPortal © 2005-2018