system: null_device (fortran-lang#945)

Author: perazz

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!}
+```

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)

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

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
@@ -81,6 +82,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 +636,39 @@ pure function OS_NAME(os)
     end select
 end function OS_NAME
 
+!> 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
+    
+    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

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.

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");

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