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 --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index ecd2ada36a320bdec739590d4fa5196d6b38a207..03e26f000843801fc1a44a652c013409062e56ef 100644 (file)
--- 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 (file)
index 0000000..a4d30aa
--- /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