{ %OPT=-gh } {$mode objfpc}{$h+} uses Classes; procedure Foo(a: array of integer); begin try writeln(a[0]); if a[0] = 1 then exit; writeln(a[0]); finally writeln(a[0]); end; end; procedure Bar(a: array of integer); safecall; begin try writeln(a[0]); if a[0] = 1 then exit; writeln(a[0]); finally writeln(a[0]); end; end; var memmgr, newmemmgr: TMemoryManager; FreeMemCalls: Longint; function HookFreeMem(ptr: Pointer): ptruint; begin Inc(FreeMemCalls); result := memmgr.FreeMem(ptr); end; begin GetMemoryManager(memmgr); newmemmgr := memmgr; newmemmgr.FreeMem := @HookFreeMem; SetMemoryManager(newmemmgr); FreeMemCalls:=0; foo([1]); if FreeMemCalls<>1 then halt(1); bar([1]); if FreeMemCalls<>2 then halt(2); end.