re PR fortran/46271 ([F03] OpenMP default(none) and procedure pointers)

2013-08-19  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/46271
	* openmp.c (resolve_omp_clauses): Bugfix for procedure pointers.


2013-08-19  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/46271
	* gfortran.dg/gomp/proc_ptr_1.f90: New.

From-SVN: r201835

gcc/fortran/ChangeLog

+2013-08-19  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/46271
+	* openmp.c (resolve_omp_clauses): Bugfix for procedure pointers.
+
 2013-08-12  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/56666

gcc/fortran/openmp.c

@@ -847,7 +847,7 @@ resolve_omp_clauses (gfc_code *code)
     for (n = omp_clauses->lists[list]; n; n = n->next)
       {
 	n->sym->mark = 0;
-	if (n->sym->attr.flavor == FL_VARIABLE)
+	if (n->sym->attr.flavor == FL_VARIABLE || n->sym->attr.proc_pointer)
 	  continue;
 	if (n->sym->attr.flavor == FL_PROCEDURE
 	    && n->sym->result == n->sym
@@ -876,8 +876,6 @@ resolve_omp_clauses (gfc_code *code)
 		if (el)
 		  continue;
 	      }
-	    if (n->sym->attr.proc_pointer)
-	      continue;
 	  }
 	gfc_error ("Object '%s' is not a variable at %L", n->sym->name,
 		   &code->loc);

gcc/testsuite/ChangeLog

+2013-08-19  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/46271
+	* gfortran.dg/gomp/proc_ptr_1.f90: New.
+
 2013-08-18  Jakub Jelinek  <jakub@redhat.com>
 
 	PR tree-optimization/58006

gcc/testsuite/gfortran.dg/gomp/proc_ptr_1.f90

+! { dg-do compile }
+!
+! PR 46271: [F03] OpenMP default(none) and procedure pointers
+!
+! Contributed by Marco Restelli <mrestelli@gmail.com>
+
+program test
+  implicit none
+  integer :: i
+  real :: s(1000)
+  procedure(f), pointer :: pf
+ 
+  pf => f
+
+  !$omp parallel do schedule(static) private(i) shared(s,pf) default(none)
+  do i=1,1000
+    call pf(real(i),s(i))
+  enddo
+  !$omp end parallel do
+
+  write(*,*) 'Sum ',sum(s)
+contains
+  pure subroutine f(x,y)
+    real, intent(in) :: x
+    real, intent(out) :: y
+    y = sin(x)*cos(x)
+  end subroutine
+end