From da8e0e1191c5512244a752b30dea0eba83e3d10c Mon Sep 17 00:00:00 2001 From: Thomas Schwinge Date: Thu, 27 Oct 2022 21:52:07 +0200 Subject: [PATCH] Support OpenACC 'declare create' with Fortran allocatable arrays, part I [PR106643] PR libgomp/106643 libgomp/ * oacc-mem.c (goacc_enter_data_internal): Support OpenACC 'declare create' with Fortran allocatable arrays, part I. * testsuite/libgomp.oacc-fortran/declare-allocatable-1-directive.f90: New. * testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1-directive.f90: New. --- libgomp/oacc-mem.c | 28 +++++++++++++++++-- ...90 => declare-allocatable-1-directive.f90} | 14 ++++++++-- ...ocatable-array_descriptor-1-directive.f90} | 12 ++++---- 3 files changed, 44 insertions(+), 10 deletions(-) copy libgomp/testsuite/libgomp.oacc-fortran/{declare-allocatable-1.f90 => declare-allocatable-1-directive.f90} (95%) copy libgomp/testsuite/libgomp.oacc-fortran/{declare-allocatable-array_descriptor-1-runtime.f90 => declare-allocatable-array_descriptor-1-directive.f90} (98%) diff --git a/libgomp/oacc-mem.c b/libgomp/oacc-mem.c index 73b2710c2b8..ba010fddbb3 100644 --- a/libgomp/oacc-mem.c +++ b/libgomp/oacc-mem.c @@ -1150,8 +1150,7 @@ goacc_enter_data_internal (struct gomp_device_descr *acc_dev, size_t mapnum, } else if (n && groupnum > 1) { - assert (n->refcount != REFCOUNT_INFINITY - && n->refcount != REFCOUNT_LINK); + assert (n->refcount != REFCOUNT_LINK); for (size_t j = i + 1; j <= group_last; j++) if ((kinds[j] & 0xff) == GOMP_MAP_ATTACH) @@ -1166,6 +1165,31 @@ goacc_enter_data_internal (struct gomp_device_descr *acc_dev, size_t mapnum, bool processed = false; struct target_mem_desc *tgt = n->tgt; + + /* Arrange so that OpenACC 'declare' code à la PR106643 + "[gfortran + OpenACC] Allocate in module causes refcount error" + has a chance to work. */ + if ((kinds[i] & 0xff) == GOMP_MAP_TO_PSET + && tgt->list_count == 0) + { + /* 'declare target'. */ + assert (n->refcount == REFCOUNT_INFINITY); + + for (size_t k = 1; k < groupnum; k++) + { + /* The only thing we expect to see here. */ + assert ((kinds[i + k] & 0xff) == GOMP_MAP_POINTER); + } + + /* Given that 'goacc_exit_data_internal'/'goacc_exit_datum_1' + will always see 'n->refcount == REFCOUNT_INFINITY', + there's no need to adjust 'n->dynamic_refcount' here. */ + + processed = true; + } + else + assert (n->refcount != REFCOUNT_INFINITY); + for (size_t j = 0; j < tgt->list_count; j++) if (tgt->list[j].key == n) { diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1-directive.f90 similarity index 95% copy from libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1.f90 copy to libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1-directive.f90 index 1c8ccd9f61f..759873bad67 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1-directive.f90 @@ -3,10 +3,10 @@ ! { dg-do run } !TODO-OpenACC-declare-allocate -! Not currently implementing correct '-DACC_MEM_SHARED=0' behavior: ! Missing support for OpenACC "Changes from Version 2.0 to 2.5": ! "The 'declare create' directive with a Fortran 'allocatable' has new behavior". -! { dg-xfail-run-if TODO { *-*-* } { -DACC_MEM_SHARED=0 } } +! Thus, after 'allocate'/before 'deallocate', do +! '!$acc enter data create'/'!$acc exit data delete' manually. !TODO { dg-additional-options -fno-inline } for stable results regarding OpenACC 'routine'. @@ -67,6 +67,7 @@ program test ! Test local usage of an allocated declared array. allocate (b(n)) + !$acc enter data create (b) if (.not.allocated (b)) error stop if (.not.acc_is_present (b)) error stop @@ -91,12 +92,14 @@ program test if (b(i) /= i*a) error stop end do + !$acc exit data delete (b) deallocate (b) ! Test the usage of an allocated declared array inside an acc ! routine subroutine. allocate (b(n)) + !$acc enter data create (b) if (.not.allocated (b)) error stop if (.not.acc_is_present (b)) error stop @@ -114,6 +117,7 @@ program test if (b(i) /= i*2) error stop end do + !$acc exit data delete (b) deallocate (b) ! Test the usage of an allocated declared array inside a host @@ -129,6 +133,7 @@ program test if (b(i) /= 1.0) error stop end do + !$acc exit data delete (b) deallocate (b) if (allocated (b)) error stop @@ -137,6 +142,7 @@ program test ! routine function. allocate (b(n)) + !$acc enter data create (b) if (.not.allocated (b)) error stop if (.not.acc_is_present (b)) error stop @@ -170,12 +176,14 @@ program test if (b(i) /= i) error stop end do + !$acc exit data delete (b) deallocate (b) ! Test the usage of an allocated declared array inside a host ! function. allocate (b(n)) + !$acc enter data create (b) if (.not.allocated (b)) error stop if (.not.acc_is_present (b)) error stop @@ -202,6 +210,7 @@ program test if (b(i) /= i*i) error stop end do + !$acc exit data delete (b) deallocate (b) end program test ! { dg-line l[incr c] } ! { dg-bogus {note: variable 'overflow\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {TODO n/a} { xfail *-*-* } l$c } @@ -234,6 +243,7 @@ subroutine sub2 integer i allocate (b(n)) + !$acc enter data create (b) if (.not.allocated (b)) error stop if (.not.acc_is_present (b)) error stop diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1-runtime.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1-directive.f90 similarity index 98% copy from libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1-runtime.f90 copy to libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1-directive.f90 index b27f312631d..10e1d5bc378 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1-runtime.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1-directive.f90 @@ -10,8 +10,8 @@ !TODO-OpenACC-declare-allocate ! Missing support for OpenACC "Changes from Version 2.0 to 2.5": ! "The 'declare create' directive with a Fortran 'allocatable' has new behavior". -! Thus, after 'allocate'/before 'deallocate', call 'acc_create'/'acc_delete' -! manually. +! Thus, after 'allocate'/before 'deallocate', do +! '!$acc enter data create'/'!$acc exit data delete' manually. !TODO { dg-additional-options -fno-inline } for stable results regarding OpenACC 'routine'. @@ -102,7 +102,7 @@ program test allocate (b(n1_lb:n1_ub)) call verify_n1_allocated if (acc_is_present (b)) error stop - call acc_create (b) + !$acc enter data create (b) ! This is now OpenACC "present": if (.not.acc_is_present (b)) error stop ! This still has the initial array descriptor: @@ -201,7 +201,7 @@ program test call verify_n1_allocated if (.not.acc_is_present (b)) error stop - call acc_delete (b) + !$acc exit data delete (b) if (.not.allocated (b)) error stop if (acc_is_present (b)) error stop ! The device-side array descriptor doesn't get updated, so 'b' still appears @@ -241,7 +241,7 @@ program test allocate (b(n2_lb:n2_ub)) call verify_n2_allocated if (acc_is_present (b)) error stop - call acc_create (b) + !$acc enter data create (b) if (.not.acc_is_present (b)) error stop ! This still has the previous (n1) array descriptor: !$acc serial @@ -299,7 +299,7 @@ program test call verify_n2_allocated if (.not.acc_is_present (b)) error stop - call acc_delete (b) + !$acc exit data delete (b) if (.not.allocated (b)) error stop if (acc_is_present (b)) error stop !$acc serial -- 2.35.1