Merge branch 'fortran-lang:master' into io_delete_file

Author: perazz

config/cmake/Findtest-drive.cmake

@@ -123,7 +123,7 @@ foreach(method ${${_pkg}_FIND_METHOD})
 
       # We need the module directory in the subproject before we finish the configure stage
       if(NOT EXISTS "${${_pkg}_BINARY_DIR}/include")
-        make_directory("${${_pkg}_BINARY_DIR}/include")
+        file(MAKE_DIRECTORY "${${_pkg}_BINARY_DIR}/include")
       endif()
 
       break()
@@ -147,7 +147,7 @@ foreach(method ${${_pkg}_FIND_METHOD})
     FetchContent_GetProperties("${_lib}" SOURCE_DIR "${_pkg}_SOURCE_DIR")
     FetchContent_GetProperties("${_lib}" BINARY_DIR "${_pkg}_BINARY_DIR")
     if(NOT EXISTS "${${_pkg}_BINARY_DIR}/include")
-      make_directory("${${_pkg}_BINARY_DIR}/include")
+      file(MAKE_DIRECTORY "${${_pkg}_BINARY_DIR}/include")
     endif()
 
     break()

doc/specs/stdlib_system.md

@@ -335,3 +335,160 @@ Returns a `logical` flag: `.true.` if the system is Windows, or `.false.` otherw
 ```fortran
 {!example/system/example_process_1.f90!}
 ```
+
+## `get_runtime_os` - Determine the OS type at runtime
+
+### Status
+
+Experimental
+
+### Description
+
+`get_runtime_os` inspects the runtime environment to identify the current OS type. It evaluates environment variables (`OSTYPE`, `OS`) and checks for specific files associated with known operating systems.
+The supported OS types are `integer, parameter` variables stored in the `stdlib_system` module:
+
+- **Linux** (`OS_LINUX`)
+- **macOS** (`OS_MACOS`)
+- **Windows** (`OS_WINDOWS`)
+- **Cygwin** (`OS_CYGWIN`)
+- **Solaris** (`OS_SOLARIS`)
+- **FreeBSD** (`OS_FREEBSD`)
+- **OpenBSD** (`OS_OPENBSD`)
+
+If the OS cannot be identified, the function returns `OS_UNKNOWN`.
+
+### Syntax
+
+`os = [[stdlib_system(module):get_runtime_os(function)]]()`
+
+### Class
+
+Function
+
+### Arguments
+
+None.
+
+### Return Value
+
+Returns one of the `integer` `OS_*` parameters representing the OS type, from the `stdlib_system` module, or `OS_UNKNOWN` if undetermined.
+
+### Example
+
+```fortran
+{!example/system/example_get_runtime_os.f90!}
+```
+
+---
+
+## `OS_TYPE` - Cached OS type retrieval
+
+### Status
+
+Experimental
+
+### Description
+
+`OS_TYPE` provides a cached result of the `get_runtime_os` function. The OS type is determined during the first invocation and stored in a static variable. 
+Subsequent calls reuse the cached value, making this function highly efficient.
+
+This caching mechanism ensures negligible overhead for repeated calls, unlike `get_runtime_os`, which performs a full runtime inspection.
+
+### Syntax
+
+`os = [[stdlib_system(module):OS_TYPE(function)]]()`
+
+### Class
+
+Function
+
+### Arguments
+
+None.
+
+### Return Value
+
+Returns one of the `integer` `OS_*` parameters representing the OS type, from the `stdlib_system` module, or `OS_UNKNOWN` if undetermined.
+
+### Example
+
+```fortran
+{!example/system/example_os_type.f90!}
+```
+
+---
+
+## `is_directory` - Test if a path is a directory
+
+### Status
+
+Experimental
+
+### Description
+
+This function checks if a specified file system path is a directory. 
+It is designed to work across multiple platforms. On Windows, paths with both forward `/` and backward `\` slashes are accepted.
+
+### Syntax
+
+`result = [[stdlib_io(module):is_directory(function)]] (path)`
+
+### Class
+
+Function
+
+### Arguments
+
+`path`: Shall be a character string containing the file system path to evaluate. It is an `intent(in)` argument.
+
+### Return values
+
+The function returns a `logical` value:
+
+- `.true.` if the path matches an existing directory.
+- `.false.` otherwise, or if the operating system is unsupported.
+
+### Example
+
+```fortran
+{!example/system/example_is_directory.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,3 +1,7 @@
+ADD_EXAMPLE(get_runtime_os)
+ADD_EXAMPLE(is_directory)
+ADD_EXAMPLE(null_device)
+ADD_EXAMPLE(os_type)
 ADD_EXAMPLE(process_1)
 ADD_EXAMPLE(process_2)
 ADD_EXAMPLE(process_3)

example/system/example_get_runtime_os.f90

@@ -0,0 +1,9 @@
+! Demonstrate usage of (non-cached) runtime OS query
+program example_get_runtime_os
+    use stdlib_system, only: OS_NAME, get_runtime_os
+    implicit none
+
+    ! Runtime OS detection (full inspection)
+    print *, "Runtime OS Type: ", OS_NAME(get_runtime_os())
+
+end program example_get_runtime_os

example/system/example_is_directory.f90

@@ -0,0 +1,11 @@
+! Demonstrate usage of `is_directory`
+program example_is_directory
+  use stdlib_system, only: is_directory
+  implicit none
+  ! Test a directory path
+  if (is_directory("/path/to/check")) then 
+    print *, "The specified path is a directory."
+  else
+    print *, "The specified path is not a directory."
+  end if
+end program example_is_directory

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

example/system/example_os_type.f90

@@ -0,0 +1,12 @@
+! Demonstrate OS detection
+program example_os_type
+    use stdlib_system, only: OS_TYPE, OS_NAME
+    implicit none
+
+    integer :: current_os
+
+    ! Cached OS detection
+    current_os = OS_TYPE() 
+    print *, "Current OS Type: ", OS_NAME(current_os) 
+
+end program example_os_type

src/CMakeLists.txt

@@ -145,7 +145,7 @@ set(LIB_MOD_DIR ${CMAKE_CURRENT_BINARY_DIR}/mod_files/)
 # We need the module directory before we finish the configure stage since the
 # build interface might resolve before the module directory is generated by CMake
 if(NOT EXISTS "${LIB_MOD_DIR}")
-  make_directory("${LIB_MOD_DIR}")
+  file(MAKE_DIRECTORY "${LIB_MOD_DIR}")
 endif()
 
 set_target_properties(${PROJECT_NAME} PROPERTIES

src/stdlib_constants.fypp

@@ -40,7 +40,7 @@ module stdlib_constants
     real(dp), parameter, public :: epsilon_0 = VACUUM_ELECTRIC_PERMITTIVITY%value !! vacuum mag. permeability
     real(dp), parameter, public :: h = PLANCK_CONSTANT%value !! Planck constant
     real(dp), parameter, public :: Planck = PLANCK_CONSTANT%value !! Planck constant
-    real(dp), parameter, public :: hbar = PLANCK_CONSTANT%value / PI_dp !! Reduced Planck constant
+    real(dp), parameter, public :: hbar = PLANCK_CONSTANT%value / (2.0_dp * PI_dp) !! Reduced Planck constant
     real(dp), parameter, public :: G = NEWTONIAN_CONSTANT_OF_GRAVITATION%value !! Newtonian constant of gravitation
     real(dp), parameter, public :: gravitation_constant = NEWTONIAN_CONSTANT_OF_GRAVITATION%value !! Newtonian constant of gravitation
     real(dp), parameter, public :: g2 = STANDARD_ACCELERATION_OF_GRAVITY%value !! Standard acceleration of gravity

src/stdlib_io.fypp

@@ -169,6 +169,7 @@ contains
 
         if (ios/=0) then 
            write(msgout,1) trim(iomsg),i,trim(filename) 
+           1 format('loadtxt: error <',a,'> skipping line ',i0,' of ',a,'.')
            call error_stop(msg=trim(msgout))
         end if
 
@@ -189,7 +190,7 @@ contains
           read (s,*,iostat=ios,iomsg=iomsg) d(i, :)
 
           if (ios/=0) then 
-             write(msgout,1) trim(iomsg),size(d,2),i,trim(filename) 
+             write(msgout,2) trim(iomsg),size(d,2),i,trim(filename)
              call error_stop(msg=trim(msgout))
           end if          
 
@@ -200,7 +201,7 @@ contains
           read (s,fmt_,iostat=ios,iomsg=iomsg) d(i, :)
 
           if (ios/=0) then 
-             write(msgout,1) trim(iomsg),size(d,2),i,trim(filename) 
+             write(msgout,2) trim(iomsg),size(d,2),i,trim(filename)
              call error_stop(msg=trim(msgout))
           end if             
 
@@ -209,7 +210,7 @@ contains
 
       close(s)
 
-      1 format('loadtxt: error <',a,'> reading ',i0,' values from line ',i0,' of ',a,'.')
+      2 format('loadtxt: error <',a,'> reading ',i0,' values from line ',i0,' of ',a,'.')
 
     end subroutine loadtxt_${t1[0]}$${k1}$
   #:endfor

src/stdlib_math_is_close.fypp

@@ -23,7 +23,7 @@ contains
         equal_nan_ = optval(equal_nan, .false.)
 
         if (ieee_is_nan(a) .or. ieee_is_nan(b)) then
-            close = merge(.true., .false., equal_nan_ .and. ieee_is_nan(a) .and. ieee_is_nan(b))
+            close = equal_nan_ .and. ieee_is_nan(a) .and. ieee_is_nan(b)
         else
             close = abs(a - b) <= max( abs(optval(rel_tol, sqrt_eps_${k1}$)*max(abs(a), abs(b))), &
                                        abs(optval(abs_tol, 0.0_${k1}$)) )

src/stdlib_specialfunctions_gamma.fypp

@@ -4,6 +4,7 @@
 #:set CI_KINDS_TYPES = INT_KINDS_TYPES + C_KINDS_TYPES
 module stdlib_specialfunctions_gamma
     use iso_fortran_env, only : qp => real128
+    use ieee_arithmetic, only: ieee_value, ieee_quiet_nan
     use stdlib_kinds, only :  sp, dp, int8, int16, int32, int64
     use stdlib_error, only : error_stop
 
@@ -575,9 +576,9 @@ contains
     ! Fortran 90 program by Jim-215-Fisher
     !
         ${t1}$, intent(in) :: p, x
-        integer :: n, m
+        integer :: n
 
-        ${t2}$ :: res, p_lim, a, b, g, c, d, y, ss
+        ${t2}$ :: res, p_lim, a, b, g, c, d, y
         ${t2}$, parameter :: zero = 0.0_${k2}$, one = 1.0_${k2}$
         ${t2}$, parameter :: dm = tiny(1.0_${k2}$) * 10 ** 6
         ${t1}$, parameter :: zero_k1 = 0.0_${k1}$
@@ -603,6 +604,9 @@ contains
             call error_stop("Error(gpx): Incomplete gamma function with "      &
             //"negative x must come with a whole number p not too small")
 
+        if(x < zero_k1) call error_stop("Error(gpx): Incomplete gamma"         &
+            // " function with negative x must have an integer parameter p")
+
         if(p >= p_lim) then     !use modified Lentz method of continued fraction
                                 !for eq. (15) in the above reference.
             a = one
@@ -668,30 +672,9 @@ contains
 
             end do
 
-        else                            !Algorithm 2 in the reference
-
-            m = nint(ss)
-            a = - x
-            c = one / a
-            d = p - one
-            b = c * (a - d)
-            n = 1
-
-            do
-
-                c = d * (d - one) / (a * a)
-                d = d - 2
-                y = c * (a - d)
-                b = b + y
-                n = n + 1
-
-                if(n > int((p - 2) / 2) .or. y < b * tol_${k2}$) exit
-
-            end do
-
-            if(y >= b * tol_${k2}$ .and. mod(m , 2) /= 0) b = b + d * c / a
+        else
+            g = ieee_value(1._${k1}$, ieee_quiet_nan)
 
-            g = ((-1) ** m * exp(-a + log_gamma(p) - (p - 1) * log(a)) + b) / a
         end if
 
         res = g