@@ -5,6 +5,70 @@ module stdlib_system
55private
66public :: 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
973public :: run
1074public :: runasync
@@ -218,7 +282,6 @@ module logical function process_is_running(process) result(is_running)
218282 end function process_is_running
219283end interface is_running
220284
221-
222285interface 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
399462end interface
400-
463+
464+ ! ! Static storage for the current OS
465+ logical :: have_os = .false.
466+ integer :: OS_CURRENT = OS_UNKNOWN
467+
401468interface
402469
403470 ! ! version: experimental
@@ -430,4 +497,130 @@ end function process_get_ID
430497
431498end 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+
433626end module stdlib_system
0 commit comments