aboutsummaryrefslogtreecommitdiff
path: root/libgomp/testsuite/libgomp.fortran
diff options
context:
space:
mode:
authorTobias Burnus <tobias@codesourcery.com>2023-12-08 15:18:25 +0100
committerTobias Burnus <tobias@codesourcery.com>2023-12-08 15:18:25 +0100
commitd4b6d147920b93297e621124a99ed01e7e310d92 (patch)
tree330b3935af3a4ad4593ca48db70d71b1672a5dc9 /libgomp/testsuite/libgomp.fortran
parent47575ec9edcd3078f066aa54ba428420be796bef (diff)
downloadgcc-d4b6d147920b93297e621124a99ed01e7e310d92.zip
gcc-d4b6d147920b93297e621124a99ed01e7e310d92.tar.gz
gcc-d4b6d147920b93297e621124a99ed01e7e310d92.tar.bz2
OpenMP/Fortran: Implement omp allocators/allocate for ptr/allocatables
This commit adds -fopenmp-allocators which enables support for 'omp allocators' and 'omp allocate' that are associated with a Fortran allocate-stmt. If such a construct is encountered, an error is shown, unless the -fopenmp-allocators flag is present. With -fopenmp -fopenmp-allocators, those constructs get turned into GOMP_alloc allocations, while -fopenmp-allocators (also without -fopenmp) ensures deallocation and reallocation (via intrinsic assignments) are properly directed to GOMP_free/omp_realloc - while normal Fortran allocations are processed by free/realloc. In order to distinguish a 'malloc'ed from a 'GOMP_alloc'ed memory, the version field of the Fortran array discriptor is (mis)used: 0 indicates the normal Fortran allocation while 1 denotes GOMP_alloc. For scalars, there is record keeping in libgomp: GOMP_add_alloc(ptr) will add the pointer address to a splay_tree while GOMP_is_alloc(ptr) will return true it was previously added but also removes it from the list. Besides Fortran FE work, BUILT_IN_GOMP_REALLOC is no part of omp-builtins.def and libgomp gains the mentioned two new function. gcc/ChangeLog: * builtin-types.def (BT_FN_PTR_PTR_SIZE_PTRMODE_PTRMODE): New. * omp-builtins.def (BUILT_IN_GOMP_REALLOC): New. * builtins.cc (builtin_fnspec): Handle it. * gimple-ssa-warn-access.cc (fndecl_alloc_p, matching_alloc_calls_p): Likewise. * gimple.cc (nonfreeing_call_p): Likewise. * predict.cc (expr_expected_value_1): Likewise. * tree-ssa-ccp.cc (evaluate_stmt): Likewise. * tree.cc (fndecl_dealloc_argno): Likewise. gcc/fortran/ChangeLog: * dump-parse-tree.cc (show_omp_node): Handle EXEC_OMP_ALLOCATE and EXEC_OMP_ALLOCATORS. * f95-lang.cc (ATTR_ALLOC_WARN_UNUSED_RESULT_SIZE_2_NOTHROW_LIST): Add 'ECF_LEAF | ECF_MALLOC' to existing 'ECF_NOTHROW'. (ATTR_ALLOC_WARN_UNUSED_RESULT_SIZE_2_NOTHROW_LEAF_LIST): Define. * gfortran.h (gfc_omp_clauses): Add contained_in_target_construct. * invoke.texi (-fopenacc, -fopenmp): Update based on C version. (-fopenmp-simd): New, based on C version. (-fopenmp-allocators): New. * lang.opt (fopenmp-allocators): Add. * openmp.cc (resolve_omp_clauses): For allocators/allocate directive, add target and no dynamic_allocators diagnostic and more invalid diagnostic. * parse.cc (decode_omp_directive): Set contains_teams_construct. * trans-array.h (gfc_array_allocate): Update prototype. (gfc_conv_descriptor_version): New prototype. * trans-decl.cc (gfc_init_default_dt): Fix comment. * trans-array.cc (gfc_conv_descriptor_version): New. (gfc_array_allocate): Support GOMP_alloc allocation. (gfc_alloc_allocatable_for_assignment, structure_alloc_comps): Handle GOMP_free/omp_realloc as needed. * trans-expr.cc (gfc_conv_procedure_call): Likewise. (alloc_scalar_allocatable_for_assignment): Likewise. * trans-intrinsic.cc (conv_intrinsic_move_alloc): Likewise. * trans-openmp.cc (gfc_trans_omp_allocators, gfc_trans_omp_directive): Handle allocators/allocate directive. (gfc_omp_call_add_alloc, gfc_omp_call_is_alloc): New. * trans-stmt.h (gfc_trans_allocate): Update prototype. * trans-stmt.cc (gfc_trans_allocate): Support GOMP_alloc. * trans-types.cc (gfc_get_dtype_rank_type): Set version field. * trans.cc (gfc_allocate_using_malloc, gfc_allocate_allocatable): Update to handle GOMP_alloc. (gfc_deallocate_with_status, gfc_deallocate_scalar_with_status): Handle GOMP_free. (trans_code): Update call. * trans.h (gfc_allocate_allocatable, gfc_allocate_using_malloc): Update prototype. (gfc_omp_call_add_alloc, gfc_omp_call_is_alloc): New prototype. * types.def (BT_FN_PTR_PTR_SIZE_PTRMODE_PTRMODE): New. libgomp/ChangeLog: * allocator.c (struct fort_alloc_splay_tree_key_s, fort_alloc_splay_compare, GOMP_add_alloc, GOMP_is_alloc): New. * libgomp.h: Define splay_tree_static for 'reverse' splay tree. * libgomp.map (GOMP_5.1.2): New; add GOMP_add_alloc and GOMP_is_alloc; move GOMP_target_map_indirect_ptr from ... (GOMP_5.1.1): ... here. * libgomp.texi (Impl. Status, Memory management): Update for allocators/allocate directives. * splay-tree.c: Handle splay_tree_static define to declare all functions as static. (splay_tree_lookup_node): New. * splay-tree.h: Handle splay_tree_decl_only define. (splay_tree_lookup_node): New prototype. * target.c: Define splay_tree_static for 'reverse'. * testsuite/libgomp.fortran/allocators-1.f90: New test. * testsuite/libgomp.fortran/allocators-2.f90: New test. * testsuite/libgomp.fortran/allocators-3.f90: New test. * testsuite/libgomp.fortran/allocators-4.f90: New test. * testsuite/libgomp.fortran/allocators-5.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/allocate-14.f90: Add coarray and not-listed tests. * gfortran.dg/gomp/allocate-5.f90: Remove sorry dg-message. * gfortran.dg/bind_c_array_params_2.f90: Update expected dump for dtype '.version=0'. * gfortran.dg/gomp/allocate-16.f90: New test. * gfortran.dg/gomp/allocators-3.f90: New test. * gfortran.dg/gomp/allocators-4.f90: New test.
Diffstat (limited to 'libgomp/testsuite/libgomp.fortran')
-rw-r--r--libgomp/testsuite/libgomp.fortran/allocators-1.f9068
-rw-r--r--libgomp/testsuite/libgomp.fortran/allocators-2.f90101
-rw-r--r--libgomp/testsuite/libgomp.fortran/allocators-3.f9025
-rw-r--r--libgomp/testsuite/libgomp.fortran/allocators-4.f9057
-rw-r--r--libgomp/testsuite/libgomp.fortran/allocators-5.f9027
5 files changed, 278 insertions, 0 deletions
diff --git a/libgomp/testsuite/libgomp.fortran/allocators-1.f90 b/libgomp/testsuite/libgomp.fortran/allocators-1.f90
new file mode 100644
index 0000000..935a37c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocators-1.f90
@@ -0,0 +1,68 @@
+! { dg-additional-options "-fopenmp-allocators -fdump-tree-original" }
+module m
+ use omp_lib
+ use iso_c_binding, only: c_intptr_t
+ implicit none (type,external)
+ integer(omp_allocator_handle_kind) :: handle
+ integer(c_intptr_t) :: iptr
+end module m
+
+subroutine scalar
+ use m
+ implicit none (type,external)
+ integer :: i
+ integer, allocatable :: SSS
+ i = 5 ! required executive statement before 'omp allocators'
+ !$omp allocate allocator(handle)
+ allocate(SSS)
+ if (mod (loc (sss), 64) /= 0) stop 1
+ deallocate(SSS)
+ allocate(SSS)
+end
+! { dg-final { scan-tree-dump-times "sss = \\(integer\\(kind=4\\) \\*\\) __builtin_GOMP_alloc \\(4, 4, D\\.\[0-9\]+\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "GOMP_add_alloc \\(sss\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "if \\(GOMP_is_alloc \\(sss\\)\\)" 2 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(sss, 0B\\);" 2 "original" } }
+
+subroutine array
+ use m
+ implicit none (type,external)
+ integer :: i
+ integer, allocatable :: A(:)
+ i = 5 ! required executive statement before 'omp allocators'
+ !$omp allocate allocator(handle) align(512)
+ allocate(A(5))
+ if (mod (loc (A), 512) /= 0) stop 2
+ A=[1]
+ if (mod (loc (A), 64) /= 0) stop 3
+ deallocate(A)
+ A=[1]
+ deallocate(A)
+ call omp_set_default_allocator (handle)
+ !$omp allocate
+ allocate(A(7))
+ if (mod (loc (A), 64) /= 0) stop 4
+end
+! { dg-final { scan-tree-dump-times "a.dtype = {.elem_len=4, .version=0, .rank=1, .type=1};" 5 "original" } }
+! { dg-final { scan-tree-dump-times "\\.elem_len=4" 5 "original" } }
+! { dg-final { scan-tree-dump-times "a.data = \\(void \\* restrict\\) __builtin_GOMP_alloc \\(512, 20, D\\.\[0-9\]+\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "a.data = \\(void \\* restrict\\) __builtin_GOMP_alloc \\(4, 28, 0B\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "a.dtype.version = 1;" 2 "original" } }
+! { dg-final { scan-tree-dump-times "a.data = \\(void \\* restrict\\) \\(a.dtype.version == 1 \\? __builtin_omp_realloc \\(\\(void \\*\\) a.data, 4, 0B, 0B\\) : __builtin_realloc \\(\\(void \\*\\) a.data, 4\\)\\);" 2 "original" } }
+! { dg-final { scan-tree-dump-times "if \\(a.dtype.version == 1\\)" 3 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(\\(integer\\(kind=4\\)\\\[0:\\\] \\* restrict\\) a.data, 0B\\);" 3 "original" } }
+! { dg-final { scan-tree-dump-times "a.dtype.version = 0;" 3 "original" } }
+
+program main
+ use m
+ implicit none (type,external)
+ external :: scalar, array
+ type (omp_alloctrait), parameter :: traits(*) &
+ = [omp_alloctrait(omp_atk_sync_hint, omp_atv_contended), &
+ omp_alloctrait(omp_atk_alignment, 64)]
+ handle = omp_init_allocator (omp_high_bw_mem_alloc, size(traits), traits)
+ call scalar
+ call array
+ call omp_destroy_allocator (handle)
+end
+
diff --git a/libgomp/testsuite/libgomp.fortran/allocators-2.f90 b/libgomp/testsuite/libgomp.fortran/allocators-2.f90
new file mode 100644
index 0000000..c42fbd3
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocators-2.f90
@@ -0,0 +1,101 @@
+! { dg-additional-options "-fopenmp-allocators" }
+module m
+ implicit none (type, external)
+ type t
+ integer, allocatable :: Acomp, Bcomp(:)
+ end type t
+
+contains
+
+subroutine intent_out(aa, bb, cc, dd, ee, ff)
+ integer, allocatable,intent(out) :: aa, bb(:)
+ type(t), intent(out) :: cc, dd(4)
+ type(t), allocatable, intent(out) :: ee, ff(:)
+end
+
+subroutine q(qa, qb, qc, qd, qe, qf)
+ integer, allocatable :: qa, qb(:)
+ type(t) :: qc, qd(4)
+ type(t), allocatable :: qe, qf(:)
+ call intent_out (qa, qb, qc, qd, qe, qf)
+end subroutine q
+
+subroutine r
+ integer, allocatable :: r1, r2(:)
+ type(t) :: r3, r4(4)
+ type(t), allocatable :: r5, r6(:)
+
+ call q(r1,r2,r3,r4,r5,r6)
+
+ allocate(r1,r2(3))
+ allocate(r5,r6(4))
+ allocate(r3%Acomp, r3%Bcomp(2))
+ allocate(r4(2)%Acomp, r4(2)%Bcomp(2))
+ allocate(r5%Acomp, r5%Bcomp(2))
+ allocate(r6(3)%Acomp, r6(3)%Bcomp(2))
+ !$omp allocate align(128)
+ allocate(r4(3)%Acomp, r4(3)%Bcomp(2), &
+ r6(1)%Acomp, r6(1)%Bcomp(2))
+ if (mod (loc (r4(3)%Acomp), 128) /= 0) stop 1
+ if (mod (loc (r4(3)%Bcomp), 128) /= 0) stop 2
+ if (mod (loc (r6(1)%Acomp), 128) /= 0) stop 3
+ if (mod (loc (r6(1)%Bcomp), 128) /= 0) stop 3
+ call q(r1,r2,r3,r4,r5,r6)
+
+ !$omp allocate align(64)
+ allocate(r1,r2(3))
+ if (mod (loc (r1), 64) /= 0) stop 1
+ if (mod (loc (r2), 64) /= 0) stop 1
+ !$omp allocate align(64)
+ allocate(r5,r6(4))
+ if (mod (loc (r5), 64) /= 0) stop 1
+ if (mod (loc (r6), 64) /= 0) stop 1
+ !$omp allocate align(64)
+ allocate(r3%Acomp, r3%Bcomp(2))
+ if (mod (loc (r3%Acomp), 64) /= 0) stop 1
+ if (mod (loc (r3%Bcomp), 64) /= 0) stop 1
+ !$omp allocate align(64)
+ allocate(r4(2)%Acomp, r4(2)%Bcomp(2))
+ if (mod (loc (r4(2)%Acomp), 64) /= 0) stop 1
+ if (mod (loc (r4(2)%Bcomp), 64) /= 0) stop 1
+ !$omp allocate align(64)
+ allocate(r5%Acomp, r5%Bcomp(2))
+ if (mod (loc (r5%Acomp), 64) /= 0) stop 1
+ if (mod (loc (r5%Bcomp), 64) /= 0) stop 1
+ !$omp allocate align(64)
+ allocate(r6(3)%Acomp, r6(3)%Bcomp(2))
+ if (mod (loc (r6(3)%Acomp), 64) /= 0) stop 1
+ if (mod (loc (r6(3)%Bcomp), 64) /= 0) stop 1
+ !$omp allocate align(128)
+ allocate(r4(3)%Acomp, r4(3)%Bcomp(2), &
+ r6(1)%Acomp, r6(1)%Bcomp(2))
+ if (mod (loc (r4(3)%Acomp), 128) /= 0) stop 1
+ if (mod (loc (r4(3)%Bcomp), 128) /= 0) stop 2
+ if (mod (loc (r6(1)%Acomp), 128) /= 0) stop 3
+ if (mod (loc (r6(1)%Bcomp), 128) /= 0) stop 3
+ call q(r1,r2,r3,r4,r5,r6)
+end subroutine r
+end
+
+subroutine s
+ use m, only : t
+ implicit none (type, external)
+ type(t) :: xx
+ integer :: i, iiiiii
+ i = 4
+ !$omp allocate
+ allocate(xx%Acomp, xx%Bcomp(4))
+ deallocate(xx%Acomp, xx%Bcomp)
+
+ !$omp allocate
+ allocate(xx%Acomp, xx%Bcomp(4))
+ xx = t(1, [1,2])
+end
+
+program main
+ use m, only: r
+ implicit none (type, external)
+ external s
+ call s
+ call r
+end
diff --git a/libgomp/testsuite/libgomp.fortran/allocators-3.f90 b/libgomp/testsuite/libgomp.fortran/allocators-3.f90
new file mode 100644
index 0000000..2e05939
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocators-3.f90
@@ -0,0 +1,25 @@
+! { dg-additional-options "-fdump-tree-original -fopenmp-allocators" }
+
+subroutine s
+ character(:), allocatable :: s1,s2
+
+ !$omp allocators allocate(s1)
+ allocate(character(len=3) :: s1)
+
+ !$omp allocators allocate(s2)
+ allocate(character(len=5) :: s2)
+
+ s2(1:5) = "12"
+ s1 = trim(s2)
+end
+! { dg-final { scan-tree-dump-times "s1 = \\(character\\(kind=1\\)\\\[1:.s1\\\] \\*\\) __builtin_GOMP_alloc \\(1, 3, 0B\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "s2 = \\(character\\(kind=1\\)\\\[1:.s2\\\] \\*\\) __builtin_GOMP_alloc \\(1, 5, 0B\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "s1 = \\(character\\(kind=1\\)\\\[1:.s1\\\] \\*\\) \\(D\\.\[0-9\]+ \\? __builtin_omp_realloc \\(\\(void \\*\\) s1, MAX_EXPR <\\(sizetype\\) len.1, 1>, 0B, 0B\\) : __builtin_realloc \\(\\(void \\*\\) s1, MAX_EXPR <\\(sizetype\\) len.1, 1>\\)\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "GOMP_add_alloc \\(s1\\);" 2 "original" } }
+! { dg-final { scan-tree-dump-times "OMP_add_alloc \\(s2\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "if \\(GOMP_is_alloc \\(s2\\)\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(s2, 0B\\);" 1 "original" } }
+
+
+call s
+end
diff --git a/libgomp/testsuite/libgomp.fortran/allocators-4.f90 b/libgomp/testsuite/libgomp.fortran/allocators-4.f90
new file mode 100644
index 0000000..12689ea
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocators-4.f90
@@ -0,0 +1,57 @@
+! { dg-additional-options "-fopenmp-allocators" }
+module m
+implicit none
+type t
+ integer, allocatable :: Acomp, Bcomp(:)
+ class(*), allocatable :: Ccomp, Dcomp(:)
+end type t
+contains
+
+subroutine intout(c,d,e,f)
+implicit none
+class(t), intent(out) :: c,d(4)
+class(t), allocatable, intent(out) :: e,f(:)
+end
+
+subroutine q(c,d,e,f)
+implicit none
+class(t) :: c,d(4)
+class(t), allocatable :: e,f(:)
+call intout(c,d,e,f)
+end subroutine q
+
+subroutine s
+implicit none
+type(t) :: xx
+class(t), allocatable :: yy
+integer :: i, iiiiii
+i = 4
+!$omp allocate
+allocate(xx%Acomp, xx%Bcomp(4))
+deallocate(xx%Acomp, xx%Bcomp)
+
+!$omp allocate
+allocate(integer :: xx%Ccomp, xx%Dcomp(4))
+deallocate(xx%Ccomp, xx%Dcomp)
+
+!$omp allocators allocate(yy)
+allocate(t :: yy)
+
+!$omp allocate
+allocate(real :: xx%Ccomp, xx%Dcomp(4))
+deallocate(xx%Ccomp, xx%Dcomp)
+
+!$omp allocate
+allocate(xx%Acomp, xx%Bcomp(4))
+!$omp allocate
+allocate(logical :: xx%Ccomp, xx%Dcomp(4))
+
+iiiiii = 555
+xx = t(1, [1,2])
+end
+
+end module
+
+use m
+call s
+end
diff --git a/libgomp/testsuite/libgomp.fortran/allocators-5.f90 b/libgomp/testsuite/libgomp.fortran/allocators-5.f90
new file mode 100644
index 0000000..8708863
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocators-5.f90
@@ -0,0 +1,27 @@
+! { dg-additional-options "-fopenmp-allocators" }
+module m
+contains
+subroutine s(a,b,c,d)
+integer, allocatable :: A, B
+integer, allocatable :: C(:), D(:)
+
+!$omp allocators allocate(A,B)
+allocate(A,B)
+call move_alloc(A,B)
+
+!$omp allocators allocate(C,D)
+allocate(C(5),D(5))
+call move_alloc(C,D)
+end
+
+subroutine q()
+integer, allocatable :: A, B
+integer, allocatable :: C(:), D(:)
+
+call s(a,b,c,d)
+end
+end
+
+use m
+call q
+end