[Openmp-commits] [openmp] [OpenMP] Add Fortran support for omp_* functions needing adapters (PR #170374)
Robert Imschweiler via Openmp-commits
openmp-commits at lists.llvm.org
Tue Dec 2 13:53:34 PST 2025
https://github.com/ro-i created https://github.com/llvm/llvm-project/pull/170374
Taking omp_get_uid_from_device and omp_get_device_from_uid as examples.
OpenMP 6.0 defines these functions as follows:
```
const char *omp_get_uid_from_device(int device_num);
character(:) function omp_get_uid_from_device(device_num)
pointer :: omp_get_uid_from_device
integer, intent(in) :: device_num
```
and
```
int omp_get_device_from_uid(const char *uid);
integer function omp_get_device_from_uid(uid)
character(len=*), intent(in) :: uid
```
As a result, we cannot directly map the Fortran API declarations to the C API declarations. We need some adapter code to do the conversion.
However, this means that we cannot just define the two functions as omp_* in kmp_ftn_entry.h without clashing with the adapter code.
The current situation is less than ideal, as demonstrated by this draft PR, which shall serve as a base for discussing different solution approaches.
---------------
@mjklemm as discussed
>From b964ce26a38cd7dbe5953bab99e85268f24b2ec6 Mon Sep 17 00:00:00 2001
From: Robert Imschweiler <robert.imschweiler at amd.com>
Date: Tue, 2 Dec 2025 14:46:33 -0600
Subject: [PATCH] [OpenMP] Add Fortran support for omp_* functions needing
adapters
Taking omp_get_uid_from_device and omp_get_device_from_uid as examples.
OpenMP 6.0 defines these functions as follows:
```
const char *omp_get_uid_from_device(int device_num);
character(:) function omp_get_uid_from_device(device_num)
pointer :: omp_get_uid_from_device
integer, intent(in) :: device_num
```
and
```
int omp_get_device_from_uid(const char *uid);
integer function omp_get_device_from_uid(uid)
character(len=*), intent(in) :: uid
```
As a result, we cannot directly map the Fortran API declarations to the
C API declarations. We need some adapter code to do the conversion.
However, this means that we cannot just define the two functions as
omp_* in kmp_ftn_entry.h without clashing with the adapter code.
The current situation is less than ideal, as demonstrated by this draft
PR, which shall serve as a base for discussing different solution
approaches.
---
openmp/runtime/CMakeLists.txt | 2 +-
openmp/runtime/src/CMakeLists.txt | 42 +++++++
openmp/runtime/src/exports_so.txt | 1 +
openmp/runtime/src/include/omp_lib.F90.var | 14 +++
openmp/runtime/src/include/omp_lib.h.var | 11 ++
openmp/runtime/src/kmp_ftn_cdecl.cpp | 48 +++++++
openmp/runtime/src/kmp_ftn_entry.h | 31 -----
openmp/runtime/src/kmp_ftn_extra.cpp | 48 +++++++
openmp/runtime/src/kmp_ftn_support.f90 | 140 +++++++++++++++++++++
openmp/runtime/test/api/omp_device_uid.f | 70 +++++++++++
openmp/runtime/test/api/omp_device_uid.f90 | 69 ++++++++++
openmp/runtime/test/lit.cfg | 2 +-
12 files changed, 445 insertions(+), 33 deletions(-)
create mode 100644 openmp/runtime/src/kmp_ftn_support.f90
create mode 100644 openmp/runtime/test/api/omp_device_uid.f
create mode 100644 openmp/runtime/test/api/omp_device_uid.f90
diff --git a/openmp/runtime/CMakeLists.txt b/openmp/runtime/CMakeLists.txt
index 93eb14f10a50a..e854593e87c2e 100644
--- a/openmp/runtime/CMakeLists.txt
+++ b/openmp/runtime/CMakeLists.txt
@@ -273,7 +273,7 @@ set(LIBOMP_INC_DIR ${LIBOMP_SRC_DIR}/include)
set(LIBOMP_BINARY_DIR ${CMAKE_CURRENT_BINARY_DIR})
# Enabling Fortran if it is needed
-if(${LIBOMP_FORTRAN_MODULES})
+if(${LIBOMP_FORTRAN_MODULES} OR NOT "${LIBOMP_FORTRAN_MODULES_COMPILER}" STREQUAL "")
enable_language(Fortran)
endif()
# Enable MASM Compiler if it is needed (Windows only)
diff --git a/openmp/runtime/src/CMakeLists.txt b/openmp/runtime/src/CMakeLists.txt
index 3202bdcd13524..3ba93c676420f 100644
--- a/openmp/runtime/src/CMakeLists.txt
+++ b/openmp/runtime/src/CMakeLists.txt
@@ -422,6 +422,48 @@ elseif(${LIBOMP_FORTRAN_MODULES})
set(BUILD_FORTRAN_MODULES True)
endif()
+if(BUILD_FORTRAN_MODULES)
+ if(NOT LIBOMP_FORTRAN_MODULES AND ${LIBOMP_FORTRAN_MODULES_COMPILER} STREQUAL "")
+ message(FATAL_ERROR
+ "Generating OpenMP Fortran modules now requires LIBOMP_FORTRAN_MODULES=ON "
+ "or LIBOMP_FORTRAN_MODULES_COMPILER to be set so the adaptor implementations "
+ "can be compiled and linked into libomp.")
+ endif()
+ target_sources(omp PRIVATE kmp_ftn_support.f90)
+ set_source_files_properties(kmp_ftn_support.f90
+ PROPERTIES COMPILE_FLAGS "${LIBOMP_CONFIGURED_FFLAGS}")
+ add_dependencies(omp libomp-mod)
+ # Determine Fortran runtime libraries to link
+ # For LLVM flang, we need flang_rt.runtime (newer)
+ set(_LIBOMP_FORTRAN_LIBS "")
+ if(CMAKE_Fortran_COMPILER_ID MATCHES "LLVMFlang" OR CMAKE_Fortran_COMPILER_ID MATCHES "Flang")
+ # Derive paths from Fortran compiler location
+ get_filename_component(_FC_DIR "${CMAKE_Fortran_COMPILER}" DIRECTORY)
+ get_filename_component(_FC_PREFIX "${_FC_DIR}" DIRECTORY)
+
+ # Try to find the flang runtime in clang resource directory
+ # Path: <prefix>/lib/clang/<version>/lib/<target>/libflang_rt.runtime.a
+ file(GLOB _FLANG_RT_CANDIDATES
+ "${_FC_PREFIX}/lib/clang/*/lib/*/libflang_rt.runtime.a"
+ )
+ if(_FLANG_RT_CANDIDATES)
+ list(GET _FLANG_RT_CANDIDATES 0 _FLANG_RT_LIB)
+ list(APPEND _LIBOMP_FORTRAN_LIBS "${_FLANG_RT_LIB}")
+ else()
+ message(WARNING "Could not find LLVM Flang runtime libraries. "
+ "libomp may fail to link.")
+ endif()
+ elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
+ set(_LIBOMP_FORTRAN_LIBS gfortran)
+ else()
+ # Fallback to CMake's auto-detected libs
+ set(_LIBOMP_FORTRAN_LIBS ${CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES})
+ endif()
+ if(_LIBOMP_FORTRAN_LIBS)
+ target_link_libraries(omp ${_LIBOMP_FORTRAN_LIBS})
+ endif()
+endif()
+
# Move files to exports/ directory if requested
if(${LIBOMP_COPY_EXPORTS})
include(LibompExports)
diff --git a/openmp/runtime/src/exports_so.txt b/openmp/runtime/src/exports_so.txt
index d826882d98804..898593d222362 100644
--- a/openmp/runtime/src/exports_so.txt
+++ b/openmp/runtime/src/exports_so.txt
@@ -29,6 +29,7 @@ VERSION {
ompt_libomp_connect; # OMPT libomptarget interface
ompc_*; # omp.h renames some standard functions to ompc_*.
+ _QMomp_*; # Fortran module procedures (flang name mangling).
kmp_*; # Intel extensions.
kmpc_*; # Intel extensions.
__kmpc_*; # Functions called by compiler-generated code.
diff --git a/openmp/runtime/src/include/omp_lib.F90.var b/openmp/runtime/src/include/omp_lib.F90.var
index 90d7e49ebf549..102f9531d1081 100644
--- a/openmp/runtime/src/include/omp_lib.F90.var
+++ b/openmp/runtime/src/include/omp_lib.F90.var
@@ -904,6 +904,18 @@
integer, intent(in) :: resources(*)
end function omp_get_submemspace
+ function omp_get_uid_from_device(device_num) result(uid)
+ use omp_lib_kinds
+ integer (kind=omp_integer_kind), intent(in) :: device_num
+ character (:), pointer :: uid
+ end function omp_get_uid_from_device
+
+ function omp_get_device_from_uid(uid) result(device_num)
+ use omp_lib_kinds
+ character (len=*), intent(in) :: uid
+ integer (kind=omp_integer_kind) :: device_num
+ end function omp_get_device_from_uid
+
! ***
! *** kmp_* entry points
! ***
@@ -1150,6 +1162,8 @@
public :: omp_realloc
public :: omp_free
public :: omp_in_explicit_task
+ public :: omp_get_uid_from_device
+ public :: omp_get_device_from_uid
public :: kmp_set_stacksize
public :: kmp_set_stacksize_s
public :: kmp_set_blocktime
diff --git a/openmp/runtime/src/include/omp_lib.h.var b/openmp/runtime/src/include/omp_lib.h.var
index a50bb018c7cc3..41802d877b754 100644
--- a/openmp/runtime/src/include/omp_lib.h.var
+++ b/openmp/runtime/src/include/omp_lib.h.var
@@ -976,6 +976,17 @@
integer, intent(in) :: resources(*)
end function omp_get_submemspace
+ function omp_get_uid_from_device(device_num) result(uid)
+ import
+ integer (kind=omp_integer_kind), intent(in) :: device_num
+ character (:), pointer :: uid
+ end function omp_get_uid_from_device
+
+ function omp_get_device_from_uid(uid) result(device_num)
+ import
+ character (len=*), intent(in) :: uid
+ integer (kind=omp_integer_kind) :: device_num
+ end function omp_get_device_from_uid
! ***
! *** kmp_* entry points
diff --git a/openmp/runtime/src/kmp_ftn_cdecl.cpp b/openmp/runtime/src/kmp_ftn_cdecl.cpp
index cf1d429a915c0..23e5af7573b87 100644
--- a/openmp/runtime/src/kmp_ftn_cdecl.cpp
+++ b/openmp/runtime/src/kmp_ftn_cdecl.cpp
@@ -29,6 +29,54 @@ char const __kmp_version_ftncdecl[] =
#define FTN_STDCALL /* no stdcall */
#include "kmp_ftn_os.h"
#include "kmp_ftn_entry.h"
+
+#if KMP_FTN_ENTRIES == KMP_FTN_PLAIN
+#define FTN_GET_UID_FROM_DEVICE omp_get_uid_from_device
+#define FTN_GET_DEVICE_FROM_UID omp_get_device_from_uid
+#endif
+#if KMP_FTN_ENTRIES == KMP_FTN_APPEND
+#define FTN_GET_UID_FROM_DEVICE omp_get_uid_from_device_
+#define FTN_GET_DEVICE_FROM_UID omp_get_device_from_uid_
+#endif
+#if KMP_FTN_ENTRIES == KMP_FTN_UPPER
+#define FTN_GET_UID_FROM_DEVICE OMP_GET_UID_FROM_DEVICE
+#define FTN_GET_DEVICE_FROM_UID OMP_GET_DEVICE_FROM_UID
+#endif
+#if KMP_FTN_ENTRIES == KMP_FTN_UAPPEND
+#define FTN_GET_UID_FROM_DEVICE OMP_GET_UID_FROM_DEVICE_
+#define FTN_GET_DEVICE_FROM_UID OMP_GET_DEVICE_FROM_UID_
+#endif
+
+extern "C" {
+const char *FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_UID_FROM_DEVICE)(int device_num)
+ KMP_WEAK_ATTRIBUTE_EXTERNAL;
+const char *FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_UID_FROM_DEVICE)(int device_num) {
+#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
+ return nullptr;
+#else
+ const char *(*fptr)(int);
+ if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_uid_from_device")))
+ return (*fptr)(device_num);
+ // Returns the same string as used by libomptarget
+ return "HOST";
+#endif
+}
+int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_DEVICE_FROM_UID)(const char *device_uid)
+ KMP_WEAK_ATTRIBUTE_EXTERNAL;
+int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_DEVICE_FROM_UID)(const char *device_uid) {
+#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
+ return omp_invalid_device;
+#else
+ int (*fptr)(const char *);
+ if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_device_from_uid")))
+ return (*fptr)(device_uid);
+ return KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)();
+#endif
+}
+
+KMP_VERSION_SYMBOL(FTN_GET_UID_FROM_DEVICE, 60, "OMP_6.0");
+KMP_VERSION_SYMBOL(FTN_GET_DEVICE_FROM_UID, 60, "OMP_6.0");
+} // extern "C"
#else
"no";
#endif /* KMP_FTN_ENTRIES */
diff --git a/openmp/runtime/src/kmp_ftn_entry.h b/openmp/runtime/src/kmp_ftn_entry.h
index 625101b067daf..042c494c13c14 100644
--- a/openmp/runtime/src/kmp_ftn_entry.h
+++ b/openmp/runtime/src/kmp_ftn_entry.h
@@ -1550,33 +1550,6 @@ int FTN_STDCALL FTN_GET_DEVICE_NUM(void) KMP_WEAK_ATTRIBUTE_EXTERNAL;
int FTN_STDCALL FTN_GET_DEVICE_NUM(void) {
return KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)();
}
-const char *FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_UID_FROM_DEVICE)(int device_num)
- KMP_WEAK_ATTRIBUTE_EXTERNAL;
-const char *FTN_STDCALL
-KMP_EXPAND_NAME(FTN_GET_UID_FROM_DEVICE)(int device_num) {
-#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
- return nullptr;
-#else
- const char *(*fptr)(int);
- if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_uid_from_device")))
- return (*fptr)(device_num);
- // Returns the same string as used by libomptarget
- return "HOST";
-#endif
-}
-int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_DEVICE_FROM_UID)(const char *device_uid)
- KMP_WEAK_ATTRIBUTE_EXTERNAL;
-int FTN_STDCALL
-KMP_EXPAND_NAME(FTN_GET_DEVICE_FROM_UID)(const char *device_uid) {
-#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
- return omp_invalid_device;
-#else
- int (*fptr)(const char *);
- if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_device_from_uid")))
- return (*fptr)(device_uid);
- return KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)();
-#endif
-}
// Compiler will ensure that this is only called from host in sequential region
int FTN_STDCALL KMP_EXPAND_NAME(FTN_PAUSE_RESOURCE)(kmp_pause_status_t kind,
@@ -1933,10 +1906,6 @@ KMP_VERSION_SYMBOL(FTN_SET_AFFINITY_FORMAT, 50, "OMP_5.0");
// KMP_VERSION_SYMBOL(FTN_GET_SUPPORTED_ACTIVE_LEVELS, 50, "OMP_5.0");
// KMP_VERSION_SYMBOL(FTN_FULFILL_EVENT, 50, "OMP_5.0");
-// OMP_6.0 versioned symbols
-KMP_VERSION_SYMBOL(FTN_GET_UID_FROM_DEVICE, 60, "OMP_6.0");
-KMP_VERSION_SYMBOL(FTN_GET_DEVICE_FROM_UID, 60, "OMP_6.0");
-
#endif // KMP_USE_VERSION_SYMBOLS
#ifdef __cplusplus
diff --git a/openmp/runtime/src/kmp_ftn_extra.cpp b/openmp/runtime/src/kmp_ftn_extra.cpp
index 74b3e96ab3003..253d0d2a79575 100644
--- a/openmp/runtime/src/kmp_ftn_extra.cpp
+++ b/openmp/runtime/src/kmp_ftn_extra.cpp
@@ -27,6 +27,54 @@ char const __kmp_version_ftnextra[] =
#define FTN_STDCALL /* nothing to do */
#include "kmp_ftn_os.h"
#include "kmp_ftn_entry.h"
+
+#if KMP_FTN_ENTRIES == KMP_FTN_PLAIN
+#define FTN_KMP_GET_UID_FROM_DEVICE __kmp_get_uid_from_device
+#define FTN_KMP_GET_DEVICE_FROM_UID __kmp_get_device_from_uid
+#endif
+#if KMP_FTN_ENTRIES == KMP_FTN_APPEND
+#define FTN_KMP_GET_UID_FROM_DEVICE __kmp_get_uid_from_device_
+#define FTN_KMP_GET_DEVICE_FROM_UID __kmp_get_device_from_uid_
+#endif
+#if KMP_FTN_ENTRIES == KMP_FTN_UPPER
+#define FTN_KMP_GET_UID_FROM_DEVICE __KMP_GET_UID_FROM_DEVICE
+#define FTN_KMP_GET_DEVICE_FROM_UID __KMP_GET_DEVICE_FROM_UID
+#endif
+#if KMP_FTN_ENTRIES == KMP_FTN_UAPPEND
+#define FTN_KMP_GET_UID_FROM_DEVICE __KMP_GET_UID_FROM_DEVICE_
+#define FTN_KMP_GET_DEVICE_FROM_UID __KMP_GET_DEVICE_FROM_UID_
+#endif
+
+extern "C" {
+const char *FTN_STDCALL KMP_EXPAND_NAME(FTN_KMP_GET_UID_FROM_DEVICE)(int device_num)
+ KMP_WEAK_ATTRIBUTE_EXTERNAL;
+const char *FTN_STDCALL KMP_EXPAND_NAME(FTN_KMP_GET_UID_FROM_DEVICE)(int device_num) {
+#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
+ return nullptr;
+#else
+ const char *(*fptr)(int);
+ if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_uid_from_device")))
+ return (*fptr)(device_num);
+ // Returns the same string as used by libomptarget
+ return "HOST";
+#endif
+}
+int FTN_STDCALL KMP_EXPAND_NAME(FTN_KMP_GET_DEVICE_FROM_UID)(const char *device_uid)
+ KMP_WEAK_ATTRIBUTE_EXTERNAL;
+int FTN_STDCALL KMP_EXPAND_NAME(FTN_KMP_GET_DEVICE_FROM_UID)(const char *device_uid) {
+#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
+ return omp_invalid_device;
+#else
+ int (*fptr)(const char *);
+ if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_device_from_uid")))
+ return (*fptr)(device_uid);
+ return KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)();
+#endif
+}
+
+KMP_VERSION_SYMBOL(FTN_KMP_GET_UID_FROM_DEVICE, 60, "OMP_6.0");
+KMP_VERSION_SYMBOL(FTN_KMP_GET_DEVICE_FROM_UID, 60, "OMP_6.0");
+} // extern "C"
#else
"no";
#endif /* KMP_FTN_ENTRIES */
diff --git a/openmp/runtime/src/kmp_ftn_support.f90 b/openmp/runtime/src/kmp_ftn_support.f90
new file mode 100644
index 0000000000000..f76beb3a6da2e
--- /dev/null
+++ b/openmp/runtime/src/kmp_ftn_support.f90
@@ -0,0 +1,140 @@
+! kmp_ftn_support.f90
+!
+!//===----------------------------------------------------------------------===//
+!//
+!// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+!// See https://llvm.org/LICENSE.txt for license information.
+!// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+!//
+!//===----------------------------------------------------------------------===//
+
+ ! submodule (omp_lib) kmp_ftn_support
+
+ ! use omp_lib_kinds
+ ! use, intrinsic :: iso_c_binding, only : c_char, c_ptr, c_null_ptr, &
+ ! & c_size_t, c_f_pointer, c_int, &
+ ! & c_loc, c_null_char, c_associated
+module kmp_ftn_c_bindings
+ interface
+ function __kmp_get_uid_from_device(device_num) bind(c, name="__kmp_get_uid_from_device_")
+ use omp_lib_kinds
+ use, intrinsic :: iso_c_binding, only : c_ptr
+ integer (kind=omp_integer_kind), intent(in) :: device_num
+ type(c_ptr) :: __kmp_get_uid_from_device
+ end function __kmp_get_uid_from_device
+ end interface
+
+ interface
+ function __kmp_get_device_from_uid(uid) bind(c, name="__kmp_get_device_from_uid_")
+ use omp_lib_kinds
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_int
+ type(c_ptr), value :: uid
+ integer(c_int) :: __kmp_get_device_from_uid
+ end function __kmp_get_device_from_uid
+ end interface
+
+ interface
+ function __omp_strlen(str) bind(c, name="strlen")
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ type(c_ptr), value :: str
+ integer(c_size_t) :: __omp_strlen
+ end function __omp_strlen
+ end interface
+
+ contains
+
+ function omp_get_uid_from_device_impl(device_num) result(uid)
+ use omp_lib_kinds
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_int, c_char, c_size_t, c_associated, c_f_pointer
+ implicit none
+ integer (kind=omp_integer_kind), intent(in) :: device_num
+ character (:), pointer :: uid
+ type(c_ptr) :: raw_uid
+ integer (c_size_t) :: len_c
+ integer :: len_f, i, alloc_status
+ character (kind=c_char), pointer :: uid_buffer(:)
+
+ nullify(uid)
+
+ raw_uid = __kmp_get_uid_from_device(device_num)
+ if (.not. c_associated(raw_uid)) return
+
+ len_c = __omp_strlen(raw_uid)
+ if (len_c == 0_c_size_t) then
+ allocate(character (kind=c_char,len=0) :: uid, stat=alloc_status)
+ if (alloc_status /= 0) nullify(uid)
+ return
+ end if
+
+ if (len_c > huge(len_f)) return
+ len_f = int(len_c, kind=kind(len_f))
+
+ allocate(character (kind=c_char,len=len_f) :: uid, stat=alloc_status)
+ if (alloc_status /= 0) then
+ nullify(uid)
+ return
+ end if
+
+ call c_f_pointer(raw_uid, uid_buffer, [len_f])
+ do i = 1, len_f
+ uid(i:i) = uid_buffer(i)
+ end do
+ end function omp_get_uid_from_device_impl
+
+ function omp_get_device_from_uid_impl(uid) result(device_num)
+ use omp_lib_kinds, only : omp_integer_kind
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_int, c_char, c_null_char, c_loc
+ implicit none
+ integer (kind=omp_integer_kind), parameter :: omp_invalid_device = -2
+ character (kind=c_char,len=*), intent(in) :: uid
+ integer (kind=omp_integer_kind) :: device_num
+ character (kind=c_char), allocatable, target :: uid_buffer(:)
+ integer :: str_len, alloc_status, i
+ type(c_ptr) :: uid_ptr
+ integer (c_int) :: device_num_c
+
+ str_len = len(uid)
+
+ allocate(uid_buffer(str_len + 1), stat=alloc_status)
+ if (alloc_status /= 0) then
+ device_num = omp_invalid_device
+ return
+ end if
+
+ if (str_len > 0) then
+ do i = 1, str_len
+ uid_buffer(i) = uid(i:i)
+ end do
+ end if
+ uid_buffer(str_len + 1) = c_null_char
+
+ uid_ptr = c_loc(uid_buffer(1))
+ device_num_c = __kmp_get_device_from_uid(uid_ptr)
+ device_num = int(device_num_c, kind=omp_integer_kind)
+
+ deallocate(uid_buffer)
+ end function omp_get_device_from_uid_impl
+
+ !end submodule kmp_ftn_support
+
+end module kmp_ftn_c_bindings
+
+ function omp_get_uid_from_device(device_num) result(uid)
+ use kmp_ftn_c_bindings
+ use omp_lib_kinds
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_int, c_char, c_size_t
+ implicit none
+ integer (kind=omp_integer_kind), intent(in) :: device_num
+ character (:), pointer :: uid
+ uid => omp_get_uid_from_device_impl(device_num)
+ end function omp_get_uid_from_device
+
+ function omp_get_device_from_uid(uid) result(device_num)
+ use kmp_ftn_c_bindings
+ use omp_lib_kinds
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_int, c_char
+ implicit none
+ character (kind=c_char,len=*), intent(in) :: uid
+ integer (kind=omp_integer_kind) :: device_num
+ device_num = omp_get_device_from_uid_impl(uid)
+ end function omp_get_device_from_uid
\ No newline at end of file
diff --git a/openmp/runtime/test/api/omp_device_uid.f b/openmp/runtime/test/api/omp_device_uid.f
new file mode 100644
index 0000000000000..de4bc7ad683ab
--- /dev/null
+++ b/openmp/runtime/test/api/omp_device_uid.f
@@ -0,0 +1,70 @@
+! RUN: %flang %flags %openmp_flags -fopenmp-version=60 %s -o %t
+! RUN: %t | FileCheck %s
+
+ program test_omp_device_uid_main
+ use, intrinsic :: iso_c_binding
+ implicit none
+ include 'omp_lib.h'
+
+ integer(kind=omp_integer_kind) :: num_devices, i, num_failed
+ logical :: success
+
+ num_devices = omp_get_num_devices()
+ num_failed = 0
+
+ ! Test all devices plus the initial device (num_devices)
+ do i = 0, num_devices
+ success = test_omp_device_uid(i)
+ if (.not. success) then
+ print '("FAIL for device ", I0)', i
+ num_failed = num_failed + 1
+ end if
+ end do
+
+ if (num_failed /= 0) then
+ print *, "FAIL"
+ stop 1
+ end if
+
+ print *, "PASS"
+ stop 0
+
+ contains
+
+ logical function test_omp_device_uid(device_num)
+ import
+ implicit none
+ integer(kind=omp_integer_kind), intent(in) :: device_num
+ character(:), pointer :: device_uid => null()
+ integer(kind=omp_integer_kind) :: device_num_from_uid
+
+ device_uid => omp_get_uid_from_device(device_num)
+
+ ! Check if device_uid is NULL
+ if (.not. associated(device_uid)) then
+ print '("FAIL for device ", I0,
+ . ": omp_get_uid_from_device returned NULL")', device_num
+ test_omp_device_uid = .false.
+ return
+ end if
+
+ device_num_from_uid = omp_get_device_from_uid(device_uid)
+ if (device_num_from_uid /= device_num) then
+ print '("FAIL for device ", I0,
+ . ": omp_get_device_from_uid returned ", I0)',
+ . device_num, device_num_from_uid
+ test_omp_device_uid = .false.
+ return
+ end if
+
+ test_omp_device_uid = .true.
+
+ if (associated(device_uid)) then
+ deallocate(device_uid)
+ nullify(device_uid)
+ end if
+ end function test_omp_device_uid
+
+ end program test_omp_device_uid_main
+
+ ! CHECK: PASS
diff --git a/openmp/runtime/test/api/omp_device_uid.f90 b/openmp/runtime/test/api/omp_device_uid.f90
new file mode 100644
index 0000000000000..2e2c7c795b337
--- /dev/null
+++ b/openmp/runtime/test/api/omp_device_uid.f90
@@ -0,0 +1,69 @@
+! RUN: %flang %flags %openmp_flags -fopenmp-version=60 %s -o %t
+! RUN: %t | FileCheck %s
+
+program test_omp_device_uid_main
+ use omp_lib
+ use, intrinsic :: iso_c_binding
+ implicit none
+
+ integer(kind=omp_integer_kind) :: num_devices, i, num_failed
+ logical :: success
+
+ num_devices = omp_get_num_devices()
+ num_failed = 0
+
+ ! Test all devices plus the initial device (num_devices)
+ do i = 0, num_devices
+ success = test_omp_device_uid(i)
+ if (.not. success) then
+ print '("FAIL for device ", I0)', i
+ num_failed = num_failed + 1
+ end if
+ end do
+
+ if (num_failed /= 0) then
+ print *, "FAIL"
+ stop 1
+ end if
+
+ print *, "PASS"
+ stop 0
+
+contains
+
+ logical function test_omp_device_uid(device_num)
+ use omp_lib
+ use, intrinsic :: iso_c_binding
+ implicit none
+ integer(kind=omp_integer_kind), intent(in) :: device_num
+ character(:), pointer :: device_uid => null()
+ integer(kind=omp_integer_kind) :: device_num_from_uid
+
+ device_uid => omp_get_uid_from_device(device_num)
+
+ ! Check if device_uid is NULL
+ if (.not. associated(device_uid)) then
+ print '("FAIL for device ", I0, ": omp_get_uid_from_device returned NULL")', device_num
+ test_omp_device_uid = .false.
+ return
+ end if
+
+ device_num_from_uid = omp_get_device_from_uid(device_uid)
+ if (device_num_from_uid /= device_num) then
+ print '("FAIL for device ", I0, ": omp_get_device_from_uid returned ", I0)', &
+ device_num, device_num_from_uid
+ test_omp_device_uid = .false.
+ return
+ end if
+
+ test_omp_device_uid = .true.
+
+ if (associated(device_uid)) then
+ deallocate(device_uid)
+ nullify(device_uid)
+ end if
+ end function test_omp_device_uid
+
+end program test_omp_device_uid_main
+
+! CHECK: PASS
diff --git a/openmp/runtime/test/lit.cfg b/openmp/runtime/test/lit.cfg
index 72da1ba1411f8..3e8acae55e749 100644
--- a/openmp/runtime/test/lit.cfg
+++ b/openmp/runtime/test/lit.cfg
@@ -43,7 +43,7 @@ config.suffixes = ['.c', '.cpp']
if config.test_fortran_compiler:
lit_config.note("OpenMP Fortran tests enabled")
- config.suffixes += ['.f90', '.F90']
+ config.suffixes += ['.f90', '.F90', '.f', '.F']
llvm_config.add_tool_substitutions([
ToolSubst(
"%flang",
More information about the Openmp-commits
mailing list