Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

MPI: check presence of a runner command only with run and test apps #937

Merged
merged 13 commits into from
Jun 27, 2023
6 changes: 4 additions & 2 deletions src/fpm.f90
Original file line number Diff line number Diff line change
Expand Up @@ -544,6 +544,8 @@ subroutine cmd_run(settings,test)
end if
end if



! Check all names are valid
! or no name and found more than one file
toomany= size(settings%name)==0 .and. size(executables)>1
Expand Down Expand Up @@ -588,10 +590,10 @@ subroutine cmd_run(settings,test)
if (exists(executables(i)%s)) then
if(settings%runner /= ' ')then
if(.not.allocated(settings%args))then
call run(settings%runner//' '//executables(i)%s, &
call run(settings%runner_command()//' '//executables(i)%s, &
echo=settings%verbose, exitstat=stat(i))
else
call run(settings%runner//' '//executables(i)%s//" "//settings%args, &
call run(settings%runner_command()//' '//executables(i)%s//" "//settings%args, &
echo=settings%verbose, exitstat=stat(i))
endif
else
Expand Down
50 changes: 44 additions & 6 deletions src/fpm_command_line.f90
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,7 @@ module fpm_command_line
OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD
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, to_fortran_name, is_fortran_name
use fpm_strings, only : lower, split, to_fortran_name, is_fortran_name, remove_characters_in_set, string_t
use fpm_filesystem, only : basename, canon_path, which, run
use fpm_environment, only : get_command_arguments_quoted
use fpm_error, only : fpm_stop, error_t
Expand Down Expand Up @@ -88,9 +88,12 @@ module fpm_command_line

type, extends(fpm_build_settings) :: fpm_run_settings
character(len=ibug),allocatable :: name(:)
character(len=:),allocatable :: args
character(len=:),allocatable :: args ! passed to the app
character(len=:),allocatable :: runner
character(len=:),allocatable :: runner_args ! passed to the runner
logical :: example
contains
procedure :: runner_command
end type

type, extends(fpm_run_settings) :: fpm_test_settings
Expand Down Expand Up @@ -139,7 +142,7 @@ module fpm_command_line
& 'test', 'runner', 'install', 'update', 'list', 'help', 'version', 'publish' ]

character(len=:), allocatable :: val_runner, val_compiler, val_flag, val_cflag, val_cxxflag, val_ldflag, &
val_profile
val_profile, val_runner_args

! '12345678901234567890123456789012345678901234567890123456789012345678901234567890',&
character(len=80), parameter :: help_text_build_common(*) = [character(len=80) :: &
Expand Down Expand Up @@ -264,7 +267,8 @@ subroutine get_command_line_settings(cmd_settings)
run_args = &
' --target " "' // &
' --list F' // &
' --runner " "'
' --runner " "' // &
' --runner-args " "'

compiler_args = &
' --profile " "' // &
Expand Down Expand Up @@ -313,12 +317,18 @@ subroutine get_command_line_settings(cmd_settings)
if(names(i)=='..')names(i)='*'
enddo

! If there are additional command-line arguments, remove the additional
! double quotes which have been added by M_CLI2
val_runner_args=sget('runner-args')
call remove_characters_in_set(val_runner_args,set='"')

c_compiler = sget('c-compiler')
cxx_compiler = sget('cxx-compiler')
archiver = sget('archiver')
allocate(fpm_run_settings :: cmd_settings)
val_runner=sget('runner')
if(specified('runner') .and. val_runner=='')val_runner='echo'

cmd_settings=fpm_run_settings(&
& args=remaining,&
& profile=val_profile,&
Expand All @@ -336,6 +346,7 @@ subroutine get_command_line_settings(cmd_settings)
& build_tests=.false.,&
& name=names,&
& runner=val_runner,&
& runner_args=val_runner_args, &
& verbose=lget('verbose') )

case('build')
Expand Down Expand Up @@ -561,12 +572,18 @@ subroutine get_command_line_settings(cmd_settings)
if(names(i)=='..')names(i)='*'
enddo

! If there are additional command-line arguments, remove the additional
! double quotes which have been added by M_CLI2
val_runner_args=sget('runner-args')
call remove_characters_in_set(val_runner_args,set='"')

c_compiler = sget('c-compiler')
cxx_compiler = sget('cxx-compiler')
archiver = sget('archiver')
allocate(fpm_test_settings :: cmd_settings)
val_runner=sget('runner')
if(specified('runner') .and. val_runner=='')val_runner='echo'

cmd_settings=fpm_test_settings(&
& args=remaining, &
& profile=val_profile, &
Expand All @@ -584,6 +601,7 @@ subroutine get_command_line_settings(cmd_settings)
& build_tests=.true., &
& name=names, &
& runner=val_runner, &
& runner_args=val_runner_args, &
& verbose=lget('verbose'))

case('update')
Expand Down Expand Up @@ -762,7 +780,7 @@ subroutine set_help()
' executables. ', &
' ', &
'SYNOPSIS ', &
' fpm run|test --runner CMD ... -- SUFFIX_OPTIONS ', &
' fpm run|test --runner CMD ... --runner-args ARGS -- SUFFIX_OPTIONS ', &
' ', &
'DESCRIPTION ', &
' The --runner option allows specifying a program to launch ', &
Expand All @@ -778,8 +796,11 @@ subroutine set_help()
' Available for both the "run" and "test" subcommands. ', &
' If the keyword is specified without a value the default command ', &
' is "echo". ', &
' --runner-args "args" an additional option to pass command-line arguments ', &
' to the runner command, instead of to the fpm app. ', &
' -- SUFFIX_OPTIONS additional options to suffix the command CMD and executable ', &
' file names with. ', &
' file names with. These options are passed as command-line ', &
' arguments to the app. ', &
'EXAMPLES ', &
' Use cases for ''fpm run|test --runner "CMD"'' include employing ', &
' the following common GNU/Linux and Unix commands: ', &
Expand Down Expand Up @@ -808,6 +829,7 @@ subroutine set_help()
' ', &
' fpm test --runner gdb ', &
' fpm run --runner "tar cvfz $HOME/bundle.tgz" ', &
' fpm run --runner "mpiexec" --runner-args "-np 12" ', &
' fpm run --runner ldd ', &
' fpm run --runner strip ', &
' fpm run --runner ''cp -t /usr/local/bin'' ', &
Expand Down Expand Up @@ -1424,4 +1446,20 @@ function get_fpm_env(env, default) result(val)
val = get_env(fpm_prefix//env, default)
end function get_fpm_env


!> Build a full runner command (executable + command-line arguments)
function runner_command(cmd) result(run_cmd)
class(fpm_run_settings), intent(in) :: cmd
character(len=:), allocatable :: run_cmd
!> Get executable
if (len_trim(cmd%runner)>0) then
run_cmd = trim(cmd%runner)
else
run_cmd = ''
end if
!> Append command-line arguments
if (len_trim(cmd%runner_args)>0) run_cmd = run_cmd//' '//trim(cmd%runner_args)
end function runner_command


end module fpm_command_line
26 changes: 16 additions & 10 deletions src/fpm_meta.f90
Original file line number Diff line number Diff line change
Expand Up @@ -293,11 +293,8 @@ subroutine resolve_cmd(self,settings,error)
select type (cmd=>settings)
class is (fpm_run_settings) ! includes fpm_test_settings

if (.not.allocated(cmd%runner)) then
cmd%runner = self%run_command%s
else
cmd%runner = self%run_command%s//' '//cmd%runner
end if
! Only override runner if user has not provided a custom one
if (.not.len_trim(cmd%runner)>0) cmd%runner = self%run_command%s

end select

Expand Down Expand Up @@ -416,6 +413,15 @@ subroutine add_metapackage_model(model,package,settings,name,error)
call meta%resolve(settings,error)
if (allocated(error)) return

! If we need to run executables, there should be an MPI runner
if (name=="mpi") then
select type (settings)
class is (fpm_run_settings) ! run, test
if (.not.meta%has_run_command) &
call fatal_error(error,"cannot find a valid mpi runner on the local host")
end select
endif

end subroutine add_metapackage_model

!> Resolve all metapackages into the package config
Expand Down Expand Up @@ -859,7 +865,7 @@ subroutine get_mpi_runner(command,verbose,error)

! Try several commands
do itri=1,size(try)
call find_command_location(trim(try(itri)),command%s,verbose=.true.,error=error)
call find_command_location(trim(try(itri)),command%s,verbose=verbose,error=error)
if (allocated(error)) cycle

! Success!
Expand Down Expand Up @@ -971,6 +977,7 @@ subroutine init_mpi_from_wrappers(this,compiler,mpilib,fort_wrapper,c_wrapper,cx
type(error_t), allocatable, intent(out) :: error

type(version_t) :: version
type(error_t), allocatable :: runner_error

! Cleanup structure
call destroy(this)
Expand Down Expand Up @@ -1009,9 +1016,8 @@ subroutine init_mpi_from_wrappers(this,compiler,mpilib,fort_wrapper,c_wrapper,cx
end if

!> Add default run command, if present
this%run_command = mpi_wrapper_query(mpilib,fort_wrapper,'runner',verbose,error)
if (allocated(error)) return
this%has_run_command = len_trim(this%run_command)>0
this%run_command = mpi_wrapper_query(mpilib,fort_wrapper,'runner',verbose,runner_error)
this%has_run_command = (len_trim(this%run_command)>0) .and. .not.allocated(runner_error)
Comment on lines -1012 to +1020
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

These lines before the change look pretty good to me. What speaks against them? We return early if there's an error and therefore do not need to care about the value of this%has_run_command.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

These were changed to account for your request @minhqdao. If you think the previous version was better, please revert, thank you.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

No, the question was what speaks against the lines 1008-1010 (before this PR)?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Confirm my previous answer


contains

Expand Down Expand Up @@ -1067,7 +1073,7 @@ subroutine mpi_compiler_match(language,wrappers,compiler,which_one,mpilib,error)
select case (language)
case (LANG_FORTRAN)
! Build compiler type. The ID is created based on the Fortran name
call new_compiler(mpi_compiler,screen%s,'','',echo=.true.,verbose=.true.)
call new_compiler(mpi_compiler,screen%s,'','',echo=.true.,verbose=.false.)

! Fortran match found!
if (mpi_compiler%id == compiler%id) then
Expand Down
51 changes: 33 additions & 18 deletions src/fpm_strings.f90
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,7 @@ module fpm_strings
public :: to_fortran_name, is_fortran_name
public :: string_array_contains, string_cat, len_trim, operator(.in.), fnv_1a
public :: replace, resize, str, join, glob
public :: notabs, dilate, remove_newline_characters
public :: notabs, dilate, remove_newline_characters, remove_characters_in_set

!> Module naming
public :: is_valid_module_name, is_valid_module_prefix, &
Expand Down Expand Up @@ -1221,44 +1221,59 @@ logical function has_valid_standard_prefix(module_name,package_name) result(vali

end function has_valid_standard_prefix

! Remove all new line characters from the current string, replace them with spaces
subroutine remove_newline_characters(string)
type(string_t), intent(inout) :: string
! Remove all characters from a set from a string
subroutine remove_characters_in_set(string,set,replace_with)
character(len=:), allocatable, intent(inout) :: string
character(*), intent(in) :: set
character, optional, intent(in) :: replace_with ! Replace with this character instead of removing

integer :: feed,length

character(*), parameter :: CRLF = new_line('a')//achar(13)
character(*), parameter :: SPACE = ' '
if (.not.allocated(string)) return
if (len(set)<=0) return

if (.not.allocated(string%s)) return


length = len(string%s)
feed = scan(string%s,CRLF)
length = len(string)
feed = scan(string,set)

do while (length>0 .and. feed>0)

! Remove heading
if (length==1) then
string = string_t("")
string = ""

elseif (feed==1) then
string%s = string%s(2:length)
string = string(2:length)

! Remove trailing
elseif (feed==length) then
string%s = string%s(1:length-1)
string = string(1:length-1)

! In between: replace with space
! In between: replace with given character
elseif (present(replace_with)) then
string(feed:feed) = replace_with
! Or just remove
else
string%s(feed:feed) = SPACE
string = string(1:feed-1)//string(feed+1:length)
end if

length = len(string%s)
feed = scan(string%s,CRLF)
length = len(string)
feed = scan(string,set)

end do

end subroutine remove_characters_in_set

! Remove all new line characters from the current string, replace them with spaces
subroutine remove_newline_characters(string)
type(string_t), intent(inout) :: string

integer :: feed,length

character(*), parameter :: CRLF = new_line('a')//achar(13)
character(*), parameter :: SPACE = ' '

call remove_characters_in_set(string%s,set=CRLF,replace_with=SPACE)

end subroutine remove_newline_characters

!>AUTHOR: John S. Urban
Expand Down