diff options
| author | Thomas König <tkoenig@gcc.gnu.org> | 2020-04-17 19:53:45 +0200 |
|---|---|---|
| committer | Thomas König <tkoenig@gcc.gnu.org> | 2020-04-17 19:53:45 +0200 |
| commit | 2298af0800b292f028298c1eaec42fd3033c4b9b (patch) | |
| tree | 95882dce57ad39ffb743d2e56ce95d694cae9cec /gcc/fortran/resolve.c | |
| parent | af557050fd011a03d21dc26b31959033061a0443 (diff) | |
| download | gcc-2298af0800b292f028298c1eaec42fd3033c4b9b.zip gcc-2298af0800b292f028298c1eaec42fd3033c4b9b.tar.gz gcc-2298af0800b292f028298c1eaec42fd3033c4b9b.tar.bz2 | |
Fix ICE on invalid, PR94090.
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.
2020-04-17 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-17 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/94090
* gfortran.dg/interface_46.f90: New test.
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 22 |
1 files changed, 14 insertions, 8 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 9b95200..2371ab2 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) { |