diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2021-02-23 19:29:04 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2021-02-23 19:29:04 +0000 |
| commit | 29a5298955f777c539c628f51e78b75d8e586c44 (patch) | |
| tree | 547cb45715e524c698d1a53c1cf0bebe5a4c53eb /gcc/fortran/resolve.c | |
| parent | a6c7e0fcffc857e67dffdd7609be663cc3aac7d2 (diff) | |
| download | gcc-29a5298955f777c539c628f51e78b75d8e586c44.zip gcc-29a5298955f777c539c628f51e78b75d8e586c44.tar.gz gcc-29a5298955f777c539c628f51e78b75d8e586c44.tar.bz2 | |
Fortran: Fix for class defined operators [PR99124].
2021-02-23 Paul Thomas <pault@gcc.gnu.org>
gcc/fortran
PR fortran/99124
* resolve.c (resolve_fl_procedure): Include class results in
the test for F2018, C15100.
* trans-array.c (get_class_info_from_ss): Do not use the saved
descriptor to obtain the class expression for variables. Use
gfc_get_class_from_expr instead.
gcc/testsuite/
PR fortran/99124
* gfortran.dg/class_defined_operator_2.f03 : New test.
* gfortran.dg/elemental_result_2.f90 : New test.
* gfortran.dg/class_assign_4.f90: Correct the non-conforming
elemental function with an allocatable result with an operator
interface with array dummies and result.
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 11 |
1 files changed, 10 insertions, 1 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 11b5dbc..2a91ae7 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -13051,6 +13051,7 @@ static bool resolve_fl_procedure (gfc_symbol *sym, int mp_flag) { gfc_formal_arglist *arg; + bool allocatable_or_pointer; if (sym->attr.function && !resolve_fl_var_and_proc (sym, mp_flag)) @@ -13235,8 +13236,16 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) /* F2018, C15100: "The result of an elemental function shall be scalar, and shall not have the POINTER or ALLOCATABLE attribute." The scalar pointer is tested and caught elsewhere. */ + if (sym->result) + allocatable_or_pointer = sym->result->ts.type == BT_CLASS + && CLASS_DATA (sym->result) ? + (CLASS_DATA (sym->result)->attr.allocatable + || CLASS_DATA (sym->result)->attr.pointer) : + (sym->result->attr.allocatable + || sym->result->attr.pointer); + if (sym->attr.elemental && sym->result - && (sym->result->attr.allocatable || sym->result->attr.pointer)) + && allocatable_or_pointer) { gfc_error ("Function result variable %qs at %L of elemental " "function %qs shall not have an ALLOCATABLE or POINTER " |