| Message ID | 90bbf341-ac70-f7ca-500d-f38fae567cb1@netcologne.de |
|---|---|
| State | New |
| Headers | show |
| Series | [fortran] Fix ICE on invalid, PR 94090 | expand |
On Mon, Apr 13, 2020 at 10:20 AM Thomas Koenig via Fortran <fortran@gcc.gnu.org> wrote: > > Hello world, > > the attached patch fixes an ICE on invalid: When the return type of > a function was misdeclared with a wrong rank, we issued a warning, > but not an error (unless with -pedantic); later on, an ICE ensued. > > Nothing good can come from wrongly declaring a function type > (considering the ABI), so I changed that into a hard error. > > OK for trunk? > > Regards > > Thomas > > 2020-04-13 Thomas Koenig <tkoenig@gcc.gnu.org> > > PR fortran/94090 > * gfortran.dg (gfc_compare_interfaces): Add > optional argument bad_result_characteristics. > * interface.c (gfc_check_result_characteristics): Fix > whitespace. > (gfc_compare_interfaces): Handle new argument; return > true if function return values are wrong. > * resolve.c (resolve_global_procedure): Hard error if > the return value of a function is wrong. > > 2020-04-13 Thomas Koenig <tkoenig@gcc.gnu.org> > > PR fortran/94090 > * gfortran.dg/interface_46.f90: New test. Thomas, I agree with your assessment and the spirit of the patch. I wonder: could you simply replace the gfc_error_opt(0, ...) call with gfc_error? From what I can tell, gfc_error() is simply a short-cut for gfc_error_opt(0, ...). This has the nice side-effects of reducing the annoying 81-character line, and using only one copy of the error call: @@ -2605,11 +2605,19 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, int sub) /* Turn erros into warnings with -std=gnu and -std=legacy. */ gfc_errors_to_warnings (true); + /* If a function returns a wrong type, this can lead to + all kinds of ICEs and wrong code; issue a hard error + in this case. */ + + bool bad_result_characteristics; if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1, - reason, sizeof(reason), NULL, NULL)) + reason, sizeof(reason), NULL, NULL, + &bad_result_characteristics)) { - gfc_error_opt (0, "Interface mismatch in global procedure %qs at %L:" - " %s", sym->name, &sym->declared_at, reason); + if (bad_result_characteristics) + gfc_errors_to_warnings (false); + gfc_error ("Interface mismatch in global procedure %qs at %L:" + " %s", sym->name, &sym->declared_at, reason); goto done; } } Otherwise LGTM, thanks for the fix. --- Fritz Reese
Hi Fritz, > I wonder: could you simply replace the gfc_error_opt(0, ...) call with > gfc_error? Yes. Looking back at the code, I think it can also be cleaned up a little - turning the error to warnings is only needed on that particular branch, and resetting it to the default can also happen there, and at the target of a goto statement. So, here's an updated patch. OK for trunk? Regards Thomas 2020-04-13 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/94090 * gfortran.dg (gfc_compare_interfaces): Add optional argument bad_result_characteristics. * interface.c (gfc_check_result_characteristics): Fix whitespace. (gfc_compare_interfaces): Handle new argument; return true if function return values are wrong. * resolve.c (resolve_global_procedure): Hard error if the return value of a function is wrong. 2020-04-13 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/94090 * gfortran.dg/interface_46.f90: New test. diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 0d77386ddae..4e1da8c88a0 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3445,7 +3445,8 @@ bool gfc_check_dummy_characteristics (gfc_symbol *, gfc_symbol *, bool gfc_check_result_characteristics (gfc_symbol *, gfc_symbol *, char *, int); bool gfc_compare_interfaces (gfc_symbol*, gfc_symbol*, const char *, int, int, - char *, int, const char *, const char *); + char *, int, const char *, const char *, + bool *bad_result_characteristics = NULL); void gfc_check_interfaces (gfc_namespace *); bool gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *); void gfc_ppc_use (gfc_component *, gfc_actual_arglist **, locus *); diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 8f041f0a0a8..ba1c8bc322e 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -1529,7 +1529,7 @@ gfc_check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2, bool gfc_check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2, - char *errmsg, int err_len) + char *errmsg, int err_len) { gfc_symbol *r1, *r2; @@ -1695,12 +1695,16 @@ bool gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2, int generic_flag, int strict_flag, char *errmsg, int err_len, - const char *p1, const char *p2) + const char *p1, const char *p2, + bool *bad_result_characteristics) { gfc_formal_arglist *f1, *f2; gcc_assert (name2 != NULL); + if (bad_result_characteristics) + *bad_result_characteristics = false; + if (s1->attr.function && (s2->attr.subroutine || (!s2->attr.function && s2->ts.type == BT_UNKNOWN && gfc_get_default_type (name2, s2->ns)->type == BT_UNKNOWN))) @@ -1726,7 +1730,11 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2, /* If both are functions, check result characteristics. */ if (!gfc_check_result_characteristics (s1, s2, errmsg, err_len) || !gfc_check_result_characteristics (s2, s1, errmsg, err_len)) - return false; + { + if (bad_result_characteristics) + *bad_result_characteristics = true; + return false; + } } if (s1->attr.pure && !s2->attr.pure) diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 9b95200c241..2371ab23645 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -2601,21 +2601,27 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, int sub) goto done; } - if (!pedantic && (gfc_option.allow_std & GFC_STD_GNU)) - /* Turn erros into warnings with -std=gnu and -std=legacy. */ - gfc_errors_to_warnings (true); - + bool bad_result_characteristics; if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1, - reason, sizeof(reason), NULL, NULL)) + reason, sizeof(reason), NULL, NULL, + &bad_result_characteristics)) { - gfc_error_opt (0, "Interface mismatch in global procedure %qs at %L:" - " %s", sym->name, &sym->declared_at, reason); + /* Turn erros into warnings with -std=gnu and -std=legacy, + unless a function returns a wrong type, which can lead + to all kinds of ICEs and wrong code. */ + + if (!pedantic && (gfc_option.allow_std & GFC_STD_GNU) + && !bad_result_characteristics) + gfc_errors_to_warnings (true); + + gfc_error ("Interface mismatch in global procedure %qs at %L: %s", + sym->name, &sym->declared_at, reason); + gfc_errors_to_warnings (false); goto done; } } done: - gfc_errors_to_warnings (false); if (gsym->type == GSYM_UNKNOWN) {
On 4/15/20 12:26 PM, Thomas Koenig via Fortran wrote:
> + /* Turn erros into warnings with -std=gnu and -std=legacy,
Only glanced at it – but can you also fix the old* typo "erro(r)s"?
Tobias
(*old as the comment block has been moved around)
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter
Am 15.04.20 um 12:33 schrieb Tobias Burnus: > On 4/15/20 12:26 PM, Thomas Koenig via Fortran wrote: >> + /* Turn erros into warnings with -std=gnu and -std=legacy, > > Only glanced at it – but can you also fix the old* typo "erro(r)s"? Yes, I think I can manage that :-) Regards Thomas
> Yes. Looking back at the code, I think it can also be cleaned up > a little - turning the error to warnings is only needed on that > particular branch, and resetting it to the default can also > happen there, and at the target of a goto statement. > > So, here's an updated patch. OK for trunk? > > Regards > > Thomas Looks great, thank you for the cleanup! While you're touching the code anyway, how would you feel about replacing the nearby "goto done"s with a chain of "else if"? There's really no reason I can see for goto here, since the block following the conditions is already "done". Here (and attached) is a diff on top of your latest changes, in case you think it's appropriate: diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 2371ab23645..617e8d01a59 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -2511,6 +2511,7 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, int sub) gfc_namespace *ns; enum gfc_symbol_type type; char reason[200]; + bool bad_result_characteristics; type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION; @@ -2586,23 +2587,16 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, int sub) } if (sym->attr.function && !gfc_compare_types (&sym->ts, &def_sym->ts)) - { - gfc_error ("Return type mismatch of function %qs at %L (%s/%s)", - sym->name, &sym->declared_at, gfc_typename (&sym->ts), - gfc_typename (&def_sym->ts)); - goto done; - } + gfc_error ("Return type mismatch of function %qs at %L (%s/%s)", + sym->name, &sym->declared_at, gfc_typename (&sym->ts), + gfc_typename (&def_sym->ts)); - if (sym->attr.if_source == IFSRC_UNKNOWN + else if (sym->attr.if_source == IFSRC_UNKNOWN && gfc_explicit_interface_required (def_sym, reason, sizeof(reason))) - { - gfc_error ("Explicit interface required for %qs at %L: %s", - sym->name, &sym->declared_at, reason); - goto done; - } + gfc_error ("Explicit interface required for %qs at %L: %s", + sym->name, &sym->declared_at, reason); - bool bad_result_characteristics; - if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1, + else if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1, reason, sizeof(reason), NULL, NULL, &bad_result_characteristics)) { @@ -2617,12 +2611,9 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, int sub) gfc_error ("Interface mismatch in global procedure %qs at %L: %s", sym->name, &sym->declared_at, reason); gfc_errors_to_warnings (false); - goto done; } } -done: - if (gsym->type == GSYM_UNKNOWN) { gsym->type = type; --- Even if you don't want to include this, your patch LGTM. Thanks again. --- Fritz Reese diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 2371ab23645..617e8d01a59 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -2511,6 +2511,7 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, int sub) gfc_namespace *ns; enum gfc_symbol_type type; char reason[200]; + bool bad_result_characteristics; type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION; @@ -2586,23 +2587,16 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, int sub) } if (sym->attr.function && !gfc_compare_types (&sym->ts, &def_sym->ts)) - { - gfc_error ("Return type mismatch of function %qs at %L (%s/%s)", - sym->name, &sym->declared_at, gfc_typename (&sym->ts), - gfc_typename (&def_sym->ts)); - goto done; - } + gfc_error ("Return type mismatch of function %qs at %L (%s/%s)", + sym->name, &sym->declared_at, gfc_typename (&sym->ts), + gfc_typename (&def_sym->ts)); - if (sym->attr.if_source == IFSRC_UNKNOWN + else if (sym->attr.if_source == IFSRC_UNKNOWN && gfc_explicit_interface_required (def_sym, reason, sizeof(reason))) - { - gfc_error ("Explicit interface required for %qs at %L: %s", - sym->name, &sym->declared_at, reason); - goto done; - } + gfc_error ("Explicit interface required for %qs at %L: %s", + sym->name, &sym->declared_at, reason); - bool bad_result_characteristics; - if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1, + else if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1, reason, sizeof(reason), NULL, NULL, &bad_result_characteristics)) { @@ -2617,12 +2611,9 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, int sub) gfc_error ("Interface mismatch in global procedure %qs at %L: %s", sym->name, &sym->declared_at, reason); gfc_errors_to_warnings (false); - goto done; } } -done: - if (gsym->type == GSYM_UNKNOWN) { gsym->type = type;
Hi Fritz, > While you're touching the code anyway, how would you feel about > replacing the nearby "goto done"s with a chain of "else if"? There's > really no reason I can see for goto here, since the block following > the conditions is already "done". I think this would really be pushing things at stage 4. Theoretically, we are expected to do regression and documentation fixes only. Since Fortran is not release critical, we are welcome to break our compiler if we want to :-) but we should really try to restrict outselves at least a little. The little cleanup that I proposed is also borderline (but maybe a little less so), so I'd rather commit as I proposed. Any other comments? If not, I'll commit in a couple of days. (At least one thing that came out of this whole virus affair - instead of walking in the Highlands, I now have more time stuff hacking gfortran). Regards Thomas
On Wed, Apr 15, 2020 at 1:47 PM Thomas Koenig <tkoenig@netcologne.de> wrote: > > Hi Fritz, > > > While you're touching the code anyway, how would you feel about > > replacing the nearby "goto done"s with a chain of "else if"? There's > > really no reason I can see for goto here, since the block following > > the conditions is already "done". > > I think this would really be pushing things at stage 4. Theoretically, > we are expected to do regression and documentation fixes only. > Since Fortran is not release critical, we are welcome to break > our compiler if we want to :-) but we should really try to > restrict outselves at least a little. The little cleanup that I proposed > is also borderline (but maybe a little less so), so I'd rather commit > as I proposed. > > Any other comments? If not, I'll commit in a couple of days. [...] Fair enough. No further comments, that patch looks good. Thanks! --- Fritz
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 0d77386ddae..4e1da8c88a0 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3445,7 +3445,8 @@ bool gfc_check_dummy_characteristics (gfc_symbol *, gfc_symbol *, bool gfc_check_result_characteristics (gfc_symbol *, gfc_symbol *, char *, int); bool gfc_compare_interfaces (gfc_symbol*, gfc_symbol*, const char *, int, int, - char *, int, const char *, const char *); + char *, int, const char *, const char *, + bool *bad_result_characteristics = NULL); void gfc_check_interfaces (gfc_namespace *); bool gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *); void gfc_ppc_use (gfc_component *, gfc_actual_arglist **, locus *); diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 75a50c999b7..5b375c65694 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -1529,7 +1529,7 @@ gfc_check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2, bool gfc_check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2, - char *errmsg, int err_len) + char *errmsg, int err_len) { gfc_symbol *r1, *r2; @@ -1695,12 +1695,16 @@ bool gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2, int generic_flag, int strict_flag, char *errmsg, int err_len, - const char *p1, const char *p2) + const char *p1, const char *p2, + bool *bad_result_characteristics) { gfc_formal_arglist *f1, *f2; gcc_assert (name2 != NULL); + if (bad_result_characteristics) + *bad_result_characteristics = false; + if (s1->attr.function && (s2->attr.subroutine || (!s2->attr.function && s2->ts.type == BT_UNKNOWN && gfc_get_default_type (name2, s2->ns)->type == BT_UNKNOWN))) @@ -1726,7 +1730,11 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2, /* If both are functions, check result characteristics. */ if (!gfc_check_result_characteristics (s1, s2, errmsg, err_len) || !gfc_check_result_characteristics (s2, s1, errmsg, err_len)) - return false; + { + if (bad_result_characteristics) + *bad_result_characteristics = true; + return false; + } } if (s1->attr.pure && !s2->attr.pure) diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index ccd2a5e3b7d..36659790ddf 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -2605,11 +2605,24 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, int sub) /* Turn erros into warnings with -std=gnu and -std=legacy. */ gfc_errors_to_warnings (true); + /* If a function returns a wrong type, this can lead to + all kinds of ICEs and wrong code; issue a hard error + in this case. */ + + bool bad_result_characteristics; if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1, - reason, sizeof(reason), NULL, NULL)) + reason, sizeof(reason), NULL, NULL, + &bad_result_characteristics)) { - gfc_error_opt (0, "Interface mismatch in global procedure %qs at %L:" + if (bad_result_characteristics) + { + gfc_errors_to_warnings (false); + gfc_error ("Interface mismatch in global procedure %qs at %L:" " %s", sym->name, &sym->declared_at, reason); + } + else + gfc_error_opt (0, "Interface mismatch in global procedure %qs at %L:" + " %s", sym->name, &sym->declared_at, reason); goto done; } } diff --git a/gcc/testsuite/gfortran.dg/interface_46.f90 b/gcc/testsuite/gfortran.dg/interface_46.f90 new file mode 100644 index 00000000000..c1d87638fbe --- /dev/null +++ b/gcc/testsuite/gfortran.dg/interface_46.f90 @@ -0,0 +1,36 @@ +! { dg-do compile } +! PR 94090 - this used to cause an ICE. +! Test case by José Rui Faustino de Sousa. +function cntf(a) result(s) + implicit none + + integer, intent(in) :: a(:) + + integer :: s(3) + + s = [1, 2, 3] + return +end function cntf + +program ice_p + + implicit none + + interface + function cntf(a) result(s) ! { dg-error "Rank mismatch in function result" } + implicit none + integer, intent(in) :: a(:) + integer :: s ! (3) <- Ups! + end function cntf + end interface + + integer, parameter :: n = 9 + + integer :: arr(n) + + integer :: s(3) + + s = cntf(arr) + stop + +end program ice_p
Hello world, the attached patch fixes an ICE on invalid: When the return type of a function was misdeclared with a wrong rank, we issued a warning, but not an error (unless with -pedantic); later on, an ICE ensued. Nothing good can come from wrongly declaring a function type (considering the ABI), so I changed that into a hard error. OK for trunk? Regards Thomas 2020-04-13 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/94090 * gfortran.dg (gfc_compare_interfaces): Add optional argument bad_result_characteristics. * interface.c (gfc_check_result_characteristics): Fix whitespace. (gfc_compare_interfaces): Handle new argument; return true if function return values are wrong. * resolve.c (resolve_global_procedure): Hard error if the return value of a function is wrong. 2020-04-13 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/94090 * gfortran.dg/interface_46.f90: New test.