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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f858e91754f6c1d04eefb0b025e9f7a3f10bee4a..954e80b260b9b27aa087be0797d29285dc897ac1 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.
+
 2019-08-13  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        Backport from trunk

diff --git a/gcc/fortran/misc.c b/gcc/fortran/misc.c
index ec31fb93cd2d7d221e430dc6a4c293bcfd7fa41f..809f2e0767471b09ff70eec699588cd769e258a5 100644 (file)
--- a/gcc/fortran/misc.c
+++ b/gcc/fortran/misc.c
@@ -125,6 +125,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;
@@ -156,9 +157,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 a68c73e92428ee86c86dfea3d75ca076bbf5deb5..187467d470135c343f0afa44276d78d7540123e2 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  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        Backport from trunk

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

diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_28.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_28.f90
index b474a243233d997a13952c64677037c2d04f605b..a9f67273d5ed08aea48ca3a7e1551bca57997263 100644 (file)
--- a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_28.f90
+++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_28.f90
@@ -21,7 +21,7 @@ implicit none
 
   type,abstract,extends(c_base) :: c_derived
   contains
-    procedure :: f_base => f_derived ! { dg-error "Type mismatch in function result \\(CLASS\\(\\*\\)/CLASS\\(c_base\\)\\)" }
+    procedure :: f_base => f_derived ! { dg-error "Type mismatch in function result" }
   end type c_derived
 
 contains