From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1534) id F3FE13858D1E; Wed, 20 Apr 2022 15:28:25 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org F3FE13858D1E Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit From: Tobias Burnus To: gcc-cvs@gcc.gnu.org Subject: [gcc/devel/omp/gcc-11] OpenMP: Fix use_device_{addr, ptr} with in-data-sharing arg X-Act-Checkin: gcc X-Git-Author: Tobias Burnus X-Git-Refname: refs/heads/devel/omp/gcc-11 X-Git-Oldrev: f0bde8aba15fcec3f6c07c7f05de56a3995fe9bf X-Git-Newrev: 6cd57652abea0162af7036ddb62c85a5e624cd1c Message-Id: <20220420152825.F3FE13858D1E@sourceware.org> Date: Wed, 20 Apr 2022 15:28:25 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Wed, 20 Apr 2022 15:28:26 -0000 https://gcc.gnu.org/g:6cd57652abea0162af7036ddb62c85a5e624cd1c commit 6cd57652abea0162af7036ddb62c85a5e624cd1c Author: Tobias Burnus Date: Wed Apr 20 16:30:40 2022 +0200 OpenMP: Fix use_device_{addr,ptr} with in-data-sharing arg For array-descriptor vars, the descriptor is assigned to a temporary. However, this failed when the clause's argument was in turn in a data-sharing clause as the outer context's VALUE_EXPR wasn't used. GCC 12/mainline patch submitted at: https://gcc.gnu.org/pipermail/gcc-patches/2022-April/593419.html gcc/ChangeLog: * omp-low.c (lower_omp_target): Fix use_device_{addr,ptr} with list item that is in an outer data-sharing clause. libgomp/ChangeLog: * testsuite/libgomp.fortran/use_device_addr-5.f90: New test. Diff: --- gcc/omp-low.c | 22 ++-- .../libgomp.fortran/use_device_addr-5.f90 | 143 +++++++++++++++++++++ 2 files changed, 156 insertions(+), 9 deletions(-) diff --git a/gcc/omp-low.c b/gcc/omp-low.c index ce30f53dbb5..ee6b4271447 100644 --- a/gcc/omp-low.c +++ b/gcc/omp-low.c @@ -14570,26 +14570,30 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) new_var = lookup_decl (var, ctx); new_var = DECL_VALUE_EXPR (new_var); tree v = new_var; + tree v2 = var; + if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_PTR + || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR) + { + v2 = maybe_lookup_decl_in_outer_ctx (var, ctx); + if (DECL_HAS_VALUE_EXPR_P (v2)) + v2 = DECL_VALUE_EXPR (v2); + } if (is_ref) { - var = build_fold_indirect_ref (var); - gimplify_expr (&var, &assign_body, NULL, is_gimple_val, - fb_rvalue); - v = create_tmp_var_raw (TREE_TYPE (var), get_name (var)); + v2 = build_fold_indirect_ref (v2); + v = create_tmp_var_raw (TREE_TYPE (v2), get_name (var)); gimple_add_tmp_var (v); TREE_ADDRESSABLE (v) = 1; - gimple_seq_add_stmt (&assign_body, - gimple_build_assign (v, var)); + gimplify_assign (v, v2, &assign_body); tree rhs = build_fold_addr_expr (v); gimple_seq_add_stmt (&assign_body, gimple_build_assign (new_var, rhs)); } else - gimple_seq_add_stmt (&assign_body, - gimple_build_assign (new_var, var)); + gimplify_assign (new_var, v2, &assign_body); - tree v2 = lang_hooks.decls.omp_array_data (unshare_expr (v), false); + v2 = lang_hooks.decls.omp_array_data (unshare_expr (v), false); gcc_assert (v2); gimplify_expr (&x, &assign_body, NULL, is_gimple_val, fb_rvalue); gimple_seq_add_stmt (&assign_body, diff --git a/libgomp/testsuite/libgomp.fortran/use_device_addr-5.f90 b/libgomp/testsuite/libgomp.fortran/use_device_addr-5.f90 new file mode 100644 index 00000000000..3892b8b8e63 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/use_device_addr-5.f90 @@ -0,0 +1,143 @@ +program main + use omp_lib + implicit none + integer, allocatable :: aaa(:,:,:) + integer :: i + + allocate (aaa(-4:10,-3:8,2)) + aaa(:,:,:) = reshape ([(i, i = 1, size(aaa))], shape(aaa)) + + do i = 0, omp_get_num_devices() + !$omp target data map(to: aaa) device(i) + call test_addr (aaa, i) + call test_ptr (aaa, i) + !$omp end target data + end do + deallocate (aaa) + +contains + + subroutine test_addr (aaaa, dev) + use iso_c_binding + integer, target, allocatable :: aaaa(:,:,:), bbbb(:,:,:) + integer, value :: dev + integer :: i + type(c_ptr) :: ptr + logical :: is_shared + + is_shared = .false. + !$omp target device(dev) map(to: is_shared) + is_shared = .true. + !$omp end target + + allocate (bbbb(-4:10,-3:8,2)) + bbbb(:,:,:) = reshape ([(-i, i = 1, size(bbbb))], shape(bbbb)) + !$omp target enter data map(to: bbbb) device(dev) + if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 1 + if (any (shape (aaaa) /= [15, 12, 2])) error stop 2 + if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 3 + if (any (shape (bbbb) /= [15, 12, 2])) error stop 4 + if (any (aaaa /= -bbbb)) error stop 5 + if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) & + error stop 6 + + !$omp parallel do shared(bbbb, aaaa) + do i = 1,1 + if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 5 + if (any (shape (aaaa) /= [15, 12, 2])) error stop 6 + if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 7 + if (any (shape (bbbb) /= [15, 12, 2])) error stop 8 + if (any (aaaa /= -bbbb)) error stop 5 + if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) & + error stop 6 + ptr = c_loc (aaaa) + !$omp target data use_device_addr(bbbb, aaaa) device(dev) + if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 9 + if (any (shape (aaaa) /= [15, 12, 2])) error stop 10 + if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 11 + if (any (shape (bbbb) /= [15, 12, 2])) error stop 12 + if (is_shared) then + if (any (aaaa /= -bbbb)) error stop 5 + if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) & + error stop 6 + end if + if (is_shared .neqv. c_associated (ptr, c_loc (aaaa))) error stop + +! !$omp target has_device_addr(bbbb, aaaa) device(dev) +! if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 9 +! if (any (shape (aaaa) /= [15, 12, 2])) error stop 10 +! if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 11 +! if (any (shape (bbbb) /= [15, 12, 2])) error stop 12 +! if (any (aaaa /= -bbbb)) error stop 5 +! if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) & +! error stop 6 +! !$omp end target + !$omp end target data + end do + !$omp target exit data map(delete: bbbb) device(dev) + deallocate (bbbb) + end subroutine test_addr + + subroutine test_ptr (aaaa, dev) + use iso_c_binding + integer, target, allocatable :: aaaa(:,:,:), bbbb(:,:,:) + integer, value :: dev + integer :: i + type(c_ptr) :: ptr + logical :: is_shared + + is_shared = .false. + !$omp target device(dev) map(to: is_shared) + is_shared = .true. + !$omp end target + + allocate (bbbb(-4:10,-3:8,2)) + bbbb(:,:,:) = reshape ([(-i, i = 1, size(bbbb))], shape(bbbb)) + !$omp target enter data map(to: bbbb) device(dev) + if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 1 + if (any (shape (aaaa) /= [15, 12, 2])) error stop 2 + if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 3 + if (any (shape (bbbb) /= [15, 12, 2])) error stop 4 + if (any (aaaa /= -bbbb)) error stop 5 + if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) & + error stop 6 + + !$omp parallel do shared(bbbb, aaaa) + do i = 1,1 + if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 5 + if (any (shape (aaaa) /= [15, 12, 2])) error stop 6 + if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 7 + if (any (shape (bbbb) /= [15, 12, 2])) error stop 8 + if (any (aaaa /= -bbbb)) error stop 5 + if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) & + error stop 6 + ptr = c_loc (aaaa) + !$omp target data use_device_ptr(bbbb, aaaa) device(dev) + if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 9 + if (any (shape (aaaa) /= [15, 12, 2])) error stop 10 + if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 11 + if (any (shape (bbbb) /= [15, 12, 2])) error stop 12 + if (is_shared) then + if (any (aaaa /= -bbbb)) error stop 5 + if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) & + error stop 6 + end if + if (is_shared .neqv. c_associated (ptr, c_loc (aaaa))) error stop + + ! Uses has_device_addr due to PR fortran/105318 + !!$omp target is_device_ptr(bbbb, aaaa) device(dev) +! !$omp target has_device_addr(bbbb, aaaa) device(dev) +! if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 9 +! if (any (shape (aaaa) /= [15, 12, 2])) error stop 10 +! if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 11 +! if (any (shape (bbbb) /= [15, 12, 2])) error stop 12 +! if (any (aaaa /= -bbbb)) error stop 5 +! if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) & +! error stop 6 +! !$omp end target + !$omp end target data + end do + !$omp target exit data map(delete: bbbb) device(dev) + deallocate (bbbb) + end subroutine test_ptr +end program main