Dear All, here's a straightforward implementation of the checks for constraint F2018:C1585 on pure function results.
Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald
From 843dce6c72d39c30e65af53db61414939a7c4095 Mon Sep 17 00:00:00 2001 From: Harald Anlauf <[email protected]> Date: Fri, 31 Oct 2025 21:16:13 +0100 Subject: [PATCH] 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. --- gcc/fortran/resolve.cc | 33 +++++++++++++++ gcc/testsuite/gfortran.dg/pure_result.f90 | 49 +++++++++++++++++++++++ 2 files changed, 82 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/pure_result.f90 diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index ecd2ada36a3..03e26f00084 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 00000000000..a4d30aa61dd --- /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 -- 2.51.0
