@@ -14,8 +14,7 @@ module fpm_filesystem
14
14
public :: basename, canon_path, dirname, is_dir, join_path, number_of_rows, list_files, get_local_prefix, &
15
15
mkdir, exists, get_temp_filename, windows_path, unix_path, getline, delete_file, fileopen, fileclose, &
16
16
filewrite, warnwrite, parent_dir, is_hidden_file, read_lines, read_lines_expanded, which, run, &
17
- os_delete_dir, is_absolute_path, env_variable, get_home, execute_and_read_output, &
18
- get_dos_path
17
+ os_delete_dir, is_absolute_path, get_home, execute_and_read_output, get_dos_path
19
18
20
19
#ifndef FPM_BOOTSTRAP
21
20
interface
@@ -53,32 +52,7 @@ end function c_is_dir
53
52
54
53
contains
55
54
56
-
57
- ! > return value of environment variable
58
- subroutine env_variable (var , name )
59
- character (len= :), allocatable , intent (out ) :: var
60
- character (len=* ), intent (in ) :: name
61
- integer :: length, stat
62
-
63
- call get_environment_variable(name, length= length, status= stat)
64
- if (stat /= 0 ) return
65
-
66
- allocate (character (len= length) :: var)
67
-
68
- if (length > 0 ) then
69
- call get_environment_variable(name, var, status= stat)
70
- if (stat /= 0 ) then
71
- deallocate (var)
72
- return
73
- end if
74
- end if
75
-
76
- end subroutine env_variable
77
-
78
-
79
- ! > Extract filename from path with or without suffix.
80
- ! >
81
- ! > The suffix is included by default.
55
+ ! > Extract filename from path with/without suffix
82
56
function basename (path ,suffix ) result (base)
83
57
84
58
character (* ), intent (In ) :: path
@@ -710,7 +684,6 @@ subroutine getline(unit, line, iostat, iomsg)
710
684
integer :: size
711
685
integer :: stat
712
686
713
-
714
687
allocate (character (len= 0 ) :: line)
715
688
do
716
689
read (unit, ' (a)' , advance= ' no' , iostat= stat, iomsg= msg, size= size) &
@@ -1079,15 +1052,15 @@ function get_local_prefix(os) result(prefix)
1079
1052
character (len= :), allocatable :: home
1080
1053
1081
1054
if (os_is_unix(os)) then
1082
- call env_variable( home, " HOME" )
1083
- if (allocated ( home) ) then
1055
+ home= get_env( ' HOME' , ' ' )
1056
+ if (home /= ' ' ) then
1084
1057
prefix = join_path(home, " .local" )
1085
1058
else
1086
1059
prefix = default_prefix_unix
1087
1060
end if
1088
1061
else
1089
- call env_variable( home, " APPDATA" )
1090
- if (allocated ( home) ) then
1062
+ home= get_env( ' APPDATA' , ' ' )
1063
+ if (home /= ' ' ) then
1091
1064
prefix = join_path(home, " local" )
1092
1065
else
1093
1066
prefix = default_prefix_win
@@ -1130,39 +1103,45 @@ subroutine get_home(home, error)
1130
1103
type (error_t), allocatable , intent (out ) :: error
1131
1104
1132
1105
if (os_is_unix()) then
1133
- call env_variable( home, ' HOME' )
1134
- if (.not. allocated ( home) ) then
1106
+ home= get_env( ' HOME' , ' ' )
1107
+ if ( home == ' ' ) then
1135
1108
call fatal_error(error, " Couldn't retrieve 'HOME' variable" )
1136
1109
return
1137
1110
end if
1138
1111
else
1139
- call env_variable( home, ' USERPROFILE' )
1140
- if (.not. allocated ( home) ) then
1112
+ home= get_env( ' USERPROFILE' , ' ' )
1113
+ if ( home == ' ' ) then
1141
1114
call fatal_error(error, " Couldn't retrieve '%USERPROFILE%' variable" )
1142
1115
return
1143
1116
end if
1144
1117
end if
1145
1118
end subroutine get_home
1146
1119
1147
1120
! > Execute command line and return output as a string.
1148
- subroutine execute_and_read_output (cmd , output , error , exitstat )
1121
+ subroutine execute_and_read_output (cmd , output , error , verbose )
1149
1122
! > Command to execute.
1150
1123
character (len=* ), intent (in ) :: cmd
1151
1124
! > Command line output.
1152
1125
character (len= :), allocatable , intent (out ) :: output
1153
1126
! > Error to handle.
1154
1127
type (error_t), allocatable , intent (out ) :: error
1155
- ! > Can optionally used for error handling .
1156
- integer , intent (out ), optional :: exitstat
1128
+ ! > Print additional information if true .
1129
+ logical , intent (in ), optional :: verbose
1157
1130
1158
- integer :: cmdstat, unit, stat = 0
1159
- character (len= :), allocatable :: cmdmsg, tmp_file
1160
- character (len= :),allocatable :: output_line
1131
+ integer :: exitstat, unit, stat
1132
+ character (len= :), allocatable :: cmdmsg, tmp_file, output_line
1133
+ logical :: is_verbose
1134
+
1135
+ if (present (verbose)) then
1136
+ is_verbose = verbose
1137
+ else
1138
+ is_verbose = .false.
1139
+ end if
1161
1140
1162
1141
tmp_file = get_temp_filename()
1163
1142
1164
- call execute_command_line (cmd// ' > ' // tmp_file, exitstat= exitstat, cmdstat = cmdstat )
1165
- if (cmdstat /= 0 ) call fatal_error(error, ' *run*: ' // " Command failed: '" // cmd// " '. Message: '" // trim (cmdmsg)// " '." )
1143
+ call run (cmd// ' > ' // tmp_file, exitstat= exitstat, echo = is_verbose )
1144
+ if (exitstat /= 0 ) call fatal_error(error, ' *run*: ' // " Command failed: '" // cmd// " '. Message: '" // trim (cmdmsg)// " '." )
1166
1145
1167
1146
open (newunit= unit, file= tmp_file, action= ' read' , status= ' old' )
1168
1147
output = ' '
@@ -1171,8 +1150,9 @@ subroutine execute_and_read_output(cmd, output, error, exitstat)
1171
1150
if (stat /= 0 ) exit
1172
1151
output = output// output_line// ' '
1173
1152
end do
1174
- close (unit, status= ' delete' ,iostat= stat)
1175
- end subroutine execute_and_read_output
1153
+ if (is_verbose) print * , output
1154
+ close (unit, status= ' delete' )
1155
+ end
1176
1156
1177
1157
! > Ensure a windows path is converted to an 8.3 DOS path if it contains spaces
1178
1158
function get_dos_path (path ,error )
0 commit comments