procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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.
This commit is contained in:
Tobias Burnus 2025-01-16 22:39:03 +01:00
parent 62daa81308
commit f5409d71e2
2 changed files with 51 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
gcc/fortran/trans-openmp.cc
View file

@ -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)));
}
}

40
gcc/testsuite/gfortran.dg/gomp/adjust-args-12.f90 Normal file
View file

@ -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