Skip to content

Commit c492ac3

Browse files
milancurcicmilancurcic
authored
Merge pull request #162 from interkosmos/master
Updated OS type identification
2 parents f641aae + 1975e92 commit c492ac3

File tree

3 files changed

+176
-113
lines changed

3 files changed

+176
-113
lines changed

‎fpm/src/fpm_command_line.f90

Lines changed: 33 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,17 @@
11
module fpm_command_line
2-
use fpm_environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS
3-
2+
use fpm_environment, only: get_os_type, &
3+
OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, &
4+
OS_CYGWIN, OS_SOLARIS, OS_FREEBSD
45
implicit none
5-
6+
67
private
78
public :: fpm_cmd_settings, &
89
fpm_build_settings, &
910
fpm_install_settings, &
1011
fpm_new_settings, &
1112
fpm_run_settings, &
1213
fpm_test_settings, &
13-
get_command_line_settings
14+
get_command_line_settings
1415

1516
type, abstract :: fpm_cmd_settings
1617
end type
@@ -62,24 +63,40 @@ subroutine get_command_line_settings(cmd_settings)
6263
end subroutine
6364

6465
subroutine print_help()
65-
print *, "fpm - A Fortran package manager and build system"
66+
print *, 'fpm - A Fortran package manager and build system'
67+
6668
select case (get_os_type())
69+
case (OS_UNKNOWN)
70+
print *, 'OS Type: Unknown'
71+
6772
case (OS_LINUX)
68-
print *, "OS Type: Linux"
73+
print *, 'OS Type: Linux'
74+
6975
case (OS_MACOS)
70-
print *, "OS Type: macOS"
76+
print *, 'OS Type: macOS'
77+
7178
case (OS_WINDOWS)
72-
print *, "OS Type: Windows"
79+
print *, 'OS Type: Windows'
80+
81+
case (OS_CYGWIN)
82+
print *, 'OS Type: Cygwin'
83+
84+
case (OS_SOLARIS)
85+
print *, 'OS Type: Solaris'
86+
87+
case (OS_FREEBSD)
88+
print *, 'OS Type: FreeBSD'
7389
end select
90+
7491
print *
75-
print *, "Usage:"
76-
print *, " fpm [COMMAND]"
92+
print *, 'Usage:'
93+
print *, ' fpm [COMMAND]'
7794
print *
78-
print *, "Valid fpm commands are:"
79-
print *, " build Compile the current package"
80-
print *, " install Install a Fortran binary or library (not implemented)"
81-
print *, " new Create a new Fortran package (not implemented)"
82-
print *, " run Run a binary of the local package (not implemented)"
83-
print *, " test Run the tests (not implemented)"
95+
print *, 'Valid fpm commands are:'
96+
print *, ' build Compile the current package'
97+
print *, ' install Install a Fortran binary or library (not implemented)'
98+
print *, ' new Create a new Fortran package (not implemented)'
99+
print *, ' run Run a binary of the local package (not implemented)'
100+
print *, ' test Run the tests (not implemented)'
84101
end subroutine
85102
end module fpm_command_line

‎fpm/src/fpm_environment.f90

Lines changed: 101 additions & 51 deletions
Original file line numberDiff line numberDiff line change
@@ -1,67 +1,117 @@
11
module fpm_environment
22
implicit none
33
private
4-
public :: get_os_type, run
5-
public :: OS_LINUX, OS_MACOS, OS_WINDOWS
6-
7-
integer, parameter :: OS_LINUX = 1
8-
integer, parameter :: OS_MACOS = 2
9-
integer, parameter :: OS_WINDOWS = 3
4+
public :: get_os_type
5+
public :: run
106

7+
integer, parameter, public :: OS_UNKNOWN = 0
8+
integer, parameter, public :: OS_LINUX = 1
9+
integer, parameter, public :: OS_MACOS = 2
10+
integer, parameter, public :: OS_WINDOWS = 3
11+
integer, parameter, public :: OS_CYGWIN = 4
12+
integer, parameter, public :: OS_SOLARIS = 5
13+
integer, parameter, public :: OS_FREEBSD = 6
1114
contains
1215
integer function get_os_type() result(r)
13-
! Determine the OS type
14-
!
15-
! Returns one of OS_LINUX, OS_MACOS, OS_WINDOWS.
16-
!
17-
! Currently we use the $HOME and $HOMEPATH environment variables to determine
18-
! the OS type. That is not 100% accurate in all cases, but it seems to be good
19-
! enough for now. See the following issue for a more robust solution:
20-
!
21-
! https://github.com/fortran-lang/fpm/issues/144
22-
!
23-
character(len=100) :: val
24-
integer stat
25-
! Only Windows define $HOMEPATH by default and we test its value to improve the
26-
! chances of it working even if a user defines $HOMEPATH on Linux or macOS.
27-
call get_environment_variable("HOMEPATH", val, status=stat)
28-
if (stat == 0 .and. val(1:7) == "\Users\") then
29-
r = OS_WINDOWS
30-
return
31-
end if
32-
33-
! We assume that $HOME=/home/... is Linux, $HOME=/Users/... is macOS, otherwise
34-
! we assume Linux. This is only a heuristic and can easily fail.
35-
call get_environment_variable("HOME", val, status=stat)
36-
if (stat == 1) then
37-
print *, "$HOME does not exist"
38-
error stop
39-
end if
40-
if (stat /= 0) then
41-
print *, "get_environment_variable() failed"
42-
error stop
43-
end if
44-
if (val(1:6) == "/home/") then
45-
r = OS_LINUX
46-
else if (val(1:7) == "/Users/") then
47-
r = OS_MACOS
48-
else
49-
! This will happen on HPC systems that typically do not use either /home nor
50-
! /Users for $HOME. Those systems are typically Linux, so for now we simply
51-
! set Linux here.
52-
r = OS_LINUX
53-
end if
54-
end function
16+
!! Determine the OS type
17+
!!
18+
!! Returns one of OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, OS_CYGWIN,
19+
!! OS_SOLARIS, OS_FREEBSD.
20+
!!
21+
!! At first, the environment variable `OS` is checked, which is usually
22+
!! found on Windows. Then, `OSTYPE` is read in and compared with common
23+
!! names. If this fails too, check the existence of files that can be
24+
!! found on specific system types only.
25+
!!
26+
!! Returns OS_UNKNOWN if the operating system cannot be determined.
27+
character(len=32) :: val
28+
integer :: length, rc
29+
logical :: file_exists
30+
31+
r = OS_UNKNOWN
32+
33+
! Check environment variable `OS`.
34+
call get_environment_variable('OS', val, length, rc)
35+
36+
if (rc == 0 .and. length > 0 .and. index(val, 'Windows_NT') > 0) then
37+
r = OS_WINDOWS
38+
return
39+
end if
40+
41+
! Check environment variable `OSTYPE`.
42+
call get_environment_variable('OSTYPE', val, length, rc)
43+
44+
if (rc == 0 .and. length > 0) then
45+
! Linux
46+
if (index(val, 'linux') > 0) then
47+
r = OS_LINUX
48+
return
49+
end if
50+
51+
! macOS
52+
if (index(val, 'darwin') > 0) then
53+
r = OS_MACOS
54+
return
55+
end if
56+
57+
! Windows, MSYS, MinGW, Git Bash
58+
if (index(val, 'win') > 0 .or. index(val, 'msys') > 0) then
59+
r = OS_WINDOWS
60+
return
61+
end if
62+
63+
! Cygwin
64+
if (index(val, 'cygwin') > 0) then
65+
r = OS_CYGWIN
66+
return
67+
end if
68+
69+
! Solaris, OpenIndiana, ...
70+
if (index(val, 'SunOS') > 0 .or. index(val, 'solaris') > 0) then
71+
r = OS_SOLARIS
72+
return
73+
end if
74+
75+
! FreeBSD
76+
if (index(val, 'FreeBSD') > 0 .or. index(val, 'freebsd') > 0) then
77+
r = OS_FREEBSD
78+
return
79+
end if
80+
end if
81+
82+
! Linux
83+
inquire (file='/etc/os-release', exist=file_exists)
84+
85+
if (file_exists) then
86+
r = OS_LINUX
87+
return
88+
end if
89+
90+
! macOS
91+
inquire (file='/usr/bin/sw_vers', exist=file_exists)
92+
93+
if (file_exists) then
94+
r = OS_MACOS
95+
return
96+
end if
97+
98+
! FreeBSD
99+
inquire (file='/bin/freebsd-version', exist=file_exists)
100+
101+
if (file_exists) then
102+
r = OS_FREEBSD
103+
return
104+
end if
105+
end function get_os_type
55106

56107
subroutine run(cmd)
57108
character(len=*), intent(in) :: cmd
58109
integer :: stat
59-
print *, "+ ", cmd
110+
print *, '+ ', cmd
60111
call execute_command_line(cmd, exitstat=stat)
61112
if (stat /= 0) then
62-
print *, "Command failed"
113+
print *, 'Command failed'
63114
error stop
64115
end if
65116
end subroutine run
66-
67117
end module fpm_environment

‎fpm/src/fpm_filesystem.f90

Lines changed: 42 additions & 46 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,14 @@
11
module fpm_filesystem
2-
use fpm_environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS
3-
use fpm_strings, only: f_string, string_t, split
4-
implicit none
2+
use fpm_environment, only: get_os_type, &
3+
OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, &
4+
OS_CYGWIN, OS_SOLARIS, OS_FREEBSD
5+
use fpm_strings, only: f_string, string_t, split
6+
implicit none
7+
private
8+
public :: basename, join_path, number_of_rows, read_lines, list_files, &
9+
mkdir, exists, get_temp_filename, windows_path
510

6-
private
7-
public :: basename, join_path, number_of_rows, read_lines, list_files,&
8-
mkdir, exists, get_temp_filename, windows_path
9-
10-
integer, parameter :: LINE_BUFFER_LEN = 1000
11+
integer, parameter :: LINE_BUFFER_LEN = 1000
1112

1213
contains
1314

@@ -34,25 +35,24 @@ function basename(path,suffix) result (base)
3435
else
3536
call split(path,file_parts,delimiters='\/.')
3637
base = trim(file_parts(size(file_parts)-1))
37-
end if
38+
end if
3839

3940
end function basename
4041

4142

4243
function join_path(a1,a2,a3,a4,a5) result(path)
43-
! Construct path by joining strings with os file separator
44+
! Construct path by joining strings with os file separator
4445
!
45-
character(*), intent(in) :: a1, a2
46-
character(*), intent(in), optional :: a3,a4,a5
47-
character(:), allocatable :: path
48-
49-
character(1) :: filesep
46+
character(len=*), intent(in) :: a1, a2
47+
character(len=*), intent(in), optional :: a3, a4, a5
48+
character(len=:), allocatable :: path
49+
character(len=1) :: filesep
5050

5151
select case (get_os_type())
52-
case (OS_LINUX,OS_MACOS)
53-
filesep = '/'
54-
case (OS_WINDOWS)
55-
filesep = '\'
52+
case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD)
53+
filesep = '/'
54+
case (OS_WINDOWS)
55+
filesep = '\'
5656
end select
5757

5858
path = a1 // filesep // a2
@@ -110,61 +110,57 @@ function read_lines(fh) result(lines)
110110
end function read_lines
111111

112112
subroutine mkdir(dir)
113-
character(*), intent(in) :: dir
114-
115-
integer :: stat
113+
character(len=*), intent(in) :: dir
114+
integer :: stat
116115

117116
select case (get_os_type())
118-
case (OS_LINUX,OS_MACOS)
119-
call execute_command_line("mkdir -p " // dir , exitstat=stat)
120-
write(*,*) "mkdir -p " // dir
121-
case (OS_WINDOWS)
122-
call execute_command_line("mkdir " // windows_path(dir), exitstat=stat)
123-
write(*,*) "mkdir " // windows_path(dir)
117+
case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD)
118+
call execute_command_line('mkdir -p ' // dir, exitstat=stat)
119+
write (*, '(2a)') 'mkdir -p ' // dir
120+
121+
case (OS_WINDOWS)
122+
call execute_command_line("mkdir " // windows_path(dir), exitstat=stat)
123+
write (*, '(2a)') 'mkdir ' // windows_path(dir)
124124
end select
125+
125126
if (stat /= 0) then
126-
print *, "execute_command_line() failed"
127+
print *, 'execute_command_line() failed'
127128
error stop
128129
end if
129-
130130
end subroutine mkdir
131131

132132

133133
subroutine list_files(dir, files)
134-
character(len=*), intent(in) :: dir
134+
character(len=*), intent(in) :: dir
135135
type(string_t), allocatable, intent(out) :: files(:)
136-
137-
integer :: stat, fh
138-
character(:), allocatable :: temp_file
136+
character(len=:), allocatable :: temp_file
137+
integer :: stat, fh
139138

140139
! Using `inquire` / exists on directories works with gfortran, but not ifort
141140
if (.not. exists(dir)) then
142-
allocate(files(0))
141+
allocate (files(0))
143142
return
144143
end if
145144

146-
allocate(temp_file, source = get_temp_filename() )
145+
allocate (temp_file, source=get_temp_filename())
147146

148147
select case (get_os_type())
149-
case (OS_LINUX)
150-
call execute_command_line("ls " // dir // " > "//temp_file, &
151-
exitstat=stat)
152-
case (OS_MACOS)
153-
call execute_command_line("ls " // dir // " > "//temp_file, &
148+
case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD)
149+
call execute_command_line('ls ' // dir // ' > ' // temp_file, &
154150
exitstat=stat)
155151
case (OS_WINDOWS)
156-
call execute_command_line("dir /b " // windows_path(dir) // " > "//temp_file, &
152+
call execute_command_line('dir /b ' // windows_path(dir) // ' > ' // temp_file, &
157153
exitstat=stat)
158154
end select
155+
159156
if (stat /= 0) then
160-
print *, "execute_command_line() failed"
157+
print *, 'execute_command_line() failed'
161158
error stop
162159
end if
163160

164-
open(newunit=fh, file=temp_file, status="old")
161+
open (newunit=fh, file=temp_file, status='old')
165162
files = read_lines(fh)
166-
close(fh,status="delete")
167-
163+
close (fh, status='delete')
168164
end subroutine list_files
169165

170166

0 commit comments

Comments
 (0)