re PR fortran/61767 ([OOP] ICE in generate_finalization_wrapper at fortran/class...

2016-12-09  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/61767
	* class.c (has_finalizer_component): Fix this function to detect only
	non-pointer non-allocatable components which have a finalizer.

2016-12-09  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/61767
	* gfortran.dg/finalize_31.f90: New test.

From-SVN: r243483

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 23421639671f37ecc8f61c852e663a85e0281544..819f5ef915620a29180f3470ccca91d9652c01fe 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2016-12-09  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/61767
+       * class.c (has_finalizer_component): Fix this function to detect only
+       non-pointer non-allocatable components which have a finalizer.
+
 2016-12-09  Andre Vehreschild  <vehre@gcc.gnu.org>
 
        PR fortran/78505

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index e59b87cdeae3ff4e207979318e76052b3e01b271..1fba6c9307244e8b13fd26ea5fcba778d9178def 100644 (file)
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -841,20 +841,19 @@ has_finalizer_component (gfc_symbol *derived)
    gfc_component *c;
 
   for (c = derived->components; c; c = c->next)
-    {
-      if (c->ts.type == BT_DERIVED && c->ts.u.derived->f2k_derived
-         && c->ts.u.derived->f2k_derived->finalizers)
-       return true;
-
-      /* Stop infinite recursion through this function by inhibiting
-        calls when the derived type and that of the component are
-        the same.  */
-      if (c->ts.type == BT_DERIVED
-         && !gfc_compare_derived_types (derived, c->ts.u.derived)
-         && !c->attr.pointer && !c->attr.allocatable
-         && has_finalizer_component (c->ts.u.derived))
-       return true;
-    }
+    if (c->ts.type == BT_DERIVED && !c->attr.pointer && !c->attr.allocatable)
+      {
+       if (c->ts.u.derived->f2k_derived
+           && c->ts.u.derived->f2k_derived->finalizers)
+         return true;
+
+       /* Stop infinite recursion through this function by inhibiting
+         calls when the derived type and that of the component are
+         the same.  */
+       if (!gfc_compare_derived_types (derived, c->ts.u.derived)
+           && has_finalizer_component (c->ts.u.derived))
+         return true;
+      }
   return false;
 }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 49146a3b6b34be76f24b61ffc04f133507993888..3f1693671381f5a74335a4c3762a0d2ba72e96c2 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2016-12-09  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/61767
+       * gfortran.dg/finalize_31.f90: New test.
+
 2016-12-09  Andre Vehreschild  <vehre@gcc.gnu.org>
 
        PR fortran/78505

diff --git a/gcc/testsuite/gfortran.dg/finalize_31.f90 b/gcc/testsuite/gfortran.dg/finalize_31.f90
new file mode 100644 (file)
index 0000000..8817a4f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_31.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+!
+! PR 61767: [OOP] ICE in generate_finalization_wrapper at fortran/class.c:1491
+!
+! Contributed by <reubendb@gmail.com>
+
+module Communicator_Form
+  implicit none
+  type :: CommunicatorForm
+  contains
+    final :: Finalize
+  end type
+  type :: MessageTemplate
+    type ( CommunicatorForm ), pointer :: Communicator
+  end type
+contains
+  subroutine Finalize ( C )
+    type ( CommunicatorForm ) :: C
+    ! should not be called
+    call abort()
+  end subroutine
+end module
+
+program p
+  use Communicator_Form
+  implicit none
+  class ( MessageTemplate ), pointer :: M
+  allocate(M)
+  deallocate(M)
+end