From 5eb5ec2f3034a1c62262914b090f64a5d5f0bc86 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Mon, 19 Aug 2013 11:03:20 +0200 Subject: [PATCH] re PR fortran/46271 ([F03] OpenMP default(none) and procedure pointers) 2013-08-19 Janus Weil PR fortran/46271 * openmp.c (resolve_omp_clauses): Bugfix for procedure pointers. 2013-08-19 Janus Weil PR fortran/46271 * gfortran.dg/gomp/proc_ptr_1.f90: New. From-SVN: r201835 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/openmp.c | 4 +--- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/gomp/proc_ptr_1.f90 | 28 +++++++++++++++++++++++++++ 4 files changed, 39 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/proc_ptr_1.f90 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 + + PR fortran/46271 + * openmp.c (resolve_omp_clauses): Bugfix for procedure pointers. + 2013-08-12 Thomas Koenig 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 + + PR fortran/46271 + * gfortran.dg/gomp/proc_ptr_1.f90: New. + 2013-08-18 Jakub Jelinek 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 + +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 -- 2.7.4