diff options
| -rw-r--r-- | fpm/src/fpm_command_line.f90 | 49 | ||||
| -rw-r--r-- | fpm/src/fpm_environment.f90 | 152 | ||||
| -rw-r--r-- | fpm/src/fpm_filesystem.f90 | 88 |
3 files changed, 176 insertions, 113 deletions
diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 5e9daee..406b58e 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -1,8 +1,9 @@ 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, & @@ -10,7 +11,7 @@ module fpm_command_line fpm_new_settings, & fpm_run_settings, & fpm_test_settings, & - get_command_line_settings + get_command_line_settings type, abstract :: fpm_cmd_settings end type @@ -62,24 +63,40 @@ contains 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 diff --git a/fpm/src/fpm_environment.f90 b/fpm/src/fpm_environment.f90 index 9ac42ac..553aa8b 100644 --- a/fpm/src/fpm_environment.f90 +++ b/fpm/src/fpm_environment.f90 @@ -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 diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index d5c8e67..985cde8 100644 --- a/fpm/src/fpm_filesystem.f90 +++ b/fpm/src/fpm_filesystem.f90 @@ -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 @@ -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 @@ -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 |