re PR fortran/64932 (ICE in gfc_conv_descriptor_data_get for generated finalizer)

2015-02-12  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/64932
	* trans-stmt.c (gfc_trans_deallocate): If a component array
	expression is not a descriptor type and it is a derived type
	that has allocatable components and is not finalizable, then
	deallocate the allocatable components.

2015-02-12  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/64932
	* gfortran.dg/finalize_28.f90: New test

From-SVN: r220659

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f9509e6665a0fe1ebef8329a305eef9a93ef7775..bc101de669bd90dfe1265d300842f7447303c18e 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2015-02-12  Paul Thomas  <pault@gcc.gnu.org>
+
+       Backported from mainline
+       2015-02-12  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/64932
+       * trans-stmt.c (gfc_trans_deallocate): If a component array
+       expression is not a descriptor type and it is a derived type
+       that has allocatable components and is not finalizable, then
+       deallocate the allocatable components.
+
 2015-02-03  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        * intrinsic.texi (CO_ASSOCIATED): c_prt_1 should be c_ptr_1.

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 6d2db5ef70f69f6191e5e5845b4cf11a534d35ba..62a63d68fa6bd599c7df135a13ab5d0291020300 100644 (file)
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5458,11 +5458,13 @@ gfc_trans_deallocate (gfc_code *code)
 
       if (expr->rank || gfc_is_coarray (expr))
        {
+         gfc_ref *ref;
+
          if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp
              && !gfc_is_finalizable (expr->ts.u.derived, NULL))
            {
-             gfc_ref *ref;
              gfc_ref *last = NULL;
+
              for (ref = expr->ref; ref; ref = ref->next)
                if (ref->type == REF_COMPONENT)
                  last = ref;
@@ -5473,13 +5475,45 @@ gfc_trans_deallocate (gfc_code *code)
                    && !(!last && expr->symtree->n.sym->attr.pointer))
                {
                  tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, se.expr,
-                                                 expr->rank);
+                                                  expr->rank);
                  gfc_add_expr_to_block (&se.pre, tmp);
                }
            }
-         tmp = gfc_array_deallocate (se.expr, pstat, errmsg, errlen,
-                                     label_finish, expr);
-         gfc_add_expr_to_block (&se.pre, tmp);
+
+         if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)))
+           {
+             tmp = gfc_array_deallocate (se.expr, pstat, errmsg, errlen,
+                                         label_finish, expr);
+             gfc_add_expr_to_block (&se.pre, tmp);
+           }
+         else if (TREE_CODE (se.expr) == COMPONENT_REF
+                  && TREE_CODE (TREE_TYPE (se.expr)) == ARRAY_TYPE
+                  && TREE_CODE (TREE_TYPE (TREE_TYPE (se.expr)))
+                       == RECORD_TYPE)
+           {
+             /* class.c(finalize_component) generates these, when a
+                finalizable entity has a non-allocatable derived type array
+                component, which has allocatable components. Obtain the
+                derived type of the array and deallocate the allocatable
+                components. */
+             for (ref = expr->ref; ref; ref = ref->next)
+               {
+                 if (ref->u.c.component->attr.dimension
+                     && ref->u.c.component->ts.type == BT_DERIVED)
+                   break;
+               }
+
+             if (ref && ref->u.c.component->ts.u.derived->attr.alloc_comp
+                 && !gfc_is_finalizable (ref->u.c.component->ts.u.derived,
+                                         NULL))
+               {
+                 tmp = gfc_deallocate_alloc_comp
+                               (ref->u.c.component->ts.u.derived,
+                                se.expr, expr->rank);
+                 gfc_add_expr_to_block (&se.pre, tmp);
+               }
+           }
+
          if (al->expr->ts.type == BT_CLASS)
            gfc_reset_vptr (&se.pre, al->expr);
        }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a1ad4f381f0b2403ff8c948fca1f6de858e4900d..0e59a394c5c3b779fb04dd3f43cd88c3c371fa59 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2015-02-12  Paul Thomas  <pault@gcc.gnu.org>
+
+       Backported from mainline
+       2015-02-12  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/64932
+       * gfortran.dg/finalize_28.f90: New test
+
 2015-02-11  Jakub Jelinek  <jakub@redhat.com>
 
        Backported from mainline

diff --git a/gcc/testsuite/gfortran.dg/finalize_28.f90 b/gcc/testsuite/gfortran.dg/finalize_28.f90
new file mode 100644 (file)
index 0000000..03de5d0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_28.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Test the fix for PR64932.
+!
+! Reported by Daniel Shapiro  <shapero@uw.edu>
+!
+module coo_graphs
+  implicit none
+  type :: dynamic_array
+    integer :: length, capacity, min_capacity
+    integer, allocatable :: array(:)
+  end type
+  type :: coo_graph
+    type(dynamic_array) :: edges(2)
+    integer, private :: ne
+  end type coo_graph
+contains
+  subroutine coo_dump_edges(g, edges)
+    class(coo_graph), intent(in) :: g
+    integer, intent(out) :: edges(:,:)
+  end subroutine coo_dump_edges
+end module coo_graphs
+! { dg-final { scan-tree-dump-times "__builtin_free" 3 "original" } }