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: r220654

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a884220f21ff1f585bbd2cea48e15b27dca31b69..bff0cb6454ae3b134ca1a9a03f56ab5b587f7080 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+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-08  Mikael Morin  <mikael@gcc.gnu.org>
 
        PR fortran/63744

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 7e0e856b0d02057c429d28eeb2663fcee83980b9..505f9052cf693ce779bfa90f1a41d0207572cf15 100644 (file)
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5575,11 +5575,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;
@@ -5590,13 +5592,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 3cb5af0c8ac636297b30a1c1c7e39737bb30884e..ef26e99d2d23622011d7b0f1b7be1a2273dfc5ca 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2015-02-12  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/64932
+       * gfortran.dg/finalize_28.f90: New test
+
 2015-02-12  Jakub Jelinek  <jakub@redhat.com>
 
        PR debug/55541

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" } }