Skip to content

Updated OS type identification #162

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 4 commits into from
Sep 15, 2020
Merged

Updated OS type identification #162

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
61b84f8
Updated OS type identification.
interkosmos Sep 5, 2020
c7c6ef0
Added new OS type checks.
interkosmos Sep 12, 2020
6fd7361
Removed colons.
interkosmos Sep 14, 2020
1975e92
Removed colons.
interkosmos Sep 15, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
49 changes: 33 additions & 16 deletions fpm/src/fpm_command_line.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,16 +1,17 @@
module fpm_command_line
use fpm_environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS

use fpm_environment, only: get_os_type, &
OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, &
OS_CYGWIN, OS_SOLARIS, OS_FREEBSD
implicit none

private
public :: fpm_cmd_settings, &
fpm_build_settings, &
fpm_install_settings, &
fpm_new_settings, &
fpm_run_settings, &
fpm_test_settings, &
get_command_line_settings
get_command_line_settings

type, abstract :: fpm_cmd_settings
end type
Expand Down Expand Up @@ -62,24 +63,40 @@ subroutine get_command_line_settings(cmd_settings)
end subroutine

subroutine print_help()
print *, "fpm - A Fortran package manager and build system"
print *, 'fpm - A Fortran package manager and build system'

select case (get_os_type())
case (OS_UNKNOWN)
print *, 'OS Type: Unknown'

case (OS_LINUX)
print *, "OS Type: Linux"
print *, 'OS Type: Linux'

case (OS_MACOS)
print *, "OS Type: macOS"
print *, 'OS Type: macOS'

case (OS_WINDOWS)
print *, "OS Type: Windows"
print *, 'OS Type: Windows'

case (OS_CYGWIN)
print *, 'OS Type: Cygwin'

case (OS_SOLARIS)
print *, 'OS Type: Solaris'

case (OS_FREEBSD)
print *, 'OS Type: FreeBSD'
end select

print *
print *, "Usage:"
print *, " fpm [COMMAND]"
print *, 'Usage:'
print *, ' fpm [COMMAND]'
print *
print *, "Valid fpm commands are:"
print *, " build Compile the current package"
print *, " install Install a Fortran binary or library (not implemented)"
print *, " new Create a new Fortran package (not implemented)"
print *, " run Run a binary of the local package (not implemented)"
print *, " test Run the tests (not implemented)"
print *, 'Valid fpm commands are:'
print *, ' build Compile the current package'
print *, ' install Install a Fortran binary or library (not implemented)'
print *, ' new Create a new Fortran package (not implemented)'
print *, ' run Run a binary of the local package (not implemented)'
print *, ' test Run the tests (not implemented)'
end subroutine
end module fpm_command_line
152 changes: 101 additions & 51 deletions fpm/src/fpm_environment.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,67 +1,117 @@
module fpm_environment
implicit none
private
public :: get_os_type, run
public :: OS_LINUX, OS_MACOS, OS_WINDOWS

integer, parameter :: OS_LINUX = 1
integer, parameter :: OS_MACOS = 2
integer, parameter :: OS_WINDOWS = 3
public :: get_os_type
public :: run

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
integer function get_os_type() result(r)
! Determine the OS type
!
! Returns one of OS_LINUX, OS_MACOS, OS_WINDOWS.
!
! Currently we use the $HOME and $HOMEPATH environment variables to determine
! the OS type. That is not 100% accurate in all cases, but it seems to be good
! enough for now. See the following issue for a more robust solution:
!
! https://github.com/fortran-lang/fpm/issues/144
!
character(len=100) :: val
integer stat
! Only Windows define $HOMEPATH by default and we test its value to improve the
! chances of it working even if a user defines $HOMEPATH on Linux or macOS.
call get_environment_variable("HOMEPATH", val, status=stat)
if (stat == 0 .and. val(1:7) == "\Users\") then
r = OS_WINDOWS
return
end if

! We assume that $HOME=/home/... is Linux, $HOME=/Users/... is macOS, otherwise
! we assume Linux. This is only a heuristic and can easily fail.
call get_environment_variable("HOME", val, status=stat)
if (stat == 1) then
print *, "$HOME does not exist"
error stop
end if
if (stat /= 0) then
print *, "get_environment_variable() failed"
error stop
end if
if (val(1:6) == "/home/") then
r = OS_LINUX
else if (val(1:7) == "/Users/") then
r = OS_MACOS
else
! This will happen on HPC systems that typically do not use either /home nor
! /Users for $HOME. Those systems are typically Linux, so for now we simply
! set Linux here.
r = OS_LINUX
end if
end function
!! Determine the OS type
!!
!! 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

subroutine run(cmd)
character(len=*), intent(in) :: cmd
integer :: stat
print *, "+ ", cmd
print *, '+ ', cmd
call execute_command_line(cmd, exitstat=stat)
if (stat /= 0) then
print *, "Command failed"
print *, 'Command failed'
error stop
end if
end subroutine run

end module fpm_environment
88 changes: 42 additions & 46 deletions fpm/src/fpm_filesystem.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,13 +1,14 @@
module fpm_filesystem
use fpm_environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS
use fpm_strings, only: f_string, string_t, split
implicit none
use fpm_environment, only: get_os_type, &
OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, &
OS_CYGWIN, OS_SOLARIS, OS_FREEBSD
use fpm_strings, only: f_string, string_t, split
implicit none
private
public :: basename, join_path, number_of_rows, read_lines, list_files, &
mkdir, exists, get_temp_filename, windows_path

private
public :: basename, join_path, number_of_rows, read_lines, list_files,&
mkdir, exists, get_temp_filename, windows_path

integer, parameter :: LINE_BUFFER_LEN = 1000
integer, parameter :: LINE_BUFFER_LEN = 1000

contains

Expand All @@ -34,25 +35,24 @@ function basename(path,suffix) result (base)
else
call split(path,file_parts,delimiters='\/.')
base = trim(file_parts(size(file_parts)-1))
end if
end if

end function basename


function join_path(a1,a2,a3,a4,a5) result(path)
! Construct path by joining strings with os file separator
! Construct path by joining strings with os file separator
!
character(*), intent(in) :: a1, a2
character(*), intent(in), optional :: a3,a4,a5
character(:), allocatable :: path

character(1) :: filesep
character(len=*), intent(in) :: a1, a2
character(len=*), intent(in), optional :: a3, a4, a5
character(len=:), allocatable :: path
character(len=1) :: filesep

select case (get_os_type())
case (OS_LINUX,OS_MACOS)
filesep = '/'
case (OS_WINDOWS)
filesep = '\'
case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD)
filesep = '/'
case (OS_WINDOWS)
filesep = '\'
end select

path = a1 // filesep // a2
Expand Down Expand Up @@ -110,61 +110,57 @@ function read_lines(fh) result(lines)
end function read_lines

subroutine mkdir(dir)
character(*), intent(in) :: dir

integer :: stat
character(len=*), intent(in) :: dir
integer :: stat

select case (get_os_type())
case (OS_LINUX,OS_MACOS)
call execute_command_line("mkdir -p " // dir , exitstat=stat)
write(*,*) "mkdir -p " // dir
case (OS_WINDOWS)
call execute_command_line("mkdir " // windows_path(dir), exitstat=stat)
write(*,*) "mkdir " // windows_path(dir)
case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD)
call execute_command_line('mkdir -p ' // dir, exitstat=stat)
write (*, '(2a)') 'mkdir -p ' // dir

case (OS_WINDOWS)
call execute_command_line("mkdir " // windows_path(dir), exitstat=stat)
write (*, '(2a)') 'mkdir ' // windows_path(dir)
end select

if (stat /= 0) then
print *, "execute_command_line() failed"
print *, 'execute_command_line() failed'
error stop
end if

end subroutine mkdir


subroutine list_files(dir, files)
character(len=*), intent(in) :: dir
character(len=*), intent(in) :: dir
type(string_t), allocatable, intent(out) :: files(:)

integer :: stat, fh
character(:), allocatable :: temp_file
character(len=:), allocatable :: temp_file
integer :: stat, fh

! Using `inquire` / exists on directories works with gfortran, but not ifort
if (.not. exists(dir)) then
allocate(files(0))
allocate (files(0))
return
end if

allocate(temp_file, source = get_temp_filename() )
allocate (temp_file, source=get_temp_filename())

select case (get_os_type())
case (OS_LINUX)
call execute_command_line("ls " // dir // " > "//temp_file, &
exitstat=stat)
case (OS_MACOS)
call execute_command_line("ls " // dir // " > "//temp_file, &
case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD)
call execute_command_line('ls ' // dir // ' > ' // temp_file, &
exitstat=stat)
case (OS_WINDOWS)
call execute_command_line("dir /b " // windows_path(dir) // " > "//temp_file, &
call execute_command_line('dir /b ' // windows_path(dir) // ' > ' // temp_file, &
exitstat=stat)
end select

if (stat /= 0) then
print *, "execute_command_line() failed"
print *, 'execute_command_line() failed'
error stop
end if

open(newunit=fh, file=temp_file, status="old")
open (newunit=fh, file=temp_file, status='old')
files = read_lines(fh)
close(fh,status="delete")

close (fh, status='delete')
end subroutine list_files


Expand Down