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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ba34ac1..53e446e 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+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

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 865f836..6c4dccb 100644 (file)
--- a/gcc/fortran/openmp.c
+++ b/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);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 659ce71..d0eee3f 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/gomp/proc_ptr_1.f90 b/gcc/testsuite/gfortran.dg/gomp/proc_ptr_1.f90
new file mode 100644 (file)
index 0000000..952c314
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/proc_ptr_1.f90
@@ -0,0 +1,28 @@
+! { 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