Could UniqueString be a function? - delphi

In Delphi there is the procedure UniqueString which forces the parameter passed to it to have a reference count of 1. It is usually done to ensure that so it is safe to pass it to a different thread without messing up the reference counting. (*1)
It has always irked me that I have to assign the string to a variable first before I can call this procedure. Is there any reason why it could not be implemented as a function?
Like:
procedure TMyThread.Create(const _SomeParam: string);
begin
FStringField := MakeUniqueString(_SomeParam);
inherited Create(false);
end;
Instead of:
procedure TMyThread.Create(const _SomeParam: string);
begin
FStringField := _SomeParam;
UniqueString(FStringField);
inherited Create(false);
end;
And is there any problem with writing such a function as
function MakeUniqueString(const _s: string): string;
begin
Result := _s;
UniqueString(Result);
end;
EDIT:
*1: Yes, my claim that reference counting is not thread safe is at least outdated or may even have been wrong alltogether. You can stop telling me that.

You can use
FStringField := Copy(_SomeParam, 1);
That will make a unique copy.
(Trivia: although documented as required, you can actually leave out the Count parameter and Copy will copy everything from the starting index to the end.)
Or you can make your own UniqueString:
function MakeUnique(const value: string): string; inline;
begin
Result := value;
UniqueString(Result);
end;
FStringField := MakeUnique(_SomeParam);
(Trivia: If you remove the inline, FStringField will actually have refcount 2 until the parent function (TMyThread.Create in your example) exits, because the compiler creates a hidden local variable that receives the result of the MakeUnique call and then assigns it to the FStringField. The string would still be unique so far as the parallel code is concerned.)
To answer the philosophical question - no, I don't think there is any big showstopper that prevents UniqueString by being implemented as a function. It just isn't.

Related

Delphi tstringlist.free erases result [duplicate]

This question already has answers here:
How do i return an object from a function in Delphi without causing Access Violation?
(10 answers)
Closed last month.
Ok, this I don't understand.
path:=tstringlist.create;
//load up the path with stuff
Result := path;
path.free;
exit;
I would have thought that result would actually equal the path but it apparently doesn't. If I remove path.free from the code above, the result works as it should and it = the path tstringlist but I get a memory leak. When I put path.free in there, the result becomes empty. I understand the memory leak but how is result getting erased if I free the path AFTER I make it := ????
And yes, the above code is inside multiple for loops which is why I'm using exit. I've tried break and try finally and had no luck making those work either.
Let me rephrase your variable and class names and add a few comments:
function MyNewHouse(): TStringList;
var
NewAddress: TStringList;
begin
// Construct a house with walls, windows, doors and a roof. Those
// are the properties and methods that we're able to use later.
NewAddress := House.Create();
// ...fill the house with content, using our walls, windows, doors...
// Only copy the new house's address, not the house in its entirety.
// And certainly not its content.
Result := NewAddress;
// Demolish/Tear down the house, which can only be made once. When
// the house is demolished, you can neither access it, nor tear it
// down anew. However, the address is still somewhat "valid". While
// everything but the spot where it once existed is gone.
NewAddress.Free();
Exit;
end;
Whenever you assign variables of a class type (such as TObject or TStringList or TForm) you're merely copying its address, not its entire content. For copying (believe it or not) the method .Assign() exists:
// Instead of only "Result := NewAddress;"
Result.Assign( NewAddress );
That copies its whole content. This method exists for many classes, and for each different class "copying its content" can mean different things, just like you may want to copy a TStringList's items, but not necessarily its other settings. But if you wanted it that way you would have used Result.Items := NewAddress.Items already in your example...
The reason why Result becomes empty when you include path.free is because Result is just a reference to path. When you call path.free, you are freeing the memory that path occupies, which makes the reference to that memory invalid. When you try to access Result after freeing path, you are trying to access invalid memory, which can result in undefined behavior.
You need to free the returned TStringList outside of the function, you should modify the function as follows:
function getPath: TStringList;
begin
Result := tstringlist.create;
//load up the path with stuff
end;
// usage:
var
path: TStringList;
begin
path := getPath;
try
// use path here
finally
path.Free;
end;
end;
This way, the returned TStringList is created inside the function and is passed as a reference to the caller. The caller is responsible for freeing the TStringList when it is no longer needed by calling Free on it. This is called "resource acquisition is initialization" (RAII) and is a common pattern in Delphi for managing resources such as dynamically allocated objects.
By using this pattern, you can ensure that the TStringList is always properly freed and avoid potential memory leaks.
More advanced trick (XE2+):
type
IScope<T: class> = interface
private
function GetIt: T;
public
property It: T read GetIt;
end;
TScope<T: class> = class(TInterfacedObject, IScope<T>)
private
FValue: T;
public
constructor Create(const AValue: T);
destructor Destroy; override;
function GetIt: T;
end;
constructor TScope<T>.Create(const AValue: T);
begin
inherited Create;
FValue := AValue;
end;
destructor TScope<T>.Destroy;
begin
FValue.Free;
inherited;
end;
function TScope<T>.GetIt: T;
begin
Result := FValue;
end;
function getPath: IScope<TStringList>;
var
path: TStringList;
begin
path := tstringlist.create;
//load up the path with stuff
Result := TScope<TStringList>.Create(path);
end;
// usage:
var
path: TStringList;
begin
path := getPath.It;
// use path here
end; // auto-free here

Pointer to Function of (Sub-)Method?

If you like to use a method's pointer as an argument, you need to type the method as function of object like this works good:
type TAcceptor = function(filename:string):boolean of object;
function acceptor(filename:string):boolean;
begin
result := filename <> '';
end;
What if you like to use the pointer of a sub-method? It does not work:
procedure TForm1.Button1Click(Sender:TObject);
function acceptor(filename:string):boolean of object;
begin
result := filename <> '';
end;
begin
end;
The error occour: ; expected but OF found!
Question: Is there any subfunction-pointer? Can i cast it?
I don't see how that this would be possible.
http://docwiki.embarcadero.com/RADStudio/XE6/en/Procedural_Types
If you look under the method pointers section, it specifically says that nested procedures and functions cannot be used:
"Nested procedures and functions (routines declared within other
routines) cannot be used as procedural values, nor can predefined
procedures and functions."
You might be able to work around it using an anonymous method. Something like:
procedure TForm1.Button1Click(Sender:TObject);
begin
DoSomethingWithAcceptor(function(FileName: string): Boolean
begin
Result := FileName <> '';
end);
end;
CAUTION
I know that the following is not universally applicable, but it works for all known Win32 versions of Delphi. As long as you are aware of this, and check its functionality in new versions, it is a viable hack, IMO.
Passing nested functions to methods
In older code, I used this to do some "poor man's anonymous methods":
type
TLocal = packed record
Code: Pointer; // local (nested) function
Frame: Pointer; // outer stack frame for local function
end;
To fill such a local inside a method, I wrote the function Local:
function Local(LocalFunction: Pointer): TLocal;
asm
MOV [EDX].TLocal.Frame,EBP
MOV [EDX].TLocal.Code,EAX
end;
Inside my unit (some kind of generic collection), I wrote a function to call them, passing one parameter (of type TGeneric, in this case, which is not important here, you can also pass a pointer or some such).
// Calls local function using local closure provided, passing
// T as parameter to the local.
function CallLocal(T: TGeneric; const Local: TLocal): TGeneric;
asm
PUSH [EDX].TLocal.Frame
CALL [EDX].TLocal.Code
ADD ESP,4
end;
It was used like this:
function TStdCollection.AsArray: TGenericArray;
var
I: Integer;
A: TGenericArray;
procedure ToArray(E: TGeneric);
begin
Result[I] := E.Traits.Copy(E);
Inc(I);
end;
begin
SetLength(A, Count);
I := 0;
ForEach(Local(#ToArray));
Assert(I = Count);
Result := A;
end;
The code in the nested function makes a copy of the element and stores it in the array. The main procedure then passes the nested function ToArray (together with its stack frame) as parameter to ForEach, which is implemented this way:
function TStdCollection.ForEach(Operation: TLocal): ICollection;
var
Enum: IEnumerator;
Elem: TGeneric;
begin
Enum := GetEnumerator;
Elem := Enum.First;
while Elem <> nil do
begin
CallLocal(Elem, Operation);
Elem := Enum.Next;
end;
Result := Self;
end;
These examples show how to use the Locals. I hope this more or less answers your question.
Note
Note that this code was written in the Delphi 6 timeframe. I know there are better alternatives these days, like generics and anonymous methods. But if compatibility with Delphi 7 is required, the above might be a solution.

Is there memory leak here?

is this piece of code safe from memory leaks?
s := TStringList.Create; // create first object
try
// Here line comes that seems to be dangerous
s := GetSomeSettings; // Overrides reference to first object by second one
finally
s.free; // Destroying only second object, leave first object to live somewhere in memory
end;
function GetSomeSettings : TStringList;
var
rawString : string;
settings : TStringList;
begin
// Singleton pattern implementation
// Trying to find already existing settings in class variable
settings := TSettingsClass.fSettings;
// If there is no already defined settings then get them
if not Assigned(settings) then
begin
GetSettingsInDB(rawString);
TSettingsClass.fSettings := ParseSettingsString(rawString);
settings := TSettingsClass.fSettings;
end;
Result := settings;
end;
I'm wondering s := GetSomeSettings; potentially harmful and ignoring first object, keeps it in the memory?
Yes, the StringList created on line 1 is leaked.
Essentialy, you are doing:
s := TStringList.Create;
s := AnotherStringList;
AnotherStringList.Free;
As for the GetSomeSettings routine:
Normally it is not wise or encouraged to return newly created instances as function results, because you transfer the responsibility for ownership and destruction to the calling code. Unless you have a mechanism/framework in place that takes care of it, which seems to be the case with your TSettingsClass, but there is not enough evidence for that in this little piece of code.
Nevertheless, the combination of both pieces of code display another problem: After s.Free, TSettingsClass.fSettings is destroyed but not nil. Thus the second time GetSomeSettings is called, it returns a dangling pointer.
1) you should not ask when you can check in two minutes!
program {$AppType Console};
uses Classes, SysUtils;
type TCheckedSL = class(TStringList)
public
procedure BeforeDestruction; override;
procedure AfterConstruction; override;
end;
procedure TCheckedSL.BeforeDestruction;
begin
inherited;
WriteLn('List ',IntToHex(Self,8), ' going to be safely destroyed.');
end;
procedure TCheckedSL.AfterConstruction;
begin
WriteLn('List ',IntToHex(Self,8), ' was created - check whether it is has matched destruction.');
inherited;
end;
procedure DoTest; var s: TStrings;
function GetSomeSettings: TStrings;
begin Result := TCheckedSL.Create end;
begin
Writeln('Entered DoTest procedure');
s := TCheckedSL.Create; // create first object
try
// Here line comes that seems to be dangerous
s := GetSomeSettings; // Overrides reference to first object by second one
finally
s.free; // Destroying only second object, leave first object
end;
Writeln('Leaving DoTest procedure');
end;
BEGIN
DoTest;
Writeln;
Writeln('Check output and press Enter when done');
ReadLn;
END.
2) Still that could be safe in few niche cases.
in FPC (http://FreePascal.org) S could be a "global property" of some unit, having a setter which would free old list.
in Delphi Classic S could be of some interface type, supported by the created object. Granted, standard TStringList lacks any interface, but some libraries ( for example http://jcl.sf.net ) do offer interface-based string lists, with richer API (iJclStringList type and related).
in Delphi/LLVM all objects were made reference-counted, like interfaces without GUID's. So that code would be safe there.
You can declare S as a record - a so-called Extended Record having re-defined class operator Implicit so that the typecast s{record} := TStringList.Create would free the previous instance before assigning a new one. That is dangerous though, as it is VERY fragile and easy to misuse, and destroy the list in some other place leaving a dangling pointer inside the S record.
Your object may be not that vanilla TStringList, but some subclass, overriding constructors or AfterConstruction to register itself in some list, that would be all-at-once in some place. Kind of Mark/Sweep heap management around large chunk of workload. VCL TComponent may be seen as following this pattern: form is owning its component and frees them when needed. And this is what you - in reduced form - are trying to do with TSettingsClass.fSettings containter (any reference is 1-sized container). However those frameworks do require a loopback: when the object is freed it should also remove itself from all the containers, referencing it.
.
procedure TCheckedSL.BeforeDestruction;
begin
if Self = TSettingsClass.fSettings then TSettingsClass.fSettings := nil;
inherited;
end;
class procedure TSettingsClass.SetFSettings(Value);
var fSet2: TObject;
begin
if fSettings <> nil then begin
fSet2 := fSettings;
f_fSettings := nil; // breaking the loop-chain
fSet2.Destroy;
end;
f_fSettings := Value;
end;
class destructor TSettingsClass.Destroy;
begin
fSettings := nil;
end;
However then - by the obvious need to keep design symmetric - the registration should also be done as a part of the class. Who is responsible for de-registration is usually the one responsible for registration as well, unless there are reasons to skew the design.
procedure TCheckedSL.AfterConstruction;
begin
inherited;
TSettingsClass.fSettings := Self;
end;
...
if not Assigned(settings) then
begin
GetSettingsInDB(rawString);
TCheckedSL.Create.Text := ParseSettingsString(rawString);
settings := TSettingsClass.fSettings;
Assert( Assigned(settings), 'wrong class used for DB settings' );
end;
Result := settings;

With a class operator is an implicit typecast to itself allowed?

I have a record that looks like:
TBigint = record
PtrDigits: Pointer; <-- The data is somewhere else.
Size: Byte;
MSB: Byte;
Sign: Shortint;
...
class operator Implicit(a: TBigint): TBigint; <<-- is this allowed?
....
The code is pre-class operator legacy code, but I want to add operators.
I know the data should really be stored in a dynamic array of byte, but I do not want to change the code, because all the meat is in x86-assembly.
I want to following code to trigger the class operator at the bottom:
procedure test(a: TBignum);
var b: TBignum;
begin
b:= a; <<-- naive copy will tangle up the `PtrDigit` pointers.
....
If I add the implicit typecast to itself, will the following code be executed?
class operator TBigint.Implicit(a: TBigint): TBigint;
begin
sdpBigint.CreateBigint(Result, a.Size);
sdpBigint.CopyBigint(a, Result);
end;
(Will test and add the answer if it works as I expect).
My first answer attempts to dissuade against the idea of overriding the assignment operator. I still stand by that answer, because many of the problems to be encountered are better solved with objects.
However, David quite rightly pointed out that TBigInt is implemented as a record to leverage operator overloads. I.e. a := b + c;. This is a very good reason to stick with a record based implementation.
Hence, I propose this alternative solution that kills two birds with one stone:
It removes the memory management risks explained in my other answer.
And provides a simple mechanism to implement Copy-on-Write semantics.
(I do still recommend that unless there's a very good reason to retain a record based solution, consider switching to an object based solution.)
The general idea is as follows:
Define an interface to represent the BigInt data. (This can initially be minimalist and support only control of the pointer - as in my example. This would make the initial conversion of existing code easier.)
Define an implementation of the above interface which will be used by the TBigInt record.
The interface solves the first problem, because interfaces are a managed type; and Delphi will dereference the interface when a record goes out of scope. Hence, the underlying object will destroy itself when no longer needed.
The interface also provides the opportunity to solve the second problem, because we can check the RefCount to know whether we should Copy-On-Write.
Note that long term it might prove beneficial to move some of the BigInt implementation from the record to the class & interface.
The following code is trimmed-down "big int" implementation purely to illustrate the concepts. (I.e. The "big" integer is limited to a regular 32-bit number, and only addition has been implemented.)
type
IBigInt = interface
['{1628BA6F-FA21-41B5-81C7-71C336B80A6B}']
function GetData: Pointer;
function GetSize: Integer;
procedure Realloc(ASize: Integer);
function RefCount: Integer;
end;
type
TBigIntImpl = class(TInterfacedObject, IBigInt)
private
FData: Pointer;
FSize: Integer;
protected
{IBigInt}
function GetData: Pointer;
function GetSize: Integer;
procedure Realloc(ASize: Integer);
function RefCount: Integer;
public
constructor CreateCopy(ASource: IBigInt);
destructor Destroy; override;
end;
type
TBigInt = record
PtrDigits: IBigInt;
constructor CreateFromInt(AValue: Integer);
class operator Implicit(AValue: TBigInt): Integer;
class operator Add(AValue1, AValue2: TBigInt): TBigInt;
procedure Add(AValue: Integer);
strict private
procedure CopyOnWriteSharedData;
end;
{ TBigIntImpl }
constructor TBigIntImpl.CreateCopy(ASource: IBigInt);
begin
Realloc(ASource.GetSize);
Move(ASource.GetData^, FData^, FSize);
end;
destructor TBigIntImpl.Destroy;
begin
FreeMem(FData);
inherited;
end;
function TBigIntImpl.GetData: Pointer;
begin
Result := FData;
end;
function TBigIntImpl.GetSize: Integer;
begin
Result := FSize;
end;
procedure TBigIntImpl.Realloc(ASize: Integer);
begin
ReallocMem(FData, ASize);
FSize := ASize;
end;
function TBigIntImpl.RefCount: Integer;
begin
Result := FRefCount;
end;
{ TBigInt }
class operator TBigInt.Add(AValue1, AValue2: TBigInt): TBigInt;
var
LSum: Integer;
begin
LSum := Integer(AValue1) + Integer(AValue2);
Result.CreateFromInt(LSum);
end;
procedure TBigInt.Add(AValue: Integer);
begin
CopyOnWriteSharedData;
PInteger(PtrDigits.GetData)^ := PInteger(PtrDigits.GetData)^ + AValue;
end;
procedure TBigInt.CopyOnWriteSharedData;
begin
if PtrDigits.RefCount > 1 then
begin
PtrDigits := TBigIntImpl.CreateCopy(PtrDigits);
end;
end;
constructor TBigInt.CreateFromInt(AValue: Integer);
begin
PtrDigits := TBigIntImpl.Create;
PtrDigits.Realloc(SizeOf(Integer));
PInteger(PtrDigits.GetData)^ := AValue;
end;
class operator TBigInt.Implicit(AValue: TBigInt): Integer;
begin
Result := PInteger(AValue.PtrDigits.GetData)^;
end;
The following tests were written as I built up the proposed solution. They prove: some basic functionality, that the copy-on-write works as expected, and that there are no memory leaks.
procedure TTestCopyOnWrite.TestCreateFromInt;
var
LBigInt: TBigInt;
begin
LBigInt.CreateFromInt(123);
CheckEquals(123, LBigInt);
//Dispose(PInteger(LBigInt.PtrDigits)); //I only needed this until I
//started using the interface
end;
procedure TTestCopyOnWrite.TestAssignment;
var
LValue1: TBigInt;
LValue2: TBigInt;
begin
LValue1.CreateFromInt(123);
LValue2 := LValue1;
CheckEquals(123, LValue2);
end;
procedure TTestCopyOnWrite.TestAddMethod;
var
LValue1: TBigInt;
begin
LValue1.CreateFromInt(123);
LValue1.Add(111);
CheckEquals(234, LValue1);
end;
procedure TTestCopyOnWrite.TestOperatorAdd;
var
LValue1: TBigInt;
LValue2: TBigInt;
LActualResult: TBigInt;
begin
LValue1.CreateFromInt(123);
LValue2.CreateFromInt(111);
LActualResult := LValue1 + LValue2;
CheckEquals(234, LActualResult);
end;
procedure TTestCopyOnWrite.TestCopyOnWrite;
var
LValue1: TBigInt;
LValue2: TBigInt;
begin
LValue1.CreateFromInt(123);
LValue2 := LValue1;
LValue1.Add(111); { If CopyOnWrite, then LValue2 should not change }
CheckEquals(234, LValue1);
CheckEquals(123, LValue2);
end;
Edit
Added a test demonstrating use of TBigInt as value parameter to a procedure.
procedure TTestCopyOnWrite.TestValueParameter;
procedure CheckValueParameter(ABigInt: TBigInt);
begin
CheckEquals(2, ABigInt.PtrDigits.RefCount);
CheckEquals(123, ABigInt);
ABigInt.Add(111);
CheckEquals(234, ABigInt);
CheckEquals(1, ABigInt.PtrDigits.RefCount);
end;
var
LValue: TBigInt;
begin
LValue.CreateFromInt(123);
CheckValueParameter(LValue);
end;
There is nothing in Delphi that allows you to hook into the assignment process. Delphi has nothing like C++ copy constructors.
Your requirements, are that:
You need a reference to the data, since it is of variable length.
You also have a need for value semantics.
The only types that meet both of those requirements are the native Delphi string types. They are implemented as a reference. But the copy-on-write behaviour that they have gives them value semantics. Since you want an array of bytes, AnsiString is the string type that meets your needs.
Another option would be to simply make your type be immutable. That would let you stop worrying about copying references since the referenced data could never be modified.
It seems to me your TBigInt should be a class rather than a record. Because you're concerned about PtrDigits being tangled up, it sounds like you're needing extra memory management for what the pointer references. Since records don't support destructors there's no automatic management of that memory. Also if you simply declare a variable of TBigInt, but don't call the CreatBigInt constructor, the memory is not correctly initialised. Again, this is because you cannot override a record's default parameterless constructor.
Basically you have to always remember what has been allocated for the record and remember to manually deallocate. Sure you can have a deallocate procedure on the record to help in this regard, but you still have to remember to call it in the correct places.
However that said, you could implement an explicit Copy function, and add an item to your code-review checklist that TBitInt has been copied correctly. Unfortunately you'll have to be very careful with the implied copies such as passing the record via a value parameter to another routine.
The following code illustrates an example conceptually similar to your needs and demonstrates how the CreateCopy function "untangles" the pointer. It also highlights some of the memory management problems that crop up, which is why records are probably not a good way to go.
type
TMyRec = record
A: PInteger;
function CreateCopy: TMyRec;
end;
function TMyRec.CreateCopy: TMyRec;
begin
New(Result.A);
Result.A^ := A^;
end;
var
R1, R2: TMyRec;
begin
New(R1.A); { I have to manually allocate memory for the pointer
before I can use the reocrd properly.
Even if I implement a record constructor to assist, I
still have to remember to call it. }
R1.A^ := 1;
R2 := R1;
R2.A^ := 2; //also changes R1.A^ because pointer is the same (or "tangled")
Writeln(R1.A^);
R2 := R1.CreateCopy;
R2.A^ := 3; //Now R1.A is different pointer so R1.A^ is unchanged
Writeln(R1.A^);
Dispose(R1.A);
Dispose(R2.A); { <-- Note that I have to remember to Dispose the additional
pointer that was allocated in CreateCopy }
end;
In a nutshell, it seems you're trying to sledgehammer records into doing things they're not really suited to doing.
They are great at making exact copies. They have simple memory management: Declare a record variable, and all memory is allocated. Variable goes out of scope and all memory is deallocated.
Edit
An example of how overriding the assignment operator can cause a memory leak.
var
LBigInt: TBigInt;
begin
LBigInt.SetValue(123);
WriteBigInt(LBigInt); { Passing the value by reference or by value depends
on how WriteBigInt is declared. }
end;
procedure WriteBigInt(ABigInt: TBigInt);
//ABigInt is a value parameter.
//This means it will be copied.
//It must use the overridden assignment operator,
// otherwise the point of the override is defeated.
begin
Writeln('The value is: ', ABigInt.ToString);
end;
//If the assignment overload allocated memory, this is the only place where an
//appropriate reference exists to deallocate.
//However, the very last thing you want to do is have method like this calling
//a cleanup routine to deallocate the memory....
//Not only would this litter your code with extra calls to accommodate a
//problematic design, would also create a risk that a simple change to taking
//ABigInt as a const parameter could suddenly lead to Access Violations.

Why there's a mem leak and how to fix it?

unit Unit7;
interface
uses Classes;
type
TListener = class(TThread)
procedure Execute; override;
end;
TMyClass = class
o1,o2: Tobject;
procedure FreeMyObject(var obj: TObject);
constructor Create;
destructor Destroy; override;
end;
implementation
uses Windows, SysUtils;
var l: TListener;
my: TMyClass;
procedure TListener.Execute;
var msg:TMsg;
begin
while(GetMessage(msg, Cardinal(-1), 0, 0)) do
if(msg.message=6) then begin
TMyClass(msg.wParam).FreeMyObject(TObject(msg.lParam));
Exit;
end;
end;
constructor TMyClass.Create;
begin
inherited;
o1:=TObject.Create;
o2:=Tobject.Create; // Invalid pointer operation => mem leak
end;
destructor TMyClass.Destroy;
begin
if(Assigned(o1)) then o1.Free;
if(Assigned(o2)) then o2.Free;
inherited;
end;
procedure TMyClass.FreeMyObject(var obj: TObject);
begin
FreeAndNil(obj);
end;
initialization
l:= TListener.Create();
my:=TMyClass.Create;
sleep(1000); //make sure the message loop is set
PostThreadMessage(l.ThreadID, 6, Integer(my), Integer(my.o2));
finalization
l.Free;
my.Free;
end.
I used the message handler to illustrate my problem as is so you understand it. The real design is a lot more complicated. The function 'FreeMyObject' actually Frees AND creates an instance using polymorphism paradigm, but this here is not needed. I only want to point out that the design should stay the same.
Now the question and problem - why it happens AND how to fix it? It seems 'if Assigned(o2)' doesn't fit it.
What I think of: Sending a pointer to my.o2 would free and nil o2 and I tries to do so, but I couldn't convert from pointer to object in the message handler, got no idea why.
Could anybody give a hand? Thanks
You free o2 twice. Once as a result of the message and once from the destructor.
You think you are setting o2 to nil when you call FreeMyObject but you are not. You are in fact setting msg.lParam to 0.
o2 is a variable holding a reference to an object. You are passing the value of o2 and when you pass by value you cannot modify the variable whose value you passed. So you need to pass a reference to o2. To do so you need to add an extra level of redirection and pass a pointer to o2, like so:
if(msg.message=6) then begin
FreeAndNil(PObject(msg.lParam)^);
Exit;
end;
...
PostThreadMessage(l.ThreadID, 6, 0, LPARAM(#my.o2));
You don't need FreeMyObject, you can just call FreeAndNil directly. And you don't need to pass an instance in the message.
I hope your real code isn't quite as weird as this! ;-)
If you want to FreeAndNil an object sending just object reference Integer(my.o2) is not enough - you need Integer(#my.o2). You should also make corresponding changes in your code.
Since your code is difficult to debug I have written a simple demo to give an idea of necessary code changes:
type
PObject = ^TObject;
procedure FreeObj(PObj: PObject);
var
Temp: TObject;
begin
Temp:= PObj^;
PObj^:= nil;
Temp.Free;
end;
procedure TForm17.Button1Click(Sender: TObject);
var
Obj: TList;
PObj: PObject;
begin
Obj:= TList.Create;
PObj:= #Obj;
Assert(Obj <> nil);
FreeObj(PObj);
Assert(Obj = nil);
end;
Here's what's going on:
Program starts. Initialization runs and sends a message to the thread, which calls FreeAndNil on the reference that gets passed in. This sets the reference that gets passed in to nil, but it does not set the object field holding o2 to nil. That's a different reference.
Then in the destructor, since the field isn't nil, it tries to free it again and you get a double-free error (invalid pointer operation exception). Since you raised an exception in the destructor, the TMyClass never gets destroyed and you get a memory leak from it.
If you want to do this right, pass an identifier of some type to FreeMyObject instead of a reference. Like an integer 2, or a string o2. Then have FreeMyObject use this value to look up what it should be calling FreeAndNil on. (If you have Delphi 2010 or later, that's pretty easy to do with RTTI.) It's a little more work, but it will fix the errors you're seeing.

Resources