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 08908d26d92bf38fdd03e4edf8249a1dcf951515..787c704cafc4b05928489093b6902325a7811432 100644 (file)
--- 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 2569f6bfdfc776f7385eb79a0b1354099bbd8f0b..eed203dee024a4c5b414e6893d42500d72fee5d3 100644 (file)
--- 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 58577092480e2b4baf8d7dd82c45c2d4d7d400d7..00785812a8eb6a71870cf9acb93a66b7d37e7abd 100644 (file)
--- 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 (file)
index 0000000..5bc6af4
--- /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