OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

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
This commit is contained in:
Janus Weil 2012-09-16 22:12:21 +02:00
parent 1d1b7dc422
commit 37bfd49f32
4 changed files with 36 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

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

9
gcc/fortran/expr.c
View File

@ -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)
{

5
gcc/testsuite/ChangeLog
View File

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

16
gcc/testsuite/gfortran.dg/proc_ptr_38.f90 Normal file
View File

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