re PR fortran/88072 (gfortran crashes with an internal compiler error)

2019-08-13  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/88072
	* misc.c (gfc_typename): Do not point to something that ought not to 
	be pointed at.

2019-08-13  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/88072
	* gfortran.dg/pr88072.f90: New test.
	* gfortran.dg/unlimited_polymorphic_28.f90: Fix error message.

From-SVN: r274399

gcc/fortran/ChangeLog

+2019-08-13  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/88072
+	* misc.c (gfc_typename): Do not point to something that ought not to 
+	be pointed at.
+
 2013-08-13  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/90563

gcc/fortran/misc.c

@@ -128,6 +128,7 @@ gfc_typename (gfc_typespec *ts)
   static char buffer2[GFC_MAX_SYMBOL_LEN + 7];
   static int flag = 0;
   char *buffer;
+  gfc_typespec *ts1;
 
   buffer = flag ? buffer1 : buffer2;
   flag = !flag;
@@ -159,9 +160,8 @@ gfc_typename (gfc_typespec *ts)
       sprintf (buffer, "TYPE(%s)", ts->u.derived->name);
       break;
     case BT_CLASS:
-      if (ts->u.derived->components)
-	ts = &ts->u.derived->components->ts;
-      if (ts->u.derived->attr.unlimited_polymorphic)
+      ts1 = ts->u.derived->components ? &ts->u.derived->components->ts : NULL;
+      if (ts1 && ts1->u.derived && ts1->u.derived->attr.unlimited_polymorphic)
 	sprintf (buffer, "CLASS(*)");
       else
 	sprintf (buffer, "CLASS(%s)", ts->u.derived->name);

gcc/testsuite/ChangeLog

+2019-08-13  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/88072
+	* gfortran.dg/pr88072.f90: New test.
+	* gfortran.dg/unlimited_polymorphic_28.f90: Fix error message.
+
 2019-08-13  Iain Sandoe  <iain@sandoe.co.uk>
 
 	* obj-c++.dg/stubify-1.mm: Rename symbol stub option.

gcc/testsuite/gfortran.dg/pr88072.f90

+! { dg-do compile }
+! PR fortran/88072
+! Original code contributed by Andrew Wood <andrew at fluidgravity dot co.uk>
+module m1
+
+   implicit none
+
+   type, abstract, public :: t1
+      integer, dimension(:), allocatable :: i
+      contains
+         procedure(f1), deferred :: f
+   end type t1
+
+   type, extends(t1), public :: t2 ! { dg-error "must be ABSTRACT because" }
+      contains
+         procedure :: f => f2    ! { dg-error "mismatch for the overriding" }
+   end type t2
+
+   abstract interface
+      function f1(this)          ! { dg-error "must be dummy, allocatable or" }
+         import
+         class(t1) :: this
+         class(t1) :: f1
+      end function f1
+   end interface
+   contains
+      type(t2) function f2(this)
+         class(t2) :: this
+      end function f2
+end module m1