Message ID | CAKwh3qjo7NLrKib5y4fUv04F4KuShVg5bUr-=W9462-vHG0duQ@mail.gmail.com |
---|---|
State | New |
Headers | show |
Looks good to me. - Andre On Thu, 15 Dec 2016 14:18:28 +0100 Janus Weil <janus@gcc.gnu.org> wrote: > Hi all, > > the attached patch deals with error recovery only and fixes an > ICE-on-invalid problem. > > Regtests cleanly on x86_64-linux-gnu. Ok for trunk? > > Cheers, > Janus > > > 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.
2016-12-15 14:30 GMT+01:00 Andre Vehreschild <vehre@gmx.de>: > Looks good to me. Thanks, Andre. Committed to trunk as r243691. Cheers, Janus > On Thu, 15 Dec 2016 14:18:28 +0100 > Janus Weil <janus@gcc.gnu.org> wrote: > >> Hi all, >> >> the attached patch deals with error recovery only and fixes an >> ICE-on-invalid problem. >> >> Regtests cleanly on x86_64-linux-gnu. Ok for trunk? >> >> Cheers, >> Janus >> >> >> 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. > > > -- > Andre Vehreschild * Email: vehre ad gmx dot de
Index: gcc/fortran/interface.c =================================================================== --- gcc/fortran/interface.c (revision 243621) +++ gcc/fortran/interface.c (working copy) @@ -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 *a 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 *a 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 *a /* 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 *a } if (formal->attr.allocatable && !formal->attr.codimension - && gfc_expr_attr (actual).codimension) + && actual_attr.codimension) { if (formal->attr.intent == INTENT_OUT) {