From 6572a68467c6dfccb168ef45e5e44dc77200a3b0 Mon Sep 17 00:00:00 2001 From: Robert Imschweiler 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 | 50 ++++++++ openmp/runtime/src/kmp_ftn_entry.h | 31 ----- openmp/runtime/src/kmp_ftn_extra.cpp | 50 ++++++++ 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, 449 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: /lib/clang//lib//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..8cf2974cc69fb 100644 --- a/openmp/runtime/src/kmp_ftn_cdecl.cpp +++ b/openmp/runtime/src/kmp_ftn_cdecl.cpp @@ -29,6 +29,56 @@ 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..24b53623a1540 100644 --- a/openmp/runtime/src/kmp_ftn_extra.cpp +++ b/openmp/runtime/src/kmp_ftn_extra.cpp @@ -27,6 +27,56 @@ 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",