From: Thomas Koenig Date: Thu, 12 Apr 2018 21:58:54 +0000 (+0000) Subject: re PR fortran/83064 (DO CONCURRENT and auto-parallelization) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=bc436e10e0b892b6953e19776367170cd982367c;p=gcc.git re PR fortran/83064 (DO CONCURRENT and auto-parallelization) 2018-04-12 Thomas Koenig PR fortran/83064 PR testsuite/85346 * trans-stmt.c (gfc_trans_forall_loop): Use annot_expr_ivdep_kind for annotation and remove dependence on -ftree-parallelize-loops. 2018-04-12 Thomas Koenig PR fortran/83064 PR testsuite/85346 * gfortran.dg/do_concurrent_5.f90: Dynamically allocate main work array and move test to libgomp/testsuite/libgomp.fortran. * gfortran.dg/do_concurrent_6.f90: New test. 2018-04-12 Thomas Koenig PR fortran/83064 PR testsuite/85346 * testsuite/libgomp.fortran/do_concurrent_5.f90: Move modified test from gfortran.dg to here. From-SVN: r259359 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 75d0a7e8d1f..3064ab6e921 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2018-04-12 Thomas Koenig + + PR fortran/83064 + PR testsuite/85346 + * trans-stmt.c (gfc_trans_forall_loop): Use annot_expr_ivdep_kind + for annotation and remove dependence on -ftree-parallelize-loops. + 2018-04-10 Jakub Jelinek PR fortran/85313 diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index c44450e6aa5..1952f6cdc08 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -3643,12 +3643,12 @@ gfc_trans_forall_loop (forall_info *forall_tmp, tree body, cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node, count, build_int_cst (TREE_TYPE (count), 0)); - /* PR 83064 means that we cannot use the annotation if the - autoparallelizer is active. */ - if (forall_tmp->do_concurrent && ! flag_tree_parallelize_loops) + /* PR 83064 means that we cannot use annot_expr_parallel_kind until + the autoparallelizer can hande this. */ + if (forall_tmp->do_concurrent) cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond), cond, build_int_cst (integer_type_node, - annot_expr_parallel_kind), + annot_expr_ivdep_kind), integer_zero_node); tmp = build1_v (GOTO_EXPR, exit_label); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 73a358e6c1f..16d39a283cf 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2018-04-12 Thomas Koenig + + PR fortran/83064 + PR testsuite/85346 + * gfortran.dg/do_concurrent_5.f90: Dynamically allocate main work + array and move test to libgomp/testsuite/libgomp.fortran. + * gfortran.dg/do_concurrent_6.f90: New test. + 2018-04-12 Marek Polacek PR c++/85258 diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_5.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_5.f90 deleted file mode 100644 index feee4c9b00a..00000000000 --- a/gcc/testsuite/gfortran.dg/do_concurrent_5.f90 +++ /dev/null @@ -1,70 +0,0 @@ -! { dg-do run } -! PR 83064 - this used to give wrong results. -! { dg-options "-O3 -ftree-parallelize-loops=2" } -! Original test case by Christian Felter - -program main - use, intrinsic :: iso_fortran_env - implicit none - - integer, parameter :: nsplit = 4 - integer(int64), parameter :: ne = 20000000 - integer(int64) :: stride, low(nsplit), high(nsplit), edof(ne), i - real(real64), dimension(nsplit) :: pi - - edof(1::4) = 1 - edof(2::4) = 2 - edof(3::4) = 3 - edof(4::4) = 4 - - stride = ceiling(real(ne)/nsplit) - do i = 1, nsplit - high(i) = stride*i - end do - do i = 2, nsplit - low(i) = high(i-1) + 1 - end do - low(1) = 1 - high(nsplit) = ne - - pi = 0 - do concurrent (i = 1:nsplit) - pi(i) = sum(compute( low(i), high(i) )) - end do - if (abs (sum(pi) - atan(1.0d0)) > 1e-5) call abort - -contains - - pure function compute( low, high ) result( ttt ) - integer(int64), intent(in) :: low, high - real(real64), dimension(nsplit) :: ttt - integer(int64) :: j, k - - ttt = 0 - - ! Unrolled loop -! do j = low, high, 4 -! k = 1 -! ttt(k) = ttt(k) + (-1)**(j+1) / real( 2*j-1 ) -! k = 2 -! ttt(k) = ttt(k) + (-1)**(j+2) / real( 2*j+1 ) -! k = 3 -! ttt(k) = ttt(k) + (-1)**(j+3) / real( 2*j+3 ) -! k = 4 -! ttt(k) = ttt(k) + (-1)**(j+4) / real( 2*j+5 ) -! end do - - ! Loop with modulo operation -! do j = low, high -! k = mod( j, nsplit ) + 1 -! ttt(k) = ttt(k) + (-1)**(j+1) / real( 2*j-1 ) -! end do - - ! Loop with subscripting via host association - do j = low, high - k = edof(j) - ttt(k) = ttt(k) + (-1.0_real64)**(j+1) / real( 2*j-1 ) - end do - end function - -end program main diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_6.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_6.f90 new file mode 100644 index 00000000000..9585a9f96f4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/do_concurrent_6.f90 @@ -0,0 +1,13 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +program main + real, dimension(100) :: a,b + call random_number(a) + do concurrent (i=1:100) + b(i) = a(i)*a(i) + end do + print *,sum(a) +end program main + +! { dg-final { scan-tree-dump-times "ivdep" 1 "original" } } diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog index ea28859efda..9568a73738e 100644 --- a/libgomp/ChangeLog +++ b/libgomp/ChangeLog @@ -1,3 +1,10 @@ +2018-04-12 Thomas Koenig + + PR fortran/83064 + PR testsuite/85346 + * testsuite/libgomp.fortran/do_concurrent_5.f90: Move modified + test from gfortran.dg to here. + 2018-04-05 Tom de Vries PR target/85204 diff --git a/libgomp/testsuite/libgomp.fortran/do_concurrent_5.f90 b/libgomp/testsuite/libgomp.fortran/do_concurrent_5.f90 new file mode 100644 index 00000000000..6fb9d1e8d96 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/do_concurrent_5.f90 @@ -0,0 +1,72 @@ +! { dg-do run } +! PR 83064 - this used to give wrong results. +! { dg-additional-options "-O1 -ftree-parallelize-loops=2" } +! Original test case by Christian Felter + +program main + use, intrinsic :: iso_fortran_env + implicit none + + integer, parameter :: nsplit = 4 + integer(int64), parameter :: ne = 2**20 + integer(int64) :: stride, low(nsplit), high(nsplit), i + real(real64), dimension(nsplit) :: pi + integer(int64), dimension(:), allocatable :: edof + + allocate (edof(ne)) + edof(1::4) = 1 + edof(2::4) = 2 + edof(3::4) = 3 + edof(4::4) = 4 + + stride = ceiling(real(ne)/nsplit) + do i = 1, nsplit + high(i) = stride*i + end do + do i = 2, nsplit + low(i) = high(i-1) + 1 + end do + low(1) = 1 + high(nsplit) = ne + + pi = 0 + do concurrent (i = 1:nsplit) + pi(i) = sum(compute( low(i), high(i) )) + end do + if (abs (sum(pi) - atan(1.0d0)) > 1e-5) STOP 1 + +contains + + pure function compute( low, high ) result( ttt ) + integer(int64), intent(in) :: low, high + real(real64), dimension(nsplit) :: ttt + integer(int64) :: j, k + + ttt = 0 + + ! Unrolled loop +! do j = low, high, 4 +! k = 1 +! ttt(k) = ttt(k) + (-1)**(j+1) / real( 2*j-1 ) +! k = 2 +! ttt(k) = ttt(k) + (-1)**(j+2) / real( 2*j+1 ) +! k = 3 +! ttt(k) = ttt(k) + (-1)**(j+3) / real( 2*j+3 ) +! k = 4 +! ttt(k) = ttt(k) + (-1)**(j+4) / real( 2*j+5 ) +! end do + + ! Loop with modulo operation +! do j = low, high +! k = mod( j, nsplit ) + 1 +! ttt(k) = ttt(k) + (-1)**(j+1) / real( 2*j-1 ) +! end do + + ! Loop with subscripting via host association + do j = low, high + k = edof(j) + ttt(k) = ttt(k) + (-1.0_real64)**(j+1) / real( 2*j-1 ) + end do + end function + +end program main