mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-23 14:11:05 +08:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Steven G. Kargl 2019-08-13 20:10:25 +00:00
parent d308419c64
commit 34342ea3f9
4 changed files with 45 additions and 3 deletions
gcc
fortran
ChangeLogmisc.c
testsuite
ChangeLog
gfortran.dg
pr88072.f90

6
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

6
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);

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

30
gcc/testsuite/gfortran.dg/pr88072.f90 Normal file

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