Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
59 changes: 54 additions & 5 deletions src/fpm_filesystem.F90
Original file line number Diff line number Diff line change
Expand Up @@ -11,12 +11,14 @@ module fpm_filesystem
str_begins_with_str
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, error_t, fatal_error
use shlex_module, only: sh_split => split, ms_split
implicit none
private
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, get_home, execute_and_read_output, get_dos_path
os_delete_dir, is_absolute_path, get_home, execute_and_read_output, get_dos_path, &
command_program, command_not_found

#ifndef FPM_BOOTSTRAP
interface
Expand Down Expand Up @@ -1030,10 +1032,21 @@ subroutine run(cmd,echo,exitstat,verbose,redirect)
if(echo_local) print *, '+ ', cmd !//redirect_str

call execute_command_line(cmd//redirect_str, exitstat=stat,cmdstat=cmdstat,cmdmsg=cmdmsg)
if(cmdstat /= 0)then
write(*,'(a)')'<ERROR>:failed command '//cmd//redirect_str
call fpm_stop(1,'*run*:'//trim(cmdmsg))
endif

! On failure only (so the success path pays nothing), distinguish a missing program
! -- Unix cmdstat/=0 "Invalid command line", Windows cmdstat==0 but exit 9009 -- from
! a found-but-unrunnable one. Nested ifs: Fortran does not mandate short-circuit .and.
if (cmdstat /= 0 .or. stat /= 0) then
if (command_not_found(cmd)) then
write(*,'(a)')'<ERROR>:failed command '//cmd//redirect_str
call fpm_stop(1, "Could not execute '"//command_program(cmd)//"': program not found on PATH."//new_line('a')// &
" Check that it is installed and on your PATH, or set it explicitly with"//new_line('a')// &
" --compiler / FPM_FC (use FPM_CC / FPM_AR for the C compiler / archiver).")
else if (cmdstat /= 0) then
write(*,'(a)')'<ERROR>:failed command '//cmd//redirect_str
call fpm_stop(1,'*run*:'//trim(cmdmsg))
end if
end if

if (verbose_local.and.present(redirect)) then

Expand All @@ -1060,6 +1073,42 @@ subroutine run(cmd,echo,exitstat,verbose,redirect)

end subroutine run

!> Return the program invoked by a command line (its first shell token), OS-aware.
!! Uses fpm's shell lexer so quoted paths stay intact and trailing arguments
!! (e.g. a wrapper's "mpifort -fc=gfortran") are dropped. Returns '' if empty.
function command_program(cmd) result(prog)
character(*), intent(in) :: cmd
character(:), allocatable :: prog
character(len=:), allocatable :: tokens(:)

prog = ''
if (os_is_unix()) then
tokens = sh_split(cmd) ! POSIX lexer
else
tokens = ms_split(cmd, ucrt=.true.) ! Windows lexer
end if
! The program is always the first token. A redirection in the command (e.g. "> log
! 2>&1") makes the lexer report failure but it still tokenizes, and a redirection
! operator never starts the command, so the first token is reliably the program.
if (allocated(tokens)) then
if (size(tokens) > 0) prog = trim(adjustl(tokens(1)))
end if

end function command_program

!> True when the program invoked by `cmd` cannot be located on PATH (nor as a
!! direct path). Cross-platform via which()/exists().
logical function command_not_found(cmd)
character(*), intent(in) :: cmd
character(:), allocatable :: prog

command_not_found = .false.
prog = command_program(cmd)
if (len_trim(prog) == 0) return
if (len_trim(which(prog)) == 0 .and. .not. exists(prog)) command_not_found = .true.

end function command_not_found

!> Delete directory using system OS remove directory commands
subroutine os_delete_dir(is_unix, dir, echo)
logical, intent(in) :: is_unix
Expand Down
98 changes: 95 additions & 3 deletions test/fpm_test/test_filesystem.f90
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,8 @@ module test_filesystem
use testsuite, only: new_unittest, unittest_t, error_t, test_failed
use fpm_filesystem, only: canon_path, is_dir, mkdir, os_delete_dir, &
join_path, is_absolute_path, get_home, &
delete_file, read_lines, get_temp_filename
delete_file, read_lines, get_temp_filename, &
command_program, command_not_found
use fpm_environment, only: OS_WINDOWS, get_os_type, os_is_unix
use fpm_strings, only: string_t, split_lines_first_last
implicit none
Expand All @@ -24,7 +25,10 @@ subroutine collect_filesystem(tests)
& new_unittest("test-is-absolute-path", test_is_absolute_path), &
& new_unittest("test-get-home", test_get_home), &
& new_unittest("test-split-lines-first-last", test_split_lines_first_last), &
& new_unittest("test-crlf-lines", test_dir_with_crlf) &
& new_unittest("test-crlf-lines", test_dir_with_crlf), &
& new_unittest("command-program-standard", test_command_program_standard), &
& new_unittest("command-not-found-missing", test_command_not_found_missing), &
& new_unittest("command-not-found-present", test_command_not_found_present) &
]

end subroutine collect_filesystem
Expand Down Expand Up @@ -428,6 +432,94 @@ subroutine test_dir_with_crlf(error)
1 format("Failed reading file with CRLF: ",a,:,i0,:,a,:,i0)

end subroutine test_dir_with_crlf


!> Pin command_program against the real command shapes fpm emits, so it always
!> returns the invoked program and never a flag/path fragment (which would risk a
!> false "program not found" abort on a healthy build). Assertions are chosen to
!> hold under both the POSIX (sh_split) and Windows (ms_split) lexers.
subroutine test_command_program_standard(error)
type(error_t), allocatable, intent(out) :: error

! The exact forum regression line: a normal gfortran compile -> 'gfortran'
call check_string(error, command_program( &
'gfortran -c ./src/first_steps.f90 -Wall -Wextra -fPIC -fmax-errors=1 -g '// &
'-fcheck=bounds -fcheck=array-temps -fbacktrace -fcoarray=single -fimplicit-none '// &
'-Werror=implicit-interface -ffree-form -J build/x -Ibuild/x -o build/x/a.o'), 'gfortran')
if (allocated(error)) return

call check_string(error, command_program('gcc -c foo.c -o foo.o'), 'gcc')
if (allocated(error)) return

call check_string(error, command_program('gfortran foo.o -o app'), 'gfortran')
if (allocated(error)) return

call check_string(error, command_program('ar -rs libfoo.a foo.o'), 'ar')
if (allocated(error)) return

call check_string(error, command_program('gfortran-mp-15 -c foo.f90'), 'gfortran-mp-15')
if (allocated(error)) return

! Compiler wrapper carrying its own arguments -> the wrapper itself
call check_string(error, command_program('mpifort -fc=gfortran -c foo.f90'), 'mpifort')
if (allocated(error)) return

! The compiler-id probe shape (redirection appended) -> still the wrapper
call check_string(error, command_program('mpifort -show > /tmp/out 2>&1'), 'mpifort')
if (allocated(error)) return

call check_string(error, command_program('/usr/bin/gfortran -c foo.f90'), '/usr/bin/gfortran')
if (allocated(error)) return

! Quoted path with spaces -> a single, unquoted token (keep_quotes defaults to .false.)
call check_string(error, command_program('"/opt/my tools/gfortran" -c foo.f90'), '/opt/my tools/gfortran')
if (allocated(error)) return

! Graceful on empty / blank input
call check_string(error, command_program(''), '')
if (allocated(error)) return

call check_string(error, command_program(' '), '')
if (allocated(error)) return

end subroutine test_command_program_standard

!> A program that is absent from PATH must be flagged (this drives the new message).
subroutine test_command_not_found_missing(error)
type(error_t), allocatable, intent(out) :: error

if (.not. command_not_found('a_missing_prog_xyz123 -c foo.f90')) then
call test_failed(error, &
"command_not_found should be .true. for a program absent from PATH")
end if

end subroutine test_command_not_found_missing

!> An existing program (here a temp file used as a stand-in, just like a present
!> compiler or wrapper) must NOT be flagged -> no false abort.
subroutine test_command_not_found_present(error)
type(error_t), allocatable, intent(out) :: error

character(len=:), allocatable :: temp_file
integer :: unit, ios

temp_file = get_temp_filename()
open(newunit=unit, file=temp_file, access='stream', action='write', iostat=ios)
if (ios /= 0) then
call test_failed(error, "could not create temp file for present-program test")
return
end if
write(unit, iostat=ios) "x"
close(unit)

! Quote the path so a temp dir containing spaces tokenizes to a single program.
if (command_not_found('"'//temp_file//'" --version')) then
call test_failed(error, &
"command_not_found should be .false. for an existing program path")
end if

call delete_file(temp_file)

end subroutine test_command_not_found_present


end module test_filesystem
Loading