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-09-20 20:27:20 +0200 |
| commit | be60aa5b608b5f09fadfeff852a46589ac311a42 (patch) | |
| tree | 8b545ac6dd6885a2ef33392ba1431aa72cd6748f /gcc/fortran | |
| parent | 2438b6a4c8df0d1870881e123cc74cc62b7e58e8 (diff) | |
| download | gcc-be60aa5b608b5f09fadfeff852a46589ac311a42.zip gcc-be60aa5b608b5f09fadfeff852a46589ac311a42.tar.gz gcc-be60aa5b608b5f09fadfeff852a46589ac311a42.tar.bz2 | |
Fortran: Fix function attributes [PR100132]
gcc/fortran/ChangeLog:
PR fortran/100132
* trans-types.cc (create_fn_spec): Fix function attributes when
passing polymorphic pointers.
gcc/testsuite/ChangeLog:
PR fortran/100132
* gfortran.dg/PR100132.f90: New test.
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/trans-types.cc | 15 |
1 files changed, 13 insertions, 2 deletions
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc index 0ea7c74..c062a5b 100644 --- a/gcc/fortran/trans-types.cc +++ b/gcc/fortran/trans-types.cc @@ -3054,12 +3054,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)) |