commit 43be8cd7a3e86af421e611c72f714b6c40f35bba Author: Julian Brown Date: Fri Apr 28 22:27:54 2023 +0000 OpenACC: Further attach/detach clause fixes for Fortran [PR109622] This patch moves several tests introduced by the following patch: https://gcc.gnu.org/pipermail/gcc-patches/2023-April/616939.html commit r14-325-gcacf65d74463600815773255e8b82b4043432bd7 into the proper location for OpenACC testing (thanks to Thomas for spotting my mistake!), and also fixes a few additional problems -- missing diagnostics for non-pointer attaches, and a case where a pointer was incorrectly dereferenced. Tests are also adjusted for vector-length warnings on nvidia accelerators. 2023-04-29 Julian Brown PR fortran/109622 gcc/fortran/ * openmp.cc (resolve_omp_clauses): Add diagnostic for non-pointer/non-allocatable attach/detach. * trans-openmp.cc (gfc_trans_omp_clauses): Remove dereference for pointer-to-scalar derived type component attach/detach. Fix attach/detach handling for descriptors. gcc/testsuite/ * gfortran.dg/goacc/pr109622-5.f90: New test. * gfortran.dg/goacc/pr109622-6.f90: New test. libgomp/ * testsuite/libgomp.fortran/pr109622.f90: Move test... * testsuite/libgomp.oacc-fortran/pr109622.f90: ...to here. Ignore vector length warning. * testsuite/libgomp.fortran/pr109622-2.f90: Move test... * testsuite/libgomp.oacc-fortran/pr109622-2.f90: ...to here. Add missing copyin/copyout variable. Ignore vector length warnings. * testsuite/libgomp.fortran/pr109622-3.f90: Move test... * testsuite/libgomp.oacc-fortran/pr109622-3.f90: ...to here. Ignore vector length warnings. * testsuite/libgomp.oacc-fortran/pr109622-4.f90: New test. diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 86e4515..322856a 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -7711,6 +7711,23 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, &n->where); } } + if (openacc + && list == OMP_LIST_MAP + && (n->u.map_op == OMP_MAP_ATTACH + || n->u.map_op == OMP_MAP_DETACH)) + { + symbol_attribute attr; + gfc_clear_attr (&attr); + if (n->expr) + attr = gfc_expr_attr (n->expr); + else if (n->sym) + attr = n->sym->attr; + if (!attr.pointer && !attr.allocatable) + gfc_error ("%qs clause argument must be ALLOCATABLE or " + "a POINTER at %L", + (n->u.map_op == OMP_MAP_ATTACH) ? "attach" + : "detach", &n->where); + } if (lastref || (n->expr && (!resolved || n->expr->expr_type != EXPR_VARIABLE))) diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index 6ee22fa..e5de85b 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -3395,6 +3395,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, && (n->u.map_op == OMP_MAP_ATTACH || n->u.map_op == OMP_MAP_DETACH)) { + OMP_CLAUSE_DECL (node) + = build_fold_addr_expr (OMP_CLAUSE_DECL (node)); OMP_CLAUSE_SIZE (node) = size_zero_node; goto finalize_map_clause; } @@ -3523,15 +3525,20 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (n->u.map_op == OMP_MAP_ATTACH || n->u.map_op == OMP_MAP_DETACH) { - if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (inner))) + if (POINTER_TYPE_P (TREE_TYPE (inner)) + || GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (inner))) { - tree ptr = gfc_conv_descriptor_data_get (inner); - OMP_CLAUSE_DECL (node) = ptr; + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (inner))) + { + tree ptr + = gfc_conv_descriptor_data_get (inner); + OMP_CLAUSE_DECL (node) = ptr; + } + else + OMP_CLAUSE_DECL (node) = inner; + OMP_CLAUSE_SIZE (node) = size_zero_node; + goto finalize_map_clause; } - else - OMP_CLAUSE_DECL (node) = inner; - OMP_CLAUSE_SIZE (node) = size_zero_node; - goto finalize_map_clause; } if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (inner))) diff --git a/gcc/testsuite/gfortran.dg/goacc/pr109622-5.f90 b/gcc/testsuite/gfortran.dg/goacc/pr109622-5.f90 new file mode 100644 index 0000000..5c483eb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/pr109622-5.f90 @@ -0,0 +1,45 @@ +! { dg-do compile } + +use openacc +implicit none + +type t +integer :: foo +character(len=8) :: bar +integer :: qux(5) +end type t + +type(t) :: var + +var%foo = 3 +var%bar = "HELLOOMP" +var%qux = (/ 1, 2, 3, 4, 5 /) + +!$acc enter data copyin(var) + +!$acc enter data attach(var%foo) +! { dg-error "'attach' clause argument must be ALLOCATABLE or a POINTER" "" { target *-*-* } .-1 } +!$acc enter data attach(var%bar) +! { dg-error "'attach' clause argument must be ALLOCATABLE or a POINTER" "" { target *-*-* } .-1 } +!$acc enter data attach(var%qux) +! { dg-error "'attach' clause argument must be ALLOCATABLE or a POINTER" "" { target *-*-* } .-1 } + +!$acc serial +var%foo = 5 +var%bar = "GOODBYE!" +var%qux = (/ 6, 7, 8, 9, 10 /) +!$acc end serial + +!$acc exit data detach(var%qux) +! { dg-error "'detach' clause argument must be ALLOCATABLE or a POINTER" "" { target *-*-* } .-1 } +!$acc exit data detach(var%bar) +! { dg-error "'detach' clause argument must be ALLOCATABLE or a POINTER" "" { target *-*-* } .-1 } +!$acc exit data detach(var%foo) +! { dg-error "'detach' clause argument must be ALLOCATABLE or a POINTER" "" { target *-*-* } .-1 } + +!$acc exit data copyout(var) + +if (var%foo.ne.5) stop 1 +if (var%bar.ne."GOODBYE!") stop 2 + +end diff --git a/gcc/testsuite/gfortran.dg/goacc/pr109622-6.f90 b/gcc/testsuite/gfortran.dg/goacc/pr109622-6.f90 new file mode 100644 index 0000000..256ab90 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/pr109622-6.f90 @@ -0,0 +1,8 @@ +! { dg-do compile } + +implicit none +integer :: x +!$acc enter data attach(x) +! { dg-error "'attach' clause argument must be ALLOCATABLE or a POINTER" "" { target *-*-* } .-1 } + +end diff --git a/libgomp/testsuite/libgomp.fortran/pr109622-2.f90 b/libgomp/testsuite/libgomp.fortran/pr109622-2.f90 deleted file mode 100644 index 8c5f373..0000000 --- a/libgomp/testsuite/libgomp.fortran/pr109622-2.f90 +++ /dev/null @@ -1,32 +0,0 @@ -! { dg-do run } - -type t -integer :: foo -integer, pointer :: bar -end type t - -type(t) :: var -integer, target :: tgt - -var%bar => tgt - -var%foo = 99 -tgt = 199 - -!$acc enter data copyin(var) - -!$acc enter data attach(var%bar) - -!$acc serial -var%foo = 5 -var%bar = 7 -!$acc end serial - -!$acc exit data detach(var%bar) - -!$acc exit data copyout(var) - -if (var%foo.ne.5) stop 1 -if (tgt.ne.7) stop 2 - -end diff --git a/libgomp/testsuite/libgomp.fortran/pr109622-3.f90 b/libgomp/testsuite/libgomp.fortran/pr109622-3.f90 deleted file mode 100644 index 3ee1b43..0000000 --- a/libgomp/testsuite/libgomp.fortran/pr109622-3.f90 +++ /dev/null @@ -1,32 +0,0 @@ -! { dg-do run } - -type t -integer :: foo -integer, pointer :: bar(:) -end type t - -type(t) :: var -integer, target :: tgt(20) - -var%bar => tgt - -var%foo = 99 -tgt = 199 - -!$acc enter data copyin(var, tgt) - -!$acc enter data attach(var%bar) - -!$acc serial -var%foo = 5 -var%bar = 7 -!$acc end serial - -!$acc exit data detach(var%bar) - -!$acc exit data copyout(var, tgt) - -if (var%foo.ne.5) stop 1 -if (any(tgt.ne.7)) stop 2 - -end diff --git a/libgomp/testsuite/libgomp.fortran/pr109622.f90 b/libgomp/testsuite/libgomp.fortran/pr109622.f90 deleted file mode 100644 index 5b8c410..0000000 --- a/libgomp/testsuite/libgomp.fortran/pr109622.f90 +++ /dev/null @@ -1,32 +0,0 @@ -! { dg-do run } - -type t -integer :: value -type(t), pointer :: chain -end type t - -type(t), target :: var, var2 - -var%value = 99 -var2%value = 199 - -var%chain => var2 -nullify(var2%chain) - -!$acc enter data copyin(var, var2) - -!$acc enter data attach(var%chain) - -!$acc serial -var%value = 5 -var%chain%value = 7 -!$acc end serial - -!$acc exit data detach(var%chain) - -!$acc exit data copyout(var, var2) - -if (var%value.ne.5) stop 1 -if (var2%value.ne.7) stop 2 - -end diff --git a/libgomp/testsuite/libgomp.oacc-fortran/pr109622-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/pr109622-2.f90 new file mode 100644 index 0000000..d3cbebe --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/pr109622-2.f90 @@ -0,0 +1,35 @@ +! { dg-do run } + +implicit none + +type t +integer :: foo +integer, pointer :: bar +end type t + +type(t) :: var +integer, target :: tgt + +var%bar => tgt + +var%foo = 99 +tgt = 199 + +!$acc enter data copyin(var, tgt) + +!$acc enter data attach(var%bar) + +!$acc serial +! { dg-warning "using .vector_length \\(32\\)., ignoring 1" "" { target openacc_nvidia_accel_selected } .-1 } +var%foo = 5 +var%bar = 7 +!$acc end serial + +!$acc exit data detach(var%bar) + +!$acc exit data copyout(var, tgt) + +if (var%foo.ne.5) stop 1 +if (tgt.ne.7) stop 2 + +end diff --git a/libgomp/testsuite/libgomp.oacc-fortran/pr109622-3.f90 b/libgomp/testsuite/libgomp.oacc-fortran/pr109622-3.f90 new file mode 100644 index 0000000..a25b1a8 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/pr109622-3.f90 @@ -0,0 +1,35 @@ +! { dg-do run } + +implicit none + +type t +integer :: foo +integer, pointer :: bar(:) +end type t + +type(t) :: var +integer, target :: tgt(20) + +var%bar => tgt + +var%foo = 99 +tgt = 199 + +!$acc enter data copyin(var, tgt) + +!$acc enter data attach(var%bar) + +!$acc serial +! { dg-warning "using .vector_length \\(32\\)., ignoring 1" "" { target openacc_nvidia_accel_selected } .-1 } +var%foo = 5 +var%bar = 7 +!$acc end serial + +!$acc exit data detach(var%bar) + +!$acc exit data copyout(var, tgt) + +if (var%foo.ne.5) stop 1 +if (any(tgt.ne.7)) stop 2 + +end diff --git a/libgomp/testsuite/libgomp.oacc-fortran/pr109622-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/pr109622-4.f90 new file mode 100644 index 0000000..3198a0b --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/pr109622-4.f90 @@ -0,0 +1,47 @@ +! { dg-do run } + +use openacc +implicit none + +type t +integer :: foo +character(len=8), pointer :: bar +character(len=4), allocatable :: qux +end type t + +type(t) :: var +character(len=8), target :: tgt + +allocate(var%qux) + +var%bar => tgt + +var%foo = 99 +tgt = "Octopus!" +var%qux = "Fish" + +!$acc enter data copyin(var, tgt) + +! Avoid automatic attach (i.e. with "enter data") +call acc_copyin (var%qux) + +!$acc enter data attach(var%bar, var%qux) + +!$acc serial +! { dg-warning "using .vector_length \\(32\\)., ignoring 1" "" { target openacc_nvidia_accel_selected } .-1 } +var%foo = 5 +var%bar = "Plankton" +var%qux = "Pond" +!$acc end serial + +!$acc exit data detach(var%bar, var%qux) + +call acc_copyout (var%qux) + +!$acc exit data copyout(var, tgt) + +if (var%foo.ne.5) stop 1 +if (tgt.ne."Plankton") stop 2 +if (var%qux.ne."Pond") stop 3 + +end diff --git a/libgomp/testsuite/libgomp.oacc-fortran/pr109622.f90 b/libgomp/testsuite/libgomp.oacc-fortran/pr109622.f90 new file mode 100644 index 0000000..a17c4f6 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/pr109622.f90 @@ -0,0 +1,35 @@ +! { dg-do run } + +implicit none + +type t +integer :: value +type(t), pointer :: chain +end type t + +type(t), target :: var, var2 + +var%value = 99 +var2%value = 199 + +var%chain => var2 +nullify(var2%chain) + +!$acc enter data copyin(var, var2) + +!$acc enter data attach(var%chain) + +!$acc serial +! { dg-warning "using .vector_length \\(32\\)., ignoring 1" "" { target openacc_nvidia_accel_selected } .-1 } +var%value = 5 +var%chain%value = 7 +!$acc end serial + +!$acc exit data detach(var%chain) + +!$acc exit data copyout(var, var2) + +if (var%value.ne.5) stop 1 +if (var2%value.ne.7) stop 2 + +end