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

@@ -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"

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