re PR fortran/66366 ([OOP] ICE on invalid with non-allocatable CLASS variable)

2016-11-13  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/66366
	* resolve.c (resolve_component): Move check for C437
	to ...
	* decl.c (build_struct): ... here. Fix indentation.

2016-11-13  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/66366
	* gfortran.dg/class_57.f90: Changed error message.
	* gfortran.dg/class_60.f90: New test.

From-SVN: r242351

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6e0b654eb0e32125b1fdaef97d803cb38de72c32..a9db062b4abc91c6b7d21bae244d30db7d03456b 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2016-11-13  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/66366
+       * resolve.c (resolve_component): Move check for C437
+       to ...
+       * decl.c (build_struct): ... here. Fix indentation.
+
 2016-11-12  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/77501

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index b17a8aa7da242cde3d0d4f454d4f989115c64bfa..4f5c0cfa4ac4c1cbb36b956a6d55fbd79159c116 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1866,9 +1866,18 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
        }
       else if (current_attr.allocatable == 0)
        {
-      gfc_error ("Component at %C must have the POINTER attribute");
-      return false;
+         gfc_error ("Component at %C must have the POINTER attribute");
+         return false;
+       }
     }
+
+  /* F03:C437.  */
+  if (current_ts.type == BT_CLASS
+      && !(current_attr.pointer || current_attr.allocatable))
+    {
+      gfc_error ("Component %qs with CLASS at %C must be allocatable "
+                 "or pointer", name);
+      return false;
     }
 
   if (gfc_current_block ()->attr.pointer && (*as)->rank != 0)

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index faf7dde41831abeafed0d59306282dd665b15a5a..c85525aabb9e557cc03367c3566257514819a797 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -13587,19 +13587,6 @@ resolve_component (gfc_component *c, gfc_symbol *sym)
       return false;
     }
 
-  /* C437.  */
-  if (c->ts.type == BT_CLASS && c->attr.flavor != FL_PROCEDURE
-      && (!c->attr.class_ok
-          || !(CLASS_DATA (c)->attr.class_pointer
-               || CLASS_DATA (c)->attr.allocatable)))
-    {
-      gfc_error ("Component %qs with CLASS at %L must be allocatable "
-                 "or pointer", c->name, &c->loc);
-      /* Prevent a recurrence of the error.  */
-      c->ts.type = BT_UNKNOWN;
-      return false;
-    }
-
   /* If an allocatable component derived type is of the same type as
      the enclosing derived type, we need a vtable generating so that
      the __deallocate procedure is created.  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 844b4b8bd32abe2a0e316665eac1c6dce7bf70cd..65fbaad34f9d8e1ce197497c3cf9f67125f22114 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2016-11-13  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/66366
+       * gfortran.dg/class_57.f90: Changed error message.
+       * gfortran.dg/class_60.f90: New test.
+
 2016-11-12  David Edelsohn  <dje.gcc@gmail.com>
 
        * g++.dg/pr78112.C: XFAIL AIX.

diff --git a/gcc/testsuite/gfortran.dg/class_57.f90 b/gcc/testsuite/gfortran.dg/class_57.f90
index 7256dfc4d2956f77b061e91513b1b2286969e46e..8104338672bee65638876db28fdbf3c12b3f1eed 100644 (file)
--- a/gcc/testsuite/gfortran.dg/class_57.f90
+++ b/gcc/testsuite/gfortran.dg/class_57.f90
@@ -18,7 +18,7 @@ contains
   function pc(pd)
     type(p) :: pc
     class(d), intent(in), target :: pd
-    pc%cc => pd   ! { dg-error "Non-POINTER in pointer association context" }
+    pc%cc => pd   ! { dg-error "is not a member of" }
   end function
 
 end

diff --git a/gcc/testsuite/gfortran.dg/class_60.f90 b/gcc/testsuite/gfortran.dg/class_60.f90
new file mode 100644 (file)
index 0000000..f51c483
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_60.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+!
+! PR 66366: [OOP] ICE on invalid with non-allocatable CLASS variable
+!
+! Contributed by Andrew Benson <abensonca@gmail.com>
+
+module bug
+
+  type :: t1d
+   contains
+     procedure :: interpolate => interp
+  end type t1d
+
+  type :: tff
+     class(t1d) :: transfer  ! { dg-error "must be allocatable or pointer" }
+  end type tff
+
+contains
+
+  double precision function interp(self)
+    implicit none
+    class(t1d), intent(inout) :: self
+    return
+  end function interp
+
+  double precision function fvb(self)
+    implicit none
+    class(tff), intent(inout) :: self
+    fvb=self%transfer%interpolate()  ! { dg-error "is not a member of" }
+    return
+  end function fvb
+
+end module bug