libgomp: Add interop types and routines to OpenMP's headers and module
This commit adds OpenMP 5.1+'s interop enumeration, type and routine
declarations to the C/C++ header file and, new in OpenMP TR13, also to
the Fortran module and omp_lib.h header file.
While a stub implementation is provided, only with foreign runtime
support by the libgomp GPU plugins and with the 'interop' directive,
this becomes really useful.
libgomp/ChangeLog:
* fortran.c (omp_get_interop_str_, omp_get_interop_name_,
omp_get_interop_type_desc_, omp_get_interop_rc_desc_): Add.
* libgomp.map (GOMP_5.1.3): New; add interop routines.
* omp.h.in: Add interop typedefs, enum and prototypes.
* omp_lib.f90.in: Add paramters and interfaces for interop.
* omp_lib.h.in: Likewise; move F90 '&' to column 81 for
-ffree-length-80.
* target.c (omp_get_num_interop_properties, omp_get_interop_int,
omp_get_interop_ptr, omp_get_interop_str, omp_get_interop_name,
omp_get_interop_type_desc, omp_get_interop_rc_desc): Add.
* testsuite/libgomp.c/interop-routines-1.c: New test.
* testsuite/libgomp.fortran/interop-routines-1.F90: New test.
* testsuite/libgomp.fortran/interop-routines-2.F90: New test.
* testsuite/libgomp.fortran/interop-routines-3.F: New test.
* testsuite/libgomp.fortran/interop-routines-4.F: New test.
* testsuite/libgomp.fortran/interop-routines-5.F: New test.
* testsuite/libgomp.fortran/interop-routines-6.F: New test.
libgomp/fortran.c | 41 ++++
libgomp/libgomp.map | 15 ++
libgomp/omp.h.in | 69 ++++++
libgomp/omp_lib.f90.in | 99 +++++++++
libgomp/omp_lib.h.in | 167 ++++++++++++--
libgomp/target.c | 91 ++++++++
libgomp/testsuite/libgomp.c/interop-routines-1.c | 246 +++++++++++++++++++++
.../libgomp.fortran/interop-routines-1.F90 | 222 +++++++++++++++++++
.../libgomp.fortran/interop-routines-2.F90 | 3 +
.../testsuite/libgomp.fortran/interop-routines-3.F | 2 +
.../testsuite/libgomp.fortran/interop-routines-4.F | 4 +
.../testsuite/libgomp.fortran/interop-routines-5.F | 4 +
.../testsuite/libgomp.fortran/interop-routines-6.F | 4 +
13 files changed, 945 insertions(+), 22 deletions(-)
@@ -102,6 +102,10 @@ ialias_redirect (omp_set_default_allocator)
ialias_redirect (omp_get_default_allocator)
ialias_redirect (omp_display_env)
ialias_redirect (omp_fulfill_event)
+ialias_redirect (omp_get_interop_str)
+ialias_redirect (omp_get_interop_name)
+ialias_redirect (omp_get_interop_type_desc)
+ialias_redirect (omp_get_interop_rc_desc)
#endif
#ifndef LIBGOMP_GNU_SYMBOL_VERSIONING
@@ -807,4 +811,41 @@ omp_display_env_8_ (const int64_t *verbose)
omp_display_env (!!*verbose);
}
+void
+omp_get_interop_str_ (const char **res, size_t *res_len,
+ const omp_interop_t interop,
+ omp_interop_property_t property_id,
+ omp_interop_rc_t *ret_code)
+{
+ *res = omp_get_interop_str (interop, property_id, ret_code);
+ *res_len = *res ? strlen (*res) : 0;
+}
+
+void
+omp_get_interop_name_ (const char **res, size_t *res_len,
+ const omp_interop_t interop,
+ omp_interop_property_t property_id)
+{
+ *res = omp_get_interop_name (interop, property_id);
+ *res_len = *res ? strlen (*res) : 0;
+}
+
+void
+omp_get_interop_type_desc_ (const char **res, size_t *res_len,
+ const omp_interop_t interop,
+ omp_interop_property_t property_id)
+{
+ *res = omp_get_interop_type_desc (interop, property_id);
+ *res_len = *res ? strlen (*res) : 0;
+}
+
+void
+omp_get_interop_rc_desc_ (const char **res, size_t *res_len,
+ const omp_interop_t interop,
+ omp_interop_rc_t ret_code)
+{
+ *res = omp_get_interop_rc_desc (interop, ret_code);
+ *res_len = *res ? strlen (*res) : 0;
+}
+
#endif /* LIBGOMP_OFFLOADED_ONLY */
@@ -428,6 +428,21 @@ GOMP_5.1.2 {
GOMP_target_map_indirect_ptr;
} GOMP_5.1.1;
+GOMP_5.1.3 {
+ global:
+ omp_get_num_interop_properties;
+ omp_get_interop_int;
+ omp_get_interop_ptr;
+ omp_get_interop_str;
+ omp_get_interop_name;
+ omp_get_interop_type_desc;
+ omp_get_interop_rc_desc;
+ omp_get_interop_str_;
+ omp_get_interop_name_;
+ omp_get_interop_type_desc_;
+ omp_get_interop_rc_desc_;
+} GOMP_5.1.2;
+
OACC_2.0 {
global:
acc_get_num_devices;
@@ -105,6 +105,7 @@ typedef enum omp_pause_resource_t
omp_pause_hard = 2
} omp_pause_resource_t;
+typedef __INTPTR_TYPE__ omp_intptr_t;
typedef __UINTPTR_TYPE__ omp_uintptr_t;
#if __cplusplus >= 201103L
@@ -191,6 +192,51 @@ enum
omp_invalid_device = -4
};
+typedef enum omp_interop_t __GOMP_UINTPTR_T_ENUM
+{
+ omp_interop_none = 0,
+ __omp_interop_t_max__ = __UINTPTR_MAX__
+} omp_interop_t;
+
+typedef enum omp_interop_fr_t
+{
+ omp_ifr_cuda = 1,
+ omp_ifr_cuda_driver = 2,
+ omp_ifr_opencl = 3,
+ omp_ifr_sycl = 4,
+ omp_ifr_hip = 5,
+ omp_ifr_level_zero = 6,
+ omp_ifr_hsa = 7,
+ omp_ifr_last = omp_ifr_hsa
+} omp_interop_fr_t;
+
+typedef enum omp_interop_property_t
+{
+ omp_ipr_fr_id = -1,
+ omp_ipr_fr_name = -2,
+ omp_ipr_vendor = -3,
+ omp_ipr_vendor_name = -4,
+ omp_ipr_device_num = -5,
+ omp_ipr_platform = -6,
+ omp_ipr_device = -7,
+ omp_ipr_device_context = -8,
+ omp_ipr_targetsync = -9,
+ omp_ipr_first = -9
+} omp_interop_property_t;
+
+
+typedef enum omp_interop_rc_t
+{
+ omp_irc_no_value = 1,
+ omp_irc_success = 0,
+ omp_irc_empty = -1,
+ omp_irc_out_of_range = -2,
+ omp_irc_type_int = -3,
+ omp_irc_type_ptr = -4,
+ omp_irc_type_str = -5,
+ omp_irc_other = -6
+} omp_interop_rc_t;
+
#ifdef __cplusplus
extern "C" {
# define __GOMP_NOTHROW throw ()
@@ -351,6 +397,29 @@ extern void *omp_realloc (void *, __SIZE_TYPE__,
extern void omp_display_env (int) __GOMP_NOTHROW;
+extern int omp_get_num_interop_properties (const omp_interop_t) __GOMP_NOTHROW;
+
+extern omp_intptr_t omp_get_interop_int (const omp_interop_t,
+ omp_interop_property_t,
+ omp_interop_rc_t *) __GOMP_NOTHROW;
+
+extern void *omp_get_interop_ptr (const omp_interop_t, omp_interop_property_t,
+ omp_interop_rc_t *) __GOMP_NOTHROW;
+
+extern const char *omp_get_interop_str (const omp_interop_t,
+ omp_interop_property_t,
+ omp_interop_rc_t *) __GOMP_NOTHROW;
+
+extern const char *omp_get_interop_name (const omp_interop_t,
+ omp_interop_property_t) __GOMP_NOTHROW;
+
+extern const char *omp_get_interop_type_desc (const omp_interop_t,
+ omp_interop_property_t)
+ __GOMP_NOTHROW;
+
+extern const char *omp_get_interop_rc_desc (const omp_interop_t,
+ omp_interop_rc_t) __GOMP_NOTHROW;
+
#ifdef __cplusplus
}
#endif
@@ -40,6 +40,10 @@
integer, parameter :: omp_memspace_handle_kind = c_intptr_t
integer, parameter :: omp_depend_kind = @OMP_DEPEND_KIND@
integer, parameter :: omp_event_handle_kind = c_intptr_t
+ integer, parameter :: omp_interop_kind = c_intptr_t
+ integer, parameter :: omp_interop_fr_kind = c_int
+ integer, parameter :: omp_interop_property_kind = c_int
+ integer, parameter :: omp_interop_rc_kind = c_int
integer (omp_sched_kind), parameter :: omp_sched_static = 1
integer (omp_sched_kind), parameter :: omp_sched_dynamic = 2
integer (omp_sched_kind), parameter :: omp_sched_guided = 3
@@ -172,6 +176,40 @@
parameter :: omp_low_lat_mem_space = 4
integer, parameter :: omp_initial_device = -1
integer, parameter :: omp_invalid_device = -4
+ integer (omp_interop_kind), &
+ parameter :: omp_interop_none = 0_omp_interop_kind
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_cuda = 1
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_cuda_driver = 2
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_opencl = 3
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_sycl = 4
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_hip = 5
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_level_zero = 6
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_hsa = 7
+ integer (omp_interop_fr_kind), &
+ parameter :: omp_ifr_last = omp_ifr_hsa
+ integer (omp_interop_property_kind), parameter :: omp_ipr_fr_id = -1
+ integer (omp_interop_property_kind), parameter :: omp_ipr_fr_name = -2
+ integer (omp_interop_property_kind), parameter :: omp_ipr_vendor = -3
+ integer (omp_interop_property_kind), &
+ parameter :: omp_ipr_vendor_name = -4
+ integer (omp_interop_property_kind), &
+ parameter :: omp_ipr_device_num = -5
+ integer (omp_interop_property_kind), parameter :: omp_ipr_platform = -6
+ integer (omp_interop_property_kind), parameter :: omp_ipr_device = -7
+ integer (omp_interop_property_kind), &
+ parameter :: omp_ipr_device_context = -8
+ integer (omp_interop_property_kind), &
+ parameter :: omp_ipr_targetsync = -9
+ integer (omp_interop_property_kind), &
+ parameter :: omp_ipr_first = omp_ipr_targetsync
+ integer (omp_interop_rc_kind), parameter :: omp_irc_no_value = 1
+ integer (omp_interop_rc_kind), parameter :: omp_irc_success = 0
+ integer (omp_interop_rc_kind), parameter :: omp_irc_empty = -1
+ integer (omp_interop_rc_kind), parameter :: omp_irc_out_of_range = -2
+ integer (omp_interop_rc_kind), parameter :: omp_irc_type_int = -3
+ integer (omp_interop_rc_kind), parameter :: omp_irc_type_ptr = -4
+ integer (omp_interop_rc_kind), parameter :: omp_irc_type_str = -5
+ integer (omp_interop_rc_kind), parameter :: omp_irc_other = -6
type omp_alloctrait
integer (kind=omp_alloctrait_key_kind) key
@@ -904,6 +942,67 @@
end function omp_target_is_accessible
end interface
+ ! Interop functions: Note that the interface is not identical to the
+ ! OpenMP specification (c_int + VALUE + BIND(C) added) but usage
+ ! compatible; the following declarations permit to directly call the C
+ ! library function, except for the four string-returning functions.
+ interface
+ integer (c_int) function omp_get_num_interop_properties (interop) &
+ bind(C)
+ use, intrinsic :: iso_c_binding, only: c_int
+ use omp_lib_kinds
+ integer (omp_interop_kind), intent(in), value :: interop
+ end function omp_get_num_interop_properties
+
+ integer (c_intptr_t) function omp_get_interop_int (interop, &
+ property_id, ret_code) bind(C)
+ use, intrinsic :: iso_c_binding, only : c_intptr_t
+ use omp_lib_kinds
+ integer (omp_interop_kind), intent(in), value :: interop
+ integer (omp_interop_property_kind), value :: property_id
+ integer (omp_interop_rc_kind), intent(out) :: ret_code
+ end function omp_get_interop_int
+
+ type (c_ptr) function omp_get_interop_ptr (interop, property_id, &
+ ret_code) bind(C)
+ use, intrinsic :: iso_c_binding, only : c_ptr
+ use omp_lib_kinds
+ integer (omp_interop_kind), intent(in), value :: interop
+ integer (omp_interop_property_kind), value :: property_id
+ integer (omp_interop_rc_kind), intent(out) :: ret_code
+ end function omp_get_interop_ptr
+
+ character(:) function omp_get_interop_str (interop, property_id, &
+ ret_code)
+ use omp_lib_kinds
+ pointer :: omp_get_interop_str
+ integer (omp_interop_kind), intent(in), value :: interop
+ integer (omp_interop_property_kind), value :: property_id
+ integer (omp_interop_rc_kind), intent(out) :: ret_code
+ end function omp_get_interop_str
+
+ character(:) function omp_get_interop_name (interop, property_id)
+ use omp_lib_kinds
+ pointer :: omp_get_interop_name
+ integer (omp_interop_kind), intent(in), value :: interop
+ integer (omp_interop_property_kind), value :: property_id
+ end function omp_get_interop_name
+
+ character(:) function omp_get_interop_type_desc (interop, property_id)
+ use omp_lib_kinds
+ pointer :: omp_get_interop_type_desc
+ integer (omp_interop_kind), intent(in), value :: interop
+ integer (omp_interop_property_kind), value :: property_id
+ end function omp_get_interop_type_desc
+
+ character(:) function omp_get_interop_rc_desc (interop, ret_code)
+ use omp_lib_kinds
+ pointer :: omp_get_interop_rc_desc
+ integer (omp_interop_kind), intent(in), value :: interop
+ integer (omp_interop_rc_kind), value :: ret_code
+ end function omp_get_interop_rc_desc
+ end interface
+
#if _OPENMP >= 201811
!GCC$ ATTRIBUTES DEPRECATED :: omp_get_nested, omp_set_nested
!GCC$ ATTRIBUTES DEPRECATED :: omp_lock_hint_kind, omp_lock_hint_none
@@ -85,11 +85,17 @@
integer omp_allocator_handle_kind, omp_alloctrait_key_kind
integer omp_alloctrait_val_kind, omp_memspace_handle_kind
integer omp_event_handle_kind
+ integer omp_interop_kind, omp_interop_fr_kind
+ integer omp_interop_property_kind, omp_interop_rc_kind
parameter (omp_allocator_handle_kind = @INTPTR_T_KIND@)
parameter (omp_alloctrait_key_kind = 4)
parameter (omp_alloctrait_val_kind = @INTPTR_T_KIND@)
parameter (omp_memspace_handle_kind = @INTPTR_T_KIND@)
parameter (omp_event_handle_kind = @INTPTR_T_KIND@)
+ parameter (omp_interop_kind = @INTPTR_T_KIND@)
+ parameter (omp_interop_fr_kind = 4)
+ parameter (omp_interop_property_kind = 4)
+ parameter (omp_interop_rc_kind = 4)
integer (omp_alloctrait_key_kind) omp_atk_sync_hint
integer (omp_alloctrait_key_kind) omp_atk_alignment
integer (omp_alloctrait_key_kind) omp_atk_access
@@ -179,6 +185,60 @@
integer omp_initial_device, omp_invalid_device
parameter (omp_initial_device = -1)
parameter (omp_invalid_device = -4)
+ integer (omp_interop_kind) omp_interop_none
+ parameter (omp_interop_none = 0_omp_interop_kind)
+ integer (omp_interop_fr_kind) omp_ifr_cuda
+ integer (omp_interop_fr_kind) omp_ifr_cuda_driver
+ integer (omp_interop_fr_kind) omp_ifr_opencl
+ integer (omp_interop_fr_kind) omp_ifr_sycl
+ integer (omp_interop_fr_kind) omp_ifr_hip
+ integer (omp_interop_fr_kind) omp_ifr_level_zero
+ integer (omp_interop_fr_kind) omp_ifr_hsa
+ integer (omp_interop_fr_kind) omp_ifr_last
+ parameter (omp_ifr_cuda = 1)
+ parameter (omp_ifr_cuda_driver = 2)
+ parameter (omp_ifr_opencl = 3)
+ parameter (omp_ifr_sycl = 4)
+ parameter (omp_ifr_hip = 5)
+ parameter (omp_ifr_level_zero = 6)
+ parameter (omp_ifr_hsa = 7)
+ parameter (omp_ifr_last = omp_ifr_hsa)
+ integer (omp_interop_property_kind) omp_ipr_fr_id
+ integer (omp_interop_property_kind) omp_ipr_fr_name
+ integer (omp_interop_property_kind) omp_ipr_vendor
+ integer (omp_interop_property_kind) omp_ipr_vendor_name
+ integer (omp_interop_property_kind) omp_ipr_device_num
+ integer (omp_interop_property_kind) omp_ipr_platform
+ integer (omp_interop_property_kind) omp_ipr_device
+ integer (omp_interop_property_kind) omp_ipr_device_context
+ integer (omp_interop_property_kind) omp_ipr_targetsync
+ integer (omp_interop_property_kind) omp_ipr_first
+ parameter (omp_ipr_fr_id = -1)
+ parameter (omp_ipr_fr_name = -2)
+ parameter (omp_ipr_vendor = -3)
+ parameter (omp_ipr_vendor_name = -4)
+ parameter (omp_ipr_device_num = -5)
+ parameter (omp_ipr_platform = -6)
+ parameter (omp_ipr_device = -7)
+ parameter (omp_ipr_device_context = -8)
+ parameter (omp_ipr_targetsync = -9)
+ parameter (omp_ipr_first = omp_ipr_targetsync)
+ integer (omp_interop_rc_kind) omp_irc_no_value
+ integer (omp_interop_rc_kind) omp_irc_success
+ integer (omp_interop_rc_kind) omp_irc_empty
+ integer (omp_interop_rc_kind) omp_irc_out_of_range
+ integer (omp_interop_rc_kind) omp_irc_type_int
+ integer (omp_interop_rc_kind) omp_irc_type_ptr
+ integer (omp_interop_rc_kind) omp_irc_type_str
+ integer (omp_interop_rc_kind) omp_irc_other
+ parameter (omp_irc_no_value = 1)
+ parameter (omp_irc_success = 0)
+ parameter (omp_irc_empty = -1)
+ parameter (omp_irc_out_of_range = -2)
+ parameter (omp_irc_type_int = -3)
+ parameter (omp_irc_type_ptr = -4)
+ parameter (omp_irc_type_str = -5)
+ parameter (omp_irc_other = -6)
type omp_alloctrait
integer (omp_alloctrait_key_kind) key
@@ -323,7 +383,7 @@
end interface
interface
- function omp_aligned_calloc (alignment, nmemb, size, allocator) &
+ function omp_aligned_calloc (alignment, nmemb, size, allocator) &
& bind(c)
use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
use, intrinsic :: omp_lib_kinds
@@ -334,7 +394,7 @@
end interface
interface
- function omp_realloc (ptr, size, allocator, free_allocator) &
+ function omp_realloc (ptr, size, allocator, free_allocator) &
& bind(c)
use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
use, intrinsic :: omp_lib_kinds
@@ -373,8 +433,8 @@
end interface
interface
- function omp_target_memcpy (dst, src, length, dst_offset, &
- & src_offset, dst_device_num, &
+ function omp_target_memcpy (dst, src, length, dst_offset, &
+ & src_offset, dst_device_num, &
& src_device_num) bind(c)
use, intrinsic :: iso_c_binding, only : c_ptr, c_int, c_size_t
integer(c_int) :: omp_target_memcpy
@@ -385,9 +445,9 @@
end interface
interface
- function omp_target_memcpy_async (dst, src, length, dst_offset, &
- & src_offset, dst_device_num, &
- & src_device_num, depobj_count, &
+ function omp_target_memcpy_async (dst, src, length, dst_offset, &
+ & src_offset, dst_device_num, &
+ & src_device_num, depobj_count, &
& depobj_list) bind(c)
use, intrinsic :: iso_c_binding, only : c_ptr, c_int, c_size_t
import :: omp_depend_kind
@@ -401,10 +461,10 @@
end interface
interface
- function omp_target_memcpy_rect (dst,src,element_size, num_dims, &
- & volume, dst_offsets, &
- & src_offsets, dst_dimensions, &
- & src_dimensions, dst_device_num, &
+ function omp_target_memcpy_rect (dst,src,element_size, num_dims, &
+ & volume, dst_offsets, &
+ & src_offsets, dst_dimensions, &
+ & src_dimensions, dst_device_num, &
& src_device_num) bind(c)
use, intrinsic :: iso_c_binding, only : c_ptr, c_int, c_size_t
integer(c_int) :: omp_target_memcpy_rect
@@ -420,14 +480,14 @@
end interface
interface
- function omp_target_memcpy_rect_async (dst,src,element_size, &
- & num_dims, volume, &
- & dst_offsets, src_offsets, &
- & dst_dimensions, &
- & src_dimensions, &
- & dst_device_num, &
- & src_device_num, &
- & depobj_count, &
+ function omp_target_memcpy_rect_async (dst,src,element_size, &
+ & num_dims, volume, &
+ & dst_offsets, src_offsets, &
+ & dst_dimensions, &
+ & src_dimensions, &
+ & dst_device_num, &
+ & src_device_num, &
+ & depobj_count, &
& depobj_list) bind(c)
use, intrinsic :: iso_c_binding, only : c_ptr, c_int, c_size_t
import :: omp_depend_kind
@@ -445,8 +505,8 @@
end interface
interface
- function omp_target_associate_ptr (host_ptr, device_ptr, size, &
- & device_offset, device_num) &
+ function omp_target_associate_ptr (host_ptr, device_ptr, size, &
+ & device_offset, device_num) &
& bind(c)
use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t, c_int
integer(c_int) :: omp_target_associate_ptr
@@ -475,7 +535,7 @@
end interface
interface
- function omp_target_is_accessible (ptr, size, device_num) &
+ function omp_target_is_accessible (ptr, size, device_num) &
& bind(c)
use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t, c_int
integer(c_int) :: omp_target_is_accessible
@@ -484,3 +544,66 @@
integer(c_int), value :: device_num
end function omp_target_is_accessible
end interface
+
+! Interop functions: Note that the interface is not identical to the
+! OpenMP specification (c_int + VALUE + BIND(C) added) but usage
+! compatible; the following declarations permit to directly call the C
+! library function, except for the four string-returning functions.
+ interface
+ integer (c_int) function omp_get_num_interop_properties(interop) &
+ & bind(C)
+ use, intrinsic :: iso_c_binding, only: c_int
+ use, intrinsic :: omp_lib_kinds
+ integer (omp_interop_kind), intent(in), value :: interop
+ end function omp_get_num_interop_properties
+
+ integer (c_intptr_t) function omp_get_interop_int (interop, &
+ & property_id, ret_code) bind(C)
+ use, intrinsic :: iso_c_binding, only : c_intptr_t
+ use, intrinsic :: omp_lib_kinds
+ integer (omp_interop_kind), intent(in), value :: interop
+ integer (omp_interop_property_kind), value :: property_id
+ integer (omp_interop_rc_kind), intent(out) :: ret_code
+ end function omp_get_interop_int
+
+ type (c_ptr) function omp_get_interop_ptr (interop, property_id, &
+ & ret_code) bind(C)
+ use, intrinsic :: iso_c_binding, only : c_ptr
+ use, intrinsic :: omp_lib_kinds
+ integer (omp_interop_kind), intent(in), value :: interop
+ integer (omp_interop_property_kind), value :: property_id
+ integer (omp_interop_rc_kind), intent(out) :: ret_code
+ end function omp_get_interop_ptr
+
+ character(:) function omp_get_interop_str (interop, property_id, &
+ & ret_code)
+ use, intrinsic :: omp_lib_kinds
+ pointer :: omp_get_interop_str
+ integer (omp_interop_kind), intent(in), value :: interop
+ integer (omp_interop_property_kind), value :: property_id
+ integer (omp_interop_rc_kind), intent(out) :: ret_code
+ end function omp_get_interop_str
+
+ character(:) function omp_get_interop_name(interop, property_id)
+ use, intrinsic :: omp_lib_kinds
+ pointer :: omp_get_interop_name
+ integer (omp_interop_kind), intent(in), value :: interop
+ integer (omp_interop_property_kind), value :: property_id
+ end function omp_get_interop_name
+
+ character(:) function omp_get_interop_type_desc (interop, &
+ & property_id)
+ use, intrinsic :: omp_lib_kinds
+ pointer :: omp_get_interop_type_desc
+ integer (omp_interop_kind), intent(in), value :: interop
+ integer (omp_interop_property_kind), value :: property_id
+ end function omp_get_interop_type_desc
+
+ character(:) function omp_get_interop_rc_desc (interop, &
+ & ret_code)
+ use, intrinsic :: omp_lib_kinds
+ pointer :: omp_get_interop_rc_desc
+ integer (omp_interop_kind), intent(in), value :: interop
+ integer (omp_interop_rc_kind), value :: ret_code
+ end function omp_get_interop_rc_desc
+ end interface
@@ -5113,6 +5113,97 @@ omp_pause_resource_all (omp_pause_resource_t kind)
ialias (omp_pause_resource)
ialias (omp_pause_resource_all)
+int
+omp_get_num_interop_properties (const omp_interop_t interop
+ __attribute__ ((unused)))
+{
+ /* Zero implementation defined. In total:
+ omp_get_num_interop_properties () - omp_ipr_first. */
+ return 0;
+}
+
+omp_intptr_t
+omp_get_interop_int (const omp_interop_t interop __attribute__ ((unused)),
+ omp_interop_property_t property_id,
+ omp_interop_rc_t *ret_code)
+{
+ if (property_id < omp_ipr_first || property_id >= 0)
+ *ret_code = omp_irc_out_of_range;
+ else
+ *ret_code = omp_irc_empty; /* Assume omp_interop_none. */
+ return 0;
+}
+
+void *
+omp_get_interop_ptr (const omp_interop_t interop __attribute__ ((unused)),
+ omp_interop_property_t property_id,
+ omp_interop_rc_t *ret_code)
+{
+ if (property_id < omp_ipr_first || property_id >= 0)
+ *ret_code = omp_irc_out_of_range;
+ else
+ *ret_code = omp_irc_empty; /* Assume omp_interop_none. */
+ return NULL;
+}
+
+const char *
+omp_get_interop_str (const omp_interop_t interop __attribute__ ((unused)),
+ omp_interop_property_t property_id,
+ omp_interop_rc_t *ret_code)
+{
+ if (property_id < omp_ipr_first || property_id >= 0)
+ *ret_code = omp_irc_out_of_range;
+ else
+ *ret_code = omp_irc_empty; /* Assume omp_interop_none. */
+ return NULL;
+}
+
+const char *
+omp_get_interop_name (const omp_interop_t interop __attribute__ ((unused)),
+ omp_interop_property_t property_id)
+{
+ static const char *prop_string[0 - omp_ipr_first]
+ = {"fr_id", "fr_name", "vendor", "vendor_name", "device_num", "platform",
+ "device", "device_context", "targetsync"};
+ if (property_id < omp_ipr_first || property_id >= 0)
+ return NULL;
+ return prop_string[omp_ipr_fr_id - property_id];
+}
+
+const char *
+omp_get_interop_type_desc (const omp_interop_t interop __attribute__ ((unused)),
+ omp_interop_property_t property_id
+ __attribute__ ((unused)))
+{
+ return NULL;
+}
+
+const char *
+omp_get_interop_rc_desc (const omp_interop_t interop __attribute__ ((unused)),
+ omp_interop_rc_t ret_code)
+{
+ static const char *rc_strings[omp_irc_no_value - omp_irc_other]
+ = {"no meaningful value available",
+ "successful",
+ "provided interoperability object is equal to omp_interop_none",
+ "property ID is out of range",
+ "property type is integer; use omp_get_interop_int",
+ "property type is pointer; use omp_get_interop_ptr",
+ "property type is string; use omp_get_interop_str"};
+ /* omp_irc_other or invalid value. */
+ if (ret_code > omp_irc_no_value || ret_code <= omp_irc_other)
+ return NULL;
+ return rc_strings[omp_irc_no_value - ret_code];
+}
+
+ialias (omp_get_num_interop_properties)
+ialias (omp_get_interop_int)
+ialias (omp_get_interop_ptr)
+ialias (omp_get_interop_str)
+ialias (omp_get_interop_name)
+ialias (omp_get_interop_type_desc)
+ialias (omp_get_interop_rc_desc)
+
#ifdef PLUGIN_SUPPORT
/* This function tries to load a plugin for DEVICE. Name of plugin is passed
new file mode 100644
@@ -0,0 +1,246 @@
+/* { dg-do run } */
+
+#include <assert.h>
+#include <stddef.h>
+#include <stdlib.h>
+#include <string.h>
+#include <omp.h>
+
+int
+main ()
+{
+ omp_interop_t interop = omp_interop_none;
+
+ assert (omp_irc_no_value == 1);
+ assert (omp_irc_success == 0);
+ assert (omp_irc_empty == -1);
+ assert (omp_irc_out_of_range == -2);
+ assert (omp_irc_type_int == -3);
+ assert (omp_irc_type_ptr == -4);
+ assert (omp_irc_type_str == -5);
+ assert (omp_irc_other == -6);
+
+ /* Check values, including invalid values. */
+ for (omp_interop_rc_t ret_code3 = omp_irc_other-1;
+ ret_code3 <= omp_irc_no_value + 1; ret_code3++)
+ {
+ const char *msg = omp_get_interop_rc_desc (interop, ret_code3);
+ if (ret_code3 < omp_irc_other || ret_code3 > omp_irc_no_value)
+ /* Assume NULL for an invalid value. */
+ assert (msg == NULL);
+ else if (ret_code3 == omp_irc_other)
+ /* Likely not to exist in an implementation; esp. not for
+ omp_interop_none. Thus, expect NULL. */
+ assert (msg == NULL);
+ else
+ /* Assume that omp_get_interop_rc_desc handles all of those and
+ not only omp_irc_empty (and possibly omp_irc_out_of_range),
+ which do occur for omp_interop_none. */
+ assert (msg != NULL && strlen (msg) > 5); /* Some sensible message. */
+ }
+
+ assert (omp_ifr_last >= omp_ifr_hsa);
+
+ for (omp_interop_fr_t fr = omp_ifr_cuda; fr <= omp_ifr_last; fr++)
+ {
+ switch (fr)
+ {
+ /* Expect the id values from the additional-definition document. */
+ case omp_ifr_cuda:
+ if (fr != 1)
+ abort ();
+ break;
+ case omp_ifr_cuda_driver:
+ if (fr != 2)
+ abort ();
+ break;
+ case omp_ifr_opencl:
+ if (fr != 3)
+ abort ();
+ break;
+ case omp_ifr_sycl:
+ if (fr != 4)
+ abort ();
+ break;
+ case omp_ifr_hip:
+ if (fr != 5)
+ abort ();
+ break;
+ case omp_ifr_level_zero:
+ if (fr != 6)
+ abort ();
+ break;
+ case omp_ifr_hsa:
+ if (fr != 7)
+ abort ();
+ break;
+ default:
+ /* Valid, but unexpected to have more interop types. */
+ abort ();
+ }
+ }
+
+ assert (omp_ipr_first <= omp_ipr_targetsync
+ && omp_get_num_interop_properties (interop) > omp_ipr_fr_id);
+
+ for (omp_interop_property_t ipr = omp_ipr_first;
+ ipr < omp_get_num_interop_properties (interop); ipr++)
+ {
+ /* As interop == omp_interop_none, NULL is permissible;
+ nonetheless, require != NULL for the GCC implementation. */
+ const char *name = omp_get_interop_name (interop, ipr);
+ if (name == NULL)
+ abort ();
+ switch (ipr)
+ {
+ case omp_ipr_fr_id:
+ if (ipr != -1 || !!strcmp (name, "fr_id"))
+ abort ();
+ break;
+ case omp_ipr_fr_name:
+ if (ipr != -2 || !!strcmp (name, "fr_name"))
+ abort ();
+ break;
+ case omp_ipr_vendor:
+ if (ipr != -3 || !!strcmp (name, "vendor"))
+ abort ();
+ break;
+ case omp_ipr_vendor_name:
+ if (ipr != -4 || !!strcmp (name, "vendor_name"))
+ abort ();
+ break;
+ case omp_ipr_device_num:
+ if (ipr != -5 || !!strcmp (name, "device_num"))
+ abort ();
+ break;
+ case omp_ipr_platform:
+ if (ipr != -6 || !!strcmp (name, "platform"))
+ abort ();
+ break;
+ case omp_ipr_device:
+ if (ipr != -7 || !!strcmp (name, "device"))
+ abort ();
+ break;
+ case omp_ipr_device_context:
+ if (ipr != -8 || !!strcmp (name, "device_context"))
+ abort ();
+ break;
+ case omp_ipr_targetsync:
+ if (ipr != -9 || !!strcmp (name, "targetsync"))
+ abort ();
+ break;
+ default:
+ /* Valid, but unexpected to have more interop types,
+ especially not for interop == omp_interop_none. */
+ abort ();
+ }
+
+ /* As interop == omp_interop_none, expect NULL. */
+ if (omp_get_interop_type_desc (interop, ipr) != NULL)
+ abort ();
+
+ omp_interop_rc_t ret_code;
+ const char *err;
+
+ ret_code = omp_irc_success;
+ omp_intptr_t ival = omp_get_interop_int (interop, ipr, &ret_code);
+ assert (ret_code == omp_irc_empty); /* As interop == omp_interop_none. */
+ assert (ival == 0); /* Implementation choice. */
+ err = omp_get_interop_rc_desc (interop, ret_code);
+ assert (err != NULL && strlen (err) > 5); /* Some sensible message. */
+ assert (!strcmp (err, "provided interoperability object is equal to "
+ "omp_interop_none")); /* GCC implementation choice. */
+
+ ret_code = omp_irc_success;
+ void *ptr = omp_get_interop_ptr (interop, ipr, &ret_code);
+ assert (ret_code == omp_irc_empty); /* As interop == omp_interop_none. */
+ assert (ptr == NULL); /* Obvious implementation choice. */
+ err = omp_get_interop_rc_desc (interop, ret_code);
+ assert (err != NULL && strlen (err) > 5); /* Some sensible message. */
+ assert (!strcmp (err, "provided interoperability object is equal to "
+ "omp_interop_none")); /* GCC implementation choice. */
+
+ ret_code = omp_irc_success;
+ const char *str = omp_get_interop_str (interop, ipr, &ret_code);
+ assert (ret_code == omp_irc_empty); /* As interop == omp_interop_none. */
+ assert (str == NULL); /* Obvious implementation choice. */
+ err = omp_get_interop_rc_desc (interop, ret_code);
+ assert (err != NULL && strlen (err) > 5); /* Some sensible message. */
+ assert (!strcmp (err, "provided interoperability object is equal to "
+ "omp_interop_none")); /* GCC implementation choice. */
+ }
+
+ /* Invalid ipr. */
+ /* Valid are either omp_irc_empty (due to omp_interop_none) or
+ omp_irc_out_of_range; assume omp_irc_out_of_range with GCC. */
+
+ omp_interop_rc_t ret_code2;
+ const char *err2;
+ omp_intptr_t ival2;
+ void *ptr2;
+ const char *str2;
+
+ /* omp_ipr_targetsync-1, i.e < lower bound. */
+
+ ret_code2 = omp_irc_success;
+ ival2 = omp_get_interop_int (interop, omp_ipr_targetsync-1, &ret_code2);
+ assert (ret_code2 == omp_irc_out_of_range);
+ assert (ival2 == 0); /* Implementation choice. */
+ err2 = omp_get_interop_rc_desc (interop, ret_code2);
+ assert (err2 != NULL && strlen (err2) > 5); /* Some sensible message. */
+ /* GCC implementation choice. */
+ assert (!strcmp (err2, "property ID is out of range"));
+
+ ret_code2 = omp_irc_success;
+ ptr2 = omp_get_interop_ptr (interop, omp_ipr_targetsync-1, &ret_code2);
+ assert (ret_code2 == omp_irc_out_of_range);
+ assert (ptr2 == NULL); /* Obvious implementation choice. */
+ err2 = omp_get_interop_rc_desc (interop, ret_code2);
+ assert (err2 != NULL && strlen (err2) > 5); /* Some sensible message. */
+ /* GCC implementation choice. */
+ assert (!strcmp (err2, "property ID is out of range"));
+
+ ret_code2 = omp_irc_success;
+ str2 = omp_get_interop_str (interop, omp_ipr_targetsync-1, &ret_code2);
+ assert (ret_code2 == omp_irc_out_of_range);
+ assert (str2 == NULL); /* Obvious implementation choice. */
+ err2 = omp_get_interop_rc_desc (interop, ret_code2);
+ assert (err2 != NULL && strlen (err2) > 5); /* Some sensible message. */
+ /* GCC implementation choice. */
+ assert (!strcmp (err2, "property ID is out of range"));
+
+ /* omp_get_num_interop_properties (), i.e > upper bound. */
+
+ ret_code2 = omp_irc_success;
+ ival2 = omp_get_interop_int (interop,
+ omp_get_num_interop_properties (interop),
+ &ret_code2);
+ assert (ret_code2 == omp_irc_out_of_range);
+ assert (ival2 == 0); /* Implementation choice. */
+ err2 = omp_get_interop_rc_desc (interop, ret_code2);
+ assert (err2 != NULL && strlen (err2) > 5); /* Some sensible message. */
+ /* GCC implementation choice. */
+ assert (!strcmp (err2, "property ID is out of range"));
+
+ ret_code2 = omp_irc_success;
+ ptr2 = omp_get_interop_ptr (interop, omp_get_num_interop_properties (interop),
+ &ret_code2);
+ assert (ret_code2 == omp_irc_out_of_range);
+ assert (ptr2 == NULL); /* Obvious implementation choice. */
+ err2 = omp_get_interop_rc_desc (interop, ret_code2);
+ assert (err2 != NULL && strlen (err2) > 5); /* Some sensible message. */
+ /* GCC implementation choice. */
+ assert (!strcmp (err2, "property ID is out of range"));
+
+ ret_code2 = omp_irc_success;
+ str2 = omp_get_interop_str (interop, omp_get_num_interop_properties (interop),
+ &ret_code2);
+ assert (ret_code2 == omp_irc_out_of_range);
+ assert (str2 == NULL); /* Obvious implementation choice. */
+ err2 = omp_get_interop_rc_desc (interop, ret_code2);
+ assert (err2 != NULL && strlen (err2) > 5); /* Some sensible message. */
+ /* GCC implementation choice. */
+ assert (!strcmp (err2, "property ID is out of range"));
+
+ return 0;
+}
new file mode 100644
@@ -0,0 +1,222 @@
+ program main
+ use iso_c_binding, only: c_intptr_t, c_ptr, c_associated
+#ifndef USE_OMP_HEADER
+ use omp_lib
+#endif
+ implicit none (type, external)
+
+#ifdef USE_OMP_HEADER
+ include "omp_lib.h"
+#endif
+
+ integer(omp_interop_kind) :: interop = omp_interop_none
+ integer(omp_interop_rc_kind) :: ret_code
+ integer(omp_interop_fr_kind) :: fr
+ integer(omp_interop_property_kind) :: ipr
+
+ integer(c_intptr_t) :: ival
+ type(c_ptr) :: ptr
+ character(len=:), pointer :: str
+
+ if (omp_irc_no_value /= 1) stop 1
+ if (omp_irc_success /= 0) stop 2
+ if (omp_irc_empty /= -1) stop 3
+ if (omp_irc_out_of_range /= -2) stop 4
+ if (omp_irc_type_int /= -3) stop 5
+ if (omp_irc_type_ptr /= -4) stop 6
+ if (omp_irc_type_str /= -5) stop 7
+ if (omp_irc_other /= -6) stop 8
+
+ ! Check values, including invalid values.
+ do ret_code = omp_irc_other - 1, omp_irc_no_value + 1
+ str => omp_get_interop_rc_desc (interop, ret_code)
+ if (ret_code < omp_irc_other &
+ & .or. ret_code > omp_irc_no_value) then
+ ! Assume disassociated for an invalid value.
+ if (associated (str)) stop 9
+ else if (ret_code == omp_irc_other) then
+ ! Likely not to exist in an implementation; esp. not for
+ ! omp_interop_none. Thus, assume disassociated.
+ if (associated (str)) stop 10
+ else
+ ! Assume that omp_get_interop_rc_desc handles all of those and
+ ! not only omp_irc_empty (and possibly omp_irc_out_of_range),
+ ! which do occur for omp_interop_none.
+ ! Assume some sensible message, i.e. at least 5 characters.
+ if (len_trim (str) <= 5) stop 11
+ end if
+ end do
+
+ if (omp_ifr_last < omp_ifr_hsa) stop 12
+
+ do fr = omp_ifr_cuda, omp_ifr_last
+ select case (fr)
+ ! Expect the id values from the additional-definition document.
+ case (omp_ifr_cuda)
+ if (fr /= 1) stop 13
+ case (omp_ifr_cuda_driver)
+ if (fr /= 2) stop 14
+ case (omp_ifr_opencl)
+ if (fr /= 3) stop 15
+ case (omp_ifr_sycl)
+ if (fr /= 4) stop 16
+ case (omp_ifr_hip)
+ if (fr /= 5) stop 17
+ case (omp_ifr_level_zero)
+ if (fr /= 6) stop 18
+ case (omp_ifr_hsa)
+ if (fr /= 7) stop 19
+ case default
+ ! Valid, but unexpected to have more interop types.
+ stop 20
+ end select
+ end do
+
+ if (omp_ipr_first > omp_ipr_targetsync &
+ & .or. (omp_ipr_fr_id &
+ & >= omp_get_num_interop_properties (interop))) &
+ & stop 21
+
+ do ipr = omp_ipr_first, &
+ & omp_get_num_interop_properties (interop) - 1
+ ! As interop == omp_interop_none, NULL is permissible;
+ ! nonetheless, require != NULL for the GCC implementation.
+ str => omp_get_interop_name (interop, ipr)
+ select case (ipr)
+ case (omp_ipr_fr_id)
+ if (ipr /= -1 .or. str /= "fr_id") &
+ & stop 21
+ case (omp_ipr_fr_name)
+ if (ipr /= -2 .or. str /= "fr_name") &
+ & stop 22
+ case (omp_ipr_vendor)
+ if (ipr /= -3 .or. str /= "vendor") &
+ & stop 23
+ case (omp_ipr_vendor_name)
+ if (ipr /= -4 .or. str /= "vendor_name") &
+ & stop 24
+ case (omp_ipr_device_num)
+ if (ipr /= -5 .or. str /= "device_num") &
+ & stop 25
+ case (omp_ipr_platform)
+ if (ipr /= -6 .or. str /= "platform") &
+ & stop 26
+ case (omp_ipr_device)
+ if (ipr /= -7 .or. str /= "device") &
+ & stop 27
+ case (omp_ipr_device_context)
+ if (ipr /= -8 .or. str /= "device_context") &
+ & stop 28
+ case (omp_ipr_targetsync)
+ if (ipr /= -9 .or. str /= "targetsync") &
+ & stop 29
+ case default
+ ! Valid, but unexpected to have more interop types,
+ ! especially not for interop == omp_interop_none.
+ stop 30
+ end select
+
+ ! As interop == omp_interop_none, expect NULL.
+ if (associated (omp_get_interop_type_desc (interop, ipr))) &
+ & stop 31
+
+ ret_code = omp_irc_success
+ ival = omp_get_interop_int (interop, ipr, ret_code)
+ if (ret_code /= omp_irc_empty) stop 32
+ if (ival /= 0) stop 33 ! Implementation choice
+ str => omp_get_interop_rc_desc (interop, ret_code)
+ if (len_trim (str) <= 5) stop 34
+ if (str /= "provided interoperability object is equal to " &
+ & // "omp_interop_none") &
+ & stop 35 ! GCC implementation choice.
+
+ ret_code = omp_irc_success
+ ptr = omp_get_interop_ptr (interop, ipr, ret_code)
+ if (ret_code /= omp_irc_empty) stop 36
+ if (c_associated (ptr)) stop 37 ! Obvious implementation choice.
+ str => omp_get_interop_rc_desc (interop, ret_code)
+ if (len_trim (str) <= 5) stop 38
+ if (str /= "provided interoperability object is equal to " &
+ & // "omp_interop_none") &
+ & stop 39 ! GCC implementation choice.
+
+ ret_code = omp_irc_success
+ str => omp_get_interop_str (interop, ipr, ret_code)
+ if (ret_code /= omp_irc_empty) stop 40
+ if (associated (str)) stop 41 ! Obvious mplementation choice
+ str => omp_get_interop_rc_desc (interop, ret_code)
+ if (len_trim (str) <= 5) stop 42
+ if (str /= "provided interoperability object is equal to " &
+ & // "omp_interop_none") &
+ & stop 43 ! GCC implementation choice.
+ end do
+
+ ! Invalid ipr.
+ ! Valid are either omp_irc_empty (due to omp_interop_none) or
+ ! omp_irc_out_of_range; assume omp_irc_out_of_range with GCC.
+
+ ! omp_ipr_targetsync-1, i.e < lower bound.
+
+ ret_code = omp_irc_success
+ ival = omp_get_interop_int (interop, omp_ipr_targetsync-1, &
+ & ret_code)
+ if (ret_code /= omp_irc_out_of_range) stop 44
+ if (ival /= 0) stop 45 ! Implementation choice.
+ str => omp_get_interop_rc_desc (interop, ret_code)
+ if (len_trim (str) <= 5) stop 46
+ ! GCC implementation choice.
+ if (str /= "property ID is out of range") stop 47
+
+ ret_code = omp_irc_success
+ ptr = omp_get_interop_ptr (interop, omp_ipr_targetsync-1, &
+ & ret_code)
+ if (ret_code /= omp_irc_out_of_range) stop 48
+ if (c_associated (ptr)) stop 49 ! Obvious implementation choice.
+ str => omp_get_interop_rc_desc (interop, ret_code)
+ if (len_trim (str) <= 5) stop 50
+ ! GCC implementation choice.
+ if (str /= "property ID is out of range") stop 51
+
+ ret_code = omp_irc_success
+ str => omp_get_interop_str (interop, omp_ipr_targetsync-1, &
+ & ret_code)
+ if (ret_code /= omp_irc_out_of_range) stop 52
+ if (associated (str)) stop 53 ! Obvious implementation choice.
+ str => omp_get_interop_rc_desc (interop, ret_code)
+ if (len_trim (str) <= 5) stop 54
+ ! GCC implementation choice.
+ if (str /= "property ID is out of range") stop 55
+
+ ! omp_get_num_interop_properties (), i.e > upper bound.
+
+ ret_code = omp_irc_success
+ ival = omp_get_interop_int (interop, &
+ & omp_get_num_interop_properties (interop), &
+ & ret_code)
+ if (ret_code /= omp_irc_out_of_range) stop 56
+ if (ival /= 0) stop 57 ! Implementation choice.
+ str => omp_get_interop_rc_desc (interop, ret_code)
+ if (len_trim (str) <= 5) stop 58
+ ! GCC implementation choice.
+ if (str /= "property ID is out of range") stop 59
+
+ ret_code = omp_irc_success
+ ptr = omp_get_interop_ptr (interop, &
+ & omp_get_num_interop_properties (interop), ret_code)
+ if (ret_code /= omp_irc_out_of_range) stop 60
+ if (c_associated (ptr)) stop 61 ! Obvious implementation choice.
+ str => omp_get_interop_rc_desc (interop, ret_code)
+ if (len_trim (str) <= 5) stop 62
+ ! GCC implementation choice.
+ if (str /= "property ID is out of range") stop 63
+
+ ret_code = omp_irc_success
+ str => omp_get_interop_str (interop, &
+ & omp_get_num_interop_properties (interop), ret_code)
+ if (ret_code /= omp_irc_out_of_range) stop 64
+ if (associated (str)) stop 65 ! Obvious implementation choice.
+ str => omp_get_interop_rc_desc (interop, ret_code)
+ if (len_trim (str) <= 5) stop 66
+ ! GCC implementation choice.
+ if (str /= "property ID is out of range") stop 67
+ end
new file mode 100644
@@ -0,0 +1,3 @@
+! { dg-additional-options "-DUSE_OMP_HEADER=1" }
+
+#include "interop-routines-1.F90"
new file mode 100644
@@ -0,0 +1,2 @@
+! Use fixed form
+#include "interop-routines-1.F90"
new file mode 100644
@@ -0,0 +1,4 @@
+! { dg-additional-options "-DUSE_OMP_HEADER=1" }
+! Use fixed form
+
+#include "interop-routines-1.F90"
new file mode 100644
@@ -0,0 +1,4 @@
+! { dg-additional-options "-ffixed-line-length-80" }
+! Use fixed form - but with 80 columns instead of 72
+
+#include "interop-routines-1.F90"
new file mode 100644
@@ -0,0 +1,4 @@
+! { dg-additional-options "-DUSE_OMP_HEADER=1 -ffixed-line-length-80" }
+! Use fixed form - but with 80 columns instead of 72
+
+#include "interop-routines-1.F90"