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

Author: perazz

src/fpm.f90

@@ -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
@@ -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

src/fpm_command_line.f90

@@ -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
@@ -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
@@ -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) ::      &
@@ -264,7 +267,8 @@ subroutine get_command_line_settings(cmd_settings)
         run_args = &
           ' --target " "' // &
           ' --list F' // &
-          ' --runner " "'
+          ' --runner " "' // &
+          ' --runner-args " "'
 
         compiler_args = &
           ' --profile " "' // &
@@ -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,&
@@ -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')
@@ -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, &
@@ -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')
@@ -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                    ', &
@@ -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:                            ', &
@@ -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''                                       ', &
@@ -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

src/fpm_meta.f90

@@ -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
 
@@ -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
@@ -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!
@@ -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)
@@ -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)
 
     contains
 
@@ -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

src/fpm_strings.f90

@@ -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, &
@@ -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