The pascal code in components/freetype/ttcache.pas is one of the weirdest I've seen so far. It has a couple of functions that return TError, where TError type is defined as boolean. The boolean values used are not the traditional true and false, instead of them Success and Failure are used, where:
const
Success = False;
Failure = True;
As you can see, it's like when you think of yes you have to write no, and when you think of no you have to write yes. This uncommon usage of boolean values is prone to easily insert bugs.
I've noticed that running an empty form in Linux-customdrawn with heaptrc unit the console writes about a memory leak at line "Alloc( element, sizeof(TList_Element) );" in function Element_New : PList_Element. Following the trail I've looked at the following code:
function Cache_New( var cache : TCache;
var new_object : Pointer;
parent_data : Pointer ) : TError;
var
error : TError;
current : PList_Element;
obj : Pointer;
label
Fail;
begin
Result := False;
(* LOCK *)
current := cache.idle;
if current <> nil then
begin
cache.idle := current^.next;
dec( cache.idle_count )
end;
(* UNLOCK *)
if current = nil then
begin
(* if no object was found in the cache, create a new one *)
obj:=nil;
if Alloc( obj, cache.clazz^.object_size ) then exit;
current := Element_New;
if current = nil then goto Fail;
current^.data := obj;
error := cache.clazz^.init( obj, parent_data );
if error then goto Fail;
end;
(* LOCK *)
current^.next := cache.active;
cache.active := current;
(* UNLOCK *)
new_object := current^.data;
Cache_New := Success;
exit;
Fail:
Free( obj );
Cache_New := Failure;
end;
Notice that the first line is "Result := False;". This line increases the confusion because mixing false with Failure(true) and Success(false) in the same routine is clearely a bad idea, making the code even harder to understand. I've removed this line by replacing "if Alloc( obj, cache.clazz^.object_size ) then exit;" with "if Alloc( obj, cache.clazz^.object_size ) then goto Fail;"; In the original code, if Alloc would have returned Failure(true) the function would have exited with a false(Success) result, which was obviously a bug.
2/2 Got back to the memory leak. I've noticed that if Alloc( obj, cache.clazz^.object_size ) = Success(false) and later if error = Failure(true) then the memory allocated at "current := Element_New;" will never be freed. For this reason I've added "Element_Done( current );" before "goto Fail;". I think somebody should double check that Element_Done is enough. "Free( current );" is safer but it might remove a cache entry.
The above two changes didn't stop the memory leak but I think the code of the function is better.
If you agree with the changes, here is a patch.
diff --git a/components/freetype/ttcache.pas b/components/freetype/ttcache.pas
index f6a4e78549..810ecb2fc7 100644
--- a/components/freetype/ttcache.pas
+++ b/components/freetype/ttcache.pas
@@ -298,7 +298,6 @@ var
label
Fail;
begin
- Result := False;
(* LOCK *)
current := cache.idle;
if current <> nil then
@@ -312,7 +311,7 @@ var
begin
(* if no object was found in the cache, create a new one *)
obj:=nil;
- if Alloc( obj, cache.clazz^.object_size ) then exit;
+ if Alloc( obj, cache.clazz^.object_size ) then goto Fail;
current := Element_New;
if current = nil then goto Fail;
@@ -320,7 +319,11 @@ var
current^.data := obj;
error := cache.clazz^.init( obj, parent_data );
- if error then goto Fail;
+ if error then
+ begin
+ Element_Done( current );
+ goto Fail;
+ end;
end;
(* LOCK *)
Recent
