6e4d01d61f
2019-12-06 Tobias Burnus <tobias@codesourcery.com>
Kwok Cheung Yeung <kcy@codesourcery.com>
gcc/fortran/
* trans-openmp.c (gfc_build_conditional_assign,
gfc_build_conditional_assign_expr): New static functions.
(gfc_omp_finish_clause, gfc_trans_omp_clauses): Handle mapping of
absent optional arguments and fix mapping of present optional args.
gcc/
* omp-low.c (lower_omp_target): For optional arguments, deref once
more to obtain the type.
libgomp/
* oacc-mem.c (update_dev_host, gomp_acc_insert_pointer): Just return
if input it a NULL pointer.
* testsuite/libgomp.oacc-c-c++-common/lib-43.c: Remove; dependent on
diagnostic of NULL pointer.
* testsuite/libgomp.oacc-c-c++-common/lib-47.c: Ditto.
* testsuite/libgomp.fortran/optional-map.f90: New.
* testsuite/libgomp.fortran/use_device_addr-1.f90
(test_dummy_opt_callee_1_absent): New.
(test_dummy_opt_call_1): Call it.
* testsuite/libgomp.fortran/use_device_addr-2.f90: Likewise.
* testsuite/libgomp.fortran/use_device_addr-3.f90: Likewise.
* testsuite/libgomp.fortran/use_device_addr-4.f90: Likewise.
* testsuite/libgomp.oacc-fortran/optional-cache.f95: New.
* testsuite/libgomp.oacc-fortran/optional-data-copyin-by-value.f90: New.
* testsuite/libgomp.oacc-fortran/optional-data-copyin.f90: New.
* testsuite/libgomp.oacc-fortran/optional-data-copyout.f90: New.
* testsuite/libgomp.oacc-fortran/optional-data-enter-exit.f90: New.
* testsuite/libgomp.oacc-fortran/optional-declare.f90: New.
* testsuite/libgomp.oacc-fortran/optional-firstprivate.f90: New.
* testsuite/libgomp.oacc-fortran/optional-host_data.f90: New.
* testsuite/libgomp.oacc-fortran/optional-nested-calls.f90: New.
* testsuite/libgomp.oacc-fortran/optional-private.f90: New.
* testsuite/libgomp.oacc-fortran/optional-reduction.f90: New.
* testsuite/libgomp.oacc-fortran/optional-update-device.f90: New.
* testsuite/libgomp.oacc-fortran/optional-update-host.f90: New.
Co-Authored-By: Kwok Cheung Yeung <kcy@codesourcery.com>
From-SVN: r279043
122 lines
3.1 KiB
Fortran
122 lines
3.1 KiB
Fortran
! { dg-do run }
|
|
!
|
|
implicit none (type, external)
|
|
call sub()
|
|
call sub2()
|
|
call call_present_1()
|
|
call call_present_2()
|
|
|
|
contains
|
|
|
|
subroutine call_present_1()
|
|
integer :: ii, ival, iarr, iptr, iparr
|
|
pointer :: iptr, iparr
|
|
dimension :: iarr(2), iparr(:)
|
|
allocate(iptr,iparr(2))
|
|
ii = 101
|
|
ival = 102
|
|
iptr = 103
|
|
iarr = 104
|
|
iparr = 105
|
|
call sub_present(ii, ival, iarr, iptr, iparr)
|
|
deallocate(iptr,iparr)
|
|
end subroutine
|
|
|
|
subroutine call_present_2()
|
|
integer :: ii, ival, iarr, iptr, iparr
|
|
pointer :: iptr, iparr
|
|
dimension :: iarr(2), iparr(:)
|
|
allocate(iptr,iparr(2))
|
|
ii = 201
|
|
ival = 202
|
|
iptr = 203
|
|
iarr = 204
|
|
iparr = 205
|
|
call sub2_present(ii, ival, iarr, iptr, iparr)
|
|
deallocate(iptr,iparr)
|
|
end subroutine
|
|
|
|
subroutine sub(ii, ival, iarr, iptr, iparr)
|
|
integer, optional :: ii, ival, iarr, iptr, iparr
|
|
pointer :: iptr, iparr
|
|
dimension :: iarr(:), iparr(:)
|
|
value :: ival
|
|
integer :: err
|
|
err = 42
|
|
!$omp target map(ii, ival, iarr, iptr, iparr, err)
|
|
if (present(ii)) then
|
|
ii = iptr + ival
|
|
iarr = iparr
|
|
else
|
|
err = 0
|
|
end if
|
|
if (present(ii)) err = 1
|
|
if (present(ival)) err = 2
|
|
if (present(iarr)) err = 3
|
|
if (present(iptr)) err = 4
|
|
if (present(iparr)) err = 5
|
|
!$omp end target
|
|
if (err /= 0) stop 1
|
|
end subroutine sub
|
|
|
|
subroutine sub2(ii, ival, iarr, iptr, iparr)
|
|
integer, optional :: ii, ival, iarr, iptr, iparr
|
|
pointer :: iptr, iparr
|
|
dimension :: iarr(:), iparr(:)
|
|
value :: ival
|
|
integer :: err(1) ! otherwise, implied defaultmap is firstprivate
|
|
err(1) = 42
|
|
!$omp target ! automatic mapping with implied defaultmap(tofrom)
|
|
if (present(ii)) then
|
|
ii = iptr + ival
|
|
iarr = iparr
|
|
else
|
|
err(1) = 0
|
|
end if
|
|
if (present(ii)) err(1) = 1
|
|
if (present(ival)) err(1) = 2
|
|
if (present(iarr)) err(1) = 3
|
|
if (present(iptr)) err(1) = 4
|
|
if (present(iparr)) err(1) = 5
|
|
!$omp end target
|
|
if (err(1) /= 0) stop 2
|
|
end subroutine sub2
|
|
|
|
subroutine sub_present(ii, ival, iarr, iptr, iparr)
|
|
integer, optional :: ii, ival, iarr, iptr, iparr
|
|
pointer :: iptr, iparr
|
|
dimension :: iarr(:), iparr(:)
|
|
value :: ival
|
|
integer :: err
|
|
err = 42
|
|
!$omp target map(ii, ival, iarr, iptr, iparr, err)
|
|
if (.not.present(ii)) err = 1
|
|
if (.not.present(ival)) err = 2
|
|
if (.not.present(iarr)) err = 3
|
|
if (.not.present(iptr)) err = 4
|
|
if (.not.present(iparr)) err = 5
|
|
err = err - 42 - 101-102-103-104-105 + ii+ival+iarr(2)+iptr+iparr(2)
|
|
!$omp end target
|
|
if (err /= 0) stop 3
|
|
end subroutine sub_present
|
|
|
|
subroutine sub2_present(ii, ival, iarr, iptr, iparr)
|
|
integer, optional :: ii, ival, iarr, iptr, iparr
|
|
pointer :: iptr, iparr
|
|
dimension :: iarr(:), iparr(:)
|
|
value :: ival
|
|
integer :: err(1) ! otherwise, implied defaultmap is firstprivate
|
|
err(1) = 53
|
|
!$omp target ! automatic mapping with implied defaultmap(tofrom)
|
|
! Note: OpenMP 4.5's 'defaultmap' is not yet supported, PR 92568
|
|
if (.not.present(ii)) err = 1
|
|
if (.not.present(ival)) err = 2
|
|
if (.not.present(iarr)) err = 3
|
|
if (.not.present(iptr)) err = 4
|
|
if (.not.present(iparr)) err = 5
|
|
err = err - 53 - 201-202-203-204-205 + ii+ival+iarr(2)+iptr+iparr(2)
|
|
!$omp end target
|
|
if (err(1) /= 0) stop 4
|
|
end subroutine sub2_present
|
|
end
|