Skip to content

Commit d0aa547

Browse files
committed
add OS query code
1 parent 69eaa20 commit d0aa547

File tree

1 file changed

+195
-2
lines changed

1 file changed

+195
-2
lines changed

src/stdlib_system.F90

Lines changed: 195 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,70 @@ module stdlib_system
55
private
66
public :: sleep
77

8+
!! version: experimental
9+
!!
10+
!! Cached OS type retrieval with negligible runtime overhead.
11+
!! ([Specification](../page/specs/stdlib_system.html#os_type-cached-os-type-retrieval))
12+
!!
13+
!! ### Summary
14+
!! Provides a cached value for the runtime OS type.
15+
!!
16+
!! ### Description
17+
!!
18+
!! This function caches the result of `get_runtime_os` after the first invocation.
19+
!! Subsequent calls return the cached value, ensuring minimal overhead.
20+
!!
21+
public :: OS_TYPE
22+
23+
!! version: experimental
24+
!!
25+
!! Determine the current operating system (OS) type at runtime.
26+
!! ([Specification](../page/specs/stdlib_system.html#get_runtime_os-determine-the-os-type-at-runtime))
27+
!!
28+
!! ### Summary
29+
!! This function inspects the runtime environment to identify the OS type.
30+
!!
31+
!! ### Description
32+
!!
33+
!! The function evaluates environment variables (`OSTYPE` or `OS`) and filesystem attributes
34+
!! to identify the OS. It distinguishes between several common operating systems:
35+
!! - Linux
36+
!! - macOS
37+
!! - Windows
38+
!! - Cygwin
39+
!! - Solaris
40+
!! - FreeBSD
41+
!! - OpenBSD
42+
!!
43+
!! Returns a constant representing the OS type or `OS_UNKNOWN` if the OS cannot be determined.
44+
!!
45+
public :: get_runtime_os
46+
47+
!> Version: experimental
48+
!>
49+
!> Integer constants representing known operating system (OS) types
50+
!> ([Specification](../page/specs/stdlib_system.html))
51+
integer, parameter, public :: &
52+
!> Represents an unknown operating system
53+
OS_UNKNOWN = 0, &
54+
!> Represents a Linux operating system
55+
OS_LINUX = 1, &
56+
!> Represents a macOS operating system
57+
OS_MACOS = 2, &
58+
!> Represents a Windows operating system
59+
OS_WINDOWS = 3, &
60+
!> Represents a Cygwin environment
61+
OS_CYGWIN = 4, &
62+
!> Represents a Solaris operating system
63+
OS_SOLARIS = 5, &
64+
!> Represents a FreeBSD operating system
65+
OS_FREEBSD = 6, &
66+
!> Represents an OpenBSD operating system
67+
OS_OPENBSD = 7
68+
69+
!! Helper function returning the name of an OS parameter
70+
public :: OS_NAME
71+
872
!> Public sub-processing interface
973
public :: run
1074
public :: runasync
@@ -218,7 +282,6 @@ module logical function process_is_running(process) result(is_running)
218282
end function process_is_running
219283
end interface is_running
220284

221-
222285
interface is_completed
223286
!! version: experimental
224287
!!
@@ -397,7 +460,11 @@ subroutine process_callback(pid,exit_state,stdin,stdout,stderr,payload)
397460
class(*), optional, intent(inout) :: payload
398461
end subroutine process_callback
399462
end interface
400-
463+
464+
!! Static storage for the current OS
465+
logical :: have_os = .false.
466+
integer :: OS_CURRENT = OS_UNKNOWN
467+
401468
interface
402469

403470
!! version: experimental
@@ -430,4 +497,130 @@ end function process_get_ID
430497

431498
end interface
432499

500+
contains
501+
502+
integer function get_runtime_os() result(os)
503+
!! The function identifies the OS by inspecting environment variables and filesystem attributes.
504+
!!
505+
!! ### Returns:
506+
!! - **OS_UNKNOWN**: If the OS cannot be determined.
507+
!! - **OS_LINUX**, **OS_MACOS**, **OS_WINDOWS**, **OS_CYGWIN**, **OS_SOLARIS**, **OS_FREEBSD**, or **OS_OPENBSD**.
508+
!!
509+
!! Note: This function performs a detailed runtime inspection, so it has non-negligible overhead.
510+
511+
! Local variables
512+
character(len=255) :: val
513+
integer :: length, rc
514+
logical :: file_exists
515+
516+
os = OS_UNKNOWN
517+
518+
! Check environment variable `OSTYPE`.
519+
call get_environment_variable('OSTYPE', val, length, rc)
520+
521+
if (rc == 0 .and. length > 0) then
522+
! Linux
523+
if (index(val, 'linux') > 0) then
524+
os = OS_LINUX
525+
return
526+
end if
527+
528+
! macOS
529+
if (index(val, 'darwin') > 0) then
530+
os = OS_MACOS
531+
return
532+
end if
533+
534+
! Windows, MSYS, MinGW, Git Bash
535+
if (index(val, 'win') > 0 .or. index(val, 'msys') > 0) then
536+
os = OS_WINDOWS
537+
return
538+
end if
539+
540+
! Cygwin
541+
if (index(val, 'cygwin') > 0) then
542+
os = OS_CYGWIN
543+
return
544+
end if
545+
546+
! Solaris, OpenIndiana, ...
547+
if (index(val, 'SunOS') > 0 .or. index(val, 'solaris') > 0) then
548+
os = OS_SOLARIS
549+
return
550+
end if
551+
552+
! FreeBSD
553+
if (index(val, 'FreeBSD') > 0 .or. index(val, 'freebsd') > 0) then
554+
os = OS_FREEBSD
555+
return
556+
end if
557+
558+
! OpenBSD
559+
if (index(val, 'OpenBSD') > 0 .or. index(val, 'openbsd') > 0) then
560+
os = OS_OPENBSD
561+
return
562+
end if
563+
end if
564+
565+
! Check environment variable `OS`.
566+
call get_environment_variable('OS', val, length, rc)
567+
568+
if (rc == 0 .and. length > 0 .and. index(val, 'Windows_NT') > 0) then
569+
os = OS_WINDOWS
570+
return
571+
end if
572+
573+
! Linux
574+
inquire (file='/etc/os-release', exist=file_exists)
575+
576+
if (file_exists) then
577+
os = OS_LINUX
578+
return
579+
end if
580+
581+
! macOS
582+
inquire (file='/usr/bin/sw_vers', exist=file_exists)
583+
584+
if (file_exists) then
585+
os = OS_MACOS
586+
return
587+
end if
588+
589+
! FreeBSD
590+
inquire (file='/bin/freebsd-version', exist=file_exists)
591+
592+
if (file_exists) then
593+
os = OS_FREEBSD
594+
return
595+
end if
596+
end function get_runtime_os
597+
598+
!> Retrieves the cached OS type for minimal runtime overhead.
599+
integer function OS_TYPE() result(os)
600+
!! This function uses a static cache to avoid recalculating the OS type after the first call.
601+
!! It is recommended for performance-sensitive use cases where the OS type is checked multiple times.
602+
if (.not.have_os) then
603+
OS_CURRENT = get_runtime_os()
604+
have_os = .true.
605+
end if
606+
os = OS_CURRENT
607+
end function OS_TYPE
608+
609+
!> Return string describing the OS type flag
610+
pure function OS_NAME(os)
611+
integer, intent(in) :: os
612+
character(len=:), allocatable :: OS_NAME
613+
614+
select case (os)
615+
case (OS_LINUX); OS_NAME = "Linux"
616+
case (OS_MACOS); OS_NAME = "macOS"
617+
case (OS_WINDOWS); OS_NAME = "Windows"
618+
case (OS_CYGWIN); OS_NAME = "Cygwin"
619+
case (OS_SOLARIS); OS_NAME = "Solaris"
620+
case (OS_FREEBSD); OS_NAME = "FreeBSD"
621+
case (OS_OPENBSD); OS_NAME = "OpenBSD"
622+
case default ; OS_NAME = "Unknown"
623+
end select
624+
end function OS_NAME
625+
433626
end module stdlib_system

0 commit comments

Comments
 (0)