diff mbox

[gomp4.5] Minor OpenMP 4.5 fortran translation fixes, 3 new taskloop testcases

Message ID 20160517170017.GM28550@tucnak.redhat.com
State New
Headers show

Commit Message

Jakub Jelinek May 17, 2016, 5 p.m. UTC
Hi!

Tested on x86_64-linux, committed to gomp-4_5-branch.

2016-05-17  Jakub Jelinek  <jakub@redhat.com>

	* trans-openmp.c (gfc_split_omp_clauses): Handle EXEC_OMP_TARGET_SIMD.
	(gfc_trans_omp_teams): Don't wrap into OMP_TEAMS if -fopenmp-simd.
	(gfc_trans_omp_target): Set OMP_TARGET_COMBINED if needed.

	* testsuite/libgomp.fortran/taskloop-1.f90: Renamed to ...
	* testsuite/libgomp.fortran/taskloop1.f90: ... this.
	* testsuite/libgomp.fortran/taskloop2.f90: New test.
	* testsuite/libgomp.fortran/taskloop3.f90: New test.
	* testsuite/libgomp.fortran/taskloop4.f90: New test.


	Jakub
diff mbox

Patch

--- gcc/fortran/trans-openmp.c.jj	2016-05-16 17:56:25.000000000 +0200
+++ gcc/fortran/trans-openmp.c	2016-05-17 12:21:11.289337099 +0200
@@ -3809,6 +3809,10 @@  gfc_split_omp_clauses (gfc_code *code,
 	     | GFC_OMP_MASK_SIMD;
       innermost = GFC_OMP_SPLIT_SIMD;
       break;
+    case EXEC_OMP_TARGET_SIMD:
+      mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_SIMD;
+      innermost = GFC_OMP_SPLIT_SIMD;
+      break;
     case EXEC_OMP_TARGET_TEAMS:
       mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS;
       innermost = GFC_OMP_SPLIT_TEAMS;
@@ -4431,10 +4435,13 @@  gfc_trans_omp_teams (gfc_code *code, gfc
       stmt = gfc_trans_omp_distribute (code, clausesa);
       break;
     }
-  stmt = build2_loc (input_location, OMP_TEAMS, void_type_node, stmt,
-		     omp_clauses);
-  if (combined)
-    OMP_TEAMS_COMBINED (stmt) = 1;
+  if (flag_openmp)
+    {
+      stmt = build2_loc (input_location, OMP_TEAMS, void_type_node, stmt,
+			 omp_clauses);
+      if (combined)
+	OMP_TEAMS_COMBINED (stmt) = 1;
+    }
   gfc_add_expr_to_block (&block, stmt);
   return gfc_finish_block (&block);
 }
@@ -4502,8 +4509,12 @@  gfc_trans_omp_target (gfc_code *code)
       break;
     }
   if (flag_openmp)
-    stmt = build2_loc (input_location, OMP_TARGET, void_type_node, stmt,
-		       omp_clauses);
+    {
+      stmt = build2_loc (input_location, OMP_TARGET, void_type_node, stmt,
+			 omp_clauses);
+      if (code->op != EXEC_OMP_TARGET)
+	OMP_TARGET_COMBINED (stmt) = 1;
+    }
   gfc_add_expr_to_block (&block, stmt);
   return gfc_finish_block (&block);
 }
--- libgomp/testsuite/libgomp.fortran/taskloop-1.f90.jj	2016-05-16 16:38:49.100807474 +0200
+++ libgomp/testsuite/libgomp.fortran/taskloop-1.f90	2016-05-17 13:06:44.974169085 +0200
@@ -1,44 +0,0 @@ 
-  common /blk/ q, e
-  integer :: q, r
-  logical :: e
-!$omp parallel
-!$omp single
-  call foo (2, 7)
-  r = bar (12, 18)
-!$omp end single
-!$omp end parallel
-  if (q .ne. 6 .or. r .ne. 17 .or. e) call abort
-contains
-  subroutine foo (a, b)
-    integer, intent (in) :: a, b
-    common /blk/ q, e
-    integer :: q, r, d
-    logical :: e
-!$omp taskloop lastprivate (q) nogroup
-    do d = a, b, 2
-      q = d
-      if (d < 2 .or. d > 6 .or. iand (d, 1) .ne. 0) then
-!$omp atomic write
-        e = .true.
-      end if
-    end do
-  end subroutine foo
-  function bar (a, b)
-    integer, intent (in) :: a, b
-    integer :: bar
-    common /blk/ q, e
-    integer :: q, r, d, s
-    logical :: e
-    s = 7
-!$omp taskloop lastprivate (s)
-    do d = a, b - 1
-      if (d < 12 .or. d > 17) then
-!$omp atomic write
-        e = .true.
-      end if
-      s = d
-    end do
-!$omp end taskloop
-    bar = s
-  end function bar
-end
--- libgomp/testsuite/libgomp.fortran/taskloop1.f90.jj	2016-05-17 13:06:28.644391501 +0200
+++ libgomp/testsuite/libgomp.fortran/taskloop1.f90	2016-05-16 16:38:49.100807474 +0200
@@ -0,0 +1,44 @@ 
+  common /blk/ q, e
+  integer :: q, r
+  logical :: e
+!$omp parallel
+!$omp single
+  call foo (2, 7)
+  r = bar (12, 18)
+!$omp end single
+!$omp end parallel
+  if (q .ne. 6 .or. r .ne. 17 .or. e) call abort
+contains
+  subroutine foo (a, b)
+    integer, intent (in) :: a, b
+    common /blk/ q, e
+    integer :: q, r, d
+    logical :: e
+!$omp taskloop lastprivate (q) nogroup
+    do d = a, b, 2
+      q = d
+      if (d < 2 .or. d > 6 .or. iand (d, 1) .ne. 0) then
+!$omp atomic write
+        e = .true.
+      end if
+    end do
+  end subroutine foo
+  function bar (a, b)
+    integer, intent (in) :: a, b
+    integer :: bar
+    common /blk/ q, e
+    integer :: q, r, d, s
+    logical :: e
+    s = 7
+!$omp taskloop lastprivate (s)
+    do d = a, b - 1
+      if (d < 12 .or. d > 17) then
+!$omp atomic write
+        e = .true.
+      end if
+      s = d
+    end do
+!$omp end taskloop
+    bar = s
+  end function bar
+end
--- libgomp/testsuite/libgomp.fortran/taskloop2.f90.jj	2016-05-17 13:08:16.947916378 +0200
+++ libgomp/testsuite/libgomp.fortran/taskloop2.f90	2016-05-17 15:42:18.328235190 +0200
@@ -0,0 +1,134 @@ 
+! { dg-do run }
+! { dg-options "-O2" }
+! { dg-additional-options "-msse2" { target sse2_runtime } }
+! { dg-additional-options "-mavx" { target avx_runtime } }
+
+  integer, save :: u(1024), v(1024), w(1024), m
+  integer :: i
+  v = (/ (i, i = 1, 1024) /)
+  w = (/ (i + 1, i = 1, 1024) /)
+  !$omp parallel
+  !$omp single
+  call f1 (1, 1024)
+  !$omp end single
+  !$omp end parallel
+  do i = 1, 1024
+    if (u(i) .ne. 2 * i + 1) call abort
+    v(i) = 1024 - i
+    w(i) = 512 - i
+  end do
+  !$omp parallel
+  !$omp single
+    call f2 (2, 1022, 17)
+  !$omp end single
+  !$omp end parallel
+  do i = 1, 1024
+    if (i .lt. 2 .or. i .gt. 1022) then
+      if (u(i) .ne. 2 * i + 1) call abort
+    else
+      if (u(i) .ne. 1536 - 2 * i) call abort
+    end if
+    v(i) = i
+    w(i) = i + 1
+  end do
+  if (m .ne. (1023 + 2 * (1021 * 5 + 17) + 9)) call abort
+  !$omp parallel
+  !$omp single
+    call f3 (1, 1024)
+  !$omp end single
+  !$omp end parallel 
+  do i = 1, 1024
+    if (u(i) .ne. 2 * i + 1) call abort
+    v(i) = 1024 - i
+    w(i) = 512 - i
+  end do
+  if (m .ne. 1025) call abort
+  !$omp parallel
+  !$omp single
+    call f4 (0, 31, 1, 32)
+  !$omp end single
+  !$omp end parallel 
+  do i = 1, 1024
+    if (u(i) .ne. 1536 - 2 * i) call abort
+    v(i) = i
+    w(i) = i + 1
+  end do
+  if (m .ne. 32 + 33 + 1024) call abort
+  !$omp parallel
+  !$omp single
+    call f5 (0, 31, 1, 32)
+  !$omp end single
+  !$omp end parallel 
+  do i = 1, 1024
+    if (u(i) .ne. 2 * i + 1) call abort
+  end do
+  if (m .ne. 32 + 33) call abort
+contains
+  subroutine f1 (a, b)
+    integer, intent(in) :: a, b
+    integer :: d
+    !$omp taskloop simd default(none) shared(u, v, w) nogroup
+    do d = a, b
+      u(d) = v(d) + w(d)
+    end do
+    ! d is predetermined linear, so we can't let the tasks continue past
+    ! end of this function.
+    !$omp taskwait
+  end subroutine f1
+  subroutine f2 (a, b, cx)
+    integer, intent(in) :: a, b, cx
+    integer :: c, d, e
+    c = cx
+    !$omp taskloop simd default(none) shared(u, v, w) linear(d:1) linear(c:5) lastprivate(e)
+    do d = a, b
+      u(d) = v(d) + w(d)
+      c = c + 5
+      e = c + 9
+    end do
+    !$omp end taskloop simd
+    m = d + c + e
+  end subroutine f2
+  subroutine f3 (a, b)
+    integer, intent(in) :: a, b
+    integer, target :: d
+    integer, pointer :: p
+    !$omp taskloop simd default(none) shared(u, v, w) private (p)
+    do d = a, b
+      p => d
+      u(d) = v(d) + w(d)
+      p => null()
+    end do
+    m = d
+  end subroutine f3
+  subroutine f4 (a, b, c, d)
+    integer, intent(in) :: a, b, c, d
+    integer, target :: e, f
+    integer, pointer :: p, q
+    integer :: g, r
+    !$omp taskloop simd default(none) shared(u, v, w) lastprivate(g) collapse(2) private (r, p, q)
+    do e = a, b
+      do f = c, d
+        p => e
+        q => f
+        r = 32 * e + f
+        u(r) = v(r) + w(r)
+        g = r
+        p => null()
+        q => null()
+      end do
+    end do
+    m = e + f + g
+  end subroutine f4
+  subroutine f5 (a, b, c, d)
+    integer, intent(in) :: a, b, c, d
+    integer :: e, f, r
+    !$omp taskloop simd default(none) shared(u, v, w) collapse(2) private (r)
+    do e = a, b
+      do f = c, d
+        r = 32 * e + f
+        u(r) = v(r) + w(r)
+      end do
+    end do
+    m = e + f
+  end subroutine f5
+end
--- libgomp/testsuite/libgomp.fortran/taskloop3.f90.jj	2016-05-17 16:17:36.606610363 +0200
+++ libgomp/testsuite/libgomp.fortran/taskloop3.f90	2016-05-17 16:13:49.000000000 +0200
@@ -0,0 +1,72 @@ 
+! { dg-do run }
+! { dg-options "-O2" }
+
+  integer, save :: g
+  integer :: i
+  !$omp parallel
+  !$omp single
+    if (f1 (74) .ne. 63 + 4) call abort
+    g = 77
+    call f2
+    !$omp taskwait
+    if (g .ne. 63 + 9) call abort
+    if (f3 (7_8, 11_8, 2_8) .ne. 11 * 7 + 13) call abort
+    if (f4 (0_8, 31_8, 16_8, 46_8, 1_8, 2_8, 73) .ne. 32 + 5 * 48 &
+&       + 11 * 31 + 17 * 46) call abort
+  !$omp end single
+  !$omp end parallel
+contains
+  function f1 (y)
+    integer, intent(in) :: y
+    integer :: i, f1, x
+    x = y
+    !$omp taskloop firstprivate(x)lastprivate(x)
+    do i = 0, 63
+      if (x .ne. 74) call abort
+      if (i .eq. 63) then
+        x = i + 4
+      end if
+    end do
+    f1 = x
+  end function f1
+  subroutine f2 ()
+    integer :: i
+    !$omp taskloop firstprivate(g)lastprivate(g)nogroup
+    do i = 0, 63
+      if (g .ne. 77) call abort
+      if (i .eq. 63) then
+        g = i + 9
+      end if
+    end do
+  end subroutine f2
+  function f3 (a, b, c)
+    integer(kind=8), intent(in) :: a, b, c
+    integer(kind=8) :: i, f3
+    integer :: l
+    !$omp taskloop default(none) lastprivate (i, l)
+    do i = a, b, c
+      l = i
+    end do
+    !$omp end taskloop
+    f3 = l * 7 + i
+  end function f3
+  function f4 (a, b, c, d, e, f, m)
+    integer(kind=8), intent(in) :: a, b, c, d, e, f
+    integer(kind=8) :: i, j, f4
+    integer, intent(in) :: m
+    integer :: l, k
+    k = m
+    !$omp taskloop default (none) collapse (2) firstprivate (k) &
+    !$omp & lastprivate (i, j, k, l)
+    do i = a, b, e
+      do j = c, d, f
+        if (k .ne. 73) call abort
+        if (i .eq. 31 .and. j .eq. 46) then
+          k = i
+        end if
+        l = j
+      end do
+    end do
+    f4 = i + 5 * j + 11 * k + 17 * l
+  end function f4
+end
--- libgomp/testsuite/libgomp.fortran/taskloop4.f90.jj	2016-05-17 18:48:08.826965808 +0200
+++ libgomp/testsuite/libgomp.fortran/taskloop4.f90	2016-05-17 18:47:33.000000000 +0200
@@ -0,0 +1,87 @@ 
+! { dg-do run }
+! { dg-options "-O2" }
+
+  integer, save :: u(64), v
+  integer :: min_iters, max_iters, ntasks, cnt
+  procedure(grainsize), pointer :: fn
+  !$omp parallel
+  !$omp single
+    fn => grainsize
+    ! If grainsize is present, # of task loop iters is
+    ! >= grainsize && < 2 * grainsize,
+    ! unless # of loop iterations is smaller than grainsize.
+    call test (0, 79, 1, 17, fn, ntasks, min_iters, max_iters, cnt)
+    if (cnt .ne. 79) call abort
+    if (min_iters .lt. 17 .or. max_iters .ge. 17 * 2) call abort
+    call test (-49, 2541, 7, 28, fn, ntasks, min_iters, max_iters, cnt)
+    if (cnt .ne. 370) call abort
+    if (min_iters .lt. 28 .or. max_iters .ge. 28 * 2) call abort
+    call test (7, 21, 2, 15, fn, ntasks, min_iters, max_iters, cnt)
+    if (cnt .ne. 7) call abort
+    if (min_iters .ne. 7 .or. max_iters .ne. 7) call abort
+    if (ntasks .ne. 1) call abort
+    fn => num_tasks
+    ! If num_tasks is present, # of task loop iters is
+    ! min (# of loop iters, num_tasks).
+    call test (-51, 2500, 48, 9, fn, ntasks, min_iters, max_iters, cnt)
+    if (cnt .ne. 54 .or. ntasks .ne. 9) call abort
+    call test (0, 25, 2, 17, fn, ntasks, min_iters, max_iters, cnt)
+    if (cnt .ne. 13 .or. ntasks .ne. 13) call abort
+  !$omp end single
+  !$omp end parallel
+contains
+  subroutine grainsize (a, b, c, d)
+    integer, intent (in) :: a, b, c, d
+    integer :: i, j, k
+    j = 0
+    k = 0
+    !$omp taskloop firstprivate (j, k) grainsize (d)
+    do i = a, b - 1, c
+      if (j .eq. 0) then
+        !$omp atomic capture
+          k = v
+          v = v + 1
+        !$omp end atomic
+        if (k .ge. 64) call abort
+      end if
+      j = j + 1
+      u(k + 1) = j
+    end do
+  end subroutine grainsize
+  subroutine num_tasks (a, b, c, d)
+    integer, intent (in) :: a, b, c, d
+    integer :: i, j, k
+    j = 0
+    k = 0
+    !$omp taskloop firstprivate (j, k) num_tasks (d)
+    do i = a, b - 1, c
+      if (j .eq. 0) then
+        !$omp atomic capture
+          k = v
+          v = v + 1
+        !$omp end atomic
+        if (k .ge. 64) call abort
+      end if
+      j = j + 1
+      u(k + 1) = j
+    end do
+  end subroutine num_tasks
+  subroutine test (a, b, c, d, fn, num_tasks, min_iters, max_iters, cnt)
+    integer, intent (in) :: a, b, c, d
+    procedure(grainsize), pointer :: fn
+    integer, intent (out) :: num_tasks, min_iters, max_iters, cnt
+    integer :: i
+    u(:) = 0
+    v = 0
+    cnt = 0
+    call fn (a, b, c, d)
+    min_iters = 0
+    max_iters = 0
+    num_tasks = v
+    if (v .ne. 0) then
+      min_iters = minval (u(1:v))
+      max_iters = maxval (u(1:v))
+      cnt = sum (u(1:v))
+    end if
+  end subroutine test
+end