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
@@ -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"
new file mode 100644
@@ -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