2013-12-14 Janus Weil <janus@gcc.gnu.org>

	PR fortran/59502
	* primary.c (gfc_match_varspec): Check for 'class_ok'.

2013-12-14  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/59502
	* gfortran.dg/class_57.f90: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@205990 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 197b890..9de1860 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,10 @@
 2013-12-14  Janus Weil  <janus@gcc.gnu.org>
 
+       PR fortran/59502
+       * primary.c (gfc_match_varspec): Check for 'class_ok'.
+
+2013-12-14  Janus Weil  <janus@gcc.gnu.org>
+
        PR fortran/59450
        * module.c (mio_expr): Handle type-bound function expressions.
 

diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index c9a26b0..089ed42 100644 (file)
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -2039,9 +2039,8 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
          if (m != MATCH_YES)
            return m;
        }
-      else if (component->ts.type == BT_CLASS
-              && CLASS_DATA (component)->as != NULL
-              && !component->attr.proc_pointer)
+      else if (component->ts.type == BT_CLASS && component->attr.class_ok
+              && CLASS_DATA (component)->as && !component->attr.proc_pointer)
        {
          tail = extend_ref (primary, tail);
          tail->type = REF_ARRAY;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7820c93..6579c8b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2013-12-14  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/59502
+       * gfortran.dg/class_57.f90: New.
+
 2013-12-14   H.J. Lu  <hongjiu.lu@intel.com>
 
        PR target/59492

diff --git a/gcc/testsuite/gfortran.dg/class_57.f90 b/gcc/testsuite/gfortran.dg/class_57.f90
new file mode 100644 (file)
index 0000000..7256dfc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_57.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+!
+! PR 59502: [OOP] ICE on invalid on pointer assignment to non-pointer CLASS
+!
+! Contributed by Andrew Benson <abensonca@gmail.com>
+
+  implicit none
+
+  type :: d
+  end type
+
+  type :: p
+    class(d) :: cc   ! { dg-error "must be allocatable or pointer" }
+  end type
+
+contains
+
+  function pc(pd)
+    type(p) :: pc
+    class(d), intent(in), target :: pd
+    pc%cc => pd   ! { dg-error "Non-POINTER in pointer association context" }
+  end function
+
+end