Forum > LCL
Improvement of function Cache_New in components/freetype/ttcache.pas
(1/1)
lagprogramming:
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:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---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:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} --- 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; 1/2 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.
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---diff --git a/components/freetype/ttcache.pas b/components/freetype/ttcache.pasindex 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 *)
Leledumbo:
This is where you should file this: https://gitlab.com/freepascal.org/fpc/source/-/issues
let the maintainers decide there.
AlexTP:
Posted to bugtracker,
https://gitlab.com/freepascal.org/lazarus/lazarus/-/issues/40202
marcov:
Please repeat anything in the bugtracker, and don't just post a link to the forum in the bugtracker.
AlexTP:
Repeated.
Navigation
[0] Message Index