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.

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index d91722e6ac6f28e0cfa3eaec7cca868123436a33..09a16c9b367712960d9fa26a92fa3a1ae583804c 100644 (file)
--- 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 (file)
index 0000000..05fd567
--- /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