Remove ENV_VARIABLE() as it duplicates the functionality of GET_ENV() (…

…#942)
fortran-lang · Jun 19, 2023 · 5333702 · 5333702
2 parents 210aafc + bf88610
commit 5333702
Show file tree

Hide file tree

Showing 3 changed files with 16 additions and 45 deletions.
diff --git a/src/fpm_compiler.F90 b/src/fpm_compiler.F90
@@ -28,7 +28,6 @@
 module fpm_compiler
 use,intrinsic :: iso_fortran_env, only: stderr=>error_unit
 use fpm_environment, only: &
-        get_env, &
         get_os_type, &
         OS_LINUX, &
         OS_MACOS, &

diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90
@@ -14,8 +14,7 @@ module fpm_filesystem
     public :: basename, canon_path, dirname, is_dir, join_path, number_of_rows, list_files, get_local_prefix, &
             mkdir, exists, get_temp_filename, windows_path, unix_path, getline, delete_file, fileopen, fileclose, &
             filewrite, warnwrite, parent_dir, is_hidden_file, read_lines, read_lines_expanded, which, run, &
-            os_delete_dir, is_absolute_path, env_variable, get_home, execute_and_read_output, &
-            get_dos_path
+            os_delete_dir, is_absolute_path, get_home, execute_and_read_output, get_dos_path
 
 #ifndef FPM_BOOTSTRAP
     interface
@@ -53,32 +52,7 @@ end function c_is_dir
 
 contains
 
-
-!> return value of environment variable
-subroutine env_variable(var, name)
-   character(len=:), allocatable, intent(out) :: var
-   character(len=*), intent(in) :: name
-   integer :: length, stat
-
-   call get_environment_variable(name, length=length, status=stat)
-   if (stat /= 0) return
-
-   allocate(character(len=length) :: var)
-
-   if (length > 0) then
-      call get_environment_variable(name, var, status=stat)
-      if (stat /= 0) then
-         deallocate(var)
-         return
-      end if
-   end if
-
-end subroutine env_variable
-
-
-!> Extract filename from path with or without suffix.
-!>
-!> The suffix is included by default.
+!> Extract filename from path with/without suffix
 function basename(path,suffix) result (base)
 
     character(*), intent(In) :: path
@@ -1079,15 +1053,15 @@ function get_local_prefix(os) result(prefix)
         character(len=:), allocatable :: home
 
         if (os_is_unix(os)) then
-            call env_variable(home, "HOME")
-            if (allocated(home)) then
+            home=get_env('HOME','')
+            if (home /= '' ) then
                 prefix = join_path(home, ".local")
             else
                 prefix = default_prefix_unix
             end if
         else
-            call env_variable(home, "APPDATA")
-            if (allocated(home)) then
+            home=get_env('APPDATA','')
+            if (home /= '' ) then
                 prefix = join_path(home, "local")
             else
                 prefix = default_prefix_win
@@ -1130,14 +1104,14 @@ subroutine get_home(home, error)
         type(error_t), allocatable, intent(out) :: error
 
         if (os_is_unix()) then
-            call env_variable(home, 'HOME')
-            if (.not. allocated(home)) then
+            home=get_env('HOME','')
+            if ( home == '' ) then
                 call fatal_error(error, "Couldn't retrieve 'HOME' variable")
                 return
             end if
         else
-            call env_variable(home, 'USERPROFILE')
-            if (.not. allocated(home)) then
+            home=get_env('USERPROFILE','')
+            if ( home == '' ) then
                 call fatal_error(error, "Couldn't retrieve '%USERPROFILE%' variable")
                 return
             end if

diff --git a/test/fpm_test/test_os.f90 b/test/fpm_test/test_os.f90
@@ -1,7 +1,7 @@
 module test_os
     use testsuite, only: new_unittest, unittest_t, error_t, test_failed
-    use fpm_filesystem, only: env_variable, join_path, mkdir, os_delete_dir, is_dir, get_local_prefix, get_home
-    use fpm_environment, only: os_is_unix
+    use fpm_filesystem, only: join_path, mkdir, os_delete_dir, is_dir, get_local_prefix, get_home
+    use fpm_environment, only: os_is_unix, get_env
     use fpm_os, only: get_absolute_path, get_absolute_path_by_cd, get_current_directory
 
     implicit none
@@ -134,7 +134,7 @@ subroutine abs_path_nonexisting(error)
     subroutine abs_path_root(error)
         type(error_t), allocatable, intent(out) :: error
 
-        character(len=:), allocatable :: home_drive, home_path, result
+        character(len=:), allocatable :: home_path, result
 
         if (os_is_unix()) then
             call get_absolute_path('/', result, error)
@@ -144,8 +144,7 @@ subroutine abs_path_root(error)
                 call test_failed(error, "Result '"//result//"' doesn't equal input value: '/'"); return
             end if
         else
-            call env_variable(home_drive, 'HOMEDRIVE')
-            home_path = home_drive//'\'
+            home_path = get_env('HOMEDRIVE','') //'\'
 
             call get_absolute_path(home_path, result, error)
             if (allocated(error)) return
@@ -177,7 +176,7 @@ subroutine abs_path_home(error)
     subroutine abs_path_cd_root(error)
         type(error_t), allocatable, intent(out) :: error
 
-        character(len=:), allocatable :: home_drive, home_path, current_dir_before, current_dir_after, result
+        character(len=:), allocatable :: home_path, current_dir_before, current_dir_after, result
 
         call get_current_directory(current_dir_before, error)
         if (allocated(error)) return
@@ -189,8 +188,7 @@ subroutine abs_path_cd_root(error)
                 call test_failed(error, "Result '"//result//"' doesn't equal input value: '/'"); return
             end if
         else
-            call env_variable(home_drive, 'HOMEDRIVE')
-            home_path = home_drive//'\'
+            home_path = get_env('HOMEDRIVE','')//'\'
 
             call get_absolute_path_by_cd(home_path, result, error)