https://gcc.gnu.org/g:acbcbeb91f93f400dcc0354713790daa84e5c707
commit r16-4922-gacbcbeb91f93f400dcc0354713790daa84e5c707 Author: Harald Anlauf <[email protected]> Date: Fri Oct 31 21:16:13 2025 +0100 Fortran: implement constraint F2018:C1585 on pure function results [PR78640] PR fortran/78640 gcc/fortran/ChangeLog: * resolve.cc (resolve_fl_procedure): Check function result of a pure function against F2018:C1585. gcc/testsuite/ChangeLog: * gfortran.dg/pure_result.f90: New test. Diff: --- gcc/fortran/resolve.cc | 33 +++++++++++++++++++++ gcc/testsuite/gfortran.dg/pure_result.f90 | 49 +++++++++++++++++++++++++++++++ 2 files changed, 82 insertions(+) diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index ecd2ada36a32..03e26f000843 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -15385,6 +15385,39 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) return false; } + /* F2018:C1585: "The function result of a pure function shall not be both + polymorphic and allocatable, or have a polymorphic allocatable ultimate + component." */ + if (sym->attr.pure && sym->result && sym->ts.u.derived) + { + if (sym->ts.type == BT_CLASS + && sym->attr.class_ok + && CLASS_DATA (sym->result) + && CLASS_DATA (sym->result)->attr.allocatable) + { + gfc_error ("Result variable %qs of pure function at %L is " + "polymorphic allocatable", + sym->result->name, &sym->result->declared_at); + return false; + } + + if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->components) + { + gfc_component *c = sym->ts.u.derived->components; + for (; c; c = c->next) + if (c->ts.type == BT_CLASS + && CLASS_DATA (c) + && CLASS_DATA (c)->attr.allocatable) + { + gfc_error ("Result variable %qs of pure function at %L has " + "polymorphic allocatable component %qs", + sym->result->name, &sym->result->declared_at, + c->name); + return false; + } + } + } + if (sym->attr.is_bind_c && sym->attr.is_c_interop != 1) { gfc_formal_arglist *curr_arg; diff --git a/gcc/testsuite/gfortran.dg/pure_result.f90 b/gcc/testsuite/gfortran.dg/pure_result.f90 new file mode 100644 index 000000000000..a4d30aa61dd8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pure_result.f90 @@ -0,0 +1,49 @@ +! { dg-do compile } +! PR fortran/78640 - constraints on pure function results +! +! F2018:C1585, F2023:C1594: +! "The function result of a pure function shall not be both polymorphic and +! allocatable, or have a polymorphic allocatable ultimate component." + +program pr78640 + implicit none + + type foo_t + end type + + type bar_t + integer, allocatable :: dummy + class(*), allocatable :: c + end type bar_t + +contains + + pure function f() result(foo) ! { dg-error "is polymorphic allocatable" } + class(foo_t), allocatable :: foo + foo = foo_t() + end function + + pure function f2() ! { dg-error "is polymorphic allocatable" } + class(foo_t), allocatable :: f2 + f2 = foo_t() + end function + + pure function g() result(foo) ! { dg-error "is polymorphic allocatable" } + class(*), allocatable :: foo + foo = foo_t() + end function + + pure function g2() ! { dg-error "is polymorphic allocatable" } + class(*), allocatable :: g2 + g2 = foo_t() + end function + + pure function h() result(bar) ! { dg-error "polymorphic allocatable component" } + type(bar_t) :: bar + end function + + pure function h2() ! { dg-error "polymorphic allocatable component" } + type(bar_t) :: h2 + end function + +end
