https://gcc.gnu.org/g:8aca2aac83606fc165d4a0755cb75913b07cf693
commit 8aca2aac83606fc165d4a0755cb75913b07cf693
Author: Tobias Burnus <tbur...@baylibre.com>
Date: Tue Jan 28 13:17:08 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.
(cherry picked from commit f5409d71e2ec8cdcc674b312dd4c115bb3626eba)
Diff:
---
gcc/fortran/ChangeLog.omp | 9 +++++
gcc/fortran/trans-openmp.cc | 16 ++++++---
gcc/testsuite/ChangeLog.omp | 8 +++++
gcc/testsuite/gfortran.dg/gomp/adjust-args-12.f90 | 40 +++++++++++++++++++++++
4 files changed, 69 insertions(+), 4 deletions(-)
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 82bd5728a8e1..60d58e539a43 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,12 @@
+2025-01-28 Tobias Burnus <tbur...@baylibre.com>
+
+ Backported from master:
+ 2025-01-16 Tobias Burnus <tbur...@baylibre.com>
+
+ PR fortran/118321
+ * trans-openmp.cc (gfc_trans_omp_declare_variant): Honor hidden
+ arguments for append_arg's need_device_ptr.
+
2025-01-28 Tobias Burnus <tbur...@baylibre.com>
Backported from master:
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 6652a2b2aca2..5e5d01380967 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -11263,8 +11263,8 @@ 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);
+ gfc_error ("The base name for %<declare variant%> must be "
+ "specified at %L", &odv->where);
else
error_found = false;
}
@@ -11381,6 +11381,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)
{
@@ -11407,14 +11414,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/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index c65b6f2651f1..46ed6b38a8da 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,11 @@
+2025-01-28 Tobias Burnus <tbur...@baylibre.com>
+
+ Backported from master:
+ 2025-01-16 Tobias Burnus <tbur...@baylibre.com>
+
+ PR fortran/118321
+ * gfortran.dg/gomp/adjust-args-12.f90: New test.
+
2025-01-28 Thomas Schwinge <tschwi...@baylibre.com>
Backported from master:
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
