From: dbroemmel <dibr-bugzilla@daswigwam.de>
To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org
Subject: Patch for [Bug fortran/81841] [5/6/7/8 Regression] THREADPRIVATE (OpenMP) wrongly rejected in BLOCK DATA
Date: Fri, 01 Sep 2017 09:09:00 -0000 [thread overview]
Message-ID: <2f2d738f-90d7-0efe-1caf-7e3a6387b0eb@daswigwam.de> (raw)
[-- Attachment #1: Type: text/plain, Size: 536 bytes --]
Hi all,
attached are a proposed fix and new testcase for PR81841. The
THREADPRIVATE statement is currently wrongly rejected as part of BLOCK DATA.
The testcase also does (very basic) runtime checks. It fails (compiling)
prior to the patch and completes after. Tested on x86_64 GNU/Linux.
Thanks,
Dirk
2017-09-01 dbroemmel
PR fortran/81841
* parse.c (parse_spec): adding ST_OMP_THREADPRIVATE as allowed
statement.
2017-09-01 dbroemmel
PR fortran/81841
* gfortran.dg/gomp/omp_threadprivate3.f90: New testcase.
[-- Attachment #2: PR81841.diff --]
[-- Type: text/x-patch, Size: 8235 bytes --]
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c (revision 251553)
+++ gcc/fortran/parse.c (working copy)
@@ -3694,6 +3694,7 @@
case ST_EQUIVALENCE:
case ST_IMPLICIT:
case ST_IMPLICIT_NONE:
+ case ST_OMP_THREADPRIVATE:
case ST_PARAMETER:
case ST_STRUCTURE_DECL:
case ST_TYPE:
Index: gcc/testsuite/gfortran.dg/gomp/omp_threadprivate3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/gomp/omp_threadprivate3.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/gomp/omp_threadprivate3.f90 (working copy)
@@ -0,0 +1,158 @@
+! { dg-do run }
+! { dg-options "-fopenmp" }
+! PR fortran/81841
+
+
+! Test OpenMP THREADPRIVATE statement together w/ BLOCK DATA for COMMON BLOCKs.
+!
+! We try to test for correct initialisation per thread of compile and runtime values.
+! (The latter should be correctly defined on the master thread only, the former should
+! be identical on all threads.)
+! We also test behaviour in between two OpenMP PARALLEL regions.
+! (Changed values only expected to be valid between the first overlapping threads.)
+!
+! This could be extended to allocatables and pointers, however, assuming
+! THREADPRIVATE works in first place, this should test the BLOCK DATA case...
+program block_data_threadprivate
+ use omp_lib
+ implicit none
+
+ integer :: int1, int2, int3 ! variables 1 and 2 end up in two common blocks
+ real :: flt1, flt2, flt3 ! variables 3 should stay undefined
+ ! (and are not necessary but included to
+ ! check undefined values)
+ common /c_block_1/ int1, flt1 ! to be initialised at runtime
+ !$OMP THREADPRIVATE (/c_block_1/)
+ common /c_block_2/ int2, flt2 ! to be initialised via BLOCK DATA
+ !$OMP THREADPRIVATE (/c_block_2/)
+
+ ! runtime init int1 and flt1
+ ! (should be defined on master thread only)
+ int1 = 1
+ flt1 = 1.1
+ ! (int2 and flt2 should be available on all threads via BLOCK DATA and COMMON BLOCK)
+ write(*,'(a27,1x,3(i5,1x,f5.2,1x))') 'main thread, variables are:', int1, flt1, int2, flt2, int3, flt3
+ write(*,'(a27,1x,3(a5,1x,a5 ,1x))') 'they should be:', '1', '1.1', '2', '2.2', '???', '???'
+
+ ! spawn fixed number of threads to have predictable behaviour
+ write(*,'(a)') 'spawning 4 threads'
+ !$OMP PARALLEL default(none) private(int3, flt3) num_threads(4)
+ !$OMP CRITICAL
+ ! critical to get nicer, sorted output
+ write(*,'(a22,1x,i3,a1,1x)',advance='no') 'thread id', omp_get_thread_num(), ':'
+ write(*,'(3(i5,1x,f5.2,1x))') int1, flt1, int2, flt2, int3, flt3
+ select case (omp_get_thread_num())
+ case (0)
+ write(*,'(a27,1x,3(a5,1x,a5 ,1x))') 'they should be:', '1', '1.1', '2', '2.2', '???', '???'
+ if (int1 /= 1) call abort
+ if (int2 /= 2) call abort
+ if (flt1 >= 1.11 .or. flt1 <= 1.09) call abort
+ if (flt2 >= 2.21 .or. flt2 <= 2.19) call abort
+ case (1)
+ write(*,'(a27,1x,3(a5,1x,a5 ,1x))') 'they should be:', '???', '???', '2', '2.2', '???', '???'
+ if (int1 == 1) call abort
+ if (int2 /= 2) call abort
+ if (flt1 <= 1.11 .and. flt1 >= 1.09) call abort
+ if (flt2 >= 2.21 .or. flt2 <= 2.19) call abort
+ case (2)
+ write(*,'(a27,1x,3(a5,1x,a5 ,1x))') 'they should be:', '???', '???', '2', '2.2', '???', '???'
+ if (int1 == 1) call abort
+ if (int2 /= 2) call abort
+ if (flt1 <= 1.11 .and. flt1 >= 1.09) call abort
+ if (flt2 >= 2.21 .or. flt2 <= 2.19) call abort
+ case (3)
+ write(*,'(a27,1x,3(a5,1x,a5 ,1x))') 'they should be:', '???', '???', '2', '2.2', '???', '???'
+ if (int1 == 1) call abort
+ if (int2 /= 2) call abort
+ if (flt1 <= 1.11 .and. flt1 >= 1.09) call abort
+ if (flt2 >= 2.21 .or. flt2 <= 2.19) call abort
+ case default
+ call abort
+ end select
+ !$OMP END CRITICAL
+ !$OMP END PARALLEL
+
+ ! spawn fixed (but lower) number of threads and change private data
+ write(*,'(a)') 'spawning 2 threads (changing thread private variables)'
+ !$OMP PARALLEL default(none) private(int3, flt3) num_threads(2)
+ int1 = 10 ! those are THREADPRIVATE variables, so should change
+ flt1 = 10.1 ! on threads 1 and 2 only.
+ int2 = 20
+ flt2 = 20.2
+ !$OMP END PARALLEL
+
+ ! spawn initial number of threads to test variables between parallel blocks
+ write(*,'(a)') 'spawning 4 threads'
+ !$OMP PARALLEL default(none) private(int3, flt3) num_threads(4)
+ !$OMP CRITICAL
+ write(*,'(a22,1x,i3,a1,1x)',advance='no') 'thread id', omp_get_thread_num(), ':'
+ write(*,'(3(i5,1x,f5.2,1x))') int1, flt1, int2, flt2, int3, flt3
+ select case (omp_get_thread_num())
+ case (0)
+ write(*,'(a27,1x,3(a5,1x,a5 ,1x))') 'they should be:', '10', '10.1', '20', '20.2', '???', '???'
+ if (int1 /= 10) call abort
+ if (int2 /= 20) call abort
+ if (flt1 >= 10.11 .or. flt1 <= 10.09) call abort
+ if (flt2 >= 20.21 .or. flt2 <= 20.19) call abort
+ case (1)
+ write(*,'(a27,1x,3(a5,1x,a5 ,1x))') 'they should be:', '10', '10.1', '20', '20.2', '???', '???'
+ if (int1 /= 10) call abort
+ if (int2 /= 20) call abort
+ if (flt1 >= 10.11 .or. flt1 <= 10.09) call abort
+ if (flt2 >= 20.21 .or. flt2 <= 20.19) call abort
+ case (2)
+ write(*,'(a27,1x,3(a5,1x,a5 ,1x))') 'they should be:', '???', '???', '2', '2.2', '???', '???'
+ if (int1 == 1 .or. int1 == 10) call abort
+ if (int2 /= 2) call abort
+ if ((flt1 <= 1.11 .and. flt1 >= 1.09 ) .or. &
+ (flt1 <= 10.11 .and. flt1 >= 10.09)) call abort
+ if (flt2 >= 2.21 .or. flt2 <= 2.19) call abort
+ case (3)
+ write(*,'(a27,1x,3(a5,1x,a5 ,1x))') 'they should be:', '???', '???', '2', '2.2', '???', '???'
+ if (int1 == 1 .or. int1 == 10) call abort
+ if (int2 /= 2) call abort
+ if ((flt1 <= 1.11 .and. flt1 >= 1.09 ) .or. &
+ (flt1 <= 10.11 .and. flt1 >= 10.09)) call abort
+ if (flt2 >= 2.21 .or. flt2 <= 2.19) call abort
+ case default
+ call abort
+ end select
+ !$OMP END CRITICAL
+ !$OMP END PARALLEL
+
+ ! change variable on master thread
+ int1 = 3
+ flt1 = 3.3
+ int2 = 4
+ flt2 = 4.4
+ write(*,'(a27,1x,3(i5,1x,f5.2,1x))') 'main thread, variables are:', int1, flt1, int2, flt2, int3, flt3
+ write(*,'(a27,1x,3(a5,1x,a5 ,1x))') 'they should be:', '3', '3.3', '4', '4.4', '???', '???'
+
+ ! spawn initial number of threads, now using copyin assignment
+ write(*,'(a)') 'spawning 4 threads (using copyin)'
+ !$OMP PARALLEL default(none) private(int3, flt3) num_threads(4) copyin(/c_block_1/, /c_block_2/)
+ !$OMP CRITICAL
+ write(*,'(a22,1x,i3,a1,1x)',advance='no') 'thread id', omp_get_thread_num(), ':'
+ write(*,'(3(i5,1x,f5.2,1x))') int1, flt1, int2, flt2, int3, flt3
+ write(*,'(a27,1x,3(a5,1x,a5 ,1x))') 'they should be:', '3', '3.3', '4', '4.4', '???', '???'
+ if (int1 /= 3) call abort
+ if (int2 /= 4) call abort
+ if (flt1 >= 3.31 .or. flt1 <= 3.29) call abort
+ if (flt2 >= 4.41 .or. flt2 <= 4.29) call abort
+ !$OMP END CRITICAL
+ !$OMP END PARALLEL
+
+end program block_data_threadprivate
+
+! The DATA statement cannot be used for variables contained in a COMMON BLOCK,
+! instead, BLOCK DATA has to be used to input data at compile time.
+! When using OpenMP, THREADPRIVATE statements should be allowed and are required
+! with every use of the COMMON BLOCK.
+block data
+ implicit none
+ integer :: int2
+ real :: flt2
+ common /c_block_2/ int2, flt2
+ !$OMP THREADPRIVATE(/c_block_2/)
+ data int2, flt2 /2, 2.2/
+end block data
next reply other threads:[~2017-09-01 9:09 UTC|newest]
Thread overview: 7+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-09-01 9:09 dbroemmel [this message]
2017-09-01 12:08 ` Jakub Jelinek
2017-09-01 12:27 ` dbroemmel
2017-09-01 13:11 ` Jakub Jelinek
2017-09-01 13:47 ` dbroemmel
2017-09-01 13:55 ` Jakub Jelinek
2017-11-23 20:26 ` Jakub Jelinek
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=2f2d738f-90d7-0efe-1caf-7e3a6387b0eb@daswigwam.de \
--to=dibr-bugzilla@daswigwam.de \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).