procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/32881 (PURE attribute escapes from contained procedure)

Browse source 
2007-08-18  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/32881
	* expr.c (gfc_check_pointer_assign): If the rhs is the
	initialization expression for the rhs, there is no error.

2007-08-18  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/32881
	* gfortran.dg/pure_initializer_1.f90: New test.

From-SVN: r127611
This commit is contained in:
Paul Thomas 2007-08-18 10:47:58 +00:00
parent 58fbb917c9
commit a595913e95
4 changed files with 30 additions and 1 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 @@
2007-08-18 Paul Thomas <pault@gcc.gnu.org>
PR fortran/32881
* expr.c (gfc_check_pointer_assign): If the rhs is the
initialization expression for the rhs, there is no error.
2007-08-18 Paul Thomas <pault@gcc.gnu.org>
PR fortran/32875

3
gcc/fortran/expr.c
View file

@ -2749,7 +2749,8 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
is_pure = gfc_pure (NULL);
if (is_pure && gfc_impure_variable (lvalue->symtree->n.sym))
if (is_pure && gfc_impure_variable (lvalue->symtree->n.sym)
&& lvalue->symtree->n.sym->value != rvalue)
{
gfc_error ("Bad pointer object in PURE procedure at %L", &lvalue->where);
return FAILURE;

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2007-08-18 Paul Thomas <pault@gcc.gnu.org>
PR fortran/32881
* gfortran.dg/pure_initializer_1.f90: New test.
2007-08-18 Paul Thomas <pault@gcc.gnu.org>
PR fortran/32875

17
gcc/testsuite/gfortran.dg/pure_initializer_1.f90 Normal file
View file

@ -0,0 +1,17 @@
! { dg-do compile }
! Tests the fix for PR32881, in which the initialization
! of 'p' generated an error because the pureness of 'bar'
! escaped.
!
! Contributed by Janne Blomqvist <jb@gcc.gnu.org>
!
subroutine foo ()
integer, pointer :: p => NULL()
contains
pure function bar (a)
integer, intent(in) :: a
integer :: bar
bar = a
end function bar
end subroutine foo