OpenMP: need_device_ptr and need_device_addr support for adjust_args

This patch adds support for the "need_device_addr" modifier to the
"adjust args" clause for the "declare variant" directive, and
extends/re-works the support for "need_device_ptr" as well.

This patch builds on waffl3x's recently posted patch, "OpenMP: C/C++
adjust-args numeric ranges", here.

https://gcc.gnu.org/pipermail/gcc-patches/2025-April/681806.html

In C++, "need_device_addr" supports mapping reference arguments to
device pointers.  In Fortran, it similarly supports arguments passed
by reference, the default for the language, in contrast to
"need_device_ptr" which is used to map arguments of c_ptr type.  The
C++ support is straightforward, but Fortran has some additional
wrinkles involving arrays passed by descriptor (a new descriptor must
be constructed with a pointer to the array data which is the only part
mapped to the device), plus special cases for passing optional
arguments and a whole array instead of a reference to its first element.

gcc/cp/ChangeLog
	* parser.cc (cp_finish_omp_declare_variant): Adjust error messages.

gcc/fortran/ChangeLog
	* trans-openmp.cc (gfc_trans_omp_declare_variant): Disallow
	polymorphic and optional arguments with need_device_addr for now, but
	don't reject need_device_addr entirely.

gcc/ChangeLog
	* gimplify.cc (modify_call_for_omp_dispatch): Rework logic for
	need_device_ptr and need_device_addr adjustments.

gcc/testsuite/ChangeLog
	* c-c++-common/gomp/adjust-args-10.c: Ignore the new sorry since the
	lack of proper diagnostic is already xfail'ed.
	* g++.dg/gomp/adjust-args-1.C: Adjust output patterns.
	* g++.dg/gomp/adjust-args-17.C: New.
	* gcc.dg/gomp/adjust-args-3.c: New.
	* gfortran.dg/gomp/adjust-args-14.f90: Don't expect this to fail now.

libgomp/ChangeLog
	* libgomp.texi: Mark need_device_addr as supported.
	* testsuite/libgomp.c++/need-device-ptr.C: New.
	* testsuite/libgomp.c-c++-common/dispatch-3.c: New.
	* testsuite/libgomp.fortran/adjust-args-array-descriptor.f90: New.
	* testsuite/libgomp.fortran/need-device-ptr.f90: New.

Co-Authored-By: Tobias Burnus <tburnus@baylibre.com>

8 files changed, 201 insertions, 39 deletions

diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc
index eb0133b..be86252 100644
--- a/gcc/cp/parser.cc
+++ b/gcc/cp/parser.cc
@@ -52410,7 +52410,8 @@ cp_finish_omp_declare_variant (cp_parser *parser, cp_token *pragma_tok,
 	      else
 		{
 		  error_at (adjust_op_tok->location,
-			    "expected %<nothing%> or %<need_device_ptr%>");
+			    "expected %<nothing%>, %<need_device_ptr%> or "
+			    "%<need_device_addr%>");
 		  /* We should be trying to recover here instead of immediately
 		     failing, skipping to close paren and continuing.  */
 		  goto fail;
@@ -52421,8 +52422,8 @@ cp_finish_omp_declare_variant (cp_parser *parser, cp_token *pragma_tok,
 	      /* We should be trying to recover here instead of immediately
 		 failing, skipping to close paren and continuing.  */
 	      error_at (adjust_op_tok->location,
-			"expected %<nothing%> or %<need_device_ptr%> followed "
-			"by %<:%>");
+			"expected %<nothing%>, %<need_device_ptr%> or "
+			"%<need_device_addr%> followed by %<:%>");
 	      goto fail;
 	    }
 	  /* cp_parser_omp_var_list_no_open used to handle this, we don't use
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index edc1adc..64e5cec 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -11355,6 +11355,34 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns, gfc_namespace *parent_ns)
 					 &arg->sym->declared_at, &loc);
 			      continue;
 			    }
+			  if (arg_list->u.adj_args.need_addr
+			      && arg->sym->ts.type == BT_CLASS)
+			    {
+			      // In OpenMP 6.1, mapping polymorphic variables
+			      // is undefined behavior. 'sorry' would be an
+			      // alternative or some other wording.
+			      gfc_error ("Argument %qs at %L to list item in "
+					 "%<need_device_addr%> at %L must not "
+					 "be polymorphic",
+					 arg->sym->name,
+					 &arg->sym->declared_at, &loc);
+			      continue;
+			    }
+			  if (arg_list->u.adj_args.need_addr
+			      && arg->sym->attr.optional)
+			    {
+			      // OPTIONAL has the issue that we need to handle
+			      // absent arguments on the caller side, which
+			      // adds extra complications.
+			      gfc_error ("Sorry, argument %qs at %L to list "
+					 "item in %<need_device_addr%> at %L "
+					 "with OPTIONAL argument is "
+					 "not yet supported",
+					 arg->sym->name,
+					 &arg->sym->declared_at, &loc);
+			      continue;
+			    }
+
 			  if (adjust_args_list.contains (arg->sym))
 			    {
 			      gfc_error ("%qs at %L is specified more than "
@@ -11363,22 +11391,6 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns, gfc_namespace *parent_ns)
 			    }
 			  adjust_args_list.safe_push (arg->sym);
 
-			  if (arg_list->u.adj_args.need_addr)
-			    {
-			      /* TODO: Has to to support OPTIONAL and array
-				 descriptors; should check for CLASS, coarrays?
-				 Reject "abc" and 123 as actual arguments (in
-				 gimplify.cc or in the FE? Reject noncontiguous
-				 actuals?  Cf. also PR C++/118859.
-				 Also check array-valued type(c_ptr).  */
-			      static bool warned = false;
-			      if (!warned)
-				sorry_at (gfc_get_location (&loc),
-					  "%<need_device_addr%> not yet "
-					  "supported");
-			      warned = true;
-			      continue;
-			    }
 			  if (arg_list->u.adj_args.need_ptr
 			      || arg_list->u.adj_args.need_addr)
 			    {
diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc
index 1e354d0..ad7c3ff 100644
--- a/gcc/gimplify.cc
+++ b/gcc/gimplify.cc
@@ -4506,25 +4506,81 @@ modify_call_for_omp_dispatch (tree expr, tree dispatch_clauses,
       //		device_num)
       // but arg has to be the actual pointer, not a
       // reference or a conversion expression.
-      tree actual_ptr = TREE_CODE (arg) == ADDR_EXPR ? TREE_OPERAND (arg, 0)
-						     : arg;
-      if (TREE_CODE (actual_ptr) == NOP_EXPR
-	  && (TREE_CODE (TREE_TYPE (TREE_OPERAND (actual_ptr, 0)))
-	      == REFERENCE_TYPE))
-	{
-	  actual_ptr = TREE_OPERAND (actual_ptr, 0);
-	  actual_ptr
-	    = build1 (INDIRECT_REF, TREE_TYPE (actual_ptr), actual_ptr);
-	}
       tree fn = builtin_decl_explicit (BUILT_IN_OMP_GET_MAPPED_PTR);
-      tree mapped_arg
-	= build_call_expr_loc (loc, fn, 2, actual_ptr, dispatch_device_num);
+      tree mapped_arg = NULL_TREE;
+      bool reference_to_ptr_p = false;
+
+      tree argtype = TREE_TYPE (arg);
+      if (!POINTER_TYPE_P (argtype))
+	{
+	  sorry_at (EXPR_LOCATION (arg),
+		    "Invalid non-pointer/reference argument "
+		    "not diagnosed properly earlier");
+	  return arg;
+	}
+
+      /* Fortran C_PTR passed by reference?  Also handle the weird case
+	 where an array of C_PTR is passed instead of its first element.  */
+      if (need_device_ptr
+	  && lang_GNU_Fortran ()
+	  && (POINTER_TYPE_P (TREE_TYPE (argtype))
+	      || (TREE_CODE (TREE_TYPE (argtype)) == ARRAY_TYPE
+		  && POINTER_TYPE_P (TREE_TYPE (TREE_TYPE (argtype))))))
+	reference_to_ptr_p = true;
+
+      /* C++ pointer passed by reference?  */
+      else if (need_device_ptr
+	       && TREE_CODE (argtype) == REFERENCE_TYPE
+	       && TREE_CODE (TREE_TYPE (argtype)) == POINTER_TYPE)
+	reference_to_ptr_p = true;
+
+      /* If reference_to_ptr_p is true, we need to dereference arg to
+	 get the actual pointer.  */
+      tree actual_ptr = (reference_to_ptr_p
+			 ? build_fold_indirect_ref (arg) : arg);
+      tree actual_ptr_type = TREE_TYPE (actual_ptr);
+      STRIP_NOPS (actual_ptr);
+
+      if (lang_hooks.decls.omp_array_data (actual_ptr, true))
+	{
+	  /* This is a Fortran array with a descriptor.  The actual_ptr that
+	     lives on the target is the array data, not the descriptor.  */
+	  tree array_data
+	    = lang_hooks.decls.omp_array_data (actual_ptr, false);
+	  tree mapped_array_data =
+	    build_call_expr_loc (loc, fn, 2, array_data, dispatch_device_num);
+
+	  gcc_assert (TREE_CODE (array_data) == COMPONENT_REF);
+
+	  /* We need to create a new array descriptor newd that points at the
+	     mapped actual_ptr instead of the original one.  Start by
+	     creating the new descriptor and copy-initializing it from the
+	     existing one.  */
+	  tree oldd = TREE_OPERAND (array_data, 0);
+	  tree newd = create_tmp_var (TREE_TYPE (oldd), get_name (oldd));
+	  tree t2 = build2 (MODIFY_EXPR, void_type_node, newd, oldd);
+	  if (init_code)
+	    init_code = build2 (COMPOUND_EXPR, void_type_node, init_code, t2);
+	  else
+	    init_code = t2;
+
+	  /* Now stash the mapped array pointer in the new descriptor newd.  */
+	  tree lhs = build3 (COMPONENT_REF, TREE_TYPE (array_data), newd,
+			     TREE_OPERAND (array_data, 1),
+			     TREE_OPERAND (array_data, 2));
+	  t2 = build2 (MODIFY_EXPR, void_type_node, lhs, mapped_array_data);
+	  init_code = build2 (COMPOUND_EXPR, void_type_node, init_code, t2);
+	  mapped_arg = build_fold_addr_expr (newd);
+	}
+      else
+	mapped_arg
+	  = build_call_expr_loc (loc, fn, 2, actual_ptr, dispatch_device_num);
 
-      if (TREE_CODE (arg) == ADDR_EXPR
-	  || (TREE_CODE (TREE_TYPE (actual_ptr)) == REFERENCE_TYPE))
+      /* Cast mapped_arg back to its original type, and if we need a
+	 reference, build one.  */
+      mapped_arg = build1 (NOP_EXPR, actual_ptr_type, mapped_arg);
+      if (reference_to_ptr_p)
 	mapped_arg = build_fold_addr_expr (mapped_arg);
-      else if (TREE_CODE (arg) == NOP_EXPR)
-	mapped_arg = build1 (NOP_EXPR, TREE_TYPE (arg), mapped_arg);
       return mapped_arg;
     };
 
diff --git a/gcc/testsuite/c-c++-common/gomp/adjust-args-10.c b/gcc/testsuite/c-c++-common/gomp/adjust-args-10.c
index 5cda21e..6730dfe 100644
--- a/gcc/testsuite/c-c++-common/gomp/adjust-args-10.c
+++ b/gcc/testsuite/c-c++-common/gomp/adjust-args-10.c
@@ -11,3 +11,5 @@ void f0(int *p0, int *p1, int *p2, int *p3, int *p4)
   #pragma omp dispatch
   b0(p0, p1, p2, p3, p4, 42); /* { dg-error "variadic argument 5 specified in an 'append_args' clause with the 'need_device_ptr' modifier must be of pointer type" "" { xfail *-*-* } } */
 }
+
+/* { dg-prune-output "sorry, unimplemented: Invalid non-pointer/reference argument not diagnosed properly earlier" } */
diff --git a/gcc/testsuite/g++.dg/gomp/adjust-args-1.C b/gcc/testsuite/g++.dg/gomp/adjust-args-1.C
index 3aee78e..d0e0bce 100644
--- a/gcc/testsuite/g++.dg/gomp/adjust-args-1.C
+++ b/gcc/testsuite/g++.dg/gomp/adjust-args-1.C
@@ -13,13 +13,13 @@ int f2a (void *a);
 int f2b (void *a);
 #pragma omp declare variant (f0) match (construct={dispatch},device={arch(gcn)}) adjust_args (need_device_ptr: a) /* { dg-error "'int f0.void..' used as a variant with incompatible 'construct' selector sets" } */
 int f2c (void *a);
-#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (other: a) /* { dg-error "expected 'nothing' or 'need_device_ptr'" } */
+#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (other: a) /* { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr'" } */
 int f3 (int a);
 #pragma omp declare variant (f0) adjust_args (nothing: a) /* { dg-error "an 'adjust_args' clause requires a 'match' clause" } */
 int f4 (void *a);
-#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args () /* { dg-error "expected 'nothing' or 'need_device_ptr' followed by ':'" } */
+#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args () /* { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr' followed by ':'" } */
 int f5 (int a);
-#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (nothing) /* { dg-error "expected 'nothing' or 'need_device_ptr' followed by ':'" } */
+#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (nothing) /* { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr' followed by ':'" } */
 int f6 (int a);
 #pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (nothing:) /* { dg-error "expected primary-expression before '\\)' token" } */
 int f7 (int a);
diff --git a/gcc/testsuite/g++.dg/gomp/adjust-args-17.C b/gcc/testsuite/g++.dg/gomp/adjust-args-17.C
new file mode 100644
index 0000000..62ddab0
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/adjust-args-17.C
@@ -0,0 +1,44 @@
+void f(int*,int &,int*);
+void f0(int*,int &,int*);
+void f1(int*,int &,int*);
+void f2(int*,int &,int*);
+void f3(int*,int &,int*);
+void f4(int*,int &,int*);
+void f5(int*,int &,int*);
+void f6(int*,int &,int*);
+void f7(int*,int &,int*);
+void f8(int*,int &,int*);
+void f9(int*,int &,int*);
+void fa(int*,int &,int*);
+void f10(int*,int &,int*);
+void f11(int*,int &,int*);
+void f12(int*,int &,int*);
+void f13(int*,int &,int*);
+void f14(int*,int &,int*);
+void f15(int*,int &,int*);
+void f16(int*,int &,int*);
+
+#pragma omp declare variant(f) match(construct={dispatch}) adjust_args(x : y) 			// { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr'" }
+#pragma omp declare variant(f0) match(construct={dispatch}) adjust_args(x) 			// { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr' followed by ':'" }
+#pragma omp declare variant(f1) match(construct={dispatch}) adjust_args(x,) 			// { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr' followed by ':'" }
+#pragma omp declare variant(f2) match(construct={dispatch}) adjust_args(foo x) 			// { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr' followed by ':'" }
+#pragma omp declare variant(f3) match(construct={dispatch}) adjust_args(nothing) 		// { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr' followed by ':'" }
+#pragma omp declare variant(f4) match(construct={dispatch}) adjust_args(need_device_ptr)	// { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr' followed by ':'" }
+#pragma omp declare variant(f5) match(construct={dispatch}) adjust_args(nothing x)	 	// { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr' followed by ':'" }
+#pragma omp declare variant(f6) match(construct={dispatch}) adjust_args(need_device_ptr x)	// { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr' followed by ':'" }
+#pragma omp declare variant(f7) match(construct={dispatch}) adjust_args(need_device_addr x) 	// { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr' followed by ':'" }
+#pragma omp declare variant(f8) match(construct={dispatch}) adjust_args(nothing :)	 	// { dg-error "expected primary-expression before '\\)' token" }
+#pragma omp declare variant(f9) match(construct={dispatch}) adjust_args(need_device_ptr :) 	// { dg-error "expected primary-expression before '\\)' token" }
+#pragma omp declare variant(fa) match(construct={dispatch}) adjust_args(need_device_addr :) 	// { dg-error "expected primary-expression before '\\)' token" }
+#pragma omp declare variant(f10) match(construct={dispatch}) adjust_args(need_device_addr : omp_num_args-1) 	// { dg-error "expected ':' before '\\)' token" }
+// { dg-note "93: an expression is only allowed in a numeric range" "" { target *-*-* } .-1 }
+
+// Valid:
+#pragma omp declare variant(f11) match(construct={dispatch}) adjust_args(nothing : z, 1:2)
+#pragma omp declare variant(f12) match(construct={dispatch}) adjust_args(need_device_ptr : x)
+#pragma omp declare variant(f13) match(construct={dispatch}) adjust_args(need_device_addr : y)
+#pragma omp declare variant(f14) match(construct={dispatch}) adjust_args(nothing : :)
+#pragma omp declare variant(f15) match(construct={dispatch}) adjust_args(need_device_ptr : 3:3)
+#pragma omp declare variant(f16) match(construct={dispatch}) adjust_args(need_device_addr : 2:2)
+
+void g(int*x, int &y, int *z);
diff --git a/gcc/testsuite/gcc.dg/gomp/adjust-args-3.c b/gcc/testsuite/gcc.dg/gomp/adjust-args-3.c
new file mode 100644
index 0000000..a9e7fab
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/gomp/adjust-args-3.c
@@ -0,0 +1,47 @@
+void f(int*,int *,int*);
+void f0(int*,int *,int*);
+void f1(int*,int *,int*);
+void f2(int*,int *,int*);
+void f3(int*,int *,int*);
+void f4(int*,int *,int*);
+void f5(int*,int *,int*);
+void f6(int*,int *,int*);
+void f7(int*,int *,int*);
+void f8(int*,int *,int*);
+void f9(int*,int *,int*);
+void fa(int*,int *,int*);
+void f10(int*,int *,int*);
+void f11(int*,int *,int*);
+void f12(int*,int *,int*);
+void f13(int*,int *,int*);
+void f14(int*,int *,int*);
+void f15(int*,int *,int*);
+void f16(int*,int *,int*);
+
+#pragma omp declare variant(f) match(construct={dispatch}) adjust_args(x : y) 			// { dg-error "expected 'nothing' or 'need_device_ptr'" }
+#pragma omp declare variant(f0) match(construct={dispatch}) adjust_args(x) 			// { dg-error "expected 'nothing' or 'need_device_ptr' followed by ':'" }
+#pragma omp declare variant(f1) match(construct={dispatch}) adjust_args(x,) 			// { dg-error "expected 'nothing' or 'need_device_ptr' followed by ':'" }
+#pragma omp declare variant(f2) match(construct={dispatch}) adjust_args(foo x) 			// { dg-error "expected 'nothing' or 'need_device_ptr' followed by ':'" }
+#pragma omp declare variant(f3) match(construct={dispatch}) adjust_args(nothing) 		// { dg-error "expected 'nothing' or 'need_device_ptr' followed by ':'" }
+#pragma omp declare variant(f4) match(construct={dispatch}) adjust_args(need_device_ptr)	// { dg-error "expected 'nothing' or 'need_device_ptr' followed by ':'" }
+#pragma omp declare variant(f5) match(construct={dispatch}) adjust_args(nothing x)	 	// { dg-error "expected 'nothing' or 'need_device_ptr' followed by ':'" }
+#pragma omp declare variant(f6) match(construct={dispatch}) adjust_args(need_device_ptr x)	// { dg-error "expected 'nothing' or 'need_device_ptr' followed by ':'" }
+#pragma omp declare variant(f7) match(construct={dispatch}) adjust_args(need_device_addr x) 	// { dg-error "expected 'nothing' or 'need_device_ptr'" }
+#pragma omp declare variant(f8) match(construct={dispatch}) adjust_args(nothing :)	 	// { dg-error "expected expression before '\\)' token" }
+#pragma omp declare variant(f9) match(construct={dispatch}) adjust_args(need_device_ptr :) 	// { dg-error "expected expression before '\\)' token" }
+#pragma omp declare variant(fa) match(construct={dispatch}) adjust_args(need_device_addr :) 	// { dg-error "expected 'nothing' or 'need_device_ptr'" }
+// { dg-note "73: 'need_device_addr' is not valid for C" "" { target *-*-* } .-1 }
+#pragma omp declare variant(f10) match(construct={dispatch}) adjust_args(need_device_ptr : omp_num_args-1) 	// { dg-error "expected ':' before '\\)' token" }
+// { dg-note "92: an expression is only allowed in a numeric range" "" { target *-*-* } .-1 }
+
+// Valid:
+#pragma omp declare variant(f11) match(construct={dispatch}) adjust_args(nothing : z, 1:2)
+#pragma omp declare variant(f12) match(construct={dispatch}) adjust_args(need_device_ptr : x)
+#pragma omp declare variant(f13) match(construct={dispatch}) adjust_args(need_device_addr : y)	// { dg-error "expected 'nothing' or 'need_device_ptr'" }
+// { dg-note "74: 'need_device_addr' is not valid for C" "" { target *-*-* } .-1 }
+#pragma omp declare variant(f14) match(construct={dispatch}) adjust_args(nothing : :)
+#pragma omp declare variant(f15) match(construct={dispatch}) adjust_args(need_device_ptr : 3:3)
+#pragma omp declare variant(f16) match(construct={dispatch}) adjust_args(need_device_addr : 2:2)// { dg-error "expected 'nothing' or 'need_device_ptr'" }
+// { dg-note "74: 'need_device_addr' is not valid for C" "" { target *-*-* } .-1 }
+
+void g(int*x, int *y, int *z);
diff --git a/gcc/testsuite/gfortran.dg/gomp/adjust-args-14.f90 b/gcc/testsuite/gfortran.dg/gomp/adjust-args-14.f90
index e644fd7..95b039e 100644
--- a/gcc/testsuite/gfortran.dg/gomp/adjust-args-14.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/adjust-args-14.f90
@@ -14,7 +14,7 @@ contains
 
 ! { dg-error "19: Argument 'y' at .1. to list item in 'need_device_addr' at .2. must not have the VALUE attribute" "" { target *-*-* } 8 }
 ! { dg-error "62: Argument 'y' at .1. to list item in 'need_device_addr' at .2. must not have the VALUE attribute" "" { target *-*-* } 9 }
-! { dg-message "sorry, unimplemented: 'need_device_addr' not yet supported" "" { target *-*-* } 9 }
+
 
 ! { dg-error "Argument 'z' at .1. to list item in 'need_device_ptr' at .2. must be a scalar of TYPE\\(C_PTR\\)" "" { target *-*-* } 8 }
 ! { dg-error "Argument 'z' at .1. to list item in 'need_device_ptr' at .2. must be a scalar of TYPE\\(C_PTR\\)" "" { target *-*-* } 10 }