public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* Patch for [Bug fortran/81841] [5/6/7/8 Regression] THREADPRIVATE (OpenMP) wrongly rejected in BLOCK DATA
@ 2017-09-01  9:09 dbroemmel
  2017-09-01 12:08 ` Jakub Jelinek
  0 siblings, 1 reply; 7+ messages in thread
From: dbroemmel @ 2017-09-01  9:09 UTC (permalink / raw)
  To: fortran, gcc-patches

[-- 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

^ permalink raw reply	[flat|nested] 7+ messages in thread

* Re: Patch for [Bug fortran/81841] [5/6/7/8 Regression] THREADPRIVATE (OpenMP) wrongly rejected in BLOCK DATA
  2017-09-01  9:09 Patch for [Bug fortran/81841] [5/6/7/8 Regression] THREADPRIVATE (OpenMP) wrongly rejected in BLOCK DATA dbroemmel
@ 2017-09-01 12:08 ` Jakub Jelinek
  2017-09-01 12:27   ` dbroemmel
  0 siblings, 1 reply; 7+ messages in thread
From: Jakub Jelinek @ 2017-09-01 12:08 UTC (permalink / raw)
  To: dbroemmel; +Cc: fortran, gcc-patches

On Fri, Sep 01, 2017 at 11:09:47AM +0200, dbroemmel wrote:
> 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

The ChangeLog format is date two spaces real name two spaces <email@address>
> 
>     PR fortran/81841
>     * parse.c (parse_spec): adding ST_OMP_THREADPRIVATE as allowed

Add instead of adding
Also all the ChangeLog lines except empty and ones starting with date
should be tab indented, not sure if it is your mailer that ate it or
omission.

>     statement.
> 
> 2017-09-01 dbroemmel
> 
>     PR fortran/81841
>     * gfortran.dg/gomp/omp_threadprivate3.f90: New testcase.

> 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:

This looks good.

> 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 }

This is wrong.  Runtime testcases for OpenMP belong into libgomp/testsuite/.
That said, I fail to see why such a large testcase is needed, wouldn't a
simple
! PR fortran/81841
! { dg-do compile }

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

testcase in gfortran.dg/gomp/ be sufficient here?

	Jakub

^ permalink raw reply	[flat|nested] 7+ messages in thread

* Re: Patch for [Bug fortran/81841] [5/6/7/8 Regression] THREADPRIVATE (OpenMP) wrongly rejected in BLOCK DATA
  2017-09-01 12:08 ` Jakub Jelinek
@ 2017-09-01 12:27   ` dbroemmel
  2017-09-01 13:11     ` Jakub Jelinek
  0 siblings, 1 reply; 7+ messages in thread
From: dbroemmel @ 2017-09-01 12:27 UTC (permalink / raw)
  To: Jakub Jelinek; +Cc: fortran, gcc-patches

> This is wrong.  Runtime testcases for OpenMP belong into libgomp/testsuite/.
Well, that's a path where I found some Fortran OpenMP stuff, I didn't
look for other places.

> That said, I fail to see why such a large testcase is needed, wouldn't a
> simple
> ! PR fortran/81841
> ! { dg-do compile }
> 
> 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
> 
> testcase in gfortran.dg/gomp/ be sufficient here?
That would suffice and is the first testcase I added to PR81841. It was
suggested I could add runtime tests as well, so I tried.

Dirk

^ permalink raw reply	[flat|nested] 7+ messages in thread

* Re: Patch for [Bug fortran/81841] [5/6/7/8 Regression] THREADPRIVATE (OpenMP) wrongly rejected in BLOCK DATA
  2017-09-01 12:27   ` dbroemmel
@ 2017-09-01 13:11     ` Jakub Jelinek
  2017-09-01 13:47       ` dbroemmel
  0 siblings, 1 reply; 7+ messages in thread
From: Jakub Jelinek @ 2017-09-01 13:11 UTC (permalink / raw)
  To: dbroemmel; +Cc: fortran, gcc-patches

On Fri, Sep 01, 2017 at 02:27:40PM +0200, dbroemmel wrote:
> > This is wrong.  Runtime testcases for OpenMP belong into libgomp/testsuite/.
> Well, that's a path where I found some Fortran OpenMP stuff, I didn't
> look for other places.
> 
> > That said, I fail to see why such a large testcase is needed, wouldn't a
> > simple
> > ! PR fortran/81841
> > ! { dg-do compile }
> > 
> > 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
> > 
> > testcase in gfortran.dg/gomp/ be sufficient here?
> That would suffice and is the first testcase I added to PR81841. It was
> suggested I could add runtime tests as well, so I tried.

If you really need a testcase, it would be enough to do something like:
  use omp_lib
  !$omp parallel num_threads(2)
  int2 = omp_get_thread_num ()
  !$omp barrier
  if (int2 != omp_get_thread_num ()) call abort
  !$omp end parallel
or so to ensure it has the threadprivate property by writing something
different to it in each thread and after barrier verifying it has the
expected value in each thread.

	Jakub

^ permalink raw reply	[flat|nested] 7+ messages in thread

* Re: Patch for [Bug fortran/81841] [5/6/7/8 Regression] THREADPRIVATE (OpenMP) wrongly rejected in BLOCK DATA
  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
  0 siblings, 2 replies; 7+ messages in thread
From: dbroemmel @ 2017-09-01 13:47 UTC (permalink / raw)
  To: Jakub Jelinek; +Cc: fortran, gcc-patches

> If you really need a testcase, it would be enough to do something like:
>   use omp_lib
>   !$omp parallel num_threads(2)
>   int2 = omp_get_thread_num ()
>   !$omp barrier
>   if (int2 != omp_get_thread_num ()) call abort
>   !$omp end parallel
> or so to ensure it has the threadprivate property by writing something
> different to it in each thread and after barrier verifying it has the
> expected value in each thread.
I'm more than fine with the short compile-only testcase. I pretty sure
my largish runtime test doesn't get near covering all relevant aspects
of the THREADPRIVATE directive for common blocks. Also, the fix is for
this reject-valid parsing error, so not really to do with anything else,
so perhaps shouldn't test anything else?

Dirk

^ permalink raw reply	[flat|nested] 7+ messages in thread

* Re: Patch for [Bug fortran/81841] [5/6/7/8 Regression] THREADPRIVATE (OpenMP) wrongly rejected in BLOCK DATA
  2017-09-01 13:47       ` dbroemmel
@ 2017-09-01 13:55         ` Jakub Jelinek
  2017-11-23 20:26         ` Jakub Jelinek
  1 sibling, 0 replies; 7+ messages in thread
From: Jakub Jelinek @ 2017-09-01 13:55 UTC (permalink / raw)
  To: dbroemmel; +Cc: fortran, gcc-patches

On Fri, Sep 01, 2017 at 03:47:10PM +0200, dbroemmel wrote:
> > If you really need a testcase, it would be enough to do something like:
> >   use omp_lib
> >   !$omp parallel num_threads(2)
> >   int2 = omp_get_thread_num ()
> >   !$omp barrier
> >   if (int2 != omp_get_thread_num ()) call abort
> >   !$omp end parallel
> > or so to ensure it has the threadprivate property by writing something
> > different to it in each thread and after barrier verifying it has the
> > expected value in each thread.
> I'm more than fine with the short compile-only testcase. I pretty sure
> my largish runtime test doesn't get near covering all relevant aspects
> of the THREADPRIVATE directive for common blocks. Also, the fix is for
> this reject-valid parsing error, so not really to do with anything else,
> so perhaps shouldn't test anything else?

Yes, I said initially a compile time testcase is just fine for me.

	Jakub

^ permalink raw reply	[flat|nested] 7+ messages in thread

* Re: Patch for [Bug fortran/81841] [5/6/7/8 Regression] THREADPRIVATE (OpenMP) wrongly rejected in BLOCK DATA
  2017-09-01 13:47       ` dbroemmel
  2017-09-01 13:55         ` Jakub Jelinek
@ 2017-11-23 20:26         ` Jakub Jelinek
  1 sibling, 0 replies; 7+ messages in thread
From: Jakub Jelinek @ 2017-11-23 20:26 UTC (permalink / raw)
  To: dbroemmel; +Cc: fortran, gcc-patches

On Fri, Sep 01, 2017 at 03:47:10PM +0200, dbroemmel wrote:
> > If you really need a testcase, it would be enough to do something like:
> >   use omp_lib
> >   !$omp parallel num_threads(2)
> >   int2 = omp_get_thread_num ()
> >   !$omp barrier
> >   if (int2 != omp_get_thread_num ()) call abort
> >   !$omp end parallel
> > or so to ensure it has the threadprivate property by writing something
> > different to it in each thread and after barrier verifying it has the
> > expected value in each thread.
> I'm more than fine with the short compile-only testcase. I pretty sure
> my largish runtime test doesn't get near covering all relevant aspects
> of the THREADPRIVATE directive for common blocks. Also, the fix is for
> this reject-valid parsing error, so not really to do with anything else,
> so perhaps shouldn't test anything else?

I was expecting you'd repost the patch with updated testcase and then
forgot about the issue, got to it only now when looking through regressions.

I've bootstrapped/regtested this version and committed it so far to trunk:

2017-11-23  Dirk Broemmel  <dibr-bugzilla@daswigwam.de>
	    Jakub Jelinek  <jakub@redhat.com>

	PR fortran/81841
	* parse.c (parse_spec): Allow ST_OMP_THREADPRIVATE inside of
	BLOCK DATA.

	* libgomp.fortran/pr81841.f90: New test.

--- gcc/fortran/parse.c.jj	2017-11-06 08:46:32.000000000 +0100
+++ gcc/fortran/parse.c	2017-11-23 18:40:44.727973342 +0100
@@ -3699,6 +3699,7 @@ loop:
 	case ST_EQUIVALENCE:
 	case ST_IMPLICIT:
 	case ST_IMPLICIT_NONE:
+	case ST_OMP_THREADPRIVATE:
 	case ST_PARAMETER:
 	case ST_STRUCTURE_DECL:
 	case ST_TYPE:
--- libgomp/testsuite/libgomp.fortran/pr81841.f90.jj	2017-11-23 18:34:37.319385141 +0100
+++ libgomp/testsuite/libgomp.fortran/pr81841.f90	2017-11-23 18:44:36.055198860 +0100
@@ -0,0 +1,26 @@
+! PR fortran/81841
+! { dg-do run }
+
+block data
+  integer :: a
+  real :: b(2)
+  common /c/ a, b
+  !$omp threadprivate (/c/)
+  data a / 32 /
+  data b /2*1./
+end
+
+program pr81841
+  use omp_lib
+  integer :: e
+  real :: f(2)
+  common /c/ e, f
+  !$omp threadprivate (/c/)
+  !$omp parallel num_threads(8)
+  if ((e /= 32) .or. any(f /= 1.)) call abort
+  e = omp_get_thread_num ()
+  f = e + 19.
+  !$omp barrier
+  if ((e /= omp_get_thread_num ()) .or. any(f /= e + 19.)) call abort
+  !$omp end parallel
+end


	Jakub

^ permalink raw reply	[flat|nested] 7+ messages in thread

end of thread, other threads:[~2017-11-23 20:22 UTC | newest]

Thread overview: 7+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-09-01  9:09 Patch for [Bug fortran/81841] [5/6/7/8 Regression] THREADPRIVATE (OpenMP) wrongly rejected in BLOCK DATA dbroemmel
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

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).