Merge branch 'fortran-lang:master' into iterative

Author: jalvesz

doc/specs/stdlib_system.md

@@ -335,3 +335,85 @@ 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!}
+```

example/system/CMakeLists.txt

@@ -1,3 +1,5 @@
+ADD_EXAMPLE(get_runtime_os)
+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_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/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

src/stdlib_system.F90

@@ -5,6 +5,70 @@ module stdlib_system
 private
 public :: sleep
 
+!! version: experimental
+!!
+!! Cached OS type retrieval with negligible runtime overhead.
+!! ([Specification](../page/specs/stdlib_system.html#os_type-cached-os-type-retrieval))
+!!
+!! ### Summary
+!! Provides a cached value for the runtime OS type. 
+!!
+!! ### Description
+!! 
+!! This function caches the result of `get_runtime_os` after the first invocation. 
+!! Subsequent calls return the cached value, ensuring minimal overhead.
+!!
+public :: OS_TYPE
+
+!! version: experimental
+!!
+!! Determine the current operating system (OS) type at runtime.
+!! ([Specification](../page/specs/stdlib_system.html#get_runtime_os-determine-the-os-type-at-runtime))
+!!
+!! ### Summary
+!! This function inspects the runtime environment to identify the OS type. 
+!!
+!! ### Description
+!! 
+!! The function evaluates environment variables (`OSTYPE` or `OS`) and filesystem attributes
+!! to identify the OS. It distinguishes between several common operating systems:
+!! - Linux
+!! - macOS
+!! - Windows
+!! - Cygwin
+!! - Solaris
+!! - FreeBSD
+!! - OpenBSD
+!!
+!! Returns a constant representing the OS type or `OS_UNKNOWN` if the OS cannot be determined.
+!!                    
+public :: get_runtime_os
+
+!> Version: experimental
+!>
+!> Integer constants representing known operating system (OS) types
+!> ([Specification](../page/specs/stdlib_system.html))
+integer, parameter, public :: &
+    !> Represents an unknown operating system
+    OS_UNKNOWN = 0, &
+    !> Represents a Linux operating system
+    OS_LINUX = 1, &
+    !> Represents a macOS operating system
+    OS_MACOS = 2, &
+    !> Represents a Windows operating system
+    OS_WINDOWS = 3, &
+    !> Represents a Cygwin environment
+    OS_CYGWIN = 4, &
+    !> Represents a Solaris operating system
+    OS_SOLARIS = 5, &
+    !> Represents a FreeBSD operating system
+    OS_FREEBSD = 6, &
+    !> Represents an OpenBSD operating system
+    OS_OPENBSD = 7
+
+!! Helper function returning the name of an OS parameter
+public :: OS_NAME 
+
 !> Public sub-processing interface
 public :: run
 public :: runasync
@@ -218,7 +282,6 @@ module logical function process_is_running(process) result(is_running)
     end function process_is_running
 end interface is_running
 
-
 interface is_completed
     !! version: experimental
     !!
@@ -397,7 +460,11 @@ subroutine process_callback(pid,exit_state,stdin,stdout,stderr,payload)
         class(*), optional, intent(inout) :: payload        
     end subroutine process_callback
 end interface          
-      
+    
+!! Static storage for the current OS
+logical :: have_os    = .false.
+integer :: OS_CURRENT = OS_UNKNOWN
+
 interface 
 
     !! version: experimental
@@ -430,4 +497,125 @@ end function process_get_ID
 
 end interface 
 
+contains
+
+integer function get_runtime_os() result(os)
+    !! The function identifies the OS by inspecting environment variables and filesystem attributes.
+    !!
+    !! ### Returns:
+    !! - **OS_UNKNOWN**: If the OS cannot be determined.
+    !! - **OS_LINUX**, **OS_MACOS**, **OS_WINDOWS**, **OS_CYGWIN**, **OS_SOLARIS**, **OS_FREEBSD**, or **OS_OPENBSD**.
+    !!
+    !! Note: This function performs a detailed runtime inspection, so it has non-negligible overhead.
+    
+    ! Local variables
+    character(len=255) :: val
+    integer            :: length, rc
+    logical            :: file_exists
+
+    os = OS_UNKNOWN
+
+    ! Check environment variable `OSTYPE`.
+    call get_environment_variable('OSTYPE', val, length, rc)
+
+    if (rc == 0 .and. length > 0) then
+        ! Linux
+        if (index(val, 'linux') > 0) then
+            os = OS_LINUX
+            return
+
+        ! macOS
+        elseif (index(val, 'darwin') > 0) then
+            os = OS_MACOS
+            return
+
+        ! Windows, MSYS, MinGW, Git Bash
+        elseif (index(val, 'win') > 0 .or. index(val, 'msys') > 0) then
+            os = OS_WINDOWS
+            return
+
+        ! Cygwin
+        elseif (index(val, 'cygwin') > 0) then
+            os = OS_CYGWIN
+            return
+
+        ! Solaris, OpenIndiana, ...
+        elseif (index(val, 'SunOS') > 0 .or. index(val, 'solaris') > 0) then
+            os = OS_SOLARIS
+            return
+
+        ! FreeBSD
+        elseif (index(val, 'FreeBSD') > 0 .or. index(val, 'freebsd') > 0) then
+            os = OS_FREEBSD
+            return
+
+        ! OpenBSD
+        elseif (index(val, 'OpenBSD') > 0 .or. index(val, 'openbsd') > 0) then
+            os = OS_OPENBSD
+            return
+        end if
+    end if
+
+    ! Check environment variable `OS`.
+    call get_environment_variable('OS', val, length, rc)
+
+    if (rc == 0 .and. length > 0 .and. index(val, 'Windows_NT') > 0) then
+        os = OS_WINDOWS
+        return
+    end if
+
+    ! Linux
+    inquire (file='/etc/os-release', exist=file_exists)
+
+    if (file_exists) then
+        os = OS_LINUX
+        return
+    end if
+
+    ! macOS
+    inquire (file='/usr/bin/sw_vers', exist=file_exists)
+
+    if (file_exists) then
+        os = OS_MACOS
+        return
+    end if
+
+    ! FreeBSD
+    inquire (file='/bin/freebsd-version', exist=file_exists)
+
+    if (file_exists) then
+        os = OS_FREEBSD
+        return
+    end if
+    
+end function get_runtime_os
+
+!> Retrieves the cached OS type for minimal runtime overhead.
+integer function OS_TYPE() result(os)
+    !! This function uses a static cache to avoid recalculating the OS type after the first call.
+    !! It is recommended for performance-sensitive use cases where the OS type is checked multiple times.
+    if (.not.have_os) then 
+        OS_CURRENT = get_runtime_os()
+        have_os = .true.        
+    end if
+    os = OS_CURRENT
+end function OS_TYPE
+
+!> Return string describing the OS type flag
+pure function OS_NAME(os)
+    integer, intent(in) :: os
+    character(len=:), allocatable :: OS_NAME
+
+    select case (os)
+        case (OS_LINUX);   OS_NAME =  "Linux"
+        case (OS_MACOS);   OS_NAME =  "macOS"
+        case (OS_WINDOWS); OS_NAME =  "Windows"
+        case (OS_CYGWIN);  OS_NAME =  "Cygwin"
+        case (OS_SOLARIS); OS_NAME =  "Solaris"
+        case (OS_FREEBSD); OS_NAME =  "FreeBSD"
+        case (OS_OPENBSD); OS_NAME =  "OpenBSD"
+        case default     ; OS_NAME =  "Unknown"
+    end select
+end function OS_NAME
+
 end module stdlib_system

test/system/CMakeLists.txt

@@ -1,2 +1,3 @@
+ADDTEST(os)
 ADDTEST(sleep)
 ADDTEST(subprocess)