[PATCH] Fortran: CLASS pointer function result in variable definition context [PR109846]

[PATCH] Fortran: CLASS pointer function result in variable definition context [PR109846]

[Harald Anlauf]

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

Dear all,

Fortran allows functions in variable definition contexts when the
result variable is a pointer.  We already handle this for the
non-CLASS case (in 11+), but the logic that checks the pointer
attribute was looking in the wrong place for the CLASS case.

Once found, the fix is simple and obvious, see attached patch.

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

Thanks,
Harald

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

From 6406f19855a3b664597d75369f0935d3d31384dc Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Sun, 14 May 2023 21:53:51 +0200
Subject: [PATCH] Fortran: CLASS pointer function result in variable definition
 context [PR109846]

gcc/fortran/ChangeLog:

	PR fortran/109846
	* expr.cc (gfc_check_vardef_context): Check appropriate pointer
	attribute for CLASS vs. non-CLASS function result in variable
	definition context.

gcc/testsuite/ChangeLog:

	PR fortran/109846
	* gfortran.dg/ptr-func-5.f90: New test.
---
 gcc/fortran/expr.cc                      |  2 +-
 gcc/testsuite/gfortran.dg/ptr-func-5.f90 | 39 ++++++++++++++++++++++++
 2 files changed, 40 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/ptr-func-5.f90

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index d91722e6ac6..09a16c9b367 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -6256,7 +6256,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
       && !(sym->attr.flavor == FL_PROCEDURE && sym == sym->result)
       && !(sym->attr.flavor == FL_PROCEDURE && sym->attr.proc_pointer)
       && !(sym->attr.flavor == FL_PROCEDURE
-	   && sym->attr.function && sym->attr.pointer))
+	   && sym->attr.function && attr.pointer))
     {
       if (context)
 	gfc_error ("%qs in variable definition context (%s) at %L is not"
diff --git a/gcc/testsuite/gfortran.dg/ptr-func-5.f90 b/gcc/testsuite/gfortran.dg/ptr-func-5.f90
new file mode 100644
index 00000000000..05fd56703ca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ptr-func-5.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }
+! PR fortran/109846
+! CLASS pointer function result in variable definition context
+
+module foo
+  implicit none
+  type :: parameter_list
+  contains
+    procedure :: sublist, sublist_nores
+  end type
+contains
+  function sublist (this) result (slist)
+    class(parameter_list), intent(inout) :: this
+    class(parameter_list), pointer       :: slist
+    allocate (slist)
+  end function
+  function sublist_nores (this)
+    class(parameter_list), intent(inout) :: this
+    class(parameter_list), pointer       :: sublist_nores
+    allocate (sublist_nores)
+  end function
+end module
+
+program example
+  use foo
+  implicit none
+  type(parameter_list) :: plist
+  call sub1 (plist%sublist())
+  call sub1 (plist%sublist_nores())
+  call sub2 (plist%sublist())
+  call sub2 (plist%sublist_nores())
+contains
+  subroutine sub1 (plist)
+    type(parameter_list), intent(inout) :: plist
+  end subroutine
+  subroutine sub2 (plist)
+    type(parameter_list) :: plist
+  end subroutine
+end program
--
2.35.3

Re: [PATCH] Fortran: CLASS pointer function result in variable definition context [PR109846]

[Steve Kargl]

On Sun, May 14, 2023 at 10:04:25PM +0200, Harald Anlauf via Fortran wrote:
> 
> Fortran allows functions in variable definition contexts when the
> result variable is a pointer.  We already handle this for the
> non-CLASS case (in 11+), but the logic that checks the pointer
> attribute was looking in the wrong place for the CLASS case.
> 
> Once found, the fix is simple and obvious, see attached patch.
> 
> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
> 

Yes.  As you say, it is obvious once found.  Ok to
backport after a few days.

-- 
Steve