[PATCH] Fortran: function returning contiguous class array [PR105543]

[PATCH] Fortran: function returning contiguous class array [PR105543]

[Harald Anlauf]

[-- Attachment #1: Type: text/plain, Size: 650 bytes --]

Dear all,

the attached patch fixes a rejects-valid for functions returning
a contiguous CLASS result.  The problem occurs because attr.class_ok
is inconsistent between sym and sym->result at the time the check
of the contiguous attribute is done.

I first thought that resolve_fl_procedure would be the right place
to do this fixup, but this is invoked only later from resolve_symbol.
Another attempt to put a fix directly after the recursive call to
resolve_symbol for sym->result lead to frightening regressions in
the testsuite, so I stayed with the attached simple solution.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr105543.diff --]
[-- Type: text/x-patch, Size: 2344 bytes --]

From 15810999b2f5cb4d8fbdaaaa69cb488c9b0c58e6 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Wed, 6 Dec 2023 20:42:27 +0100
Subject: [PATCH] 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.
---
 gcc/fortran/resolve.cc                      |  5 +++++
 gcc/testsuite/gfortran.dg/contiguous_13.f90 | 22 +++++++++++++++++++++
 2 files changed, 27 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/contiguous_13.f90

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 166b702cd9a..4fe0e7202e5 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 00000000000..8c6784432c9
--- /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
--
2.35.3