From: Steven G. Kargl <kargl@gcc.gnu.org>
Date: Tue, 13 Aug 2019 20:10:25 +0000 (+0000)
Subject: re PR fortran/88072 (gfortran crashes with an internal compiler error)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=34342ea3f96a82266a92386a97555b0d9bc51777;p=gcc.git

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
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 08908d26d92..787c704cafc 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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
diff --git a/gcc/fortran/misc.c b/gcc/fortran/misc.c
index 2569f6bfdfc..eed203dee02 100644
--- a/gcc/fortran/misc.c
+++ b/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);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 58577092480..00785812a8e 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+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.
diff --git a/gcc/testsuite/gfortran.dg/pr88072.f90 b/gcc/testsuite/gfortran.dg/pr88072.f90
new file mode 100644
index 00000000000..5bc6af498dc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr88072.f90
@@ -0,0 +1,30 @@
+! { 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