https://gcc.gnu.org/g:f5409d71e2ec8cdcc674b312dd4c115bb3626eba
commit r15-6976-gf5409d71e2ec8cdcc674b312dd4c115bb3626eba
Author: Tobias Burnus <tbur...@baylibre.com>
Date: Thu Jan 16 22:39:03 2025 +0100
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.
Diff:
---
gcc/fortran/trans-openmp.cc | 14 ++++++--
gcc/testsuite/gfortran.dg/gomp/adjust-args-12.f90 | 40 +++++++++++++++++++++++
2 files changed, 51 insertions(+), 3 deletions(-)
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 2c6192820cc6..d3ebc9b47455 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 000000000000..94fdd6c7a625
--- /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
