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

re PR fortran/39998 (Procedure Pointer Assignments: Statement Functions & Internal Functions) 

2009-05-05  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/39998
	* expr.c (gfc_check_pointer_assign): Check for statement functions and
	internal procedures in procedure pointer assignments.


2009-05-05  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/39998
	* gfortran.dg/proc_ptr_17.f90: New.

From-SVN: r147133
This commit is contained in:
Janus Weil 2009-05-05 22:41:00 +02:00
parent 2650d9e15a
commit 210aee68d4
4 changed files with 43 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 @@
2009-05-05 Janus Weil <janus@gcc.gnu.org>
PR fortran/39998
* expr.c (gfc_check_pointer_assign): Check for statement functions and
internal procedures in procedure pointer assignments.
2009-04-28 Janus Weil <janus@gcc.gnu.org>
PR fortran/39946

16
gcc/fortran/expr.c
View File

@ -3148,6 +3148,22 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
rvalue->symtree->name, &rvalue->where);
return FAILURE;
}
/* Check for C727. */
if (attr.flavor == FL_PROCEDURE)
{
if (attr.proc == PROC_ST_FUNCTION)
{
gfc_error ("Statement function '%s' is invalid "
"in procedure pointer assignment at %L",
rvalue->symtree->name, &rvalue->where);
return FAILURE;
}
if (attr.proc == PROC_INTERNAL &&
gfc_notify_std (GFC_STD_F2008, "Internal procedure '%s' is "
"invalid in procedure pointer assignment at %L",
rvalue->symtree->name, &rvalue->where) == FAILURE)
return FAILURE;
}
if (rvalue->expr_type == EXPR_VARIABLE
&& !gfc_compare_interfaces (lvalue->symtree->n.sym,
rvalue->symtree->n.sym, 0))

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2009-05-05 Janus Weil <janus@gcc.gnu.org>
PR fortran/39998
* gfortran.dg/proc_ptr_17.f90: New.
2009-05-05 Richard Guenther <rguenther@suse.de>
PR tree-optimization/40022

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

@ -0,0 +1,16 @@
! { dg-do compile }
! { dg-options "-std=f2003" }
!
! PR39998: Procedure Pointer Assignments: Statement Functions & Internal Functions.
!
! Contributed by Tobias Burnus <burnus@net-b.de>
procedure(), pointer :: p
f(x) = x**2
p => f ! { dg-error "invalid in procedure pointer assignment" }
p => sub ! { dg-error "invalid in procedure pointer assignment" }
contains
subroutine sub
end subroutine sub
end