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

Fix omp target issue with Fortran optional arguments

Browse source 
gcc/
        * omp-low.c (lower_omp_target): Dereference optional argument
        to work with the right pointer.

        gcc/testsuite/
        * libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-1.f90: New.

From-SVN: r276445
This commit is contained in:
Tobias Burnus 2019-10-02 10:33:42 +00:00 • committed by Tobias Burnus
parent 73a2863409
commit 67c259509c
4 changed files with 46 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
gcc/ChangeLog
View file

@ -1,3 +1,8 @@
2019-10-02 Tobias Burnus <tobias@codesourcery.com>
* omp-low.c (lower_omp_target): Dereference optional argument
to work with the right pointer.
2019-10-02 Kwok Cheung Yeung <kcy@codesourcery.com>
* langhooks-def.h (LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT): Default to

2
gcc/omp-low.c
View file

@ -11870,7 +11870,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
var = build_fold_addr_expr (var);
else
{
if (omp_is_reference (ovar))
if (omp_is_reference (ovar) || omp_is_optional_argument (ovar))
{
type = TREE_TYPE (type);
if (TREE_CODE (type) != ARRAY_TYPE

4
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,7 @@
2019-10-02 Tobias Burnus <tobias@codesourcery.com>
* libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-1.f90: New.
2019-10-02 Jakub Jelinek <jakub@redhat.com>
PR tree-optimization/91940

36
libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-1.f90 Normal file
View file

@ -0,0 +1,36 @@
! Test whether use_device_ptr properly handles OPTIONAL arguments
! (Only case of present arguments is tested)
program test_it
implicit none
integer, target :: ixx
integer, pointer :: ptr_i, ptr_null
ptr_i => ixx
call foo(ptr_i)
ptr_null => null()
call bar(ptr_null)
contains
subroutine foo(ii)
integer, pointer, optional :: ii
if (.not.present(ii)) call abort()
if (.not.associated(ii, ixx)) call abort()
!$omp target data map(to:ixx) use_device_ptr(ii)
if (.not.present(ii)) call abort()
if (.not.associated(ii)) call abort()
!$omp end target data
end subroutine foo
! For bar, it is assumed that a NULL ptr on the host maps to NULL on the device
subroutine bar(jj)
integer, pointer, optional :: jj
if (.not.present(jj)) call abort()
if (associated(jj)) call abort()
!$omp target data map(to:ixx) use_device_ptr(jj)
if (.not.present(jj)) call abort()
if (associated(jj)) call abort()
!$omp end target data
end subroutine bar
end program test_it