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/interface.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/interface.c')
| -rw-r--r-- | gcc/fortran/interface.c | 14 |
1 files changed, 11 insertions, 3 deletions
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 8f041f0..ba1c8bc 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) |