re PR fortran/71894 ([OOP] ICE in gfc_add_component_ref, at fortran/class.c:227)

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

	PR fortran/71894
	* class.c (gfc_add_component_ref): Add safety checks to avoid ICE.

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

	PR fortran/71894
	* gfortran.dg/class_59.f90: New test.

From-SVN: r241993

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 499c3d4..6c39866 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2016-11-09  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/71894
+       * class.c (gfc_add_component_ref): Add safety checks to avoid ICE.
+
 2016-11-08  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/68440

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 400c22a..b7f68d2 100644 (file)
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -224,7 +224,8 @@ gfc_add_component_ref (gfc_expr *e, const char *name)
        break;
       tail = &((*tail)->next);
     }
-  if (derived->components->next->ts.type == BT_DERIVED &&
+  if (derived->components && derived->components->next &&
+      derived->components->next->ts.type == BT_DERIVED &&
       derived->components->next->ts.u.derived == NULL)
     {
       /* Fix up missing vtype.  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 888e9e2..43586a9 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2016-11-09  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/71894
+       * gfortran.dg/class_59.f90: New test.
+
 2016-11-09  Richard Biener  <rguenther@suse.de>
 
        PR tree-optimization/78007

diff --git a/gcc/testsuite/gfortran.dg/class_59.f90 b/gcc/testsuite/gfortran.dg/class_59.f90
new file mode 100644 (file)
index 0000000..e077ef8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_59.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+!
+! PR 71894: [OOP] ICE in gfc_add_component_ref, at fortran/class.c:227
+!
+! Contributed by Gerhard Steinmetz <gerhard.steinmetz.fortran@t-online.de>
+
+subroutine s1
+  type t
+    integer :: n
+  end type
+  type(t) :: x
+  class(t) :: y  ! { dg-error "must be dummy, allocatable or pointer" }
+  x = y
+end
+
+subroutine s2
+  type t
+  end type
+  class(t) :: x    ! { dg-error "must be dummy, allocatable or pointer" }
+  class(t), allocatable :: y
+  select type (y)
+  type is (t)
+    y = x
+  end select
+end