aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLaurence Kedward <laurence.kedward@bristol.ac.uk>2021-11-28 11:55:50 +0000
committerLaurence Kedward <laurence.kedward@bristol.ac.uk>2021-11-29 11:56:10 +0000
commit0c561b0f76bc6fa7777dec884a16b76694913adf (patch)
tree76d60af0501dc66ee8c81881ef2a01f0ad6039e5
parentb0115d1a000ee15d3ca773c3da3300595d805454 (diff)
downloadfpm-0c561b0f76bc6fa7777dec884a16b76694913adf.tar.gz
fpm-0c561b0f76bc6fa7777dec884a16b76694913adf.zip
Apply suggestion: move run to filesystem and use getline
fpm_environment::run is moved to fpm_filesystem so that it can use the getline function to retrieve redirected output from file
-rw-r--r--src/fpm.f905
-rw-r--r--src/fpm/cmd/new.f904
-rw-r--r--src/fpm_backend.F907
-rw-r--r--src/fpm_command_line.f904
-rw-r--r--src/fpm_compiler.f903
-rw-r--r--src/fpm_environment.f9069
-rw-r--r--src/fpm_filesystem.F9073
-rw-r--r--test/new_test/new_test.f904
8 files changed, 84 insertions, 85 deletions
diff --git a/src/fpm.f90 b/src/fpm.f90
index 135cadc..7291247 100644
--- a/src/fpm.f90
+++ b/src/fpm.f90
@@ -4,8 +4,9 @@ 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: run, get_env
-use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, basename, filewrite, mkdir
+use fpm_environment, only: get_env
+use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, &
+ basename, filewrite, mkdir, run
use fpm_model, only: fpm_model_t, srcfile_t, show_model, &
FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, FPM_SCOPE_DEP, &
FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST
diff --git a/src/fpm/cmd/new.f90 b/src/fpm/cmd/new.f90
index a402432..61afc74 100644
--- a/src/fpm/cmd/new.f90
+++ b/src/fpm/cmd/new.f90
@@ -54,9 +54,9 @@ module fpm_cmd_new
!> be the first go-to for a CLI utility).
use fpm_command_line, only : fpm_new_settings
-use fpm_environment, only : run, OS_LINUX, OS_MACOS, OS_WINDOWS
+use fpm_environment, only : OS_LINUX, OS_MACOS, OS_WINDOWS
use fpm_filesystem, only : join_path, exists, basename, mkdir, is_dir
-use fpm_filesystem, only : fileopen, fileclose, filewrite, warnwrite
+use fpm_filesystem, only : fileopen, fileclose, filewrite, warnwrite, run
use fpm_strings, only : join, to_fortran_name
use fpm_error, only : fpm_stop
use,intrinsic :: iso_fortran_env, only : stderr=>error_unit
diff --git a/src/fpm_backend.F90 b/src/fpm_backend.F90
index e666d03..ceba7ac 100644
--- a/src/fpm_backend.F90
+++ b/src/fpm_backend.F90
@@ -29,8 +29,7 @@ module fpm_backend
use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit
use fpm_error, only : fpm_stop
-use fpm_environment, only: run, get_os_type, OS_WINDOWS
-use fpm_filesystem, only: basename, dirname, join_path, exists, mkdir, LINE_BUFFER_LEN
+use fpm_filesystem, only: basename, dirname, join_path, exists, mkdir, run, getline
use fpm_model, only: fpm_model_t
use fpm_strings, only: string_t, operator(.in.)
use fpm_targets, only: build_target_t, build_target_ptr, FPM_TARGET_OBJECT, &
@@ -349,13 +348,13 @@ subroutine print_build_log(target)
type(build_target_t), intent(in), target :: target
integer :: fh, ios
- character(LINE_BUFFER_LEN) :: line
+ character(:), allocatable :: line
if (exists(target%output_log_file)) then
open(newunit=fh,file=target%output_log_file,status='old')
do
- read(fh, '(A)', iostat=ios) line
+ call getline(fh, line, ios)
if (ios /= 0) exit
write(*,'(A)') trim(line)
end do
diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90
index 0837bf2..99fdef2 100644
--- a/src/fpm_command_line.f90
+++ b/src/fpm_command_line.f90
@@ -29,8 +29,8 @@ use fpm_environment, only : get_os_type, get_env, &
use M_CLI2, only : set_args, lget, sget, unnamed, remaining, specified
use M_CLI2, only : get_subcommand, CLI_RESPONSE_FILE
use fpm_strings, only : lower, split, fnv_1a, to_fortran_name, is_fortran_name
-use fpm_filesystem, only : basename, canon_path, which
-use fpm_environment, only : run, get_command_arguments_quoted
+use fpm_filesystem, only : basename, canon_path, which, run
+use fpm_environment, only : get_command_arguments_quoted
use fpm_error, only : fpm_stop
use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, &
& stdout=>output_unit, &
diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90
index 2f939ad..1c086cc 100644
--- a/src/fpm_compiler.f90
+++ b/src/fpm_compiler.f90
@@ -27,7 +27,6 @@
! Unisys ? ? ? ? ? discontinued
module fpm_compiler
use fpm_environment, only: &
- run, &
get_env, &
get_os_type, &
OS_LINUX, &
@@ -39,7 +38,7 @@ use fpm_environment, only: &
OS_OPENBSD, &
OS_UNKNOWN
use fpm_filesystem, only: join_path, basename, get_temp_filename, delete_file, unix_path, &
- & getline
+ & getline, run
use fpm_strings, only: string_cat, string_t
implicit none
public :: compiler_t, new_compiler, archiver_t, new_archiver
diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90
index 224d2aa..7926703 100644
--- a/src/fpm_environment.f90
+++ b/src/fpm_environment.f90
@@ -11,7 +11,6 @@ module fpm_environment
private
public :: get_os_type
public :: os_is_unix
- public :: run
public :: get_env
public :: get_command_arguments_quoted
public :: separator
@@ -157,74 +156,6 @@ contains
unix = build_os /= OS_WINDOWS
end function os_is_unix
- !> echo command string and pass it to the system for execution
- subroutine run(cmd,echo,exitstat,verbose,redirect)
- character(len=*), intent(in) :: cmd
- logical,intent(in),optional :: echo
- integer, intent(out),optional :: exitstat
- logical, intent(in), optional :: verbose
- character(*), intent(in), optional :: redirect
-
- logical :: echo_local, verbose_local
- character(:), allocatable :: redirect_str
- character(1000) :: line
- integer :: stat, fh, ios
-
-
- if(present(echo))then
- echo_local=echo
- else
- echo_local=.true.
- end if
-
- if(present(verbose))then
- verbose_local=verbose
- else
- verbose_local=.true.
- end if
-
- if (present(redirect)) then
- redirect_str = ">"//redirect//" 2>&1"
- else
- if(verbose_local)then
- ! No redirection but verbose output
- redirect_str = ""
- else
- ! No redirection and non-verbose output
- if (os_is_unix()) then
- redirect_str = ">/dev/null 2>&1"
- else
- redirect_str = ">NUL 2>&1"
- end if
- end if
- end if
-
- if(echo_local) print *, '+ ', cmd
-
- call execute_command_line(cmd//redirect_str, exitstat=stat)
-
- if (verbose_local.and.present(redirect)) then
-
- open(newunit=fh,file=redirect,status='old')
- do
- read(fh, '(A)', iostat=ios) line
- if (ios /= 0) exit
- write(*,'(A)') trim(line)
- end do
- close(fh)
-
- end if
-
- if (present(exitstat)) then
- exitstat = stat
- else
- if (stat /= 0) then
- call fpm_stop(1,'*run*:Command failed')
- end if
- 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)
diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90
index 6127844..7510ba7 100644
--- a/src/fpm_filesystem.F90
+++ b/src/fpm_filesystem.F90
@@ -5,7 +5,7 @@ module fpm_filesystem
use fpm_environment, only: get_os_type, &
OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, &
OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD
- use fpm_environment, only: separator, get_env
+ use fpm_environment, only: separator, get_env, os_is_unix
use fpm_strings, only: f_string, replace, string_t, split, notabs
use iso_c_binding, only: c_char, c_ptr, c_int, c_null_char, c_associated, c_f_pointer
use fpm_error, only : fpm_stop
@@ -15,7 +15,7 @@ module fpm_filesystem
mkdir, exists, get_temp_filename, windows_path, unix_path, getline, delete_file
public :: fileopen, fileclose, filewrite, warnwrite, parent_dir
public :: read_lines, read_lines_expanded
- public :: which, LINE_BUFFER_LEN
+ public :: which, run, LINE_BUFFER_LEN
integer, parameter :: LINE_BUFFER_LEN = 1000
@@ -850,4 +850,73 @@ integer :: i, j
enddo SEARCH
end function which
+!> echo command string and pass it to the system for execution
+subroutine run(cmd,echo,exitstat,verbose,redirect)
+ character(len=*), intent(in) :: cmd
+ logical,intent(in),optional :: echo
+ integer, intent(out),optional :: exitstat
+ logical, intent(in), optional :: verbose
+ character(*), intent(in), optional :: redirect
+
+ logical :: echo_local, verbose_local
+ character(:), allocatable :: redirect_str
+ character(:), allocatable :: line
+ integer :: stat, fh, ios
+
+
+ if(present(echo))then
+ echo_local=echo
+ else
+ echo_local=.true.
+ end if
+
+ if(present(verbose))then
+ verbose_local=verbose
+ else
+ verbose_local=.true.
+ end if
+
+ if (present(redirect)) then
+ redirect_str = ">"//redirect//" 2>&1"
+ else
+ if(verbose_local)then
+ ! No redirection but verbose output
+ redirect_str = ""
+ else
+ ! No redirection and non-verbose output
+ if (os_is_unix()) then
+ redirect_str = ">/dev/null 2>&1"
+ else
+ redirect_str = ">NUL 2>&1"
+ end if
+ end if
+ end if
+
+ if(echo_local) print *, '+ ', cmd
+
+ call execute_command_line(cmd//redirect_str, exitstat=stat)
+
+ if (verbose_local.and.present(redirect)) then
+
+ open(newunit=fh,file=redirect,status='old')
+ do
+ call getline(fh, line, ios)
+ if (ios /= 0) exit
+ write(*,'(A)') trim(line)
+ end do
+ close(fh)
+
+ end if
+
+ if (present(exitstat)) then
+ exitstat = stat
+ else
+ if (stat /= 0) then
+ call fpm_stop(1,'*run*:Command failed')
+ end if
+ end if
+
+end subroutine run
+
+
end module fpm_filesystem
diff --git a/test/new_test/new_test.f90 b/test/new_test/new_test.f90
index f191015..61cbeb2 100644
--- a/test/new_test/new_test.f90
+++ b/test/new_test/new_test.f90
@@ -1,9 +1,9 @@
program new_test
use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit
use fpm_filesystem, only : is_dir, list_files, exists, windows_path, join_path, &
- dirname
+ dirname, run
use fpm_strings, only : string_t, operator(.in.)
-use fpm_environment, only : run, get_os_type
+use fpm_environment, only : get_os_type
use fpm_environment, only : OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD, OS_WINDOWS
implicit none
type(string_t), allocatable :: file_names(:)