mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-13 16:41:19 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/78800 ([OOP] ICE in compare_parameter, at fortran/interface.c:2246)

Browse Source 
2016-12-15  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/78800
	* interface.c (compare_allocatable): Avoid additional errors on bad
	class declarations.
	(compare_parameter): Put the result of gfc_expr_attr into a variable,
	in order to avoid calling it multiple times. Exit early on bad class
	declarations to avoid ICE.

2016-12-15  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/78800
	* gfortran.dg/unlimited_polymorphic_27.f90: New test case.

From-SVN: r243691
This commit is contained in:
Janus Weil 2016-12-15 15:07:51 +01:00
parent 50a8a9413d
commit fec5ce2485
4 changed files with 40 additions and 9 deletions

9
gcc/fortran/ChangeLog

@ -1,3 +1,12 @@
2016-12-15 Janus Weil <janus@gcc.gnu.org>
PR fortran/78800
* interface.c (compare_allocatable): Avoid additional errors on bad
class declarations.
(compare_parameter): Put the result of gfc_expr_attr into a variable,
in order to avoid calling it multiple times. Exit early on bad class
declarations to avoid ICE.
2016-12-14 Martin Jambor <mjambor@suse.cz>
* trans-openmp.c: Include omp-general.h.

19
gcc/fortran/interface.c

@ -2075,13 +2075,13 @@ done:
static int
compare_allocatable (gfc_symbol *formal, gfc_expr *actual)
{
symbol_attribute attr;
if (formal->attr.allocatable
|| (formal->ts.type == BT_CLASS && CLASS_DATA (formal)->attr.allocatable))
{
attr = gfc_expr_attr (actual);
if (!attr.allocatable)
symbol_attribute attr = gfc_expr_attr (actual);
if (actual->ts.type == BT_CLASS && !attr.class_ok)
return 1;
else if (!attr.allocatable)
return 0;
}
@ -2237,6 +2237,10 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
return 0;
}
symbol_attribute actual_attr = gfc_expr_attr (actual);
if (actual->ts.type == BT_CLASS && !actual_attr.class_ok)
return 1;
if ((actual->expr_type != EXPR_NULL || actual->ts.type != BT_UNKNOWN)
&& actual->ts.type != BT_HOLLERITH
&& formal->ts.type != BT_ASSUMED
@ -2278,9 +2282,6 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
return 0;
}
if (!gfc_expr_attr (actual).class_ok)
return 0;
if ((!UNLIMITED_POLY (formal) || !UNLIMITED_POLY(actual))
&& !gfc_compare_derived_types (CLASS_DATA (actual)->ts.u.derived,
CLASS_DATA (formal)->ts.u.derived))
@ -2345,7 +2346,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
/* F2015, 12.5.2.8. */
if (formal->attr.dimension
&& (formal->attr.contiguous || formal->as->type != AS_ASSUMED_SHAPE)
&& gfc_expr_attr (actual).dimension
&& actual_attr.dimension
&& !gfc_is_simply_contiguous (actual, true, true))
{
if (where)
@ -2406,7 +2407,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
}
if (formal->attr.allocatable && !formal->attr.codimension
&& gfc_expr_attr (actual).codimension)
&& actual_attr.codimension)
{
if (formal->attr.intent == INTENT_OUT)
{

5
gcc/testsuite/ChangeLog

@ -1,3 +1,8 @@
2016-12-15 Janus Weil <janus@gcc.gnu.org>
PR fortran/78800
* gfortran.dg/unlimited_polymorphic_27.f90: New test case.
2016-12-15 Toma Tabacu <toma.tabacu@imgtec.com>
* gcc.target/mips/mips.exp (mips-dg-options): Upgrade to R2 for

16
gcc/testsuite/gfortran.dg/unlimited_polymorphic_27.f90 Normal file

@ -0,0 +1,16 @@
! { dg-do compile }
!
! PR 78800: [OOP] ICE in compare_parameter, at fortran/interface.c:2246
!
! Contributed by Gerhard Steinmetz <gerhard.steinmetz.fortran@t-online.de>
program p
type t
end type
class(*) :: z ! { dg-error "must be dummy, allocatable or pointer" }
call s(z)
contains
subroutine s(x)
type(t) :: x
end
end