2011-02-09 Janus Weil <janus@gcc.gnu.org>

	PR fortran/47637
	* trans-decl.c (init_intent_out_dt): Handle CLASS arguments.

2011-02-09  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/47637
	* gfortran.dg/auto_dealloc_2.f90: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@169978 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index cebbe36..14ae30f 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2011-02-09  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/47637
+       * trans-decl.c (init_intent_out_dt): Handle CLASS arguments.
+
 2011-02-08  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        * io.c (match_io_element): Do not set dt if not inquire.

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index fb2f9a8..793b262 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3192,6 +3192,32 @@ init_intent_out_dt (gfc_symbol * proc_sym, gfc_wrapped_block * block)
        else if (f->sym->value)
          gfc_init_default_dt (f->sym, &init, true);
       }
+    else if (f->sym && f->sym->attr.intent == INTENT_OUT
+            && f->sym->ts.type == BT_CLASS
+            && !CLASS_DATA (f->sym)->attr.class_pointer
+            && CLASS_DATA (f->sym)->ts.u.derived->attr.alloc_comp)
+      {
+       tree decl = build_fold_indirect_ref_loc (input_location,
+                                                f->sym->backend_decl);
+       tmp = CLASS_DATA (f->sym)->backend_decl;
+       tmp = fold_build3_loc (input_location, COMPONENT_REF,
+                              TREE_TYPE (tmp), decl, tmp, NULL_TREE);
+       tmp = build_fold_indirect_ref_loc (input_location, tmp);
+       tmp = gfc_deallocate_alloc_comp (CLASS_DATA (f->sym)->ts.u.derived,
+                                        tmp,
+                                        CLASS_DATA (f->sym)->as ?
+                                        CLASS_DATA (f->sym)->as->rank : 0);
+
+       if (f->sym->attr.optional || f->sym->ns->proc_name->attr.entry_master)
+         {
+           present = gfc_conv_expr_present (f->sym);
+           tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp),
+                             present, tmp,
+                             build_empty_stmt (input_location));
+         }
+
+       gfc_add_expr_to_block (&init, tmp);
+      }
 
   gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
 }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7d0f60e..044dd3a 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2011-02-09  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/47637
+       * gfortran.dg/auto_dealloc_2.f90: New.
+
 2011-02-09  Rainer Orth  <ro@CeBiTec.Uni-Bielefeld.DE>
 
        * gcc.dg/builtins-config.h: Remove __sgi handling.

diff --git a/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90 b/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90
new file mode 100644 (file)
index 0000000..4cbda82
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR 47637: [OOP] Memory leak involving INTENT(OUT) CLASS argument w/ allocatable components
+!
+! Contributed by Rich Townsend <townsend@astro.wisc.edu>
+
+program test
+
+type :: t
+  integer, allocatable :: i(:)
+end type
+
+type(t) :: a
+
+call init(a)
+call init(a)
+
+contains
+
+  subroutine init(x)
+    class(t), intent(out) :: x
+    allocate(x%i(1000))
+  end subroutine
+
+end program 
+
+! { dg-final { scan-tree-dump-times "__builtin_free" 2 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }