diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2016-12-15 15:07:51 +0100 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2016-12-15 15:07:51 +0100 |
| commit | fec5ce248546144be3bec8655fd72c091c813594 (patch) | |
| tree | 3d10f0a3a39ed09a0afcf4532ce4b7077b4d82ad /gcc/fortran/interface.c | |
| parent | 50a8a9413d3a0a485ef5b1886361c2a1c4487433 (diff) | |
| download | gcc-fec5ce248546144be3bec8655fd72c091c813594.zip gcc-fec5ce248546144be3bec8655fd72c091c813594.tar.gz gcc-fec5ce248546144be3bec8655fd72c091c813594.tar.bz2 | |
re PR fortran/78800 ([OOP] ICE in compare_parameter, at fortran/interface.c:2246)
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
Diffstat (limited to 'gcc/fortran/interface.c')
| -rw-r--r-- | gcc/fortran/interface.c | 19 |
1 files changed, 10 insertions, 9 deletions
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index a6f4e72..8c09b90 100644 --- a/gcc/fortran/interface.c +++ b/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) { |