diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2023-12-06 20:42:27 +0100 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2023-12-10 20:24:53 +0100 |
| commit | 1e462fb480d38de5f9a4578bbe5c5bc66a01a9ed (patch) | |
| tree | b94f46eaeb75b8fe889f12b5877e1c95daa5fd87 | |
| parent | fa99f7d12b87f36d3c38349fcdcfca074564858d (diff) | |
| download | gcc-1e462fb480d38de5f9a4578bbe5c5bc66a01a9ed.zip gcc-1e462fb480d38de5f9a4578bbe5c5bc66a01a9ed.tar.gz gcc-1e462fb480d38de5f9a4578bbe5c5bc66a01a9ed.tar.bz2 | |
Fortran: function returning contiguous class array [PR105543]
gcc/fortran/ChangeLog:
PR fortran/105543
* resolve.cc (resolve_symbol): For a CLASS-valued function having a
RESULT clause, ensure that attr.class_ok is set for its symbol as
well as for its resolved result variable.
gcc/testsuite/ChangeLog:
PR fortran/105543
* gfortran.dg/contiguous_13.f90: New test.
| -rw-r--r-- | gcc/fortran/resolve.cc | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/contiguous_13.f90 | 22 |
2 files changed, 27 insertions, 0 deletions
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 166b702..4fe0e72 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -16102,6 +16102,11 @@ resolve_symbol (gfc_symbol *sym) specification_expr = saved_specification_expr; } + /* For a CLASS-valued function with a result variable, affirm that it has + been resolved also when looking at the symbol 'sym'. */ + if (mp_flag && sym->ts.type == BT_CLASS && sym->result->attr.class_ok) + sym->attr.class_ok = sym->result->attr.class_ok; + if (sym->ts.type == BT_CLASS && sym->attr.class_ok && sym->ts.u.derived && CLASS_DATA (sym)) { diff --git a/gcc/testsuite/gfortran.dg/contiguous_13.f90 b/gcc/testsuite/gfortran.dg/contiguous_13.f90 new file mode 100644 index 0000000..8c67844 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/contiguous_13.f90 @@ -0,0 +1,22 @@ +! { dg-do compile } +! PR fortran/105543 - function returning contiguous class array +! Contributed by martin <mscfd@gmx.net> + +module func_contiguous + implicit none + type :: a + end type a +contains + function create1 () result(x) + class(a), dimension(:), contiguous, pointer :: x + end + function create2 () + class(a), dimension(:), contiguous, pointer :: create2 + end + function create3 () result(x) + class(*), dimension(:), contiguous, pointer :: x + end + function create4 () + class(*), dimension(:), contiguous, pointer :: create4 + end +end module func_contiguous |