[Openmp-commits] [llvm] [openmp] [OpenMP] Add Fortran support routines for dyn_groupprivate (OpenMP 6.1) (PR #211630)
Michael Klemm via Openmp-commits
openmp-commits at lists.llvm.org
Fri Oct 2 06:11:34 PDT 2026
https://github.com/mjklemm updated https://github.com/llvm/llvm-project/pull/211630
>From ed57d5421ad8ab73f89cbcf498be076dbd612bf3 Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Thu, 23 Jul 2026 15:28:59 +0200
Subject: [PATCH 01/14] [OpenMP] Add Fortran routine declarations for device
dynamic memory
---
openmp/module/omp_lib.F90.var | 48 +++++++++++++++++++++++++++++++++++
openmp/module/omp_lib.h.var | 45 ++++++++++++++++++++++++++++++++
2 files changed, 93 insertions(+)
diff --git a/openmp/module/omp_lib.F90.var b/openmp/module/omp_lib.F90.var
index a41b2faad9d3d2e..0b04190e2e6b73f 100644
--- a/openmp/module/omp_lib.F90.var
+++ b/openmp/module/omp_lib.F90.var
@@ -36,6 +36,7 @@
integer, parameter, public :: omp_control_tool_result_kind = omp_integer_kind
integer, parameter, public :: omp_allocator_handle_kind = c_intptr_t
integer, parameter, public :: omp_memspace_handle_kind = c_intptr_t
+ integer, parameter, public :: omp_access_kind = omp_integer_kind
integer, parameter, public :: omp_alloctrait_key_kind = omp_integer_kind
integer, parameter, public :: omp_alloctrait_val_kind = c_intptr_t
integer, parameter, public :: omp_interop_kind = c_intptr_t
@@ -82,6 +83,7 @@
public :: omp_control_tool_result_kind
public :: omp_allocator_handle_kind
public :: omp_memspace_handle_kind
+ public :: omp_access_kind
public :: omp_alloctrait_key_kind
public :: omp_alloctrait_val_kind
public :: omp_interop_kind
@@ -207,6 +209,9 @@
integer (kind=omp_memspace_handle_kind), parameter, public :: llvm_omp_target_shared_mem_space = 101
integer (kind=omp_memspace_handle_kind), parameter, public :: llvm_omp_target_device_mem_space = 102
+ integer (kind=omp_access_kind), parameter, public :: omp_access_cgroup = 0
+ integer (kind=omp_access_kind), parameter, public :: omp_access_pteam = 1
+
integer (kind=omp_pause_resource_kind), parameter, public :: omp_pause_resume = 0
integer (kind=omp_pause_resource_kind), parameter, public :: omp_pause_soft = 1
integer (kind=omp_pause_resource_kind), parameter, public :: omp_pause_hard = 2
@@ -933,6 +938,44 @@
integer, intent(in) :: resources(*)
end function omp_get_submemspace
+ function omp_get_dyn_gprivate_ptr(offset, access_group)
+ use omp_lib_kinds
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ type (c_ptr) omp_get_dyn_gprivate_ptr
+ integer (kind=c_size_t), value, optional :: offset
+ integer (kind=omp_access_kind), value, optional :: access_group
+ end function omp_get_dyn_gprivate_ptr
+
+ function omp_get_dyn_gprivate_nofb_ptr(offset, access_group)
+ use omp_lib_kinds
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ type (c_ptr) omp_get_dyn_gprivate_nofb_ptr
+ integer (kind=c_size_t), value, optional :: offset
+ integer (kind=omp_access_kind), value, optional :: access_group
+ end function omp_get_dyn_gprivate_nofb_ptr
+
+ function omp_get_dyn_gprivate_size(access_group)
+ use omp_lib_kinds
+ use, intrinsic :: iso_c_binding, only : c_size_t
+ integer (kind=c_size_t) omp_get_dyn_gprivate_size
+ integer (kind=omp_access_kind), value, optional :: access_group
+ end function omp_get_dyn_gprivate_size
+
+ function omp_get_dyn_gprivate_memspace(access_group)
+ use omp_lib_kinds
+ integer (kind=omp_memspace_handle_kind) &
+ omp_get_dyn_gprivate_memspace
+ integer (kind=omp_access_kind), value, optional :: access_group
+ end function omp_get_dyn_gprivate_memspace
+
+ function omp_get_gprivate_limit(device_num, access_group)
+ use omp_lib_kinds
+ use, intrinsic :: iso_c_binding, only : c_size_t, c_int
+ integer (kind=c_size_t) omp_get_gprivate_limit
+ integer (kind=c_int), value :: device_num
+ integer (kind=omp_access_kind), value, optional :: access_group
+ end function omp_get_gprivate_limit
+
! ***
! *** kmp_* entry points
! ***
@@ -1269,6 +1312,11 @@
public :: kmp_set_warnings_on
public :: kmp_set_warnings_off
public :: kmp_get_cancellation_status
+ public :: omp_get_dyn_gprivate_ptr
+ public :: omp_get_dyn_gprivate_nofb_ptr
+ public :: omp_get_dyn_gprivate_size
+ public :: omp_get_dyn_gprivate_memspace
+ public :: omp_get_gprivate_limit
public :: omp_get_num_interop_properties
public :: omp_get_interop_int
public :: omp_get_interop_ptr
diff --git a/openmp/module/omp_lib.h.var b/openmp/module/omp_lib.h.var
index 5e1996e31fe0a96..de00b05cb2cf189 100644
--- a/openmp/module/omp_lib.h.var
+++ b/openmp/module/omp_lib.h.var
@@ -42,6 +42,8 @@
parameter(omp_allocator_handle_kind=int_ptr_kind())
integer omp_memspace_handle_kind
parameter(omp_memspace_handle_kind=int_ptr_kind())
+ integer omp_access_kind
+ parameter(omp_access_kind=omp_integer_kind)
integer omp_alloctrait_key_kind
parameter(omp_alloctrait_key_kind=omp_integer_kind)
integer omp_alloctrait_val_kind
@@ -273,6 +275,11 @@
integer(omp_memspace_handle_kind)llvm_omp_target_device_mem_space
parameter(llvm_omp_target_device_mem_space=102)
+ integer(kind=omp_access_kind)omp_access_cgroup
+ parameter(omp_access_cgroup=0)
+ integer(kind=omp_access_kind)omp_access_pteam
+ parameter(omp_access_pteam=1)
+
integer(kind=omp_pause_resource_kind)omp_pause_resume
parameter(omp_pause_resume=0)
integer(kind=omp_pause_resource_kind)omp_pause_soft
@@ -1025,6 +1032,44 @@
integer, intent(in) :: resources(*)
end function omp_get_submemspace
+ function omp_get_dyn_gprivate_ptr(offset, access_group)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ import
+ type (c_ptr) omp_get_dyn_gprivate_ptr
+ integer (kind=c_size_t), value, optional :: offset
+ integer(omp_access_kind), value, optional :: access_group
+ end function omp_get_dyn_gprivate_ptr
+
+ function omp_get_dyn_gprivate_nofb_ptr(offset, access_group)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ import
+ type (c_ptr) omp_get_dyn_gprivate_nofb_ptr
+ integer (kind=c_size_t), value, optional :: offset
+ integer(omp_access_kind), value, optional :: access_group
+ end function omp_get_dyn_gprivate_nofb_ptr
+
+ function omp_get_dyn_gprivate_size(access_group)
+ use, intrinsic :: iso_c_binding, only : c_size_t
+ import
+ integer (kind=c_size_t) omp_get_dyn_gprivate_size
+ integer(omp_access_kind), value, optional :: access_group
+ end function omp_get_dyn_gprivate_size
+
+ function omp_get_dyn_gprivate_memspace(access_group)
+ import
+ integer(omp_memspace_handle_kind)
+ & omp_get_dyn_gprivate_memspace
+ integer(omp_access_kind), value, optional :: access_group
+ end function omp_get_dyn_gprivate_memspace
+
+ function omp_get_gprivate_limit(device_num, access_group)
+ use, intrinsic :: iso_c_binding, only : c_size_t, c_int
+ import
+ integer (kind=c_size_t) omp_get_gprivate_limit
+ integer (kind=c_int), value :: device_num
+ integer(omp_access_kind), value, optional :: access_group
+ end function omp_get_gprivate_limit
+
! ***
! *** kmp_* entry points
>From 9987ed0891e09cfac539ac70b0555feab65f8e8a Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Thu, 23 Jul 2026 17:34:57 +0200
Subject: [PATCH 02/14] Add stub implementation
---
openmp/runtime/src/kmp.h | 5 +++++
openmp/runtime/src/kmp_ftn_entry.h | 24 ++++++++++++++++++++++++
openmp/runtime/src/kmp_ftn_os.h | 20 ++++++++++++++++++++
3 files changed, 49 insertions(+)
diff --git a/openmp/runtime/src/kmp.h b/openmp/runtime/src/kmp.h
index 818e07c2bb23f7c..32c22177e7b0510 100644
--- a/openmp/runtime/src/kmp.h
+++ b/openmp/runtime/src/kmp.h
@@ -1086,6 +1086,11 @@ extern omp_allocator_handle_t const llvm_omp_target_device_mem_alloc;
extern omp_allocator_handle_t const kmp_max_mem_alloc;
extern omp_allocator_handle_t __kmp_def_allocator;
+typedef enum omp_access_t {
+ omp_access_cgroup = 0,
+ omp_access_pteam = 1
+} omp_access_t;
+
// end of duplicate type definitions from omp.h
#endif
diff --git a/openmp/runtime/src/kmp_ftn_entry.h b/openmp/runtime/src/kmp_ftn_entry.h
index 1c8e568b7840710..eebd08502728a30 100644
--- a/openmp/runtime/src/kmp_ftn_entry.h
+++ b/openmp/runtime/src/kmp_ftn_entry.h
@@ -551,6 +551,30 @@ FTN_GET_SUBMEMSPACE(omp_memspace_handle_t KMP_DEREF memspace,
#endif
}
+// The C (KMP_FTN_PLAIN) versions of the dynamic groupprivate information
+// routines are defined in kmp_csupport.cpp, so only the Fortran entry points
+// are generated here. The offset and access_group arguments are optional in
+// Fortran and are passed as null pointers when omitted. These stubs report that
+// no dynamic groupprivate block exists.
+#if KMP_FTN_ENTRIES != KMP_FTN_PLAIN
+void *FTN_STDCALL FTN_GET_DYN_GPRIVATE_PTR(size_t *, omp_access_t *) {
+ return NULL;
+}
+
+void *FTN_STDCALL FTN_GET_DYN_GPRIVATE_NOFB_PTR(size_t *, omp_access_t *) {
+ return NULL;
+}
+
+size_t FTN_STDCALL FTN_GET_DYN_GPRIVATE_SIZE(omp_access_t *) { return 0; }
+
+omp_memspace_handle_t FTN_STDCALL
+FTN_GET_DYN_GPRIVATE_MEMSPACE(omp_access_t *) {
+ return omp_null_mem_space;
+}
+
+size_t FTN_STDCALL FTN_GET_GPRIVATE_LIMIT(int *, omp_access_t *) { return 0; }
+#endif // KMP_FTN_ENTRIES != KMP_FTN_PLAIN
+
/* OpenMP 5.0 affinity format support */
#ifndef KMP_STUB
static void __kmp_fortran_strncpy_truncate(char *buffer, size_t buf_size,
diff --git a/openmp/runtime/src/kmp_ftn_os.h b/openmp/runtime/src/kmp_ftn_os.h
index c439a058f22b4c7..1e981b44031fb13 100644
--- a/openmp/runtime/src/kmp_ftn_os.h
+++ b/openmp/runtime/src/kmp_ftn_os.h
@@ -139,6 +139,11 @@
#define FTN_GET_DEVICES_ALL_ALLOCATOR omp_get_devices_all_allocator
#define FTN_GET_MEMSPACE_NUM_RESOURCES omp_get_memspace_num_resources
#define FTN_GET_SUBMEMSPACE omp_get_submemspace
+#define FTN_GET_DYN_GPRIVATE_PTR omp_get_dyn_gprivate_ptr
+#define FTN_GET_DYN_GPRIVATE_NOFB_PTR omp_get_dyn_gprivate_nofb_ptr
+#define FTN_GET_DYN_GPRIVATE_SIZE omp_get_dyn_gprivate_size
+#define FTN_GET_DYN_GPRIVATE_MEMSPACE omp_get_dyn_gprivate_memspace
+#define FTN_GET_GPRIVATE_LIMIT omp_get_gprivate_limit
#define FTN_GET_DEVICE_NUM omp_get_device_num
#define FTN_GET_UID_FROM_DEVICE omp_get_uid_from_device
#define FTN_GET_DEVICE_FROM_UID omp_get_device_from_uid
@@ -288,6 +293,11 @@
#define FTN_GET_DEVICES_ALL_ALLOCATOR omp_get_devices_all_allocator_
#define FTN_GET_MEMSPACE_NUM_RESOURCES omp_get_memspace_num_resources_
#define FTN_GET_SUBMEMSPACE omp_get_submemspace_
+#define FTN_GET_DYN_GPRIVATE_PTR omp_get_dyn_gprivate_ptr_
+#define FTN_GET_DYN_GPRIVATE_NOFB_PTR omp_get_dyn_gprivate_nofb_ptr_
+#define FTN_GET_DYN_GPRIVATE_SIZE omp_get_dyn_gprivate_size_
+#define FTN_GET_DYN_GPRIVATE_MEMSPACE omp_get_dyn_gprivate_memspace_
+#define FTN_GET_GPRIVATE_LIMIT omp_get_gprivate_limit_
#define FTN_ALLOC omp_alloc_
#define FTN_FREE omp_free_
#define FTN_GET_DEVICE_NUM omp_get_device_num_
@@ -439,6 +449,11 @@
#define FTN_GET_DEVICES_ALL_ALLOCATOR OMP_GET_DEVICES_ALL_ALLOCATOR
#define FTN_GET_MEMSPACE_NUM_RESOURCES OMP_GET_MEMSPACE_NUM_RESOURCES
#define FTN_GET_SUBMEMSPACE OMP_GET_SUBMEMSPACE
+#define FTN_GET_DYN_GPRIVATE_PTR OMP_GET_DYN_GPRIVATE_PTR
+#define FTN_GET_DYN_GPRIVATE_NOFB_PTR OMP_GET_DYN_GPRIVATE_NOFB_PTR
+#define FTN_GET_DYN_GPRIVATE_SIZE OMP_GET_DYN_GPRIVATE_SIZE
+#define FTN_GET_DYN_GPRIVATE_MEMSPACE OMP_GET_DYN_GPRIVATE_MEMSPACE
+#define FTN_GET_GPRIVATE_LIMIT OMP_GET_GPRIVATE_LIMIT
#define FTN_GET_DEVICE_NUM OMP_GET_DEVICE_NUM
#define FTN_GET_UID_FROM_DEVICE OMP_GET_UID_FROM_DEVICE
#define FTN_GET_DEVICE_FROM_UID OMP_GET_DEVICE_FROM_UID
@@ -588,6 +603,11 @@
#define FTN_GET_DEVICES_ALL_ALLOCATOR OMP_GET_DEVICES_ALL_ALLOCATOR_
#define FTN_GET_MEMSPACE_NUM_RESOURCES OMP_GET_MEMSPACE_NUM_RESOURCES_
#define FTN_GET_SUBMEMSPACE OMP_GET_SUBMEMSPACE_
+#define FTN_GET_DYN_GPRIVATE_PTR OMP_GET_DYN_GPRIVATE_PTR_
+#define FTN_GET_DYN_GPRIVATE_NOFB_PTR OMP_GET_DYN_GPRIVATE_NOFB_PTR_
+#define FTN_GET_DYN_GPRIVATE_SIZE OMP_GET_DYN_GPRIVATE_SIZE_
+#define FTN_GET_DYN_GPRIVATE_MEMSPACE OMP_GET_DYN_GPRIVATE_MEMSPACE_
+#define FTN_GET_GPRIVATE_LIMIT OMP_GET_GPRIVATE_LIMIT_
#define FTN_ALLOC OMP_ALLOC_
#define FTN_FREE OMP_FREE_
#define FTN_GET_DEVICE_NUM OMP_GET_DEVICE_NUM_
>From 9793e51bd2aaa2de278df8046dee668490836f28 Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Thu, 23 Jul 2026 18:44:56 +0200
Subject: [PATCH 03/14] Add implementation for dyn_groupprivate routines
---
openmp/runtime/src/kmp_ftn_entry.h | 81 +++++++++++++++++++++++++++---
1 file changed, 74 insertions(+), 7 deletions(-)
diff --git a/openmp/runtime/src/kmp_ftn_entry.h b/openmp/runtime/src/kmp_ftn_entry.h
index eebd08502728a30..0f32f920ed65e8d 100644
--- a/openmp/runtime/src/kmp_ftn_entry.h
+++ b/openmp/runtime/src/kmp_ftn_entry.h
@@ -554,25 +554,92 @@ FTN_GET_SUBMEMSPACE(omp_memspace_handle_t KMP_DEREF memspace,
// The C (KMP_FTN_PLAIN) versions of the dynamic groupprivate information
// routines are defined in kmp_csupport.cpp, so only the Fortran entry points
// are generated here. The offset and access_group arguments are optional in
-// Fortran and are passed as null pointers when omitted. These stubs report that
-// no dynamic groupprivate block exists.
+// Fortran and are passed as null pointers when omitted; the defaults are a zero
+// offset and omp_access_cgroup.
+//
+// The dynamic-groupprivate-information routines report on the dynamic
+// groupprivate block that is instantiated by a dyn_groupprivate clause. When an
+// offload runtime is loaded it provides a device-aware definition; forward to
+// it so that Fortran code observes the same block as C/C++. When no offload
+// runtime is available the lookup resolves to the host entry in
+// kmp_csupport.cpp, which reports that no block exists (a null pointer, a size
+// of zero and a null memory space).
#if KMP_FTN_ENTRIES != KMP_FTN_PLAIN
-void *FTN_STDCALL FTN_GET_DYN_GPRIVATE_PTR(size_t *, omp_access_t *) {
+void *FTN_STDCALL FTN_GET_DYN_GPRIVATE_PTR(size_t *offset,
+ omp_access_t *access_group) {
+#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
+ return NULL;
+#else
+ void *(*fptr)(size_t, omp_access_t);
+ if ((*(void **)(&fptr) = KMP_DLSYM("omp_get_dyn_gprivate_ptr"))) {
+ size_t off = offset ? *offset : 0;
+ omp_access_t ag = access_group ? *access_group : omp_access_cgroup;
+ return (*fptr)(off, ag);
+ }
return NULL;
+#endif
}
-void *FTN_STDCALL FTN_GET_DYN_GPRIVATE_NOFB_PTR(size_t *, omp_access_t *) {
+void *FTN_STDCALL FTN_GET_DYN_GPRIVATE_NOFB_PTR(size_t *offset,
+ omp_access_t *access_group) {
+#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
return NULL;
+#else
+ void *(*fptr)(size_t, omp_access_t);
+ if ((*(void **)(&fptr) = KMP_DLSYM("omp_get_dyn_gprivate_nofb_ptr"))) {
+ size_t off = offset ? *offset : 0;
+ omp_access_t ag = access_group ? *access_group : omp_access_cgroup;
+ return (*fptr)(off, ag);
+ }
+ return NULL;
+#endif
}
-size_t FTN_STDCALL FTN_GET_DYN_GPRIVATE_SIZE(omp_access_t *) { return 0; }
+size_t FTN_STDCALL FTN_GET_DYN_GPRIVATE_SIZE(omp_access_t *access_group) {
+#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
+ return 0;
+#else
+ size_t (*fptr)(omp_access_t);
+ if ((*(void **)(&fptr) = KMP_DLSYM("omp_get_dyn_gprivate_size"))) {
+ omp_access_t ag = access_group ? *access_group : omp_access_cgroup;
+ return (*fptr)(ag);
+ }
+ return 0;
+#endif
+}
omp_memspace_handle_t FTN_STDCALL
-FTN_GET_DYN_GPRIVATE_MEMSPACE(omp_access_t *) {
+FTN_GET_DYN_GPRIVATE_MEMSPACE(omp_access_t *access_group) {
+#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
return omp_null_mem_space;
+#else
+ omp_memspace_handle_t (*fptr)(omp_access_t);
+ if ((*(void **)(&fptr) = KMP_DLSYM("omp_get_dyn_gprivate_memspace"))) {
+ omp_access_t ag = access_group ? *access_group : omp_access_cgroup;
+ return (*fptr)(ag);
+ }
+ return omp_null_mem_space;
+#endif
}
-size_t FTN_STDCALL FTN_GET_GPRIVATE_LIMIT(int *, omp_access_t *) { return 0; }
+// The groupprivate limit is a per-device property. libomptarget, if loaded,
+// provides a device-aware omp_get_gprivate_limit; forward to it so that Fortran
+// code observes the same limits as C/C++. When no offload runtime is available
+// there are no non-host devices and the host reports no limit, so return zero.
+size_t FTN_STDCALL FTN_GET_GPRIVATE_LIMIT(int *device_num,
+ omp_access_t *access_group) {
+#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
+ return 0;
+#else
+ size_t (*fptr)(int, omp_access_t);
+ if ((*(void **)(&fptr) = KMP_DLSYM("omp_get_gprivate_limit"))) {
+ int dev = device_num ? *device_num : 0;
+ omp_access_t ag = access_group ? *access_group : omp_access_cgroup;
+ return (*fptr)(dev, ag);
+ }
+ return 0;
+#endif
+}
#endif // KMP_FTN_ENTRIES != KMP_FTN_PLAIN
/* OpenMP 5.0 affinity format support */
>From 4eb4a3a32c2a54407f676918bc4df822ccef6714 Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Thu, 23 Jul 2026 19:55:46 +0200
Subject: [PATCH 04/14] Add test
---
.../test/api/omp61_dyn_gprivate_routines.f90 | 69 +++++++++++++++++++
1 file changed, 69 insertions(+)
create mode 100644 openmp/runtime/test/api/omp61_dyn_gprivate_routines.f90
diff --git a/openmp/runtime/test/api/omp61_dyn_gprivate_routines.f90 b/openmp/runtime/test/api/omp61_dyn_gprivate_routines.f90
new file mode 100644
index 000000000000000..8db7eb65e60d9dc
--- /dev/null
+++ b/openmp/runtime/test/api/omp61_dyn_gprivate_routines.f90
@@ -0,0 +1,69 @@
+! RUN: %flang %flags %openmp_flags %s -o %t.exe
+! RUN: %t.exe | FileCheck %s
+
+! REQUIRES: linux
+
+! Test the Fortran interfaces of the OpenMP dynamic-groupprivate-information
+! routines and omp_get_gprivate_limit (TR15 Sec. 34.13).
+!
+! This exercises the interfaces, including the optional offset and access_group
+! arguments, and checks the values reported by the host runtime. When no dynamic
+! groupprivate block exists and no offload runtime is loaded, the routines report
+! a null pointer, a size of zero, a null memory space and a zero limit.
+
+program omp61_dyn_gprivate_routines
+ use omp_lib
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t, c_int, c_associated
+ implicit none
+
+ type(c_ptr) :: p
+ integer(c_size_t) :: sz
+ integer(omp_memspace_handle_kind) :: ms
+ logical :: ok
+
+ ok = .true.
+
+ ! omp_get_dyn_gprivate_ptr: no block => null pointer. Cover default args,
+ ! explicit offset, explicit access_group, and the offset-omitted-via-keyword
+ ! form.
+ p = omp_get_dyn_gprivate_ptr()
+ if (c_associated(p)) ok = .false.
+ p = omp_get_dyn_gprivate_ptr(0_c_size_t)
+ if (c_associated(p)) ok = .false.
+ p = omp_get_dyn_gprivate_ptr(0_c_size_t, omp_access_cgroup)
+ if (c_associated(p)) ok = .false.
+ p = omp_get_dyn_gprivate_ptr(access_group=omp_access_cgroup)
+ if (c_associated(p)) ok = .false.
+
+ ! omp_get_dyn_gprivate_nofb_ptr: no block => null pointer.
+ p = omp_get_dyn_gprivate_nofb_ptr()
+ if (c_associated(p)) ok = .false.
+ p = omp_get_dyn_gprivate_nofb_ptr(0_c_size_t, omp_access_cgroup)
+ if (c_associated(p)) ok = .false.
+
+ ! omp_get_dyn_gprivate_size: no block => zero.
+ sz = omp_get_dyn_gprivate_size()
+ if (sz /= 0_c_size_t) ok = .false.
+ sz = omp_get_dyn_gprivate_size(omp_access_cgroup)
+ if (sz /= 0_c_size_t) ok = .false.
+
+ ! omp_get_dyn_gprivate_memspace: no block => omp_null_mem_space.
+ ms = omp_get_dyn_gprivate_memspace()
+ if (ms /= omp_null_mem_space) ok = .false.
+ ms = omp_get_dyn_gprivate_memspace(omp_access_cgroup)
+ if (ms /= omp_null_mem_space) ok = .false.
+
+ ! omp_get_gprivate_limit: the host reports no groupprivate limit.
+ sz = omp_get_gprivate_limit(0_c_int)
+ if (sz /= 0_c_size_t) ok = .false.
+ sz = omp_get_gprivate_limit(0_c_int, omp_access_cgroup)
+ if (sz /= 0_c_size_t) ok = .false.
+
+ if (ok) then
+ print *, "PASS"
+ else
+ print *, "FAIL"
+ end if
+
+! CHECK: PASS
+end program omp61_dyn_gprivate_routines
\ No newline at end of file
>From 24294cc8de75efa2ff761953147eddaa95f4e343 Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Wed, 30 Sep 2026 19:23:53 +0200
Subject: [PATCH 05/14] Correct dlsym logic.
---
openmp/runtime/src/kmp_ftn_entry.h | 10 +++++-----
1 file changed, 5 insertions(+), 5 deletions(-)
diff --git a/openmp/runtime/src/kmp_ftn_entry.h b/openmp/runtime/src/kmp_ftn_entry.h
index 0f32f920ed65e8d..ae83689cecd3c37 100644
--- a/openmp/runtime/src/kmp_ftn_entry.h
+++ b/openmp/runtime/src/kmp_ftn_entry.h
@@ -571,7 +571,7 @@ void *FTN_STDCALL FTN_GET_DYN_GPRIVATE_PTR(size_t *offset,
return NULL;
#else
void *(*fptr)(size_t, omp_access_t);
- if ((*(void **)(&fptr) = KMP_DLSYM("omp_get_dyn_gprivate_ptr"))) {
+ if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_dyn_gprivate_ptr"))) {
size_t off = offset ? *offset : 0;
omp_access_t ag = access_group ? *access_group : omp_access_cgroup;
return (*fptr)(off, ag);
@@ -586,7 +586,7 @@ void *FTN_STDCALL FTN_GET_DYN_GPRIVATE_NOFB_PTR(size_t *offset,
return NULL;
#else
void *(*fptr)(size_t, omp_access_t);
- if ((*(void **)(&fptr) = KMP_DLSYM("omp_get_dyn_gprivate_nofb_ptr"))) {
+ if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_dyn_gprivate_nofb_ptr"))) {
size_t off = offset ? *offset : 0;
omp_access_t ag = access_group ? *access_group : omp_access_cgroup;
return (*fptr)(off, ag);
@@ -600,7 +600,7 @@ size_t FTN_STDCALL FTN_GET_DYN_GPRIVATE_SIZE(omp_access_t *access_group) {
return 0;
#else
size_t (*fptr)(omp_access_t);
- if ((*(void **)(&fptr) = KMP_DLSYM("omp_get_dyn_gprivate_size"))) {
+ if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_dyn_gprivate_size"))) {
omp_access_t ag = access_group ? *access_group : omp_access_cgroup;
return (*fptr)(ag);
}
@@ -614,7 +614,7 @@ FTN_GET_DYN_GPRIVATE_MEMSPACE(omp_access_t *access_group) {
return omp_null_mem_space;
#else
omp_memspace_handle_t (*fptr)(omp_access_t);
- if ((*(void **)(&fptr) = KMP_DLSYM("omp_get_dyn_gprivate_memspace"))) {
+ if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_dyn_gprivate_memspace"))) {
omp_access_t ag = access_group ? *access_group : omp_access_cgroup;
return (*fptr)(ag);
}
@@ -632,7 +632,7 @@ size_t FTN_STDCALL FTN_GET_GPRIVATE_LIMIT(int *device_num,
return 0;
#else
size_t (*fptr)(int, omp_access_t);
- if ((*(void **)(&fptr) = KMP_DLSYM("omp_get_gprivate_limit"))) {
+ if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_gprivate_limit"))) {
int dev = device_num ? *device_num : 0;
omp_access_t ag = access_group ? *access_group : omp_access_cgroup;
return (*fptr)(dev, ag);
>From bd5743b673f82a796f95dde8126112d4c799befc Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Wed, 30 Sep 2026 19:56:49 +0200
Subject: [PATCH 06/14] Fix newline
---
openmp/runtime/test/api/omp61_dyn_gprivate_routines.f90 | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/openmp/runtime/test/api/omp61_dyn_gprivate_routines.f90 b/openmp/runtime/test/api/omp61_dyn_gprivate_routines.f90
index 8db7eb65e60d9dc..6998de2a58372a0 100644
--- a/openmp/runtime/test/api/omp61_dyn_gprivate_routines.f90
+++ b/openmp/runtime/test/api/omp61_dyn_gprivate_routines.f90
@@ -66,4 +66,5 @@ program omp61_dyn_gprivate_routines
end if
! CHECK: PASS
-end program omp61_dyn_gprivate_routines
\ No newline at end of file
+end program omp61_dyn_gprivate_routines
+
>From ecc5b82ac6e815bea00e929a67f81fc1285909e8 Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Thu, 1 Oct 2026 11:26:16 +0200
Subject: [PATCH 07/14] Update openmp/runtime/src/kmp_ftn_entry.h
Co-authored-by: Hansang Bae <hansang.bae at intel.com>
---
openmp/runtime/src/kmp_ftn_entry.h | 10 +++-------
1 file changed, 3 insertions(+), 7 deletions(-)
diff --git a/openmp/runtime/src/kmp_ftn_entry.h b/openmp/runtime/src/kmp_ftn_entry.h
index ae83689cecd3c37..0a8aaec7ed19d4e 100644
--- a/openmp/runtime/src/kmp_ftn_entry.h
+++ b/openmp/runtime/src/kmp_ftn_entry.h
@@ -570,13 +570,9 @@ void *FTN_STDCALL FTN_GET_DYN_GPRIVATE_PTR(size_t *offset,
#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
return NULL;
#else
- void *(*fptr)(size_t, omp_access_t);
- if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_dyn_gprivate_ptr"))) {
- size_t off = offset ? *offset : 0;
- omp_access_t ag = access_group ? *access_group : omp_access_cgroup;
- return (*fptr)(off, ag);
- }
- return NULL;
+ size_t off = offset ? *offset : 0;
+ omp_access_t ag = access_group ? *access_group : omp_access_cgroup;
+ return omp_get_dyn_gprivate_ptr(off, ag);
#endif
}
>From 82d04d36974a11fd58f65d950966e29c573f9ec8 Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Thu, 1 Oct 2026 15:11:04 +0200
Subject: [PATCH 08/14] Remove newline
---
openmp/runtime/test/api/omp61_dyn_gprivate_routines.f90 | 1 -
1 file changed, 1 deletion(-)
diff --git a/openmp/runtime/test/api/omp61_dyn_gprivate_routines.f90 b/openmp/runtime/test/api/omp61_dyn_gprivate_routines.f90
index 6998de2a58372a0..807cbfe8fca63b0 100644
--- a/openmp/runtime/test/api/omp61_dyn_gprivate_routines.f90
+++ b/openmp/runtime/test/api/omp61_dyn_gprivate_routines.f90
@@ -67,4 +67,3 @@ program omp61_dyn_gprivate_routines
! CHECK: PASS
end program omp61_dyn_gprivate_routines
-
>From 214abb5069a7f9b8b1519e676f7040684634c3ec Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Thu, 1 Oct 2026 17:42:06 +0200
Subject: [PATCH 09/14] Add missing mem_space mnemonic
---
openmp/module/omp_lib.F90.var | 1 +
openmp/module/omp_lib.h.var | 2 ++
2 files changed, 3 insertions(+)
diff --git a/openmp/module/omp_lib.F90.var b/openmp/module/omp_lib.F90.var
index 0b04190e2e6b73f..f13e13f6a8a62c6 100644
--- a/openmp/module/omp_lib.F90.var
+++ b/openmp/module/omp_lib.F90.var
@@ -205,6 +205,7 @@
integer (kind=omp_memspace_handle_kind), parameter, public :: omp_const_mem_space = 2
integer (kind=omp_memspace_handle_kind), parameter, public :: omp_high_bw_mem_space = 3
integer (kind=omp_memspace_handle_kind), parameter, public :: omp_low_lat_mem_space = 4
+ integer (kind=omp_memspace_handle_kind), parameter, public :: omp_cgroup_mem_space = 5
integer (kind=omp_memspace_handle_kind), parameter, public :: llvm_omp_target_host_mem_space = 100
integer (kind=omp_memspace_handle_kind), parameter, public :: llvm_omp_target_shared_mem_space = 101
integer (kind=omp_memspace_handle_kind), parameter, public :: llvm_omp_target_device_mem_space = 102
diff --git a/openmp/module/omp_lib.h.var b/openmp/module/omp_lib.h.var
index de00b05cb2cf189..30d1c23da10de77 100644
--- a/openmp/module/omp_lib.h.var
+++ b/openmp/module/omp_lib.h.var
@@ -268,6 +268,8 @@
parameter(omp_high_bw_mem_space=3)
integer(kind=omp_memspace_handle_kind)omp_low_lat_mem_space
parameter(omp_low_lat_mem_space=4)
+ integer(kind=omp_memspace_handle_kind)omp_cgroup_mem_space
+ parameter(omp_cgroup_mem_space=5)
integer(omp_memspace_handle_kind)llvm_omp_target_host_mem_space
parameter(llvm_omp_target_host_mem_space=100)
integer(omp_memspace_handle_kind)llvm_omp_target_shared_mem_space
>From a999dd0eeec89b4637f2ef31f544b187a4810b5f Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Thu, 1 Oct 2026 18:40:32 +0200
Subject: [PATCH 10/14] Change logic: host routines call C stub (for now)
---
openmp/runtime/src/kmp.h | 8 +++++
openmp/runtime/src/kmp_ftn_entry.h | 50 ++++++++----------------------
2 files changed, 21 insertions(+), 37 deletions(-)
diff --git a/openmp/runtime/src/kmp.h b/openmp/runtime/src/kmp.h
index 32c22177e7b0510..4679f64f0b2e7f9 100644
--- a/openmp/runtime/src/kmp.h
+++ b/openmp/runtime/src/kmp.h
@@ -1091,6 +1091,14 @@ typedef enum omp_access_t {
omp_access_pteam = 1
} omp_access_t;
+// declare the host API entry points for the Fortran interface to 'em pick up
+extern void *omp_get_dyn_gprivate_ptr(size_t offset, omp_access_t access_group);
+extern void *omp_get_dyn_gprivate_nofb_ptr(size_t offset,
+ omp_access_t access_group);
+extern size_t omp_get_dyn_gprivate_size(omp_access_t access_group);
+extern omp_memspace_handle_t
+omp_get_dyn_gprivate_memspace(omp_access_t access_group);
+
// end of duplicate type definitions from omp.h
#endif
diff --git a/openmp/runtime/src/kmp_ftn_entry.h b/openmp/runtime/src/kmp_ftn_entry.h
index 0a8aaec7ed19d4e..a6fa6f1671323ee 100644
--- a/openmp/runtime/src/kmp_ftn_entry.h
+++ b/openmp/runtime/src/kmp_ftn_entry.h
@@ -551,19 +551,11 @@ FTN_GET_SUBMEMSPACE(omp_memspace_handle_t KMP_DEREF memspace,
#endif
}
-// The C (KMP_FTN_PLAIN) versions of the dynamic groupprivate information
-// routines are defined in kmp_csupport.cpp, so only the Fortran entry points
-// are generated here. The offset and access_group arguments are optional in
-// Fortran and are passed as null pointers when omitted; the defaults are a zero
-// offset and omp_access_cgroup.
-//
-// The dynamic-groupprivate-information routines report on the dynamic
-// groupprivate block that is instantiated by a dyn_groupprivate clause. When an
-// offload runtime is loaded it provides a device-aware definition; forward to
-// it so that Fortran code observes the same block as C/C++. When no offload
-// runtime is available the lookup resolves to the host entry in
-// kmp_csupport.cpp, which reports that no block exists (a null pointer, a size
-// of zero and a null memory space).
+// Fortran requires a different calling convention for the following
+// dyn_groupprivate access entry points. Therefore, we need to make sure that
+// we only generate a Fortran mangled version here. Note: the unmangled,
+// C-style symbol does not provide the right ABI and so non-Linux OSes
+// might require some effort here.
#if KMP_FTN_ENTRIES != KMP_FTN_PLAIN
void *FTN_STDCALL FTN_GET_DYN_GPRIVATE_PTR(size_t *offset,
omp_access_t *access_group) {
@@ -581,13 +573,9 @@ void *FTN_STDCALL FTN_GET_DYN_GPRIVATE_NOFB_PTR(size_t *offset,
#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
return NULL;
#else
- void *(*fptr)(size_t, omp_access_t);
- if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_dyn_gprivate_nofb_ptr"))) {
- size_t off = offset ? *offset : 0;
- omp_access_t ag = access_group ? *access_group : omp_access_cgroup;
- return (*fptr)(off, ag);
- }
- return NULL;
+ size_t off = offset ? *offset : 0;
+ omp_access_t ag = access_group ? *access_group : omp_access_cgroup;
+ return omp_get_dyn_gprivate_nofb_ptr(off, ag);
#endif
}
@@ -595,12 +583,8 @@ size_t FTN_STDCALL FTN_GET_DYN_GPRIVATE_SIZE(omp_access_t *access_group) {
#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
return 0;
#else
- size_t (*fptr)(omp_access_t);
- if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_dyn_gprivate_size"))) {
- omp_access_t ag = access_group ? *access_group : omp_access_cgroup;
- return (*fptr)(ag);
- }
- return 0;
+ omp_access_t ag = access_group ? *access_group : omp_access_cgroup;
+ return omp_get_dyn_gprivate_size(ag);
#endif
}
@@ -609,20 +593,12 @@ FTN_GET_DYN_GPRIVATE_MEMSPACE(omp_access_t *access_group) {
#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
return omp_null_mem_space;
#else
- omp_memspace_handle_t (*fptr)(omp_access_t);
- if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_dyn_gprivate_memspace"))) {
- omp_access_t ag = access_group ? *access_group : omp_access_cgroup;
- return (*fptr)(ag);
- }
- return omp_null_mem_space;
+ omp_access_t ag = access_group ? *access_group : omp_access_cgroup;
+ return omp_get_dyn_gprivate_memspace(ag);
#endif
}
-// The groupprivate limit is a per-device property. libomptarget, if loaded,
-// provides a device-aware omp_get_gprivate_limit; forward to it so that Fortran
-// code observes the same limits as C/C++. When no offload runtime is available
-// there are no non-host devices and the host reports no limit, so return zero.
-size_t FTN_STDCALL FTN_GET_GPRIVATE_LIMIT(int *device_num,
+ size_t FTN_STDCALL FTN_GET_GPRIVATE_LIMIT(int *device_num,
omp_access_t *access_group) {
#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
return 0;
>From 32a4b635f6c3502eee328d4f112d4a42b515d3fb Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Thu, 1 Oct 2026 18:40:45 +0200
Subject: [PATCH 11/14] Add device routines
---
openmp/device/src/State.cpp | 32 ++++++++++++++++++++++++++++++++
1 file changed, 32 insertions(+)
diff --git a/openmp/device/src/State.cpp b/openmp/device/src/State.cpp
index 243af1f2cb5e236..72a0275670e0ec6 100644
--- a/openmp/device/src/State.cpp
+++ b/openmp/device/src/State.cpp
@@ -498,7 +498,39 @@ size_t omp_get_dyn_gprivate_size(omp_access_t) {
omp_memspace_handle_t omp_get_dyn_gprivate_memspace(omp_access_t) {
return DynCGroupMem.getMemSpace();
}
+
+// Fortran API entry points. These entry points use the default Flang
+// name mangling. We cannot use BIND(C) in omp_lib due to restrictions
+// w.r.t. OPTIONAL arguments that cannot also have the VALUE attribute
+// for BIND(C) routines.
+// TODO: if the name mangling changes or is different for other OSes,
+// implement improved name mangling schemes.
+// TODO: refactor this code to potentially move the Fortran entry points
+// to their own compilation unit.
+void *omp_get_dyn_gprivate_ptr_(size_t *Offset, omp_access_t *AccessGroup) {
+ size_t Off = Offset ? *Offset : 0;
+ omp_access_t AccGrp = AccessGroup ? *AccessGroup : omp_access_cgroup;
+ return omp_get_dyn_gprivate_ptr(Off, AccGrp);
+}
+
+void *omp_get_dyn_gprivate_nofb_ptr_(size_t *Offset,
+ omp_access_t *AccessGroup) {
+ size_t Off = Offset ? *Offset : 0;
+ omp_access_t AccGrp = AccessGroup ? *AccessGroup : omp_access_cgroup;
+ return omp_get_dyn_gprivate_nofb_ptr(Off, AccGrp);
+}
+
+size_t omp_get_dyn_gprivate_size_(omp_access_t *AccessGroup) {
+ omp_access_t AccGrp = AccessGroup ? *AccessGroup : omp_access_cgroup;
+ return omp_get_dyn_gprivate_size(AccGrp);
+}
+
+omp_memspace_handle_t
+omp_get_dyn_gprivate_memspace_(omp_access_t *AccessGroup) {
+ omp_access_t AccGrp = AccessGroup ? *AccessGroup : omp_access_cgroup;
+ return omp_get_dyn_gprivate_memspace(AccGrp);
}
+} // extern "C"
extern "C" {
[[clang::noinline]] void *__kmpc_alloc_shared(uint64_t Bytes) {
>From 4a017cc2a49a8dc2995781b440475eea04e15793 Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Thu, 1 Oct 2026 18:40:55 +0200
Subject: [PATCH 12/14] Add DLL exports
---
openmp/runtime/src/dllexports | 4 ++++
1 file changed, 4 insertions(+)
diff --git a/openmp/runtime/src/dllexports b/openmp/runtime/src/dllexports
index 8a70f8bc6d20cb0..27b8119b5cc9653 100644
--- a/openmp/runtime/src/dllexports
+++ b/openmp/runtime/src/dllexports
@@ -546,6 +546,10 @@ kmp_set_disp_num_buffers 890
omp_get_submemspace 821
omp_get_device_from_uid 822
omp_get_uid_from_device 823
+ omp_get_dyn_gprivate_ptr 824
+ omp_get_dyn_gprivate_nofb_ptr 825
+ omp_get_dyn_gprivate_size 826
+ omp_get_dyn_gprivate_memspace 827
%ifndef stub
__kmpc_set_default_allocator
__kmpc_get_default_allocator
>From f55a6d9aed5bf3f886cde8536030813095e973c1 Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Thu, 1 Oct 2026 19:13:05 +0200
Subject: [PATCH 13/14] Fix spurious edit
---
openmp/runtime/src/kmp_ftn_entry.h | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/openmp/runtime/src/kmp_ftn_entry.h b/openmp/runtime/src/kmp_ftn_entry.h
index a6fa6f1671323ee..257fc27b3f827d6 100644
--- a/openmp/runtime/src/kmp_ftn_entry.h
+++ b/openmp/runtime/src/kmp_ftn_entry.h
@@ -598,7 +598,7 @@ FTN_GET_DYN_GPRIVATE_MEMSPACE(omp_access_t *access_group) {
#endif
}
- size_t FTN_STDCALL FTN_GET_GPRIVATE_LIMIT(int *device_num,
+size_t FTN_STDCALL FTN_GET_GPRIVATE_LIMIT(int *device_num,
omp_access_t *access_group) {
#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
return 0;
>From 9259bc85e55bcb76d2f9ff5fb3bc04cf85d606d6 Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Fri, 2 Oct 2026 15:09:53 +0200
Subject: [PATCH 14/14] Add test
---
.../offloading/fortran/dyn_groupprivate.f90 | 223 ++++++++++++++++++
1 file changed, 223 insertions(+)
create mode 100644 offload/test/offloading/fortran/dyn_groupprivate.f90
diff --git a/offload/test/offloading/fortran/dyn_groupprivate.f90 b/offload/test/offloading/fortran/dyn_groupprivate.f90
new file mode 100644
index 000000000000000..60a015c6f1e3b9a
--- /dev/null
+++ b/offload/test/offloading/fortran/dyn_groupprivate.f90
@@ -0,0 +1,223 @@
+! Test the Fortran interfaces of the OpenMP dynamic-groupprivate-information
+! routines on the host and inside target regions, mirroring
+! offload/test/offloading/dyn_groupprivate.cpp.
+! REQUIRES: flang, gpu
+
+! RUN: %libomptarget-compile-fortran-generic -fopenmp-version=61
+! RUN: %libomptarget-run-generic | %fcheck-generic
+! RUN: %libomptarget-compile-fortran-generic -fopenmp-version=61 -O3
+! RUN: %libomptarget-run-generic | %fcheck-generic
+! XFAIL: intelgpu
+
+module dyn_gprivate_helpers
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_associated
+ implicit none
+contains
+ ! C_ASSOCIATED(A, B) is false when A is null, so handle null pointers
+ ! explicitly to compare two C pointers for equality.
+ logical function same_ptr(a, b)
+ !$omp declare target
+ type(c_ptr), intent(in) :: a, b
+ if (.not. c_associated(a)) then
+ same_ptr = .not. c_associated(b)
+ else
+ same_ptr = c_associated(a, b)
+ end if
+ end function same_ptr
+end module dyn_gprivate_helpers
+
+program main
+ use omp_lib
+ use dyn_gprivate_helpers
+ use, intrinsic :: iso_c_binding
+ implicit none
+
+ integer, parameter :: n = 512
+ integer(c_int) :: res(n), buffer(n)
+ integer(c_int), pointer :: dynbuf(:)
+ integer :: nthreads, tid, wrapped, i, failed
+ integer(c_size_t) :: max_size, exceeded_size
+
+ failed = 0
+
+ ! Verify the groupprivate buffer works as expected.
+ !$omp target teams num_teams(1) thread_limit(n) &
+ !$omp& dyn_groupprivate(fallback(abort) : n * c_sizeof(0_c_int)) &
+ !$omp& map(from : res, nthreads) map(alloc : buffer)
+ !$omp parallel private(dynbuf, tid, wrapped)
+ call c_f_pointer(omp_get_dyn_gprivate_nofb_ptr(), dynbuf, [n])
+ tid = omp_get_thread_num()
+ if (tid == 0) nthreads = omp_get_num_threads()
+ buffer(tid + 1) = 7
+ dynbuf(tid + 1) = 3
+ !$omp barrier
+ wrapped = mod(tid + 37, nthreads)
+ res(tid + 1) = buffer(wrapped + 1) + dynbuf(wrapped + 1)
+ !$omp end parallel
+ !$omp end target teams
+
+ if (nthreads < n / 2 .or. nthreads > n) then
+ print *, "Expected number of threads to be in [", n / 2, ":", n, &
+ "], but got: ", nthreads
+ stop 1
+ end if
+
+ do i = 1, nthreads
+ if (res(i) /= 7 + 3) then
+ print *, "res(", i, ") is ", res(i), ", expected ", 7 + 3
+ failed = failed + 1
+ end if
+ end do
+
+ ! Verify that the routines on the host return null and zero.
+ if (c_associated(omp_get_dyn_gprivate_ptr())) failed = failed + 1
+ if (c_associated(omp_get_dyn_gprivate_nofb_ptr())) failed = failed + 1
+ if (omp_get_dyn_gprivate_size() /= 0) failed = failed + 1
+ if (omp_get_dyn_gprivate_memspace() /= omp_null_mem_space) &
+ failed = failed + 1
+
+ max_size = omp_get_gprivate_limit(0, omp_access_cgroup)
+ exceeded_size = max_size + 10
+
+ ! Verify that the fallback(default_mem) modifier works.
+ !$omp target dyn_groupprivate(fallback(default_mem) : exceeded_size) &
+ !$omp& map(tofrom : failed)
+ if (.not. c_associated(omp_get_dyn_gprivate_ptr(0_c_size_t))) &
+ failed = failed + 1
+ if (c_associated(omp_get_dyn_gprivate_nofb_ptr(0_c_size_t))) &
+ failed = failed + 1
+ if (same_ptr(omp_get_dyn_gprivate_ptr(0_c_size_t), &
+ omp_get_dyn_gprivate_nofb_ptr(0_c_size_t))) failed = failed + 1
+ if (omp_get_dyn_gprivate_size() == 0) failed = failed + 1
+ if (omp_get_dyn_gprivate_size() /= exceeded_size) failed = failed + 1
+ if (omp_get_dyn_gprivate_memspace() /= omp_default_mem_space) &
+ failed = failed + 1
+ !$omp end target
+
+ ! Verify that the fallback(null) modifier works.
+ !$omp target dyn_groupprivate(fallback(null) : exceeded_size) &
+ !$omp& map(tofrom : failed)
+ if (c_associated(omp_get_dyn_gprivate_ptr(0_c_size_t))) failed = failed + 1
+ if (c_associated(omp_get_dyn_gprivate_nofb_ptr(0_c_size_t))) &
+ failed = failed + 1
+ if (.not. same_ptr(omp_get_dyn_gprivate_ptr(0_c_size_t), &
+ omp_get_dyn_gprivate_nofb_ptr(0_c_size_t))) &
+ failed = failed + 1
+ if (omp_get_dyn_gprivate_size() /= 0) failed = failed + 1
+ if (omp_get_dyn_gprivate_memspace() /= omp_null_mem_space) &
+ failed = failed + 1
+ !$omp end target
+
+ ! Verify that the default modifier is fallback(default_mem).
+ !$omp target dyn_groupprivate(exceeded_size) map(tofrom : failed)
+ if (.not. c_associated(omp_get_dyn_gprivate_ptr(0_c_size_t))) &
+ failed = failed + 1
+ if (c_associated(omp_get_dyn_gprivate_nofb_ptr(0_c_size_t))) &
+ failed = failed + 1
+ if (same_ptr(omp_get_dyn_gprivate_ptr(0_c_size_t), &
+ omp_get_dyn_gprivate_nofb_ptr(0_c_size_t))) failed = failed + 1
+ if (omp_get_dyn_gprivate_size() == 0) failed = failed + 1
+ if (omp_get_dyn_gprivate_size() /= exceeded_size) failed = failed + 1
+ if (omp_get_dyn_gprivate_memspace() /= omp_default_mem_space) &
+ failed = failed + 1
+ !$omp end target
+
+ ! Verify that the fallback(abort) modifier works.
+ !$omp target dyn_groupprivate(fallback(abort) : n) map(tofrom : failed)
+ if (.not. c_associated(omp_get_dyn_gprivate_ptr(0_c_size_t))) &
+ failed = failed + 1
+ if (.not. c_associated(omp_get_dyn_gprivate_nofb_ptr(0_c_size_t))) &
+ failed = failed + 1
+ if (.not. same_ptr(omp_get_dyn_gprivate_ptr(0_c_size_t), &
+ omp_get_dyn_gprivate_nofb_ptr(0_c_size_t))) &
+ failed = failed + 1
+ if (.not. same_ptr(omp_get_dyn_gprivate_ptr(5_c_size_t), &
+ omp_get_dyn_gprivate_nofb_ptr(5_c_size_t))) &
+ failed = failed + 1
+ if (omp_get_dyn_gprivate_size() == 0) failed = failed + 1
+ if (omp_get_dyn_gprivate_size() /= n) failed = failed + 1
+ if (omp_get_dyn_gprivate_memspace() /= omp_cgroup_mem_space) &
+ failed = failed + 1
+ !$omp end target
+
+ ! Verify that omitted OPTIONAL arguments default to a zero offset and
+ ! omp_access_cgroup.
+ !$omp target dyn_groupprivate(fallback(abort) : n) map(tofrom : failed)
+ if (.not. same_ptr(omp_get_dyn_gprivate_ptr(), &
+ omp_get_dyn_gprivate_ptr(0_c_size_t, omp_access_cgroup))) &
+ failed = failed + 1
+ if (.not. same_ptr(omp_get_dyn_gprivate_ptr(access_group=omp_access_cgroup), &
+ omp_get_dyn_gprivate_ptr(0_c_size_t))) &
+ failed = failed + 1
+ if (.not. same_ptr(omp_get_dyn_gprivate_nofb_ptr(), &
+ omp_get_dyn_gprivate_nofb_ptr(0_c_size_t, &
+ omp_access_cgroup))) &
+ failed = failed + 1
+ if (omp_get_dyn_gprivate_size() /= &
+ omp_get_dyn_gprivate_size(omp_access_cgroup)) failed = failed + 1
+ if (omp_get_dyn_gprivate_memspace() /= &
+ omp_get_dyn_gprivate_memspace(omp_access_cgroup)) failed = failed + 1
+ !$omp end target
+
+ ! Verify that the fallback(default_mem) does not trigger when not needed.
+ !$omp target dyn_groupprivate(fallback(default_mem) : n) map(tofrom : failed)
+ if (.not. c_associated(omp_get_dyn_gprivate_ptr(0_c_size_t))) &
+ failed = failed + 1
+ if (.not. c_associated(omp_get_dyn_gprivate_nofb_ptr(0_c_size_t))) &
+ failed = failed + 1
+ if (.not. same_ptr(omp_get_dyn_gprivate_ptr(0_c_size_t), &
+ omp_get_dyn_gprivate_nofb_ptr(0_c_size_t))) &
+ failed = failed + 1
+ if (omp_get_dyn_gprivate_size() == 0) failed = failed + 1
+ if (omp_get_dyn_gprivate_size() /= n) failed = failed + 1
+ if (omp_get_dyn_gprivate_memspace() /= omp_cgroup_mem_space) &
+ failed = failed + 1
+ !$omp end target
+
+ ! Verify that the clause works when passing a zero size.
+ !$omp target dyn_groupprivate(fallback(abort) : 0) map(tofrom : failed)
+ if (c_associated(omp_get_dyn_gprivate_ptr(0_c_size_t))) failed = failed + 1
+ if (c_associated(omp_get_dyn_gprivate_nofb_ptr(0_c_size_t))) &
+ failed = failed + 1
+ if (.not. same_ptr(omp_get_dyn_gprivate_ptr(0_c_size_t), &
+ omp_get_dyn_gprivate_nofb_ptr(0_c_size_t))) &
+ failed = failed + 1
+ if (omp_get_dyn_gprivate_size() /= 0) failed = failed + 1
+ if (omp_get_dyn_gprivate_memspace() /= omp_null_mem_space) &
+ failed = failed + 1
+ !$omp end target
+
+ ! Verify that the clause works when passing a zero size and
+ ! fallback(default_mem).
+ !$omp target dyn_groupprivate(fallback(default_mem) : 0) map(tofrom : failed)
+ if (c_associated(omp_get_dyn_gprivate_ptr(0_c_size_t))) failed = failed + 1
+ if (c_associated(omp_get_dyn_gprivate_nofb_ptr(0_c_size_t))) &
+ failed = failed + 1
+ if (.not. same_ptr(omp_get_dyn_gprivate_ptr(0_c_size_t), &
+ omp_get_dyn_gprivate_nofb_ptr(0_c_size_t))) &
+ failed = failed + 1
+ if (omp_get_dyn_gprivate_size() /= 0) failed = failed + 1
+ if (omp_get_dyn_gprivate_memspace() /= omp_null_mem_space) &
+ failed = failed + 1
+ !$omp end target
+
+ ! Verify that omitting the clause is the same as setting zero size.
+ !$omp target map(tofrom : failed)
+ if (c_associated(omp_get_dyn_gprivate_ptr(0_c_size_t))) failed = failed + 1
+ if (c_associated(omp_get_dyn_gprivate_nofb_ptr(0_c_size_t))) &
+ failed = failed + 1
+ if (.not. same_ptr(omp_get_dyn_gprivate_ptr(0_c_size_t), &
+ omp_get_dyn_gprivate_nofb_ptr(0_c_size_t))) &
+ failed = failed + 1
+ if (omp_get_dyn_gprivate_size() /= 0) failed = failed + 1
+ if (omp_get_dyn_gprivate_memspace() /= omp_null_mem_space) &
+ failed = failed + 1
+ !$omp end target
+
+ ! CHECK: PASS
+ if (failed == 0) then
+ print *, "PASS"
+ else
+ print *, "FAIL: ", failed
+ end if
+end program main
\ No newline at end of file
More information about the Openmp-commits
mailing list