OpenMP/Fortran: Parsing support for 'uses_allocators'

The 'uses_allocators' clause to the 'target' construct accepts predefined
allocators and can also be used to define a new allocator for a target region.
As predefined allocators in GCC do not require special handling, those can and
are ignored after parsing, such that this feature now works. On the other hand,
defining a new allocator will fail for now with a 'sorry, unimplemented'.

Note that both the OpenMP 5.0/5.1 and 5.2 syntax for uses_allocators
is supported by this commit.

2023-07-17  Tobias Burnus  <tobias@codesoucery.com>
	    Chung-Lin Tang  <cltang@codesourcery.com>

gcc/fortran/ChangeLog:

	* dump-parse-tree.cc (show_omp_namelist, show_omp_clauses): Dump
	uses_allocators clause.
	* gfortran.h (gfc_free_omp_namelist): Add memspace_sym to u union
	and traits_sym to u2 union.
	(OMP_LIST_USES_ALLOCATORS): New enum value.
	(gfc_free_omp_namelist): Add 'bool free_mem_traits_space' arg.
	* match.cc (gfc_free_omp_namelist): Likewise.
	* openmp.cc (gfc_free_omp_clauses, gfc_match_omp_variable_list,
	gfc_match_omp_to_link, gfc_match_omp_doacross_sink,
	gfc_match_omp_clause_reduction, gfc_match_omp_allocate,
	gfc_match_omp_flush): Update call.
	(gfc_match_omp_clauses): Likewise. Parse uses_allocators clause.
	(gfc_match_omp_clause_uses_allocators): New.
	(enum omp_mask2): Add new OMP_CLAUSE_USES_ALLOCATORS.
	(OMP_TARGET_CLAUSES): Accept it.
	(resolve_omp_clauses): Resolve uses_allocators clause
	* st.cc (gfc_free_statement): Update gfc_free_omp_namelist call.
	* trans-openmp.cc (gfc_trans_omp_clauses): Handle
	OMP_LIST_USES_ALLOCATORS; fail with sorry unless predefined allocator.
	(gfc_split_omp_clauses): Handle uses_allocators.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/uses_allocators_1.f90: New test.
	* testsuite/libgomp.fortran/uses_allocators_2.f90: New test.

Co-authored-by: Chung-Lin Tang <cltang@codesourcery.com>

2 files changed, 267 insertions, 0 deletions

diff --git a/libgomp/testsuite/libgomp.fortran/uses_allocators_1.f90 b/libgomp/testsuite/libgomp.fortran/uses_allocators_1.f90
new file mode 100644
index 0000000..66984d9
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/uses_allocators_1.f90
@@ -0,0 +1,168 @@
+! { dg-do compile }
+
+subroutine test
+  use omp_lib
+  implicit none
+
+  !$omp target uses_allocators ( omp_default_mem_alloc , omp_large_cap_mem_alloc, &
+  !$omp&                         omp_const_mem_alloc,omp_high_bw_mem_alloc, &
+  !$omp&                         omp_low_lat_mem_alloc ,omp_cgroup_mem_alloc , &
+  !$omp&                         omp_pteam_mem_alloc, omp_thread_mem_alloc )
+  block; end block
+
+  !$omp target uses_allocators(omp_default_mem_alloc, omp_high_bw_mem_alloc) &
+  !$omp&       uses_allocators(omp_high_bw_mem_alloc, omp_low_lat_mem_alloc)  ! { dg-error "Symbol 'omp_high_bw_mem_alloc' present on multiple clauses" }
+  block; end block
+
+  !$omp target firstprivate ( omp_default_mem_alloc ) , uses_allocators &
+  !$omp&                                                 (omp_default_mem_alloc , omp_high_bw_mem_alloc ) &
+  !$omp&       map(to: omp_high_bw_mem_alloc)
+  block; end block
+! { dg-error "Object 'omp_default_mem_alloc' is not a variable" "" { target *-*-* } .-4 }
+! { dg-error "Symbol 'omp_default_mem_alloc' present on both data and map clauses" "" { target *-*-* } .-5 }
+! { dg-error "Symbol 'omp_high_bw_mem_alloc' present on multiple clauses" "" { target *-*-* } .-5 }
+! { dg-error "Object 'omp_high_bw_mem_alloc' is not a variable at .1.; parameters cannot be and need not be mapped" "" { target *-*-* } .-5 }
+end
+
+subroutine non_predef
+  use omp_lib
+  implicit none
+
+  type(omp_alloctrait), parameter :: trait(0) = [omp_alloctrait :: ]
+  type(omp_alloctrait), parameter :: trait2(*) &
+    = [omp_alloctrait (omp_atk_alignment, 16),                    &
+       omp_alloctrait (omp_atk_sync_hint, omp_atv_default),       &
+       omp_alloctrait (omp_atk_access, omp_atv_default)]
+
+  integer(kind=omp_allocator_handle_kind) :: a1, a2, a3
+
+  !$omp target uses_allocators(omp_default_mem_alloc, a1(trait), a2(trait2))
+  block; end block
+
+  !$omp target uses_allocators(omp_default_mem_alloc, a1(trait), omp_cgroup_mem_alloc, a1(trait2)) ! { dg-error "Symbol 'a1' present on multiple clauses" }
+  block; end block
+
+  !$omp target uses_allocators(traits(trait):a1) &
+  !$omp&        uses_allocators ( memspace ( omp_low_lat_mem_space ) , traits ( trait2 ) : a2 , a3)
+  block; end block
+
+  !$omp target uses_allocators ( traits(trait2) , memspace ( omp_low_lat_mem_space ) : a2 , a3)
+  block; end block
+
+  !$omp target firstprivate ( a2 ) , &  ! { dg-error "Symbol 'a2' present on both data and map clauses" }
+  !$omp&       uses_allocators (a2, a3) &  ! { dg-error "Symbol 'a3' present on multiple clauses" }
+  !$omp&       map(to: a3)
+  block; end block
+end subroutine
+
+subroutine duplicate
+  use omp_lib
+  implicit none
+  type(omp_alloctrait), parameter :: trait1(0) = [omp_alloctrait :: ]
+  type(omp_alloctrait), parameter :: trait2(0) = [omp_alloctrait :: ]
+
+  !$omp target uses_allocators(traits(trait1), memspace ( omp_low_lat_mem_space ) , traits ( trait2 ) : bar)  ! { dg-error "Duplicate TRAITS modifier" }
+  block; end block
+
+  !$omp target uses_allocators(traits(trait1), memspace ( omp_low_lat_mem_space ) , memspace (omp_large_cap_mem_space) : bar)  ! { dg-error "Duplicate MEMSPACE modifier" }
+  block; end block
+end
+
+subroutine trait_present
+  use omp_lib
+  implicit none
+
+  type(omp_alloctrait), parameter :: trait1(0) = [omp_alloctrait :: ]
+  integer(kind=omp_allocator_handle_kind) :: a1
+
+  !$omp target uses_allocators(omp_cgroup_mem_alloc(trait1))  ! { dg-error "A memory space or traits array may not be specified for predefined allocator 'omp_cgroup_mem_alloc'" }
+  block; end block
+
+  !$omp target uses_allocators(traits(trait1) : omp_pteam_mem_alloc)  ! { dg-error "A memory space or traits array may not be specified for predefined allocator 'omp_pteam_mem_alloc'" }
+  block; end block
+
+  !$omp target uses_allocators(memspace(omp_low_lat_mem_space) : omp_thread_mem_alloc)  ! { dg-error "A memory space or traits array may not be specified for predefined allocator 'omp_thread_mem_alloc'" }
+  block; end block
+
+  ! Invalid in OpenMP 5.0 / 5.1, but valid since 5.2 the same as omp_default_mem_space + emptry traits array
+  !$omp target uses_allocators ( a1 )
+  block; end block
+end
+
+subroutine odd_names
+  use omp_lib
+  implicit none
+
+  type(omp_alloctrait), parameter :: trait1(0) = [omp_alloctrait :: ]
+
+  ! oddly named allocators:
+  integer(kind=omp_allocator_handle_kind) :: traits
+  integer(kind=omp_allocator_handle_kind) :: memspace
+
+  !$omp target uses_allocators ( traits(trait1), memspace(trait1) )
+  block; end block
+
+  !$omp target uses_allocators ( traits(trait1), memspace(omp_low_lat_mem_space)  : traits)
+  block; end block
+
+  !$omp target uses_allocators ( memspace(omp_low_lat_mem_space), traits(trait1) : memspace)
+  block; end block
+end
+
+subroutine more_checks
+  use omp_lib
+  implicit none
+
+  integer(kind=kind(omp_low_lat_mem_space)) :: my_memspace
+  integer(kind=omp_allocator_handle_kind) :: a1, a2(4)
+  integer(kind=1) :: a3
+
+  !$omp target uses_allocators ( memspace(my_memspace) : a1)  ! { dg-error "Memspace 'my_memspace' at .1. in USES_ALLOCATORS must be a predefined memory space" }
+  block; end block
+
+  !$omp target uses_allocators ( omp_low_lat_mem_space)  ! { dg-error "Allocator 'omp_low_lat_mem_space' at .1. in USES_ALLOCATORS must either a variable or a predefined allocator" }
+  block; end block
+
+  !$omp target uses_allocators ( memspace (omp_low_lat_mem_alloc) : a1)  ! { dg-error "Memspace 'omp_low_lat_mem_alloc' at .1. in USES_ALLOCATORS must be a predefined memory space" }
+  block; end block
+
+  !$omp target uses_allocators(memspace (omp_low_lat_mem_space) : a1 )
+  block; end block
+
+  !$omp target uses_allocators(memspace (omp_low_lat_mem_space) : a2 )  ! { dg-error "Allocator 'a2' at .1. in USES_ALLOCATORS must be a scalar integer of kind 'omp_allocator_handle_kind'" }
+  block; end block
+
+  !$omp target uses_allocators(memspace (omp_low_lat_mem_space) : a3 )  ! { dg-error "Allocator 'a3' at .1. in USES_ALLOCATORS must be a scalar integer of kind 'omp_allocator_handle_kind'" }
+  block; end block
+end
+
+subroutine traits_checks
+  use omp_lib
+  implicit none
+
+  type(omp_alloctrait), parameter :: trait1 = omp_alloctrait (omp_atk_alignment, 16)
+  type(omp_alloctrait) :: trait2
+  integer(kind=omp_atk_alignment), parameter :: trait3(1) = omp_atk_alignment
+  integer(kind=omp_allocator_handle_kind) :: a1
+
+  ! Sensible - but not (yet?) valid - an array constructor:
+  !$omp target uses_allocators(traits ([omp_alloctrait :: ]) : a1 )  ! { dg-error "Invalid character in name" }
+  block; end block
+  !$omp target uses_allocators(a1 ([omp_alloctrait :: ]))  ! { dg-error "Invalid character in name" }
+  block; end block
+
+  !$omp target uses_allocators(traits (trait1) : a1 )  ! { dg-error "Traits array 'trait1' in USES_ALLOCATORS .1. must be a one-dimensional named constant array of type 'omp_alloctrait'" }
+  block; end block
+  !$omp target uses_allocators(a1 (trait1))  ! { dg-error "Traits array 'trait1' in USES_ALLOCATORS .1. must be a one-dimensional named constant array of type 'omp_alloctrait'" }
+  block; end block
+
+  !$omp target uses_allocators(traits (trait2) : a1 )  ! { dg-error "Traits array 'trait2' in USES_ALLOCATORS .1. must be a one-dimensional named constant array of type 'omp_alloctrait'" }
+  block; end block
+  !$omp target uses_allocators(a1 (trait2))  ! { dg-error "Traits array 'trait2' in USES_ALLOCATORS .1. must be a one-dimensional named constant array of type 'omp_alloctrait'" }
+  block; end block
+
+  !$omp target uses_allocators(traits (trait3) : a1 )  ! { dg-error "Traits array 'trait3' in USES_ALLOCATORS .1. must be a one-dimensional named constant array of type 'omp_alloctrait'" }
+  block; end block
+  !$omp target uses_allocators(a1 (trait3))  ! { dg-error "Traits array 'trait3' in USES_ALLOCATORS .1. must be a one-dimensional named constant array of type 'omp_alloctrait'" }
+  block; end block
+end
diff --git a/libgomp/testsuite/libgomp.fortran/uses_allocators_2.f90 b/libgomp/testsuite/libgomp.fortran/uses_allocators_2.f90
new file mode 100644
index 0000000..0732796
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/uses_allocators_2.f90
@@ -0,0 +1,99 @@
+! { dg-do compile }
+
+! Minimal test for valid code:
+! - predefined allocators do not need any special treatment in uses_allocators
+!   (as 'requires dynamic_allocators' is the default).
+!
+! - Non-predefined allocators are currently rejected ('sorry)'
+
+subroutine test
+  use omp_lib
+  implicit none
+
+  !$omp target uses_allocators ( omp_default_mem_alloc , omp_large_cap_mem_alloc, &
+  !$omp&                         omp_const_mem_alloc,omp_high_bw_mem_alloc, &
+  !$omp&                         omp_low_lat_mem_alloc ,omp_cgroup_mem_alloc , &
+  !$omp&                         omp_pteam_mem_alloc, omp_thread_mem_alloc )
+  block; end block
+
+  !$omp target parallel uses_allocators ( omp_default_mem_alloc , omp_large_cap_mem_alloc, &
+  !$omp&                                  omp_const_mem_alloc,omp_high_bw_mem_alloc, &
+  !$omp&                                  omp_low_lat_mem_alloc ,omp_cgroup_mem_alloc , &
+  !$omp&                                  omp_pteam_mem_alloc, omp_thread_mem_alloc )
+  block; end block
+end
+
+subroutine non_predef
+  use omp_lib
+  implicit none
+
+  type(omp_alloctrait), parameter :: trait(0) = [omp_alloctrait :: ]
+  type(omp_alloctrait), parameter :: trait2(*) &
+    = [omp_alloctrait (omp_atk_alignment, 16),                    &
+       omp_alloctrait (omp_atk_sync_hint, omp_atv_default),       &
+       omp_alloctrait (omp_atk_access, omp_atv_default)]
+
+  integer(kind=omp_allocator_handle_kind) :: a1, a2, a3
+
+  !$omp target uses_allocators(omp_default_mem_alloc, a1(trait), a2(trait2))  ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+  block; end block
+
+  !$omp target parallel uses_allocators(omp_default_mem_alloc, a1(trait), a2(trait2))  ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+  block; end block
+
+
+  !$omp target uses_allocators(traits(trait):a1) &
+  !$omp&        uses_allocators ( memspace ( omp_low_lat_mem_space ) , traits ( trait2 ) : a2 , a3)  ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+  block; end block
+
+  !$omp target parallel uses_allocators(traits(trait):a1) &
+  !$omp&        uses_allocators ( memspace ( omp_low_lat_mem_space ) , traits ( trait2 ) : a2 , a3)  ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+  block; end block
+
+  !$omp target uses_allocators ( traits(trait2) , memspace ( omp_low_lat_mem_space ) : a2 , a3)  ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+  block; end block
+end subroutine
+
+subroutine trait_present
+  use omp_lib
+  implicit none
+
+  type(omp_alloctrait), parameter :: trait1(0) = [omp_alloctrait :: ]
+  integer(kind=omp_allocator_handle_kind) :: a1
+
+  ! Invalid in OpenMP 5.0 / 5.1, but valid since 5.2 the same as omp_default_mem_space + emptry traits array
+  !$omp target uses_allocators ( a1 )  ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+  block; end block
+end
+
+subroutine odd_names
+  use omp_lib
+  implicit none
+
+  type(omp_alloctrait), parameter :: trait1(0) = [omp_alloctrait :: ]
+
+  ! oddly named allocators:
+  integer(kind=omp_allocator_handle_kind) :: traits
+  integer(kind=omp_allocator_handle_kind) :: memspace
+
+  !$omp target uses_allocators ( traits(trait1), memspace(trait1) )  ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+  block; end block
+
+  !$omp target uses_allocators ( traits(trait1), memspace(omp_low_lat_mem_space)  : traits)  ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+  block; end block
+
+  !$omp target uses_allocators ( memspace(omp_low_lat_mem_space), traits(trait1) : memspace)  ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+  block; end block
+end
+
+subroutine more_checks
+  use omp_lib
+  implicit none
+
+  integer(kind=kind(omp_low_lat_mem_space)) :: my_memspace
+  integer(kind=omp_allocator_handle_kind) :: a1, a2(4)
+  integer(kind=1) :: a3
+
+  !$omp target uses_allocators(memspace (omp_low_lat_mem_space) : a1 )  ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+  block; end block
+end