From a6c975bd8e847c29541026b66b33275b42df4995 Mon Sep 17 00:00:00 2001
From: Jakub Jelinek <jakub@redhat.com>
Date: Fri, 26 Aug 2011 16:55:05 +0200
Subject: [PATCH] trans-decl.c (get_proc_pointer_decl): Set DECL_TLS_MODEL if
threadprivate.
* 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.
From-SVN: r178114
---
gcc/fortran/ChangeLog | 7 ++
gcc/fortran/symbol.c | 3 +-
gcc/fortran/trans-decl.c | 5 ++
libgomp/ChangeLog | 4 +
.../libgomp.fortran/threadprivate4.f90 | 78 +++++++++++++++++++
5 files changed, 96 insertions(+), 1 deletion(-)
create mode 100644 libgomp/testsuite/libgomp.fortran/threadprivate4.f90
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index be796bae6e15..08c68ada97e5 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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.
+
2011-08-25 Mikael Morin <mikael.morin@gcc.gnu.org>
PR fortran/50050
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 126a52b9e7e8..ce4ab3d1c38f 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -673,7 +673,8 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf2 (codimension);
conf2 (dimension);
conf2 (function);
- conf2 (threadprivate);
+ if (!attr->proc_pointer)
+ conf2 (threadprivate);
}
if (!attr->proc_pointer)
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 1059a42f8abb..c85e20c007b4 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1534,6 +1534,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);
diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog
index c5ebeb0b555e..37864682ea16 100644
--- a/libgomp/ChangeLog
+++ b/libgomp/ChangeLog
@@ -1,3 +1,7 @@
+2011-08-26 Jakub Jelinek <jakub@redhat.com>
+
+ * testsuite/libgomp.fortran/threadprivate4.f90: New test.
+
2011-08-19 Jakub Jelinek <jakub@redhat.com>
PR fortran/49792
diff --git a/libgomp/testsuite/libgomp.fortran/threadprivate4.f90 b/libgomp/testsuite/libgomp.fortran/threadprivate4.f90
new file mode 100644
index 000000000000..b5fb10bfee76
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/threadprivate4.f90
@@ -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" } }
--
GitLab