re PR fortran/83567 (Parametrized derived types: Segmentation fault when assigning...

2017-12-28  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/83567
	* trans-expr.c (gfc_trans_assignment_1): Free parameterized
	components of the lhs if dealloc is set.
	*trans-decl.c (gfc_trans_deferred_vars): Do not free the
	parameterized components of function results on leaving scope.

2017-12-28  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/83567
	* gfortran.dg/pdt_26.f90 : New test.

From-SVN: r256019

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 91771e0d6699a74a331e654d3fe55efd8727113d..3f3dc3ee23a9122b679ac16aed591f234efc56a9 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2017-12-28  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/83567
+       * trans-expr.c (gfc_trans_assignment_1): Free parameterized
+       components of the lhs if dealloc is set.
+       *trans-decl.c (gfc_trans_deferred_vars): Do not free the
+       parameterized components of function results on leaving scope.
+
 2017_12_27  Louis Krupp  <louis.krupp@zoho.com>
 
        PR fortran/83092

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index ada38b894c4176b810da31532d82dc8fdadc33e6..35dee6107cc50c3a6991c51ead25cf36960846ce 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -4344,9 +4344,12 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
                                           sym->as ? sym->as->rank : 0,
                                           sym->param_list);
              gfc_add_expr_to_block (&tmpblock, tmp);
-             tmp = gfc_deallocate_pdt_comp (sym->ts.u.derived,
-                                            sym->backend_decl,
-                                            sym->as ? sym->as->rank : 0);
+             if (!sym->attr.result)
+               tmp = gfc_deallocate_pdt_comp (sym->ts.u.derived,
+                                              sym->backend_decl,
+                                              sym->as ? sym->as->rank : 0);
+             else
+               tmp = NULL_TREE;
              gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock), tmp);
            }
          else if (sym->attr.dummy)
@@ -4376,8 +4379,11 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
                                           sym->param_list);
              gfc_add_expr_to_block (&tmpblock, tmp);
              tmp = gfc_class_data_get (sym->backend_decl);
-             tmp = gfc_deallocate_pdt_comp (data->ts.u.derived, tmp,
-                                            data->as ? data->as->rank : 0);
+             if (!sym->attr.result)
+               tmp = gfc_deallocate_pdt_comp (data->ts.u.derived, tmp,
+                                              data->as ? data->as->rank : 0);
+             else
+               tmp = NULL_TREE;
              gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock), tmp);
            }
          else if (sym->attr.dummy)

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 2ba5c405cf7835638be01bfa9b7d3420f85b81fc..30151dd9fa4048b71b07dd1f36ad207323d9d8c4 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -10076,6 +10076,28 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
          gfc_trans_runtime_check (true, false, cond, &loop.pre,
                                   &expr1->where, msg);
        }
+
+      /* Deallocate the lhs parameterized components if required.  */ 
+      if (dealloc && expr2->expr_type == EXPR_FUNCTION)
+       {
+         if (expr1->ts.type == BT_DERIVED
+             && expr1->ts.u.derived
+             && expr1->ts.u.derived->attr.pdt_type)
+           {
+             tmp = gfc_deallocate_pdt_comp (expr1->ts.u.derived, lse.expr,
+                                            expr1->rank);
+             gfc_add_expr_to_block (&lse.pre, tmp);
+           }
+         else if (expr1->ts.type == BT_CLASS
+                  && CLASS_DATA (expr1)->ts.u.derived
+                  && CLASS_DATA (expr1)->ts.u.derived->attr.pdt_type)
+           {
+             tmp = gfc_class_data_get (lse.expr);
+             tmp = gfc_deallocate_pdt_comp (CLASS_DATA (expr1)->ts.u.derived,
+                                            tmp, expr1->rank);
+             gfc_add_expr_to_block (&lse.pre, tmp);
+           }
+       }
     }
 
   /* Assignments of scalar derived types with allocatable components

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f8fcc47ad7a0ab829e5aac4a476fe299131a0e87..2e69175084c42ace2b94d1246404d9ac8311a0bb 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2017-12-28  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/83567
+       * gfortran.dg/pdt_26.f90 : New test.
+
 2017_12_27  Louis Krupp  <louis.krupp@zoho.com>
 
        PR fortran/83092

diff --git a/gcc/testsuite/gfortran.dg/pdt_26.f03 b/gcc/testsuite/gfortran.dg/pdt_26.f03
new file mode 100644 (file)
index 0000000..a4819b0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_26.f03
@@ -0,0 +1,46 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+!
+! Test the fix for PR83567 in which the parameterized component 'foo' was
+! being deallocated before return from 'addw', with consequent segfault in 
+! the main program.
+!
+! Contributed by Berke Durak  <berke.durak@gmail.com>
+! The function 'addvv' has been made elemental so that the test can check that
+! arrays are correctly treated and that no memory leaks occur.
+!
+module pdt_m
+  implicit none
+  type :: vec(k)
+     integer, len :: k=3
+     integer :: foo(k)=[1,2,3]
+  end type vec
+contains
+  elemental function addvv(a,b) result(c)
+    type(vec(k=*)), intent(in) :: a
+    type(vec(k=*)), intent(in) :: b
+    type(vec(k=a%k)) :: c
+
+    c%foo=a%foo+b%foo
+  end function
+end module pdt_m
+
+program test_pdt
+  use pdt_m
+  implicit none
+  type(vec) :: u,v,w, a(2), b(2), c(2)
+  integer :: i
+
+  u%foo=[1,2,3]
+  v%foo=[2,3,4]
+  w=addvv(u,v)
+  if (any (w%foo .ne. [3,5,7])) call abort
+  do i = 1 , a(1)%k
+    a%foo(i) = i + 4
+    b%foo(i) = i + 7
+  end do
+  c = addvv(a,b)
+  if (any (c(1)%foo .ne. [13,15,17])) call abort
+end program test_pdt
+! { dg-final { scan-tree-dump-times "__builtin_free" 8 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_malloc" 7 "original" } }