PR fortran/44036

	* openmp.c (resolve_omp_clauses): Allow procedure pointers in clause
	variable lists.
	* trans-openmp.c (gfc_omp_privatize_by_reference): Don't privatize
	by reference dummy procedures or non-dummy procedure pointers.
	(gfc_omp_predetermined_sharing): Return
	OMP_CLAUSE_DEFAULT_FIRSTPRIVATE for dummy procedures.

	* gfortran.dg/gomp/pr44036-1.f90: New test.
	* gfortran.dg/gomp/pr44036-2.f90: New test.
	* gfortran.dg/gomp/pr44036-3.f90: New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159361 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 86a9574931850ef7bcb0eb45c5de2f7c31467e9c..2eb730b212f717b01bc5aec21f238e8038c7a1f7 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2010-05-13  Jakub Jelinek  <jakub@redhat.com>
+
+       PR fortran/44036
+       * openmp.c (resolve_omp_clauses): Allow procedure pointers in clause
+       variable lists.
+       * trans-openmp.c (gfc_omp_privatize_by_reference): Don't privatize
+       by reference dummy procedures or non-dummy procedure pointers.
+       (gfc_omp_predetermined_sharing): Return
+       OMP_CLAUSE_DEFAULT_FIRSTPRIVATE for dummy procedures.
+
 2010-05-11  Daniel Franke  <franke.daniel@gmail.com>
 
         PR fortran/43711

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index bbf7e5a245dcb4c7457311feb74e440671d1c94f..4e965217cc77a31715fa061b1df4b45f7294f674 100644 (file)
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -837,6 +837,8 @@ 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/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 016c5cff269bddd18fecf5fc242792b5476fd263..f2e550acdc74d5d47b7404fb21673c770ae3f13e 100644 (file)
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -1,5 +1,6 @@
 /* OpenMP directive translation -- generate GCC trees from gfc_code.
-   Copyright (C) 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+   Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+   Free Software Foundation, Inc.
    Contributed by Jakub Jelinek <jakub@redhat.com>
 
 This file is part of GCC.
@@ -57,7 +58,8 @@ gfc_omp_privatize_by_reference (const_tree decl)
       if (GFC_POINTER_TYPE_P (type))
        return false;
 
-      if (!DECL_ARTIFICIAL (decl))
+      if (!DECL_ARTIFICIAL (decl)
+         && TREE_CODE (TREE_TYPE (type)) != FUNCTION_TYPE)
        return true;
 
       /* Some arrays are expanded as DECL_ARTIFICIAL pointers
@@ -96,6 +98,15 @@ gfc_omp_predetermined_sharing (tree decl)
         == NULL)
     return OMP_CLAUSE_DEFAULT_SHARED;
 
+  /* Dummy procedures aren't considered variables by OpenMP, thus are
+     disallowed in OpenMP clauses.  They are represented as PARM_DECLs
+     in the middle-end, so return OMP_CLAUSE_DEFAULT_FIRSTPRIVATE here
+     to avoid complaining about their uses with default(none).  */
+  if (TREE_CODE (decl) == PARM_DECL
+      && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE
+      && TREE_CODE (TREE_TYPE (TREE_TYPE (decl))) == FUNCTION_TYPE)
+    return OMP_CLAUSE_DEFAULT_FIRSTPRIVATE;
+
   /* COMMON and EQUIVALENCE decls are shared.  They
      are only referenced through DECL_VALUE_EXPR of the variables
      contained in them.  If those are privatized, they will not be

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8b0418c4b39b0f979ea0d17f1fdf8842c6030816..32f980101f64850234fc39dd221e5596e4da4f5e 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 2010-05-13  Jakub Jelinek  <jakub@redhat.com>
 
+       PR fortran/44036
+       * gfortran.dg/gomp/pr44036-1.f90: New test.
+       * gfortran.dg/gomp/pr44036-2.f90: New test.
+       * gfortran.dg/gomp/pr44036-3.f90: New test.
+
        PR debug/43983
        * gcc.dg/guality/sra-1.c: New test.
 

diff --git a/gcc/testsuite/gfortran.dg/gomp/pr44036-1.f90 b/gcc/testsuite/gfortran.dg/gomp/pr44036-1.f90
new file mode 100644 (file)
index 0000000..e856578
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr44036-1.f90
@@ -0,0 +1,24 @@
+! PR fortran/44036
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+subroutine foo(a, b)
+  integer, external :: a
+  integer, external, pointer :: b
+  integer, external :: c
+  integer, external, pointer :: d
+  integer :: x
+  x = 6
+!$omp parallel default(none) private (x)
+  x = a(4)
+!$omp end parallel
+!$omp parallel default(none) private (x)       ! { dg-error "enclosing parallel" }
+  x = b(5)                                     ! { dg-error "not specified in" "" { target *-*-* } 11 }
+!$omp end parallel
+!$omp parallel default(none) private (x)
+  x = c(6)
+!$omp end parallel
+  d => a
+!$omp parallel default(none) private (x)       ! { dg-error "enclosing parallel" }
+  x = d(7)                                     ! { dg-error "not specified in" }
+!$omp end parallel
+end

diff --git a/gcc/testsuite/gfortran.dg/gomp/pr44036-2.f90 b/gcc/testsuite/gfortran.dg/gomp/pr44036-2.f90
new file mode 100644 (file)
index 0000000..c9320f1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr44036-2.f90
@@ -0,0 +1,17 @@
+! PR fortran/44036
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+subroutine foo(a, b)
+  integer, external :: a
+  integer, external, pointer :: b
+  integer, external :: c
+  integer, external, pointer :: d
+  integer :: x
+  d => a
+!$omp parallel default(none) private (x) firstprivate (b, d)
+  x = a(4)
+  x = b(5)
+  x = c(6)
+  x = d(7)
+!$omp end parallel
+end

diff --git a/gcc/testsuite/gfortran.dg/gomp/pr44036-3.f90 b/gcc/testsuite/gfortran.dg/gomp/pr44036-3.f90
new file mode 100644 (file)
index 0000000..449cb95
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr44036-3.f90
@@ -0,0 +1,13 @@
+! PR fortran/44036
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+subroutine foo(a)
+  integer, external :: a, c
+  integer :: x
+!$omp parallel default(none) private (x) shared (a)    ! { dg-error "is not a variable" }
+  x = a(6)
+!$omp end parallel
+!$omp parallel default(none) private (x) shared (c)    ! { dg-error "is not a variable" }
+  x = c(6)
+!$omp end parallel
+end