diff options
| -rw-r--r-- | src/fpm.f90 | 5 | ||||
| -rw-r--r-- | src/fpm/cmd/new.f90 | 4 | ||||
| -rw-r--r-- | src/fpm_backend.F90 | 7 | ||||
| -rw-r--r-- | src/fpm_command_line.f90 | 4 | ||||
| -rw-r--r-- | src/fpm_compiler.f90 | 3 | ||||
| -rw-r--r-- | src/fpm_environment.f90 | 69 | ||||
| -rw-r--r-- | src/fpm_filesystem.F90 | 73 | ||||
| -rw-r--r-- | test/new_test/new_test.f90 | 4 |
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(:) |