re PR fortran/78814 (ICE in symbol_rank, at fortran/interface.c:1265)

2017-11-09  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/78814
	* interface.c (symbol_rank): Check for NULL pointer.

2017-11-09  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/78814
	* gfortran.dg/interface_40.f90: New testcase.

From-SVN: r254604

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6c9f246..9be20c8 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2017-11-09  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/78814
+       * interface.c (symbol_rank): Check for NULL pointer.
+
 2017-11-08  Steven G. Kargl  <kargl@kgcc.gnu.org>
 
        PR Fortran/82841

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 9f0fcc8..1b7ebf5 100644 (file)
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1262,8 +1262,13 @@ generic_correspondence (gfc_formal_arglist *f1, gfc_formal_arglist *f2,
 static int
 symbol_rank (gfc_symbol *sym)
 {
-  gfc_array_spec *as;
-  as = (sym->ts.type == BT_CLASS) ? CLASS_DATA (sym)->as : sym->as;
+  gfc_array_spec *as = NULL;
+
+  if (sym->ts.type == BT_CLASS && CLASS_DATA (sym) && CLASS_DATA (sym)->as)
+    as = CLASS_DATA (sym)->as;
+  else
+    as = sym->as;
+
   return as ? as->rank : 0;
 }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a38d19f..7ee000b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2017-11-09  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/78814
+       * gfortran.dg/interface_40.f90: New testcase.
+
 2017-11-09  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gnat.dg/controlled2.adb, gnat.dg/controlled4.adb,

diff --git a/gcc/testsuite/gfortran.dg/interface_40.f90 b/gcc/testsuite/gfortran.dg/interface_40.f90
new file mode 100644 (file)
index 0000000..085c6b3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_40.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! PR fortran/78814
+! Code contributed by Gerhard Steinmetz
+program p
+   class(*) :: x  ! { dg-error " must be dummy, allocatable or pointer" }
+   print *, f(x)
+end
+