From: Janus Weil <janus@gcc.gnu.org>
Date: Mon, 19 Aug 2013 09:03:20 +0000 (+0200)
Subject: re PR fortran/46271 ([F03] OpenMP default(none) and procedure pointers)
X-Git-Tag: upstream/12.2.0~68349
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=5eb5ec2f3034a1c62262914b090f64a5d5f0bc86;p=platform%2Fupstream%2Fgcc.git

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
--- 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
--- 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
--- 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
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