diff options
| author | José Rui Faustino de Sousa <jrfsousa@gmail.com> | 2022-09-19 22:00:45 +0200 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2022-10-01 20:41:03 +0200 |
| commit | 8c583871e70f5530907d22a21b0f1d1e7b90e224 (patch) | |
| tree | c1a9ecd97a284eca76e4666859efda96763f2e5d /gcc/fortran | |
| parent | b17648c7d5f9bab852cc420054ca4cc2880edb2a (diff) | |
| download | gcc-8c583871e70f5530907d22a21b0f1d1e7b90e224.zip gcc-8c583871e70f5530907d22a21b0f1d1e7b90e224.tar.gz gcc-8c583871e70f5530907d22a21b0f1d1e7b90e224.tar.bz2 | |
Fortran: Fix function attributes [PR100132]
gcc/fortran/ChangeLog:
PR fortran/100132
* trans-types.c (create_fn_spec): Fix function attributes when
passing polymorphic pointers.
gcc/testsuite/ChangeLog:
PR fortran/100132
* gfortran.dg/PR100132.f90: New test.
(cherry picked from commit be60aa5b608b5f09fadfeff852a46589ac311a42)
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/trans-types.c | 15 |
1 files changed, 13 insertions, 2 deletions
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index d9f54d8..d9f3dae 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -2954,12 +2954,23 @@ create_fn_spec (gfc_symbol *sym, tree fntype) for (f = gfc_sym_get_dummy_args (sym); f; f = f->next) if (spec_len < sizeof (spec)) { - if (!f->sym || f->sym->attr.pointer || f->sym->attr.target + bool is_class = false; + bool is_pointer = false; + + if (f->sym) + { + is_class = f->sym->ts.type == BT_CLASS && CLASS_DATA (f->sym) + && f->sym->attr.class_ok; + is_pointer = is_class ? CLASS_DATA (f->sym)->attr.class_pointer + : f->sym->attr.pointer; + } + + if (f->sym == NULL || is_pointer || f->sym->attr.target || f->sym->attr.external || f->sym->attr.cray_pointer || (f->sym->ts.type == BT_DERIVED && (f->sym->ts.u.derived->attr.proc_pointer_comp || f->sym->ts.u.derived->attr.pointer_comp)) - || (f->sym->ts.type == BT_CLASS + || (is_class && (CLASS_DATA (f->sym)->ts.u.derived->attr.proc_pointer_comp || CLASS_DATA (f->sym)->ts.u.derived->attr.pointer_comp)) || (f->sym->ts.type == BT_INTEGER && f->sym->ts.is_c_interop)) |