From 12575526da14c13132d772473fb76f19ee1e9397 Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Sat, 1 Sep 2007 14:18:09 +0000
Subject: [PATCH]   * also generate an implicit exception frame in case only
 the function     result is refcounted, since it may need to be finalized in
 case of     an exception (mantis #9385)

git-svn-id: trunk@8347 -
---
 .gitattributes         |  1 +
 compiler/psub.pas      |  3 ++-
 tests/webtbs/tw9385.pp | 28 ++++++++++++++++++++++++++++
 3 files changed, 31 insertions(+), 1 deletion(-)
 create mode 100644 tests/webtbs/tw9385.pp

diff --git a/.gitattributes b/.gitattributes
index bd915a63f6..f071c88518 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -8398,6 +8398,7 @@ tests/webtbs/tw9347.pp svneol=native#text/plain
 tests/webtbs/tw9347a.pp svneol=native#text/plain
 tests/webtbs/tw9347b.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/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain
diff --git a/compiler/psub.pas b/compiler/psub.pas
index c62caad691..32b08cd4ab 100644
--- a/compiler/psub.pas
+++ b/compiler/psub.pas
@@ -156,9 +156,10 @@ implementation
 
     procedure check_finalize_locals(p:TObject;arg:pointer);
       begin
+        { include the result: it needs to be finalized in case an exception }
+        { occurs                                                            }
         if (tsym(p).typ=localvarsym) and
            (tlocalvarsym(p).refs>0) and
-           not(vo_is_funcret in tlocalvarsym(p).varoptions) and
            not(is_class(tlocalvarsym(p).vardef)) and
            tlocalvarsym(p).vardef.needs_inittable then
           include(current_procinfo.flags,pi_needs_implicit_finally);
diff --git a/tests/webtbs/tw9385.pp b/tests/webtbs/tw9385.pp
new file mode 100644
index 0000000000..a0f7443417
--- /dev/null
+++ b/tests/webtbs/tw9385.pp
@@ -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.