This patch moves several tests introduced by the following patch:
https://gcc.gnu.org/pipermail/gcc-patches/2023-April/616939.html
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.
Tested with offloading to nvptx. OK?
2023-04-29 Julian Brown <jul...@codesourcery.com>
PR fortran/109622
gcc/fortran/
* trans-openmp.cc (gfc_trans_omp_clauses): Add diagnostic for
non-pointer/non-allocatable attach/detach. Remove dereference for
pointer-to-scalar derived type component attach/detach.
gcc/testsuite/
* gfortran.dg/goacc/pr109622-5.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.
---
gcc/fortran/trans-openmp.cc | 38 ++++++++++++---
.../gfortran.dg/goacc/pr109622-5.f90 | 45 ++++++++++++++++++
.../pr109622-2.f90 | 7 ++-
.../pr109622-3.f90 | 3 ++
.../libgomp.oacc-fortran/pr109622-4.f90 | 47 +++++++++++++++++++
.../pr109622.f90 | 3 ++
6 files changed, 135 insertions(+), 8 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/goacc/pr109622-5.f90
rename libgomp/testsuite/{libgomp.fortran =>
libgomp.oacc-fortran}/pr109622-2.f90 (63%)
rename libgomp/testsuite/{libgomp.fortran =>
libgomp.oacc-fortran}/pr109622-3.f90 (76%)
create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/pr109622-4.f90
rename libgomp/testsuite/{libgomp.fortran =>
libgomp.oacc-fortran}/pr109622.f90 (78%)
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 6ee22faa836a..b9a4ae3e53a8 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;
}
@@ -3430,6 +3432,13 @@ gfc_trans_omp_clauses (stmtblock_t *block,
gfc_omp_clauses *clauses,
= TYPE_SIZE_UNIT (gfc_charlen_type_node);
}
}
+ else if (openacc
+ && (n->u.map_op == OMP_MAP_ATTACH
+ || n->u.map_op == OMP_MAP_DETACH))
+ gfc_error ("%qs clause argument not pointer or "
+ "allocatable at %L",
+ (n->u.map_op == OMP_MAP_ATTACH)
+ ? "attach" : "detach", &where);
}
else if (n->expr
&& n->expr->expr_type == EXPR_VARIABLE
@@ -3510,6 +3519,13 @@ gfc_trans_omp_clauses (stmtblock_t *block,
gfc_omp_clauses *clauses,
}
else
{
+ if (openacc
+ && (n->u.map_op == OMP_MAP_ATTACH
+ || n->u.map_op == OMP_MAP_DETACH))
+ gfc_error ("%qs clause argument not pointer or "
+ "allocatable at %L",
+ (n->u.map_op == OMP_MAP_ATTACH)
+ ? "attach" : "detach", &where);
OMP_CLAUSE_DECL (node) = inner;
OMP_CLAUSE_SIZE (node)
= TYPE_SIZE_UNIT (TREE_TYPE (inner));
@@ -3523,15 +3539,25 @@ 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;
+ gfc_error ("%qs clause argument not pointer or "
+ "allocatable at %L",
+ (n->u.map_op == OMP_MAP_ATTACH)
+ ? "attach" : "detach", &where);
}
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 000000000000..e2748964a1c2
--- /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 not pointer or allocatable" "" { target
*-*-* } .-1 }
+!$acc enter data attach(var%bar)
+! { dg-error "'attach' clause argument not pointer or allocatable" "" { target
*-*-* } .-1 }
+!$acc enter data attach(var%qux)
+! { dg-error "'attach' clause argument not pointer or allocatable" "" { 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 not pointer or allocatable" "" { target
*-*-* } .-1 }
+!$acc exit data detach(var%bar)
+! { dg-error "'detach' clause argument not pointer or allocatable" "" { target
*-*-* } .-1 }
+!$acc exit data detach(var%foo)
+! { dg-error "'detach' clause argument not pointer or allocatable" "" { 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/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 8c5f373f39f7..d3cbebea6892 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 3ee1b43a7464..a25b1a814143 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 000000000000..3198a0bbf79f
--- /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 5b8c4102f768..a17c4f627147 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
--
2.29.2
