re PR fortran/54387 ([F03] Wrongly accepts non-proc result variable on the RHS of...

2012-09-16  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/54387
	* expr.c (gfc_check_pointer_assign): Check for result of embracing
	function.

2012-09-16  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/54387
	* gfortran.dg/proc_ptr_38.f90: New.

From-SVN: r191364

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 24ff91f..bf9f0b9 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2012-09-16  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/54387
+       * expr.c (gfc_check_pointer_assign): Check for result of embracing
+       function.
+
 2012-09-16  Tobias Burnus  <burnus@net-b.de>
 
        * trans-decl.c (gfc_generate_function_code): Fix

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index bc1f5e3..dced05d 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3430,6 +3430,15 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
              gfc_resolve_intrinsic (sym, &rvalue->where);
              attr = gfc_expr_attr (rvalue);
            }
+         /* Check for result of embracing function.  */
+         if (sym == gfc_current_ns->proc_name
+             && sym->attr.function && sym->result == sym)
+           {
+             gfc_error ("Function result '%s' is invalid as proc-target "
+                        "in procedure pointer assignment at %L",
+                        sym->name, &rvalue->where);
+             return FAILURE;
+           }
        }
       if (attr.abstract)
        {

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e38e779..978e3df 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2012-09-16  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/54387
+       * gfortran.dg/proc_ptr_38.f90: New.
+
 2012-09-16  John David Anglin  <dave.anglin@nrc-cnrc.gc.ca>
 
        PR debug/54460

diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_38.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_38.f90
new file mode 100644 (file)
index 0000000..9387b6b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_38.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+!
+! PR 54387: [F03] Wrongly accepts non-proc result variable on the RHS of a proc-pointer assignment
+!
+! Contributed by James Van Buskirk
+
+integer function foo()
+  procedure(), pointer :: i
+  i => foo  ! { dg-error "is invalid as proc-target in procedure pointer assignment" }
+end 
+
+recursive function bar() result (res)
+  integer :: res
+  procedure(), pointer :: j
+  j => bar
+end