diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 86e451531a6..81cdf1b42e5 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -7711,6 +7711,22 @@ 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; + if (n->expr) + attr = gfc_expr_attr (n->expr); + else + 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 6ee22faa836..96aecdd1cb3 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; } @@ -3520,8 +3522,10 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, { /* Bare attach and detach clauses don't want any additional nodes. */ - if (n->u.map_op == OMP_MAP_ATTACH - || n->u.map_op == OMP_MAP_DETACH) + if ((n->u.map_op == OMP_MAP_ATTACH + || n->u.map_op == OMP_MAP_DETACH) + && (POINTER_TYPE_P (TREE_TYPE (inner)) + || GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (inner)))) { 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 00000000000..59dbe9c8c92 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/pr109622-5.f90 @@ -0,0 +1,44 @@ +! { dg-do compile } + +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 00000000000..256ab90f282 --- /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.oacc-fortran/pr109622-2.f90 similarity index 63% rename from libgomp/testsuite/libgomp.fortran/pr109622-2.f90 rename to libgomp/testsuite/libgomp.oacc-fortran/pr109622-2.f90 index 8c5f373f39f..d3cbebea689 100644 --- a/libgomp/testsuite/libgomp.fortran/pr109622-2.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/pr109622-2.f90 @@ -1,5 +1,7 @@ ! { dg-do run } +implicit none + type t integer :: foo integer, pointer :: bar @@ -13,18 +15,19 @@ var%bar => tgt var%foo = 99 tgt = 199 -!$acc enter data copyin(var) +!$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) +!$acc exit data copyout(var, tgt) if (var%foo.ne.5) stop 1 if (tgt.ne.7) stop 2 diff --git a/libgomp/testsuite/libgomp.fortran/pr109622-3.f90 b/libgomp/testsuite/libgomp.oacc-fortran/pr109622-3.f90 similarity index 76% rename from libgomp/testsuite/libgomp.fortran/pr109622-3.f90 rename to libgomp/testsuite/libgomp.oacc-fortran/pr109622-3.f90 index 3ee1b43a746..a25b1a81414 100644 --- a/libgomp/testsuite/libgomp.fortran/pr109622-3.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/pr109622-3.f90 @@ -1,5 +1,7 @@ ! { dg-do run } +implicit none + type t integer :: foo integer, pointer :: bar(:) @@ -18,6 +20,7 @@ tgt = 199 !$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 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 00000000000..3198a0bbf79 --- /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.fortran/pr109622.f90 b/libgomp/testsuite/libgomp.oacc-fortran/pr109622.f90 similarity index 78% rename from libgomp/testsuite/libgomp.fortran/pr109622.f90 rename to libgomp/testsuite/libgomp.oacc-fortran/pr109622.f90 index 5b8c4102f76..a17c4f62714 100644 --- a/libgomp/testsuite/libgomp.fortran/pr109622.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/pr109622.f90 @@ -1,5 +1,7 @@ ! { dg-do run } +implicit none + type t integer :: value type(t), pointer :: chain @@ -18,6 +20,7 @@ nullify(var2%chain) !$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