aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn S. Urban <urbanjost@comcast.net>2020-11-15 08:59:58 -0800
committerJohn S. Urban <urbanjost@comcast.net>2020-11-15 14:07:08 -0800
commit29c1fa581020fb3dccd72823a1b4acd69268cf2d (patch)
tree10bf9f651e6611b0e78d1b6efc8170032e429265
parentca1a0e4f50db32770b6e9aa60db9ce0b660b5bf8 (diff)
downloadfpm-29c1fa581020fb3dccd72823a1b4acd69268cf2d.tar.gz
fpm-29c1fa581020fb3dccd72823a1b4acd69268cf2d.zip
This option already exists in the Haskell version. It helps reduce the need
for the user to interact directly with the build/ directory, which ideally should be a black box as far as the user is concerned. --runner CMD A command to prefix the program execution paths with. For use with utilities like valgrind(1), time(1), and other utilities that launch executables; commands that inspect the files like ldd(1), file(1), and ls(1); and that copy or change the files like strip(1) and install(1). EXAMPLES # install executables in directory (assuming install(1) exists) fpm run -c 'install -b -m 0711 -p -t /usr/local/bin'
-rw-r--r--fpm/fpm.toml2
-rw-r--r--fpm/src/fpm.f906
-rw-r--r--fpm/src/fpm_command_line.f9053
3 files changed, 42 insertions, 19 deletions
diff --git a/fpm/fpm.toml b/fpm/fpm.toml
index 404e65c..3aad30a 100644
--- a/fpm/fpm.toml
+++ b/fpm/fpm.toml
@@ -12,7 +12,7 @@ tag = "v0.2.1"
[dependencies.M_CLI2]
git = "https://github.com/urbanjost/M_CLI2.git"
-rev = "649075aceb97f997665a1a4656514fd2e9b4becc"
+rev = "09b4079f58ccf3e2ddbd82fe9f44986dc58f85bd"
[[test]]
name = "cli-test"
diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90
index daa4d98..e15fc49 100644
--- a/fpm/src/fpm.f90
+++ b/fpm/src/fpm.f90
@@ -453,7 +453,11 @@ subroutine cmd_run(settings,test)
else
if (exists(executables(i)%s)) then
- call run(executables(i)%s//" "//settings%args)
+ if(settings%runner .ne. ' ')then
+ call run(settings%runner//' '//executables(i)%s//" "//settings%args)
+ else
+ call run(executables(i)%s//" "//settings%args)
+ endif
else
write(stderr,*)'fpm::run<ERROR>',executables(i)%s,' not found'
stop 1
diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90
index dc6823f..217657c 100644
--- a/fpm/src/fpm_command_line.f90
+++ b/fpm/src/fpm_command_line.f90
@@ -2,7 +2,7 @@ module fpm_command_line
use fpm_environment, only : get_os_type, &
OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, &
OS_CYGWIN, OS_SOLARIS, OS_FREEBSD
-use M_CLI2, only : set_args, lget, unnamed, remaining, specified
+use M_CLI2, only : set_args, lget, sget, unnamed, remaining, specified
use fpm_strings, only : lower
use fpm_filesystem, only : basename, canon_path
use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, &
@@ -39,6 +39,7 @@ end type
type, extends(fpm_build_settings) :: fpm_run_settings
character(len=ibug),allocatable :: name(:)
character(len=:),allocatable :: args
+ character(len=:),allocatable :: runner
end type
type, extends(fpm_run_settings) :: fpm_test_settings
@@ -57,6 +58,7 @@ character(len=:), allocatable :: help_new(:), help_fpm(:), help_run(:), &
& help_text(:), help_install(:), help_help(:), &
& help_list(:), help_list_dash(:), help_list_nodash(:)
+character(len=:), allocatable :: charbug
contains
subroutine get_command_line_settings(cmd_settings)
class(fpm_cmd_settings), allocatable, intent(out) :: cmd_settings
@@ -97,7 +99,7 @@ contains
select case(trim(cmdarg))
case('run')
- call set_args('--list F --release F --',help_run,version_text)
+ call set_args('--list:l F --release:r F --runner:c " " --',help_run,version_text)
if( size(unnamed) .gt. 1 )then
names=unnamed(2:)
@@ -107,17 +109,17 @@ contains
allocate(fpm_run_settings :: cmd_settings)
cmd_settings=fpm_run_settings( name=names, list=lget('list'), &
- & release=lget('release'), args=remaining )
+ & release=lget('release'), args=remaining ,runner=sget('runner'))
case('build')
- call set_args( '--release F --list F --',help_build,version_text )
+ call set_args( '--release:r F --list:l F --',help_build,version_text )
allocate( fpm_build_settings :: cmd_settings )
cmd_settings=fpm_build_settings( release=lget('release'), &
& list=lget('list') )
case('new')
- call set_args(' --src F --lib F --app F --test F --backfill F', &
+ call set_args(' --src:s F --lib:l F --app:a F --test:t F --backfill:b F', &
& help_new, version_text)
select case(size(unnamed))
case(1)
@@ -203,17 +205,17 @@ contains
call printhelp(help_text)
case('install')
- call set_args('--release F ', help_install, version_text)
+ call set_args('--release:r F ', help_install, version_text)
allocate(fpm_install_settings :: cmd_settings)
case('list')
- call set_args(' --list F', help_list, version_text)
+ call set_args(' --list:l F', help_list, version_text)
call printhelp(help_list_nodash)
if(lget('list'))then
call printhelp(help_list_dash)
endif
case('test')
- call set_args('--list F --release F --',help_test,version_text)
+ call set_args('--list:l F --release:r F --runner:c " " --',help_test,version_text)
if( size(unnamed) .gt. 1 )then
names=unnamed(2:)
@@ -222,12 +224,13 @@ contains
endif
allocate(fpm_test_settings :: cmd_settings)
+ charbug=sget('runner')
cmd_settings=fpm_test_settings( name=names, list=lget('list'), &
- & release=lget('release'), args=remaining )
+ & release=lget('release'), args=remaining ,runner=charbug )
case default
- call set_args(' --list F', help_fpm, version_text)
+ call set_args(' --list:l F', help_fpm, version_text)
! Note: will not get here if --version or --usage or --help
! is present on commandline
help_text=help_usage
@@ -296,8 +299,8 @@ contains
' help [NAME(s)] ', &
' new NAME [--lib|--src] [--app] [--test] [--backfill] ', &
' list [--list] ', &
- ' run [NAME(s)] [--release] [--list] [-- ARGS] ', &
- ' test [NAME(s)] [--release] [--list] [-- ARGS] ', &
+ ' run [NAME(s)] [--release] [--runner "CMD"] [--list] [-- ARGS] ', &
+ ' test [NAME(s)] [--release] [--runner "CMD"] [--list] [-- ARGS] ', &
' ']
help_usage=[character(len=80) :: &
'' ]
@@ -334,10 +337,10 @@ contains
' new NAME [--lib|--src] [--app] [--test] [--backfill] ', &
' Create a new Fortran package directory ', &
' with sample files ', &
- ' run [NAME(s)] [--release] [--list] [-- ARGS] ', &
+ ' run [NAME(s)] [--release] [--list] [--runner "CMD"][-- ARGS] ', &
' Run the local package binaries. defaults to all ', &
' binaries for that release. ', &
- ' test [NAME(s)] [--release] [--list] [-- ARGS] ', &
+ ' test [NAME(s)] [--release] [--list] [--runner "CMD"] [-- ARGS] ', &
' Run the tests ', &
' help [NAME(s)] Alternate method for displaying subcommand help ', &
' list [--list] Display brief descriptions of all subcommands. ', &
@@ -350,6 +353,7 @@ contains
' optimization flags are used. ', &
' --list List candidates instead of building or running them. On ', &
' the fpm(1) command this shows a brief list of subcommands.', &
+ ' --runner CMD Provides a command to prefix program execution paths. ', &
' -- ARGS Arguments to pass to executables. ', &
' --help Show help text and exit. Valid for all subcommands. ', &
' --version Show version information and exit. Valid for all ', &
@@ -398,7 +402,7 @@ contains
' run(1) - the fpm(1) subcommand to run project applications ', &
' ', &
'SYNOPSIS ', &
- ' fpm run [NAME(s)] [--release] [-- ARGS] ', &
+ ' fpm run [NAME(s)] [--release] [--runner "CMD"] [-- ARGS] ', &
' ', &
' fpm run --help|--version ', &
' ', &
@@ -412,12 +416,18 @@ contains
' --release selects the optimized build instead of the debug ', &
' build. ', &
' --list list candidates instead of building or running them ', &
+ ' --runner CMD A command to prefix the program execution paths with. ', &
+ ' For use with utilities like valgrind(1), time(1), and ', &
+ ' other utilities that launch executables; commands that ', &
+ ' inspect the files like ldd(1), file(1), and ls(1); and ', &
+ ' ones that copy or change files like strip(1) and ', &
+ ' install(1). ', &
' -- ARGS optional arguments to pass to the program(s). ', &
' The same arguments are passed to all names ', &
' specified. ', &
' ', &
'EXAMPLES ', &
- ' run fpm(1) project applications ', &
+ ' fpm(1) "run" project applications ', &
' ', &
' # run default programs in /app or as specified in "fpm.toml" ', &
' fpm run ', &
@@ -428,6 +438,9 @@ contains
' # run production version of two applications ', &
' fpm run prg1 prg2 --release ', &
' ', &
+ ' # install executables in directory (assuming install(1) exists) ', &
+ ' fpm run -c ''install -b -m 0711 -p -t /usr/local/bin'' ', &
+ ' ', &
'SEE ALSO ', &
' The fpm(1) home page at https://github.com/fortran-lang/fpm ', &
'' ]
@@ -589,7 +602,7 @@ contains
' test(1) - the fpm(1) subcommand to run project tests ', &
' ', &
'SYNOPSIS ', &
- ' fpm test [NAME(s)] [--release] [--list] [-- ARGS] ', &
+ ' fpm test [NAME(s)] [--release] [--list] [--runner "CMD"] [-- ARGS] ', &
' ', &
' fpm test --help|--version ', &
' ', &
@@ -603,6 +616,12 @@ contains
' --release selects the optimized build instead of the debug ', &
' build. ', &
' --list list candidates instead of building or running them ', &
+ ' --runner CMD A command to prefix the program execution paths with. ', &
+ ' For use with utilities like valgrind(1), time(1), and ', &
+ ' other utilities that launch executables; commands that ', &
+ ' inspect the files like ldd(1), file(1), and ls(1); and ', &
+ ' ones that copy or change files like strip(1) and ', &
+ ' install(1). ', &
' -- ARGS optional arguments to pass to the test program(s). ', &
' The same arguments are passed to all test names ', &
' specified. ', &