Exception of using freed objects in rapid painting cycles
Summarization:
For a Delphi function/procedure, if an instance of a class is passed through as an argument, another reference (besides the original reference) is created on temporary calling stack to point to that instance and is used locally. Thus, be careful:(1) If the function/procedure only wants to change the content/fields/properties of that instance, no var prefix is needed;
(2) If the function/procedure probably wants to re-assign the reference to a new instance, use var prefix, or it is the temporary reference that gets re-assigned.
(3) Note, if the function/procedure re-assigns the reference and the var prefix is not used, the outcome is probably right, which is even worse, because eventually the code will break some day.
=======================================
The situat开发者_Go百科ion is: It is a small application. The TMolForm is a MDIChild Form, and every TMolForm contains a TMolScene, which descends from TPaintBox. The TMolScene draws the TMol. In the painting procedure of TMolScene, TMolScene calls TMol.Rescale if TMolScene is resized. Then TMolScene calls TMol.TransformCoordinates to build up coordinates for the subsequent rendering.The problem is:
Now, in TMol.Rescale, I reset the matrices passed through by the caller, TMolScene. However, I meet exceptions which I cannot think of the reason.(1) Specifically, if I have multiple TMolForm, and rapidly do resizing, mouse dragging (which is molecule rotating), switching between TMolForm, in less than 5 minutes, suddenly the matrices (supposedly already resetted in TMol.Rescale) passed into TMol.TransformCoordinates are nil or contain nil content.
(2) If I enable FastMM4 and its FullDebugMode, and repeat the above mouse movements, I can get "TMol.Rescale attempts to free a freed object". It seems TMol.Rescale is called again when the last call (or the last paint cycle) is not finished. I mean, I didn't make any attempts involving multi-threading, how possibly could TMol.Rescale be call the second time when the last call does not return yet? I am completely lost. Could you help to comment on any possible reasons?
(3) If I remove the resetting of matrices out of TMol.Rescale and into its caller, TMolScene.OnScenePaint, the exceptions seem not to happen, at least not in 5 minutes. (I did not rapidly abusing the mouse longer than 5 minutes. Perhaps there is other better way of testing.) I have no clue why this works and why the above crashes sometimes.
(4) If I only have one TMolform, the above exceptions seem not to happen, at least not in 5 minutes.
I must admit that I made up the following minimized code in order to catch the exceptions. However, although the execution procedure should mirror the real situation, the exceptions don't occur. If you would like to see the real code I am willing to send to you through email or something else. It is hobby and not well written, though, sorry.
Any suggestions, either on the exceptions, or on bad coding habits, are really appreciated.
unit uMolForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
ExtCtrls, Dialogs;
type
TVec = class;
TMat = class;
TMol = class;
TMolScene = class;
TMolForm = class;
TVec = class
public
X, Y, Z: Extended;
constructor Create; overload;
constructor Create(aX, aY, aZ: Extended); overload;
end;
TMat = class
private
FX, FY, FZ, FT: TVec;
public
property X: TVec read FX;
property Y: TVec read FY;
property Z: TVec read FZ;
constructor Create;
destructor Destroy; override;
function ToUnit: TMat;
end;
TMol = class
public
constructor Create;
destructor Destroy; override;
procedure Rescale(aBbWidth, aBbHeight: Integer;
aRotationMatUser, aTranslationMatUser, aScalingMatUser: TMat);
procedure TransformCoordinates(aBbWidth, aBbHeight: Integer;
aRotationMatUser, aTranslationMatUser, aScalingMatUser: TMat);
end;
TMolScene = class(TPaintBox)
private
FBbWidth, FBbHeight: Integer;
FRotationMat, FTranslationMat, FScalingMat: TMat;
FMol: TMol;
procedure OnScenePaint(Sender: TObject);
procedure OnSceneMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure OnSceneMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure OnSceneMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
public
constructor Create(AOwner: TComponent);
destructor Destroy; override;
end;
TMolForm = class(TForm)
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
FMolScene: TMolScene;
public
{ Public declarations }
end;
implementation
{$R *.dfm}
{ TVec }
constructor TVec.Create;
begin
inherited;
X := 0;
Y := 0;
Z := 0;
end;
constructor TVec.Create(aX, aY, aZ: Extended);
begin
inherited Create;
X := aX;
Y := aY;
Z := aZ;
end;
{ TMat }
constructor TMat.Create;
begin
inherited;
ToUnit;
end;
destructor TMat.Destroy;
begin
FreeAndNil(FX);
FreeAndNil(FY);
FreeAndNil(FZ);
FreeAndNil(FT);
inherited;
end;
function TMat.ToUnit: TMat;
begin
FreeAndNil(FX);
FreeAndNil(FY);
FreeAndNil(FZ);
FreeAndNil(FT);
FX := TVec.Create(1, 0, 0);
FY := TVec.Create(0, 1, 0);
FZ := TVec.Create(0, 0, 1);
FT := TVec.Create;
Result := Self;
end;
{ TMol }
constructor TMol.Create;
begin
inherited;
end;
destructor TMol.Destroy;
begin
inherited;
end;
procedure TMol.Rescale(aBbWidth, aBbHeight: Integer;
aRotationMatUser, aTranslationMatUser, aScalingMatUser: TMat);
begin
FreeAndNil(aRotationMatUser);
FreeAndNil(aTranslationMatUser);
FreeAndNil(aScalingMatUser);
aRotationMatUser := TMat.Create;
aTranslationMatUser := TMat.Create;
aScalingMatUser := TMat.Create;
end;
procedure TMol.TransformCoordinates(aBbWidth, aBbHeight: Integer;
aRotationMatUser, aTranslationMatUser, aScalingMatUser: TMat);
begin
if (aRotationMatUser.X = nil) or (aRotationMatUser.Y = nil) or
(aRotationMatUser.Z = nil) or (aTranslationMatUser.X = nil) or
(aTranslationMatUser.Y = nil) or (aTranslationMatUser.Z = nil) or
(aScalingMatUser.X = nil) or (aScalingMatUser.Y = nil) or
(aScalingMatUser.Z = nil) then
begin
raise Exception.Create('what happened?!');
end;
end;
{ TMolScene }
constructor TMolScene.Create(AOwner: TComponent);
begin
inherited;
FRotationMat := TMat.Create;
FTranslationMat := TMat.Create;
FScalingMat := TMat.Create;
FMol := TMol.Create;
Self.OnPaint := Self.OnScenePaint;
Self.OnMouseDown := Self.OnSceneMouseDown;
Self.OnMouseUp := Self.OnSceneMouseUp;
Self.OnMouseMove := Self.OnSceneMouseMove;
end;
destructor TMolScene.Destroy;
begin
FreeAndNil(FRotationMat);
FreeAndNil(FTranslationMat);
FreeAndNil(FScalingMat);
FreeAndNil(FMol);
inherited;
end;
procedure TMolScene.OnScenePaint(Sender: TObject);
begin
if (FBbWidth <> Self.ClientWidth) or (FBbHeight <> Self.ClientHeight) then
begin
FBbWidth := Self.ClientWidth;
FBbHeight := Self.ClientHeight;
FMol.Rescale(FBbWidth, FBbHeight, FRotationMat, FTranslationMat,
FScalingMat);
end;
FMol.TransformCoordinates(FBbWidth, FBbHeight, FRotationMat, FTranslationMat,
FScalingMat);
end;
procedure TMolScene.OnSceneMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Self.Repaint;
end;
procedure TMolScene.OnSceneMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Self.Repaint;
end;
procedure TMolScene.OnSceneMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Self.Repaint;
end;
{ TMolForm }
procedure TMolForm.FormCreate(Sender: TObject);
begin
FMolScene := TMolScene.Create(Self);
FMolScene.Parent := Self;
FMolScene.Align := alClient;
end;
procedure TMolForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
end.
The code
procedure TMol.Rescale(aBbWidth, aBbHeight: Integer;
aRotationMatUser, aTranslationMatUser, aScalingMatUser: TMat);
begin
FreeAndNil(aRotationMatUser);
FreeAndNil(aTranslationMatUser);
FreeAndNil(aScalingMatUser);
aRotationMatUser := TMat.Create;
aTranslationMatUser := TMat.Create;
aScalingMatUser := TMat.Create;
end;
is an error. You should pass aRotationMatUser, aTranslationMatUser, aScalingMatUser
parameters by reference:
procedure TMol.Rescale(aBbWidth, aBbHeight: Integer;
**var** aRotationMatUser, aTranslationMatUser, aScalingMatUser: TMat);
You should use var to pass the arguments in the above procedure because without it
- FreeAndNil 'nilles' the temporary stack variables, and it makes no sense;
- constructor calls assign values to the temporary stack variables, with resulting memory leaks.
The question why the erroneous code sometimes work right (and probably does not even cause memory leaks) is a different story.
One more edit
As you already mentioned a Delphi object is a reference. So you need not use var
to change the object. But your procedure is different - it changes the references themselves, not only the data pointed by these references, so you should pass these references (aRotationMatUser, aTranslationMatUser, aScalingMatUser
) by reference. That is why you need var
.
精彩评论