[PATCH] Support (as an extension) threadprivate procedure pointers

[Jakub Jelinek <jakub@redhat.com>]

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