TADOConnection.Execute function returns a _Recordset.
I am currently using this code for simplicity (1):
V := ADOConnection1.Execute(SQL).Fields[0].Value;
I know that the recordset is never empty so no worry about BOF.
Now I can write it like this with a local _Recordset variable (2).
var
rs: _Recordset;
rs := ADOConnection1.Execute(SQL);
V := rs.Fields[0].Value;
A bit more code.
Now my question is: since the _Recordset is an interface variable returned by Execute function, would it be correctly released if I'm not using a local rs variable (1)? is using my simplified code (1) safe and could there be a reference count issue here?
I would like to get some insights about this issue please.
EDIT: My question is specific to the case:
V := ADOConnection1.Execute(SQL).Fields[0].Value
where I do not have a local variable reference to _Recordset.
Try this: Create a procedure that contains the single line
V := AdoConnection1.Execute(Sql).Fields[0].Value;
, put a breakpoint on it run the app and view the disassembly. You'll see that just before the line
jmp #HandleFinally
there are three calls to
call #IntfClear
That's the compiler releasing the three interfaces it has had to access in order to execute the statement, namely
the RecordSet interface returned by AdoConnection1.Execute(),
the Fields interface of that RecordSet, and
the particular Field interface obtained via Fields[0].
So, it has automatically generated the code necessary to free up these interfaces after executing the source statement.
The following is an imperfect analogy but its disassembly is much easier to follow; it illustrates the code the compiler automatically generates to deal with finalizing interfaces.
Given
type
IMyInterface = interface
function GetValue : Integer;
end;
TMyClass = class(TInterfacedObject, IMyInterface)
function GetValue : Integer;
destructor Destroy; override;
end;
TForm1 = class(TForm)
[...]
procedure Button1Click(Sender: TObject);
end;
destructor TMyClass.Destroy;
begin
inherited;
end;
function TMyClass.GetValue: Integer;
begin
Result := 1;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
I : IMyInterface;
begin
I := TMyClass.Create;
Caption := IntToStr(I.GetValue);
end;
the CPU disassembly of Button1Click looks like this
and the line arrowed red is where the interface is cleared despite the source code
not doing anything explicit to do this. Put a breakpoint on the
inherited
in TMyClass.Destroy and you'll find that also gets called, again despite the
source code not explicitly calling it.
Like I said, the above is an imperfect analogy. An interesting thing is that for the horrific (from the pov of the usage of the "with" construct) alternative
procedure TForm1.Button1Click(Sender: TObject);
begin
with IMyInterface(TMyClass.Create) do
Caption := IntToStr(GetValue);
end;
which uses no (explicit) local variable, the compiler generates the exact same code as the disassembly illustrated.
Of course, the situation in the q is slightly different because the memory allocated to the recordset object is on the other side of the Ado COM interface, so one has no control over whether that memory is correctly de-allocated beyond the fact that the compiler will generate the code to call _Release on the interface to it.
Related
I experienced a RTTI-related problem in Delphi 10.2 Update 2 and was able to track it down to a fewer amount of code (see below).
I have some TPersistent-descendant class TMyObj that publishes a property of type TArray<Integer>. When I recieve its value via GetDynArrayProp() and query its size via DynArraySize() this works only up to a size of exactly 649 elements. Above this special count some very big size value is returned.
Note, that my array is generated from an instance of TDictionary<Integer,Boolean>'s Keys property with its very own ToArray method.
I also tried to modify TMyObj.GetDynArray so that it returns a instance of TArray<Integer> directly and it worked correctly.
Thus, I think that could correlate in some mystical way.
What is wrong with my use of DynArraySize()? What's behind this mystical behaviour of dynamic arrays?
program RTTIPropDynArray;
{$APPTYPE CONSOLE}
uses
System.Classes, System.Generics.Collections, System.SysUtils, System.TypInfo;
type
TMyDict = TDictionary<Integer,Boolean>;
TMyArray = TArray<Integer>;
TMyObj = class(TPersistent)
private
FValues: TMyDict;
function GetDynArray: TMyArray;
public
constructor Create(const ACount: Integer);
destructor Destroy; override;
published
property DynArray: TMyArray read GetDynArray;
end;
{ TMyObj }
constructor TMyObj.Create(const ACount: Integer);
begin
FValues := TMyDict.Create;
while FValues.Count < ACount do
FValues.AddOrSetValue(Random(MaxInt), False);
end;
destructor TMyObj.Destroy;
begin
FreeAndNil(FValues);
inherited;
end;
function TMyObj.GetDynArray: TMyArray;
begin
Result := FValues.Keys.ToArray;
end;
function Test(const ACount: Integer): Boolean;
var
LInstance: TMyObj;
LExpectedSize: Integer;
LDynArraySize: Integer;
begin
LInstance := TMyObj.Create(ACount);
try
LExpectedSize := Length(LInstance.DynArray);
LDynArraySize := DynArraySize(GetDynArrayProp(LInstance, 'DynArray'));
Result := LExpectedSize = LDynArraySize;
if not Result then
WriteLn(Format('Expected size: %d; DynArraySize: %d', [LExpectedSize, LDynArraySize]));
finally
LInstance.Free;
end;
end;
var
LCount: Integer;
begin
Randomize;
LCount := 1;
while Test(LCount) do
Inc(LCount);
ReadLn;
end.
Short answer: Your code is broken
Long answer:
The call to the getter is creating a new array (see TEnumerable<T>.ToArrayImpl in System.Generics.Collections.pas) which is being deallocated in the epilogue of System.TypInfo.GetDynArrayProp (put a breakpoint there and look into the disassembler - it shows #DynArrayClear). Since there is no other reference to this array its memory gets deallocated (if you step into System.pas further you will see that it eventually ends up in _FreeMem). That means every call to this function is returning a dangling pointer!
Now why do you get correct results in all prior calls? Coincidence - the memory has not been reallocated by anything else.
Two possible solutions come into mind that don't involve rewriting the getter:
use the RTTI from System.Rtti.pas as TValue keeps the reference alive
write your own version of GetDynArrayProp that keeps the reference alive - but you have to make sure to always call DynArrayClear after or you create memory leaks
Personally I would use the first one.
I have this piece of working code using AsyncCalls 2.99 in the modified version by Zarko Gajic:
function TForm1.DoIt(i:integer):integer;
begin
end;
procedure TForm1.Main;
//-------------------------------------------------------
procedure CallIt;
begin
TAsyncCalls.Invoke(
procedure
var i:integer;
begin
For i := 0 to 10 do
If i < 11
then TAsyncCalls.Invoke<integer>(DoIt,i));
end);
end;
//-------------------------------------------------------
begin
CallIt;
end;
Now I would like to move the function DoIt into Main to be a nested function next to CallIt:
procedure TForm1.Main;
//-------------------------------------------------------
function DoIt(i:integer):integer;
begin
end;
//-------------------------------------------------------
procedure CallIt;
begin
TAsyncCalls.Invoke(
procedure
var i:integer;
begin
For i := 0 to 10 do
If i < 11
then TAsyncCalls.Invoke<integer>(DoIt,i));
end);
end;
//-------------------------------------------------------
begin
CallIt;
end;
The above code (naturally) does not work. As much as I unterstand Invoke requires a method as parameter and a nested function isn't one.
Invoke expects a TAsyncCallArgGenericMethod:
class function Invoke<T>(Event: TAsyncCallArgGenericMethod<T>; const Arg: T): IAsyncCall; overload; static;
TAsyncCallArgGenericMethod<T> = function(Arg: T): Integer of object;
I have already received a hint to convert the TAsyncCallArgGenericMethod into a reference:
TAsyncCallArgGenericMethod<T> = reference to function(Arg: T): Integer;
Although I have the general notion (i.e. illusion) that I understand the concept I have not been able to produce working code.
Now I would like to move the function DoIt into Main to be a nested function next to CallIt:
You can not call nested function from outside the function containing it - because nested functions need to access the outer(containing) function local variables, that only exists while executing code inside that containing function.
Even if the particular nested function does not evaluate their rights of accessing those local variables - it has those rights and the compiler should be able to produce all the lo-level scaffolding for that.
Specifically in your snippet, You can not call TForm1.Main.DoIt from outside of the TForm1.Main itself. So you can not take the reference to it and pass it to some external body like AsyncCall dispatcher.
It does not depend upon whether you would use procedure of object or reference to procedure or any other type - it is the fundamental property of nested function that they "exist" only locally to the containing function and only can be run when the outer function runs. AsyncCall would most probably try to run the function when TForm1.Main would be exited and thus its local variables stack frame required by TForm1.Main.DoIt would not exist.
You have to find some other way to "pack" those functions together, nested functions would not do here.
For example one may try using Advanced Records here.
Try to arrange it somehow like that:
type
TForm1 = class(TForm)
....
private
type Dummy = record
procedure CallIt;
procedure DoIt(const i:integer);
end;
end;
....
//-------------------------------------------------------
procedure TForm1.Dummy.CallIt;
begin
TAsyncCalls.Invoke(
procedure
var i:integer;
begin
For i := 0 to 10 do
If i < 11
then TAsyncCalls.Invoke<integer>(DoIt,i));
end);
end;
procedure TForm1.Dummy.DoIt(const i:integer);
begin
end;
procedure TForm1.Main;
var d: Dummy;
begin
d.CallIt;
end;
Also, I think your approach is wrong here: you would instantly form many-many threads exhausting your OS resources.
I would suggest you using OmniThreadLibrary instead, where there are hi-level Parallel-Loop and Collection-Pipeline concepts. They would give you benefit of automatic threads pool management, so you would only have so many worker threads as your CPU can bear, adapting your program to any hardware it would happen to run on.
I may also have the illusion that I understand these things (i.e. I may be wrong) so take this with a pinch of salt, but this is my take on it.
A nested function has access to all parameters available to the calling function (including self), but has no 'hidden' parameters (it doesn't need any). The class function on the other hand has a hidden parameter (called 'self') that the function accesses to find the object that is actually calling the function. Thus the signatures are totally different.
If you go back to the olden days when C++ was an interpreter, something like Fred.Main( x, y) in C++ would be translated to something like Main( Fred, x, y) in C. I only include this to illustrate how that hidden parameter works.
So the upshot is you can't do what you are trying to do because by moving DoIt inside your Main function, you are completely changing its signature, and indeed how it works.
I just couldn't leave it at that since for some reason I really had sunk my teeth into it. Now, here's a solution. Not a solution I would recommend, but a solution.
There has been a discussion here on stackoverflow some 4 years ago. David quoted the documentation and continued:
If I recall correctly, an extra, hidden, parameter is passed to nested functions with the pointer to the enclosing stack frame. This is omitted in 32 bit code if no reference is made to the enclosing environment.
Sertaç Akyüz apparently poked around in the assembler code and reported:
It's an implicit parameter alright! The compiler assumes it has its thing in 'rcx' and the parameters to the function are at 'rdx' and 'r8', while in fact there's no 'its thing' and the parameters are at 'rcx' and 'rdx'.
This seemed to finish the whole thing.
But then, there is this text: How to pass a nested routine as a procedural parameter (32 bit). A rather surprising title if you consider the documentation. This led to the following code:
{unit AsyncCalls;}
TAsyncCalls = class(TObject)
private
type
…
//TAsyncCallArgGenericMethod<T> = function(Arg: T): Integer of object;
TAsyncCallArgGenericMethod<T> = reference to function(Arg: T): Integer;
uses … ,AsyncCalls,AsyncCallsHelper;
procedure TForm1.Main;
//-------------------------------------------------------
function DoIt(i:integer):integer;
begin
Result := i;
end;
//-------------------------------------------------------
procedure CallIt;
var p:Pointer;
begin
p := #DoIt;
TAsyncCalls.Invoke(
procedure
var i:integer;
begin
For i := 0 to 10 do
If i < 11 then
AsyncHelper.AddTask(TAsyncCalls.Invoke<integer>(p,i));
end);
end;
//-------------------------------------------------------
begin
CallIt;
end;
This code works. As I mentioned before, I wouldn't recommend using it, but it works. I learned a lot in the course of finding a solution which I now consider the main benefit.
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.
I recently stumbled over a problem caused by some very old code I wrote which was obviously assuming that interface references used in a with statement would be released as soon as the with-block is left - kind of like an implicit try-finally-block (similar to C#'s using-statement if I understood correctly).
Apparently (in Delphi 2009) this is not (no longer?) the case. Does anyone know when this happened? Or was my code just plain wrong to begin with?
To clarify, here's a simplified example:
type
IMyIntf = interface;
TSomeObject = class(TInterfacedObject, IMyIntf)
protected
constructor Create; override; // creates some sort of context
destructor Destroy; override; // cleans up the context created in Create
public
class function GetMyIntf: IMyIntf; //a factory method, calling the constructor
end;
procedure TestIt;
begin
DoSomething;
with (TSomeObject.GetMyIntf) do
begin
DoStuff;
DoMoreStuff;
end; // <- expected: TSomeObject gets destroyed because its ref.count is decreased to 0
DoSomethingElse;
end; // <- this is where TSomeObject.Destroy actually gets called
Whenever somebody started the old "with is evil" argument this was always the one example I had in mind which kept me going "Yes, but...". Seems like I was wrong... Can anyone confirm?
The with preserved word in Pascal/Delphi is only used for easily accessing the members of records or objects/classes (i.e. in order not to mention the record's/object's/class's name). It's very different from the C# with that relates to garbage collection. It has existed in the Pascal language since the day records were born, to simplify code calling to many data members (back then simply called "fields").
To summarize, with has nothing to do with garbage collection, release of memory or destruction of object instances. Objects that are constructed at the with header could just have been initialized in a separate code line before, it's the same.
This WITH-behavior has never changed. To reach your expected behavior you can change your code in this way:
procedure TestIt;
var
myIntf: IMyIntf;
begin
DoSomething;
myIntf := TSomeObject.GetMyIntf
DoStuff;
DoMoreStuff;
myIntf := nil; // <- here is where TSomeObject.Destroy called
DoSomethingElse;
end;
or you can do it in procedure:
procedure TestIt;
procedure DoAllStuff;
var
myIntf: IMyIntf;
begin
myIntf := TSomeObject.GetMyIntf
DoStuff;
DoMoreStuff;
end; // <- here is where TSomeObject.Destroy called
begin
DoSomething;
DoAllStuff;
DoSomethingElse;
end;
What techniques exist to automatically free objects in delphi applications?
Use interfaces instead of objects. They are reference counted and freed automatically when the reference count reaches 0.
I have written a function GC(obj: TObject) (for Garbage Collect) which takes an object and frees it when the execution leaves the current method. It's kind of like a one-line shorthand function for a Try Finally Free block.
Instead of:
procedure Test;
var AQuery: TQuery;
begin
AQuery := TQuery.Create(nil);
try
...
finally
FreeAndNil(AQuery);
end;
end;
I just have:
procedure Test;
var AQuery: TQuery;
begin
AQuery := TQuery.Create(nil);
GC(AQuery);
...
end;
The GC function simply returns an object in the form of an interface.
function GC(obj: TObject): IGarbo;
begin
Result := TGarbo.Create(obj);
end;
Because the TGarbo class descends from TInterfacedObject, when the TGarbo object goes out of scope it will automatically get freed. In the destructor of the TGarbo object, it also frees the object you passed to it in it's constructor (the object you passed in the GC function).
type
IGarbo = interface
['{A6E17957-C233-4433-BCBD-3B53C0C2C596}']
function Obj: TObject;
end;
TGarbo = class(TInterfacedObject, IGarbo)
private
FObj: TObject;
public
constructor Create(AObjectToGC: TObject);
destructor Destroy; override;
function Obj: TObject;
end;
{ TGarbo }
constructor TGarbo.Create(AObjectToGC: TObject);
begin
inherited Create;
FObj := AObjectToGC;
end;
destructor TGarbo.Destroy;
begin
if Assigned(FObj) then
FreeAndNil(FObj);
inherited;
end;
function TGarbo.Obj: TObject;
begin
Result := FObj;
end;
Being stuck in the world of Delphi 7 with no sight of upgrading to a version of Delphi with built-in garbage collection in the near future, I'm addicted to using this short-hand method of easily freeing local temporary objects! :)
Along the lines of interfaces, you can try the Guard function in the JclSysUtils unit, part of the free Jedi Code Library. It allows you to associate an object with a separate interface reference, so when that interface reference is destroyed, the object is destroyed along with it. This can be useful when you don't have the option of modifying the classes you're using to make them support interfaces of their own.
var
G: ISafeGuard;
foo: TStrings;
begin
// Guard returns TObject, so a type-cast is necessary
foo := Guard(TStringList.Create, G) as TStrings;
// Use the object as normal
foo.Add('bar');
end; // foo gets freed automatically as G goes out of scope
There are overloads for objects and GetMem-allocated pointers. There is also IMultiSafeGuard, which can ensure that multiple objects get freed.
If you have a factory function, you might be creating an object, setting some of its properties, and then returning it. If an exception occurs while setting the properties, you'll want to make sure you free the object since you can't return it. One way to do that is like this:
function Slurp(const source: TFileName): TStrings;
begin
Result := TStringList.Create;
try
Result.LoadFromFile(source);
except
Result.Free;
raise;
end;
end;
With Guard, it would become this:
function Slurp(const source: TFileName): TStrings;
var
G: ISafeGuard;
begin
Result := Guard(TStringList.Create, G) as TStrings;
Result.LoadFromFile(source);
G.ReleaseItem;
end;
The ReleaseItem method revokes the ISafeGuard's ownership of the object. If an exception occurs before that happens, then as the stack unwinds and the interface is released, the guard will free the object.
I have to say, I don't like "hiding" the Free of an object. Far better to have the traditional code:
MyObject := TObject.Create;
try
// do stuff
finally
FreeAndNil(MyObject);
end;
No way it can go wrong, works as expected, and people recognise the pattern.
Use the object ownership of components that the VCL provides. As long as you create objects with a non-nil owner you don't need to free them explicitely. See also my answer to this question.
Here is the API for Boehm Garbage Collector DLL for Delphi. The Delphi API is written by Barry Kelly, who works for CodeGear writing the compiler now.
Smart Pointers work really well if you have Delphi 2009.
If you use Delphi for .Net / Delphi Prism you get Garbage Collection which takes care of all the freeing.