From a89bc91e73bb3f488521e070cc36ae31d1bffb8b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 7 Mar 2025 11:45:48 +0100 Subject: [PATCH 1/5] add `null_device` --- src/stdlib_system.F90 | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 576f72273..757ae7c25 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -81,6 +81,23 @@ module stdlib_system public :: elapsed public :: is_windows +!! version: experimental +!! +!! Returns the file path of the null device, which discards all data written to it. +!! ([Specification](../page/specs/stdlib_system.html#null_device-return-the-null-device-file-path)) +!! +!! ### Summary +!! Function that provides the file path of the null device appropriate for the current operating system. +!! +!! ### Description +!! +!! The null device is a special file that discards all data written to it and always reads as +!! an empty file. This function returns the null device path, adapted for the operating system in use. +!! +!! On Windows, this is `NUL`. On UNIX-like systems, this is `/dev/null`. +!! +public :: null_device + ! CPU clock ticks storage integer, parameter, private :: TICKS = int64 integer, parameter, private :: RTICKS = dp @@ -618,4 +635,17 @@ pure function OS_NAME(os) end select end function OS_NAME +!> Return the file path of the null device for the current operating system. +function null_device() result(path) + !> File path of the null device + character(:), allocatable :: path + + if (OS_TYPE()==OS_WINDOWS) then + path = 'NUL' + else + path = '/dev/null' + end if + +end function null_device + end module stdlib_system From 103cf9b79f7529090a913b8f9909da5aa2ecbc8e Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 7 Mar 2025 11:53:10 +0100 Subject: [PATCH 2/5] add test --- test/system/test_os.f90 | 25 +++++++++++++++++++++++-- 1 file changed, 23 insertions(+), 2 deletions(-) diff --git a/test/system/test_os.f90 b/test/system/test_os.f90 index 836ea9893..1607b7ec1 100644 --- a/test/system/test_os.f90 +++ b/test/system/test_os.f90 @@ -1,6 +1,6 @@ module test_os use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test - use stdlib_system, only: get_runtime_os, OS_WINDOWS, OS_UNKNOWN, OS_TYPE, is_windows + use stdlib_system, only: get_runtime_os, OS_WINDOWS, OS_UNKNOWN, OS_TYPE, is_windows, null_device implicit none @@ -13,7 +13,8 @@ subroutine collect_suite(testsuite) testsuite = [ & new_unittest('test_get_runtime_os', test_get_runtime_os), & - new_unittest('test_is_windows', test_is_windows) & + new_unittest('test_is_windows', test_is_windows), & + new_unittest('test_null_device', test_null_device) & ] end subroutine collect_suite @@ -38,6 +39,26 @@ subroutine test_is_windows(error) end subroutine test_is_windows + !> Test that the null_device is valid by writing something to it + subroutine test_null_device(error) + type(error_type), allocatable, intent(out) :: error + integer :: unit, ios + character(len=512) :: iomsg + + ! Try opening the null device for writing + open(newunit=unit, file=null_device(), status='old', action='write', iostat=ios, iomsg=iomsg) + call check(error, ios==0, 'Cannot open null_device unit: '//trim(iomsg)) + if (allocated(error)) return + + write(unit, *, iostat=ios, iomsg=iomsg) 'Hello, World!' + call check(error, ios==0, 'Cannot write to null_device unit: '//trim(iomsg)) + if (allocated(error)) return + + close(unit, iostat=ios, iomsg=iomsg) + call check(error, ios==0, 'Cannot close null_device unit: '//trim(iomsg)) + if (allocated(error)) return + + end subroutine test_null_device end module test_os From 4a4c135b220f8c196e34ffc2b2a81015394b9e5c Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 7 Mar 2025 12:02:38 +0100 Subject: [PATCH 3/5] use no-overhead C function --- src/stdlib_system.F90 | 39 +++++++++++++++++++++++++------- src/stdlib_system_subprocess.F90 | 30 ------------------------ src/stdlib_system_subprocess.c | 2 +- 3 files changed, 32 insertions(+), 39 deletions(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 757ae7c25..3c2502878 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -1,6 +1,7 @@ module stdlib_system -use, intrinsic :: iso_c_binding, only : c_int, c_long, c_null_ptr, c_int64_t -use stdlib_kinds, only: int64, dp +use, intrinsic :: iso_c_binding, only : c_int, c_long, c_ptr, c_null_ptr, c_int64_t, c_size_t, & + c_f_pointer +use stdlib_kinds, only: int64, dp, c_char implicit none private public :: sleep @@ -635,17 +636,39 @@ pure function OS_NAME(os) end select end function OS_NAME -!> Return the file path of the null device for the current operating system. +!> Returns the file path of the null device for the current operating system. +!> +!> Version: Helper function. function null_device() result(path) !> File path of the null device character(:), allocatable :: path - if (OS_TYPE()==OS_WINDOWS) then - path = 'NUL' - else - path = '/dev/null' - end if + interface + + ! No-overhead return path to the null device + type(c_ptr) function process_null_device(len) bind(C,name='process_null_device') + import c_ptr, c_size_t + implicit none + integer(c_size_t), intent(out) :: len + end function process_null_device + + end interface + integer(c_size_t) :: i, len + type(c_ptr) :: c_path_ptr + character(kind=c_char), pointer :: c_path(:) + + ! Call the C function to get the null device path and its length + c_path_ptr = process_null_device(len) + call c_f_pointer(c_path_ptr,c_path,[len]) + + ! Allocate the Fortran string with the length returned from C + allocate(character(len=len) :: path) + + do concurrent (i=1:len) + path(i:i) = c_path(i) + end do + end function null_device end module stdlib_system diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index 00f5d759a..4b617971c 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/src/stdlib_system_subprocess.F90 @@ -51,13 +51,6 @@ subroutine process_wait(seconds) bind(C,name='process_wait') real(c_float), intent(in), value :: seconds end subroutine process_wait - ! Return path to the null device - type(c_ptr) function process_null_device(len) bind(C,name='process_null_device') - import c_ptr, c_int - implicit none - integer(c_int), intent(out) :: len - end function process_null_device - ! Utility: check if _WIN32 is defined in the C compiler logical(c_bool) function process_is_windows() bind(C,name='process_is_windows') import c_bool @@ -604,29 +597,6 @@ function assemble_cmd(args, stdin, stdout, stderr) result(cmd) end function assemble_cmd - !> Returns the file path of the null device for the current operating system. - !> - !> Version: Helper function. - function null_device() - character(:), allocatable :: null_device - - integer(c_int) :: i, len - type(c_ptr) :: c_path_ptr - character(kind=c_char), pointer :: c_path(:) - - ! Call the C function to get the null device path and its length - c_path_ptr = process_null_device(len) - call c_f_pointer(c_path_ptr,c_path,[len]) - - ! Allocate the Fortran string with the length returned from C - allocate(character(len=len) :: null_device) - - do concurrent (i=1:len) - null_device(i:i) = c_path(i) - end do - - end function null_device - !> Returns the file path of the null device for the current operating system. !> !> Version: Helper function. diff --git a/src/stdlib_system_subprocess.c b/src/stdlib_system_subprocess.c index 59f010ddd..0a0cba099 100644 --- a/src/stdlib_system_subprocess.c +++ b/src/stdlib_system_subprocess.c @@ -376,7 +376,7 @@ void process_wait(float seconds) } // Returns the cross-platform file path of the null device for the current operating system. -const char* process_null_device(int* len) +const char* process_null_device(size_t* len) { #ifdef _WIN32 (*len) = strlen("NUL"); From 522f35ec809b06b61becf302b20712dc8ea29374 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 7 Mar 2025 12:05:31 +0100 Subject: [PATCH 4/5] add documentation --- doc/specs/stdlib_system.md | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 3dbe434fe..58e38cc55 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -417,3 +417,39 @@ Returns one of the `integer` `OS_*` parameters representing the OS type, from th ```fortran {!example/system/example_os_type.f90!} ``` + +## `null_device` - Return the null device file path + +### Status + +Experimental + +### Description + +This function returns the file path of the null device, which is a special file used to discard any data written to it. +It reads as an empty file. The null device's path varies by operating system: +- On Windows, the null device is represented as `NUL`. +- On UNIX-like systems (Linux, macOS), the null device is represented as `/dev/null`. + +### Syntax + +`path = [[stdlib_system(module):null_device(function)]]()` + +### Class + +Function + +### Arguments + +None. + +### Return Value + +- **Type:** `character(:), allocatable` +- Returns the null device file path as a character string, appropriate for the operating system. + +### Example + +```fortran +{!example/system/example_null_device.f90!} +``` From 167623333343963f5d57bf7c0e610d6872c440c6 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 7 Mar 2025 12:08:22 +0100 Subject: [PATCH 5/5] add example program --- example/system/CMakeLists.txt | 1 + example/system/example_null_device.f90 | 20 ++++++++++++++++++++ 2 files changed, 21 insertions(+) create mode 100644 example/system/example_null_device.f90 diff --git a/example/system/CMakeLists.txt b/example/system/CMakeLists.txt index f5518b74b..c61b31bdb 100644 --- a/example/system/CMakeLists.txt +++ b/example/system/CMakeLists.txt @@ -1,4 +1,5 @@ ADD_EXAMPLE(get_runtime_os) +ADD_EXAMPLE(null_device) ADD_EXAMPLE(os_type) ADD_EXAMPLE(process_1) ADD_EXAMPLE(process_2) diff --git a/example/system/example_null_device.f90 b/example/system/example_null_device.f90 new file mode 100644 index 000000000..fd21427b7 --- /dev/null +++ b/example/system/example_null_device.f90 @@ -0,0 +1,20 @@ +! Showcase usage of the null device +program example_null_device + use stdlib_system, only: null_device + use iso_fortran_env, only: output_unit + implicit none + integer :: unit + logical :: screen_output = .false. + + if (screen_output) then + unit = output_unit + else + ! Write to the null device if no screen output is wanted + open(newunit=unit,file=null_device()) + endif + + write(unit,*) "Hello, world!" + + if (.not.screen_output) close(unit) + +end program example_null_device