Fortran: fix procedure pointer handling with -fcheck=pointer [PR102900]

	PR fortran/102900

gcc/fortran/ChangeLog:

	* trans-decl.cc (gfc_generate_function_code): Use sym->result
	when generating fake result decl for functions returning
	allocatable or pointer results.
	* trans-expr.cc (gfc_conv_procedure_call): When checking the
	pointer status of an actual argument passed to a non-allocatable,
	non-pointer dummy which is of type CLASS, do not check the
	class container of the actual if it is just a procedure pointer.
	(gfc_trans_pointer_assignment): Fix treatment of assignment to
	NULL of a procedure pointer.

gcc/testsuite/ChangeLog:

	* gfortran.dg/proc_ptr_52.f90: Add -fcheck=pointer to options.
	* gfortran.dg/proc_ptr_57.f90: New test.

(cherry picked from commit cc8d86ee4680d56eefeb76a8f2f752282e2631e3)

4 files changed, 46 insertions, 7 deletions

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index ddc4960..4f2ea76 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -8085,13 +8085,13 @@ gfc_generate_function_code (gfc_namespace * ns)
 		   || sym->result->ts.u.derived->attr.alloc_comp
 		   || sym->result->ts.u.derived->attr.pointer_comp))
 	      || (sym->result->ts.type == BT_CLASS
-		  && (CLASS_DATA (sym)->attr.allocatable
-		      || CLASS_DATA (sym)->attr.class_pointer
+		  && (CLASS_DATA (sym->result)->attr.allocatable
+		      || CLASS_DATA (sym->result)->attr.class_pointer
 		      || CLASS_DATA (sym->result)->attr.alloc_comp
 		      || CLASS_DATA (sym->result)->attr.pointer_comp))))
 	{
 	  artificial_result_decl = true;
-	  result = gfc_get_fake_result_decl (sym, 0);
+	  result = gfc_get_fake_result_decl (sym->result, 0);
 	}
 
       if (result != NULL_TREE && sym->attr.function && !sym->attr.pointer)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 62dd38d..7031a829 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -8147,7 +8147,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		goto end_pointer_check;
 
 	      tmp = parmse.expr;
-	      if (fsym && fsym->ts.type == BT_CLASS)
+	      if (fsym && fsym->ts.type == BT_CLASS && !attr.proc_pointer)
 		{
 		  if (POINTER_TYPE_P (TREE_TYPE (tmp)))
 		    tmp = build_fold_indirect_ref_loc (input_location, tmp);
@@ -10909,9 +10909,11 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
   gfc_init_se (&lse, NULL);
 
   /* Usually testing whether this is not a proc pointer assignment.  */
-  non_proc_ptr_assign = !(gfc_expr_attr (expr1).proc_pointer
-			&& expr2->expr_type == EXPR_VARIABLE
-			&& expr2->symtree->n.sym->attr.flavor == FL_PROCEDURE);
+  non_proc_ptr_assign
+    = !(gfc_expr_attr (expr1).proc_pointer
+	&& ((expr2->expr_type == EXPR_VARIABLE
+	     && expr2->symtree->n.sym->attr.flavor == FL_PROCEDURE)
+	    || expr2->expr_type == EXPR_NULL));
 
   /* Check whether the expression is a scalar or not; we cannot use
      expr1->rank as it can be nonzero for proc pointers.  */
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_52.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_52.f90
index cb7cf70..421d247 100644
--- a/gcc/testsuite/gfortran.dg/proc_ptr_52.f90
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_52.f90
@@ -1,4 +1,5 @@
 ! { dg-do run }
+! { dg-additional-options "-fcheck=pointer" }
 !
 ! Test the fix for PRs93924 & 93925.
 !
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_57.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_57.f90
new file mode 100644
index 0000000..7ecb88f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_57.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! { dg-additional-options "-fcheck=pointer" }
+!
+! PR fortran/102900
+
+module cs
+  implicit none
+  interface
+     function classStar_map_ifc() result(y)
+       import
+       class(*), pointer :: y
+     end function classStar_map_ifc
+  end interface
+
+contains
+
+   function selector()
+     procedure(classStar_map_ifc), pointer :: selector
+     selector => NULL()
+   end function selector
+
+   function selector_result() result(f)
+     procedure(classStar_map_ifc), pointer :: f
+     f => NULL()
+   end function selector_result
+
+   function fun(x) result(y)
+      class(*), pointer            :: y
+      class(*), target, intent(in) :: x
+      select type (x)
+      class default
+         y => null()
+      end select
+   end function fun
+
+end module cs