1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
|
!> This module contains procedures that interact with the programming environment.
!!
!! * [get_os_type] -- Determine the OS type
!! * [get_env] -- return the value of an environment variable
module fpm_environment
implicit none
private
public :: get_os_type
public :: os_is_unix
public :: run
public :: get_env
integer, parameter, public :: OS_UNKNOWN = 0
integer, parameter, public :: OS_LINUX = 1
integer, parameter, public :: OS_MACOS = 2
integer, parameter, public :: OS_WINDOWS = 3
integer, parameter, public :: OS_CYGWIN = 4
integer, parameter, public :: OS_SOLARIS = 5
integer, parameter, public :: OS_FREEBSD = 6
contains
!> Determine the OS type
integer function get_os_type() result(r)
!!
!! Returns one of OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, OS_CYGWIN,
!! OS_SOLARIS, OS_FREEBSD.
!!
!! At first, the environment variable `OS` is checked, which is usually
!! found on Windows. Then, `OSTYPE` is read in and compared with common
!! names. If this fails too, check the existence of files that can be
!! found on specific system types only.
!!
!! Returns OS_UNKNOWN if the operating system cannot be determined.
character(len=32) :: val
integer :: length, rc
logical :: file_exists
r = OS_UNKNOWN
! 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
r = OS_WINDOWS
return
end if
! 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
r = OS_LINUX
return
end if
! macOS
if (index(val, 'darwin') > 0) then
r = OS_MACOS
return
end if
! Windows, MSYS, MinGW, Git Bash
if (index(val, 'win') > 0 .or. index(val, 'msys') > 0) then
r = OS_WINDOWS
return
end if
! Cygwin
if (index(val, 'cygwin') > 0) then
r = OS_CYGWIN
return
end if
! Solaris, OpenIndiana, ...
if (index(val, 'SunOS') > 0 .or. index(val, 'solaris') > 0) then
r = OS_SOLARIS
return
end if
! FreeBSD
if (index(val, 'FreeBSD') > 0 .or. index(val, 'freebsd') > 0) then
r = OS_FREEBSD
return
end if
end if
! Linux
inquire (file='/etc/os-release', exist=file_exists)
if (file_exists) then
r = OS_LINUX
return
end if
! macOS
inquire (file='/usr/bin/sw_vers', exist=file_exists)
if (file_exists) then
r = OS_MACOS
return
end if
! FreeBSD
inquire (file='/bin/freebsd-version', exist=file_exists)
if (file_exists) then
r = OS_FREEBSD
return
end if
end function get_os_type
!> Compare the output of [[get_os_type]] or the optional
!! passed INTEGER value to the value for OS_WINDOWS
!! and return .TRUE. if they match and .FALSE. otherwise
logical function os_is_unix(os) result(unix)
integer, intent(in), optional :: os
integer :: build_os
if (present(os)) then
build_os = os
else
build_os = get_os_type()
end if
unix = os /= OS_WINDOWS
end function os_is_unix
!> echo command string and pass it to the system for execution
subroutine run(cmd,echo)
character(len=*), intent(in) :: cmd
logical,intent(in),optional :: echo
logical :: echo_local
integer :: stat
if(present(echo))then
echo_local=echo
else
echo_local=.true.
endif
if(echo_local) print *, '+ ', cmd
call execute_command_line(cmd, exitstat=stat)
if (stat /= 0) then
print *, 'Command failed'
error stop
end if
end subroutine run
!> get named environment variable value. It it is blank or
!! not set return the optional default value
function get_env(NAME,DEFAULT) result(VALUE)
implicit none
!> name of environment variable to get the value of
character(len=*),intent(in) :: NAME
!> default value to return if the requested value is undefined or blank
character(len=*),intent(in),optional :: DEFAULT
!> the returned value
character(len=:),allocatable :: VALUE
integer :: howbig
integer :: stat
integer :: length
! get length required to hold value
length=0
if(NAME.ne.'')then
call get_environment_variable(NAME, length=howbig,status=stat,trim_name=.true.)
select case (stat)
case (1)
!*!print *, NAME, " is not defined in the environment. Strange..."
VALUE=''
case (2)
!*!print *, "This processor doesn't support environment variables. Boooh!"
VALUE=''
case default
! make string to hold value of sufficient size
allocate(character(len=max(howbig,1)) :: VALUE)
! get value
call get_environment_variable(NAME,VALUE,status=stat,trim_name=.true.)
if(stat.ne.0)VALUE=''
end select
else
VALUE=''
endif
if(VALUE.eq.''.and.present(DEFAULT))VALUE=DEFAULT
end function get_env
end module fpm_environment
|
