paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 06:49:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

* also generate an implicit exception frame in case only the function

Browse Source 
result is refcounted, since it may need to be finalized in case of
    an exception (mantis #9385)

git-svn-id: trunk@8347 -
This commit is contained in:
Jonas Maebe 2007-09-01 14:18:09 +00:00
parent 2d8d8b1cac
commit 12575526da
3 changed files with 31 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -8398,6 +8398,7 @@ tests/webtbs/tw9347.pp svneol=native#text/plain
tests/webtbs/tw9347a.pp svneol=native#text/plain tests/webtbs/tw9347a.pp svneol=native#text/plain
tests/webtbs/tw9347b.pp svneol=native#text/plain tests/webtbs/tw9347b.pp svneol=native#text/plain
tests/webtbs/tw9384.pp svneol=native#text/plain tests/webtbs/tw9384.pp svneol=native#text/plain
tests/webtbs/tw9385.pp svneol=native#text/plain
tests/webtbs/ub1873.pp svneol=native#text/plain tests/webtbs/ub1873.pp svneol=native#text/plain
tests/webtbs/ub1883.pp svneol=native#text/plain tests/webtbs/ub1883.pp svneol=native#text/plain
tests/webtbs/uw0555.pp svneol=native#text/plain tests/webtbs/uw0555.pp svneol=native#text/plain

3
compiler/psub.pas
View File

@ -156,9 +156,10 @@ implementation
procedure check_finalize_locals(p:TObject;arg:pointer); procedure check_finalize_locals(p:TObject;arg:pointer);
begin begin
{ include the result: it needs to be finalized in case an exception }
{ occurs }
if (tsym(p).typ=localvarsym) and if (tsym(p).typ=localvarsym) and
(tlocalvarsym(p).refs>0) and (tlocalvarsym(p).refs>0) and
not(vo_is_funcret in tlocalvarsym(p).varoptions) and
not(is_class(tlocalvarsym(p).vardef)) and not(is_class(tlocalvarsym(p).vardef)) and
tlocalvarsym(p).vardef.needs_inittable then tlocalvarsym(p).vardef.needs_inittable then
include(current_procinfo.flags,pi_needs_implicit_finally); include(current_procinfo.flags,pi_needs_implicit_finally);

28
tests/webtbs/tw9385.pp Normal file
View File

@ -0,0 +1,28 @@
{ %opt=-gh }
program resultmemleak;
{$ifdef FPC}{$mode objfpc}{$h+}{$INTERFACES CORBA}{$endif}
{$ifdef mswindows}{$apptype console}{$endif}
//compile with -gh
uses
{$ifdef FPC}{$ifdef linux}cthreads,{$endif}{$endif}
sysutils;
type
integerarty = array of integer;
function testproc: integerarty;
begin
setlength(result,100);
raise exception.create('');
end;
var
ar1: integerarty;
begin
HaltOnNotReleased := true;
try
ar1:= testproc;
except
end;
end.