Re: [PATCH] OpenACC: Further attach/detach clause fixes for Fortran [PR109622]

[Julian Brown <julian@codesourcery.com>]

[-- Attachment #1: Type: text/plain, Size: 1502 bytes --]

On Tue, 2 May 2023 12:29:22 +0200
Tobias Burnus <tobias@codesourcery.com> wrote:

> On 29.04.23 12:57, Julian Brown wrote:
> > This patch moves several tests introduced by the following patch:
> >
> >    https://gcc.gnu.org/pipermail/gcc-patches/2023-April/616939.html
> >  
> 
> I believe you intent this as git log entry. Can you add
>    ... commit r14-325-gcacf65d74463600815773255e8b82b4043432bd7
> as this makes looking at the git history easier.

Added.

> > 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  <julian@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.  
> 
> In general, we prefer resolution-time diagnostic to tree-translation
> diagnostic, unless there is a good reason to do the latter.
> At a glance, it should be even sufficient to have a single diagnostic
> instead of two when placed into openmp.cc.

How does this version look?

Retested with offloading to nvptx.

Thanks,

Julian

[-- Attachment #2: fortran-attach-detach-fixes-2.diff --]
[-- Type: text/x-patch, Size: 11901 bytes --]

commit 43be8cd7a3e86af421e611c72f714b6c40f35bba
Author: Julian Brown <julian@codesourcery.com>
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  <julian@codesourcery.com>
    
    	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