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.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4103e25..f0fa1f4 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,11 @@
 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
        * trans-array.c (get_array_ctor_strlen): Set the character
        length of a zero length array to zero.

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index f0de19f..8c44028 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -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;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3c01d60..992a1a0 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 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
        * gfortran.dg/array_constructor_18.f90: New test.
 

diff --git a/gcc/testsuite/gfortran.dg/pure_initializer_1.f90 b/gcc/testsuite/gfortran.dg/pure_initializer_1.f90
new file mode 100644 (file)
index 0000000..6f521a0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pure_initializer_1.f90
@@ -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
+