mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-01-10 22:35:26 +08:00
80bb0b8a81
Previously, array descriptors might have been mapped as 'alloc' instead of 'to' for 'alloc', not updating the array bounds. The 'alloc' could also appear for 'data exit', failing with a libgomp assert. In some cases, either array descriptors or deferred-length string's length variable was not mapped. And, finally, some offset calculations with array-sections mappings went wrong. Additionally, the patch now unmaps for scalar allocatables/pointers the GOMP_MAP_POINTER, avoiding stale mappings. The testcases contain some comment-out tests which require follow-up work and for which PR exist. Those mostly relate to deferred-length strings which have several issues beyong OpenMP support. gcc/fortran/ChangeLog: * trans-decl.cc (gfc_get_symbol_decl): Add attributes such as 'declare target' also to hidden artificial variable for deferred-length character variables. * trans-openmp.cc (gfc_trans_omp_array_section, gfc_trans_omp_clauses, gfc_trans_omp_target_exit_data): Improve mapping of array descriptors and deferred-length string variables. gcc/ChangeLog: * gimplify.cc (gimplify_scan_omp_clauses): Remove Fortran special case. libgomp/ChangeLog: * testsuite/libgomp.fortran/target-enter-data-3.f90: Uncomment 'target exit data'. * testsuite/libgomp.fortran/target-enter-data-4.f90: New test. * testsuite/libgomp.fortran/target-enter-data-5.f90: New test. * testsuite/libgomp.fortran/target-enter-data-6.f90: New test. * testsuite/libgomp.fortran/target-enter-data-7.f90: New test. gcc/testsuite/ * gfortran.dg/goacc/finalize-1.f: Update dg-tree; shows a fix for 'finalize' as a ptr is now 'delete' instead of 'release'. * gfortran.dg/gomp/pr78260-2.f90: Likewise as elem-size calc moved to if (allocated) block * gfortran.dg/gomp/target-exit-data.f90: Likewise as a var is now a replaced by a MEM< _25 > expression. * gfortran.dg/gomp/map-9.f90: Update dg-scan-tree-dump. * gfortran.dg/gomp/map-10.f90: New test.
23 lines
597 B
Fortran
23 lines
597 B
Fortran
implicit none
|
|
type t
|
|
integer :: dummy
|
|
integer, pointer :: p1(:), p2(:)
|
|
integer :: dummy2
|
|
end type t
|
|
type(t) :: var
|
|
integer :: i
|
|
allocate(var%p1(5),var%p2(2:4))
|
|
var%p1 = [22,53,28,6,4]
|
|
var%p2 = [46,679,54]
|
|
|
|
!$omp target enter data map(to:var%p1, var%p2)
|
|
!$omp target
|
|
if (.not.associated(var%p1).or.lbound(var%p1,1)/=1.or.ubound(var%p1,1)/=5) stop 1
|
|
if (.not.associated(var%p2).or.lbound(var%p2,1)/=2.or.ubound(var%p2,1)/=4) stop 2
|
|
if (any (var%p1 /= [22,53,28,6,4])) stop 3
|
|
if (any (var%p2 /= [46,679,54])) stop 4
|
|
!$omp end target
|
|
!$omp target exit data map(from:var%p1, var%p2)
|
|
end
|
|
|