Hi! This patch adds (tiny) code to handle procedure pointers in !$omp threadprivate plus a testcase. This is outside of the scope of OpenMP standard, i.e. an extension so far, hopefully OpenMP 4.0 will cover at least F2003, C++11 and maybe also F2008. Haven't touched any other OpenMP places wrt. procedure pointers, so e.g. they aren't allowed in various other clauses.
Bootstrapped/regtested on x86_64-linux and i686-linux, committed to trunk. 2011-08-26 Jakub Jelinek <ja...@redhat.com> * trans-decl.c (get_proc_pointer_decl): Set DECL_TLS_MODEL if threadprivate. * symbol.c (check_conflict): Allow threadprivate attribute with FL_PROCEDURE if proc_pointer. * testsuite/libgomp.fortran/threadprivate4.f90: New test. --- gcc/fortran/trans-decl.c.jj 2011-08-18 08:35:51.000000000 +0200 +++ gcc/fortran/trans-decl.c 2011-08-26 11:34:31.000000000 +0200 @@ -1533,6 +1533,11 @@ get_proc_pointer_decl (gfc_symbol *sym) false, true); } + /* Handle threadprivate procedure pointers. */ + if (sym->attr.threadprivate + && (TREE_STATIC (decl) || DECL_EXTERNAL (decl))) + DECL_TLS_MODEL (decl) = decl_default_tls_model (decl); + attributes = add_attributes_to_decl (sym->attr, NULL_TREE); decl_attributes (&decl, attributes, 0); --- gcc/fortran/symbol.c.jj 2011-08-22 08:17:04.000000000 +0200 +++ gcc/fortran/symbol.c 2011-08-26 12:31:10.000000000 +0200 @@ -673,7 +673,8 @@ check_conflict (symbol_attribute *attr, conf2 (codimension); conf2 (dimension); conf2 (function); - conf2 (threadprivate); + if (!attr->proc_pointer) + conf2 (threadprivate); } if (!attr->proc_pointer) --- libgomp/testsuite/libgomp.fortran/threadprivate4.f90.jj 2011-08-26 11:54:50.000000000 +0200 +++ libgomp/testsuite/libgomp.fortran/threadprivate4.f90 2011-08-26 12:35:22.000000000 +0200 @@ -0,0 +1,78 @@ +! { dg-do run } +! { dg-require-effective-target tls_runtime } + +module threadprivate4 + integer :: vi + procedure(), pointer :: foo +!$omp threadprivate (foo, vi) + +contains + subroutine fn0 + vi = 0 + end subroutine fn0 + subroutine fn1 + vi = 1 + end subroutine fn1 + subroutine fn2 + vi = 2 + end subroutine fn2 + subroutine fn3 + vi = 3 + end subroutine fn3 +end module threadprivate4 + + use omp_lib + use threadprivate4 + + integer :: i + logical :: l + + procedure(), pointer :: bar1 + common /thrc/ bar1 +!$omp threadprivate (/thrc/) + + procedure(), pointer, save :: bar2 +!$omp threadprivate (bar2) + + l = .false. + call omp_set_dynamic (.false.) + call omp_set_num_threads (4) + +!$omp parallel num_threads (4) reduction (.or.:l) private (i) + i = omp_get_thread_num () + if (i.eq.0) then + foo => fn0 + bar1 => fn0 + bar2 => fn0 + elseif (i.eq.1) then + foo => fn1 + bar1 => fn1 + bar2 => fn1 + elseif (i.eq.2) then + foo => fn2 + bar1 => fn2 + bar2 => fn2 + else + foo => fn3 + bar1 => fn3 + bar2 => fn3 + end if + vi = -1 +!$omp barrier + vi = -1 + call foo () + l=l.or.(vi.ne.i) + vi = -2 + call bar1 () + l=l.or.(vi.ne.i) + vi = -3 + call bar2 () + l=l.or.(vi.ne.i) + vi = -1 +!$omp end parallel + + if (l) call abort + +end + +! { dg-final { cleanup-modules "threadprivate4" } } Jakub