From faced2359ff7bf1c003aaf3990d006fde1124186 Mon Sep 17 00:00:00 2001
From: Brad Richardson <everythingfunctional@protonmail.com>
Date: Mon, 19 Apr 2021 19:19:24 -0500
Subject: refactor(get_archiver): extract to it's own function

---
 src/fpm.f90             | 19 ++-----------------
 src/fpm_environment.f90 | 27 ++++++++++++++++++++++++---
 2 files changed, 26 insertions(+), 20 deletions(-)

(limited to 'src')

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
-- 
cgit v1.2.3