@@ -5,6 +5,70 @@ module stdlib_system
5
5
private
6
6
public :: sleep
7
7
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
+
8
72
! > Public sub-processing interface
9
73
public :: run
10
74
public :: runasync
@@ -218,7 +282,6 @@ module logical function process_is_running(process) result(is_running)
218
282
end function process_is_running
219
283
end interface is_running
220
284
221
-
222
285
interface is_completed
223
286
! ! version: experimental
224
287
! !
@@ -397,7 +460,11 @@ subroutine process_callback(pid,exit_state,stdin,stdout,stderr,payload)
397
460
class(* ), optional , intent (inout ) :: payload
398
461
end subroutine process_callback
399
462
end interface
400
-
463
+
464
+ ! ! Static storage for the current OS
465
+ logical :: have_os = .false.
466
+ integer :: OS_CURRENT = OS_UNKNOWN
467
+
401
468
interface
402
469
403
470
! ! version: experimental
@@ -430,4 +497,130 @@ end function process_get_ID
430
497
431
498
end interface
432
499
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
+
433
626
end module stdlib_system
0 commit comments