diff options
Diffstat (limited to 'src/fpm_environment.f90')
| -rw-r--r-- | src/fpm_environment.f90 | 185 |
1 files changed, 185 insertions, 0 deletions
diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 new file mode 100644 index 0000000..0408ec4 --- /dev/null +++ b/src/fpm_environment.f90 @@ -0,0 +1,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 |