re PR fortran/32881 (PURE attribute escapes from contained procedure)
authorPaul Thomas <pault@gcc.gnu.org>
Sat, 18 Aug 2007 10:47:58 +0000 (10:47 +0000)
committerPaul Thomas <pault@gcc.gnu.org>
Sat, 18 Aug 2007 10:47:58 +0000 (10:47 +0000)
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

gcc/fortran/ChangeLog
gcc/fortran/expr.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/pure_initializer_1.f90 [new file with mode: 0644]

index 4103e254993a84f19b86f4a70f23bb6b0f1e7e1a..f0fa1f4e7571b5baa23ed73c1957775a67712b21 100644 (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
index f0de19fa48ca95232fd28bccf2817b2c5f13df51..8c44028fb23ab4378ae0dc730ef217680d38d360 100644 (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;
index 3c01d60051507c80d35e79973c812897d4eeff47..992a1a03c401f7aad214d71038ff6e13e0ebf74e 100644 (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
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
@@ -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
+