diff mbox series

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

Message ID trinity-2b29de67-6497-40b6-bc2d-2ff749ab4d90-1684094665147@3c-app-gmx-bs49
State Accepted
Headers
Series Fortran: CLASS pointer function result in variable definition context [PR109846] |

Checks

Context Check Description
snail/gcc-patch-check success Github commit url

Commit Message

Harald Anlauf May 14, 2023, 8:04 p.m. UTC 
  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

Comments

Li, Pan2 via Gcc-patches May 14, 2023, 9:01 p.m. UTC | #1 
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.
diff mbox series

Patch

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