fix PR 84504

2019-03-09  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/84504
	* expr.c (gfc_check_assign_symbol): Deal with procedure pointers to
	pointer-valued functions.

2019-03-09  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/84504
	* gfortran.dg/pointer_init_10.f90: New test case.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@269529 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 48ab06b0a185bf04da41096b813afe6059367e3c..40b3a3247f846caafbc2c5ee102cf17978412d14 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2019-03-09  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/84504
+       * expr.c (gfc_check_assign_symbol): Deal with procedure pointers to
+       pointer-valued functions.
+
 2019-03-09  Thomas König  <tkoenig@gcc.gnu.org>
 
        PR fortran/71203

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 51552a79cdee2f12b91b02ceed71dd186361573d..4e95f2436614cab8a06c35c086d4ee999706070b 100644 (file)
--- 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 003fe1cd70210f45066a1b748ee2d369f2a8a886..a2eec5e74480f97cbd22a2e547b2b109e418c895 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-03-09  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/84504
+       * gfortran.dg/pointer_init_10.f90: New test case.
+
 2019-03-09  John David Anglin  <dave.anglin@bell.net>
 
        * gfortran.dg/ieee/ieee_9.f90: Fix typo.

diff --git a/gcc/testsuite/gfortran.dg/pointer_init_10.f90 b/gcc/testsuite/gfortran.dg/pointer_init_10.f90
new file mode 100644 (file)
index 0000000..81e7d73
--- /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 <sriram@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