Hi all,
the attached patch is close to trivial and fixes a rejects-valid
problem concerning procedure pointers to pointer-valued functions. It
regtests cleanly on x86_64-linux-gnu. Ok for trunk?
Cheers,
Janus
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 28403689bb1..e15ef5b6996 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2019-03-09 Janus Weil <ja...@gcc.gnu.org>
+
+ PR fortran/84504
+ * expr.c (gfc_check_assign_symbol): Deal with procedure pointers to
+ pointer-valued functions.
+
2019-03-08 Jakub Jelinek <ja...@redhat.com>
PR other/80058
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 51552a79cde..4e95f243661 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4321,7 +4321,7 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_component *comp, gfc_expr *rvalue)
if (!r)
return r;
- if (pointer && rvalue->expr_type != EXPR_NULL)
+ if (pointer && rvalue->expr_type != EXPR_NULL && !proc_pointer)
{
/* F08:C461. Additional checks for pointer initialization. */
symbol_attribute attr;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f32b5afeed9..77d0f233f10 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-03-09 Janus Weil <ja...@gcc.gnu.org>
+
+ PR fortran/84504
+ * gfortran.dg/pointer_init_10.f90: New test case.
+
2019-03-09 Jakub Jelinek <ja...@redhat.com>
PR rtl-optimization/89634
diff --git a/gcc/testsuite/gfortran.dg/pointer_init_10.f90 b/gcc/testsuite/gfortran.dg/pointer_init_10.f90
new file mode 100644
index 00000000000..81e7d73755f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_init_10.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+!
+! PR 84504: [F08] procedure pointer variables cannot be initialized with functions returning pointers
+!
+! Contributed by Sriram Swaminarayan <sri...@pobox.com>
+
+module test_mod
+ implicit none
+ private
+ integer, target :: i = 333
+ procedure(the_proc), pointer, public :: ptr => the_proc
+contains
+ function the_proc()
+ integer, pointer :: the_proc
+ the_proc => i
+ end function
+end module
+
+program test_prog
+ use test_mod
+ integer, pointer :: ip
+ ip => ptr()
+ if (ip /= 333) stop 1
+end
