Fortran/OpenMP: Fix declare_variant's 'adjust_args' mishandling with return by reference [PR118321]

declare_variant's 'adjust_args' clause references the arguments in the
middle end by the argument position; this has to account for hidden
arguments that are inserted before due to return by reference,
as done in this commit.

	PR fortran/118321

gcc/fortran/ChangeLog:

	* trans-openmp.cc (gfc_trans_omp_declare_variant): Honor hidden
	arguments for append_arg's need_device_ptr.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/adjust-args-12.f90: New test.

2 files changed, 51 insertions, 3 deletions

diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 2c61928..d3ebc9b 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -8622,7 +8622,7 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns)
 	  if (!search_ns->proc_name->attr.function
 	      && !search_ns->proc_name->attr.subroutine)
 	    gfc_error ("The base name for %<declare variant%> must be "
-		       "specified at %L ", &odv->where);
+		       "specified at %L", &odv->where);
 	  else
 	    error_found = false;
 	}
@@ -8821,6 +8821,13 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns)
 		  // Handle adjust_args
 		  tree need_device_ptr_list = make_node (TREE_LIST);
 		  vec<gfc_symbol *> adjust_args_list = vNULL;
+		  int arg_idx_offset = 0;
+		  if (gfc_return_by_reference (ns->proc_name))
+		    {
+		      arg_idx_offset++;
+		      if (ns->proc_name->ts.type == BT_CHARACTER)
+			arg_idx_offset++;
+		    }
 		  for (gfc_omp_namelist *arg_list = odv->adjust_args_list;
 		       arg_list != NULL; arg_list = arg_list->next)
 		    {
@@ -8847,14 +8854,15 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns)
 			    if (arg->sym == arg_list->sym)
 			      break;
 			  gcc_assert (arg != NULL);
+			  // Store 0-based argument index,
+			  // as in gimplify_call_expr
 			  need_device_ptr_list = chainon (
 			    need_device_ptr_list,
 			    build_tree_list (
 			      NULL_TREE,
 			      build_int_cst (
 				integer_type_node,
-				idx))); // Store 0-based argument index,
-					// as in gimplify_call_expr
+				idx + arg_idx_offset)));
 			}
 		    }
 
diff --git a/gcc/testsuite/gfortran.dg/gomp/adjust-args-12.f90 b/gcc/testsuite/gfortran.dg/gomp/adjust-args-12.f90
new file mode 100644
index 0000000..94fdd6c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/adjust-args-12.f90
@@ -0,0 +1,40 @@
+! { dg-additional-options "-fdump-tree-gimple" }
+
+! PR fortran/118321
+
+! Ensure that hidden arguments (return by reference) do not mess up the
+! argument counting of need_device_ptr
+
+! Here, we want to process the 3rd argument: 'c' as dummy argument = 'y' as actual.
+
+
+! { dg-final { scan-tree-dump-times "__builtin_omp_get_mapped_ptr" 1 "gimple" } }
+! { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(y, D\.\[0-9\]+\\);" "gimple" } }
+
+! { dg-final { scan-tree-dump "ffff \\(&pstr.\[0-9\], &slen.\[0-9\], &\"abc\"\\\[1\\\]\{lb: 1 sz: 1\}, x, D\.\[0-9\]+, z, &\"cde\"\\\[1\\\]\{lb: 1 sz: 1\}, 3, 3\\);" "gimple" } }
+
+module m
+  use iso_c_binding
+  implicit none (type, external)
+contains
+  character(:) function ffff (a,b,c,d,e)
+    allocatable :: ffff
+    character(*) :: a, e
+    type(c_ptr), value :: b,c,d
+  end
+  character(:) function gggg (a,b,c,d,e)
+    !$omp declare variant(ffff) match(construct={dispatch})  &
+    !$omp&                      adjust_args(need_device_ptr : c)
+    allocatable :: gggg
+    character(*) :: a, e
+    type(c_ptr), value :: b,c,d
+  end
+end module m
+
+use m
+implicit none (type, external)
+type(c_ptr) :: x,y,z
+character(len=:), allocatable :: str
+!$omp dispatch
+  str = gggg ("abc", x, y, z, "cde")
+end