aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorBrad Richardson <everythingfunctional@protonmail.com>2021-04-19 19:19:24 -0500
committerBrad Richardson <everythingfunctional@protonmail.com>2021-04-19 19:19:24 -0500
commitfaced2359ff7bf1c003aaf3990d006fde1124186 (patch)
tree306911e067d31e3a0348adbb7f7d658503451808 /src
parent0ac5f5bef94c8f12caa64f19fe6cb5026a5535c0 (diff)
downloadfpm-faced2359ff7bf1c003aaf3990d006fde1124186.tar.gz
fpm-faced2359ff7bf1c003aaf3990d006fde1124186.zip
refactor(get_archiver): extract to it's own function
Diffstat (limited to 'src')
-rw-r--r--src/fpm.f9019
-rw-r--r--src/fpm_environment.f9027
2 files changed, 26 insertions, 20 deletions
diff --git a/src/fpm.f90 b/src/fpm.f90
index 3e2b518..fa2087d 100644
--- a/src/fpm.f90
+++ b/src/fpm.f90
@@ -4,7 +4,7 @@ use fpm_backend, only: build_package
use fpm_command_line, only: fpm_build_settings, fpm_new_settings, &
fpm_run_settings, fpm_install_settings, fpm_test_settings
use fpm_dependency, only : new_dependency_tree
-use fpm_environment, only: get_os_type, run, OS_UNKNOWN, OS_WINDOWS
+use fpm_environment, only: get_archiver, run
use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, basename
use fpm_model, only: fpm_model_t, srcfile_t, show_model, &
FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, FPM_SCOPE_DEP, &
@@ -62,22 +62,7 @@ subroutine build_model(model, settings, package, error)
model%fortran_compiler = settings%compiler
endif
- associate(os_type => get_os_type())
- if (os_type /= OS_WINDOWS .and. os_type /= OS_UNKNOWN) then
- model%archiver = "ar -rs "
- else
- block
- integer :: estat
-
- call execute_command_line("ar --version", exitstat=estat)
- if (estat /= 0) then
- model%archiver = "lib /OUT:"
- else
- model%archiver = "ar -rs "
- end if
- end block
- end if
- end associate
+ model%archiver = get_archiver()
if (is_unknown_compiler(model%fortran_compiler)) then
write(*, '(*(a:,1x))') &
diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90
index 0408ec4..cde1780 100644
--- a/src/fpm_environment.f90
+++ b/src/fpm_environment.f90
@@ -1,5 +1,5 @@
!> 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
@@ -9,6 +9,7 @@ module fpm_environment
public :: os_is_unix
public :: run
public :: get_env
+ public :: get_archiver
integer, parameter, public :: OS_UNKNOWN = 0
integer, parameter, public :: OS_LINUX = 1
@@ -110,7 +111,7 @@ contains
end if
end function get_os_type
- !> Compare the output of [[get_os_type]] or the optional
+ !> 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)
@@ -150,7 +151,7 @@ contains
function get_env(NAME,DEFAULT) result(VALUE)
implicit none
!> name of environment variable to get the value of
- character(len=*),intent(in) :: NAME
+ 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
@@ -182,4 +183,24 @@ contains
if(VALUE.eq.''.and.present(DEFAULT))VALUE=DEFAULT
end function get_env
+ function get_archiver() result(archiver)
+ character(:), allocatable :: archiver
+
+ associate(os_type => get_os_type())
+ if (os_type /= OS_WINDOWS .and. os_type /= OS_UNKNOWN) then
+ archiver = "ar -rs "
+ else
+ block
+ integer :: estat
+
+ call execute_command_line("ar --version", exitstat=estat)
+ if (estat /= 0) then
+ archiver = "lib /OUT:"
+ else
+ archiver = "ar -rs "
+ end if
+ end block
+ end if
+ end associate
+ end function
end module fpm_environment