aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLaurence Kedward <laurence.kedward@bristol.ac.uk>2020-11-25 15:24:00 +0000
committerGitHub <noreply@github.com>2020-11-25 15:24:00 +0000
commit2612d9aea9db8802042516ca97e6eb7268da200d (patch)
treebb4cd25aed2c74aad72b20912d3309684088baf4
parentc4ce73e485cf48d6b6b3e9f34938c7f8effec22b (diff)
parent03fec875cfab2e358ab2665d70ce09b64cf7ddbf (diff)
downloadfpm-2612d9aea9db8802042516ca97e6eb7268da200d.tar.gz
fpm-2612d9aea9db8802042516ca97e6eb7268da200d.zip
Merge pull request #239 from urbanjost/runner
Add --runner option to Fortran fpm to match Haskell fpm
-rw-r--r--CONTRIBUTING.md2
-rw-r--r--PACKAGING.md6
-rw-r--r--README.md2
-rw-r--r--fpm/fpm.toml2
-rw-r--r--fpm/src/fpm.f9026
-rw-r--r--fpm/src/fpm_command_line.f90164
-rw-r--r--manifest-reference.md6
7 files changed, 138 insertions, 70 deletions
diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md
index 9a1f5a3..b74aeda 100644
--- a/CONTRIBUTING.md
+++ b/CONTRIBUTING.md
@@ -77,7 +77,7 @@ decisions. This is the workflow that we follow:
one person disagrees.
At this stage, the scope of the fix/feature, its behavior, and API if
applicable should be defined.
- Only when you have community concensus on these items you should proceed to
+ Only when you have community consensus on these items you should proceed to
writing code and opening a PR.
**When actively working on code towards a PR, please assign yourself to the
issue on GitHub.**
diff --git a/PACKAGING.md b/PACKAGING.md
index 44a0c02..663db62 100644
--- a/PACKAGING.md
+++ b/PACKAGING.md
@@ -177,7 +177,7 @@ Based on the output of `fpm build`, *fpm* first ran `gfortran` to emit the
binary object (`math_constants.o`) and module (`math_constants.mod`) files.
Then it ran `ar` to create a static library archive `math_constants.a`.
`build/debug/library` is thus both your include and library path, should you
-want to compile and link an exteranl program with this library.
+want to compile and link an external program with this library.
For modules in the top-level (`src`) directory, *fpm* requires that:
@@ -585,7 +585,7 @@ And now, `fpm run` will output the following:
```
Additionally, any users of your library will now automatically depend on your
-dependencies too. So if you don’t need that depedency for the library, like in
+dependencies too. So if you don’t need that dependency for the library, like in
the above example, then you can specify it for the specific executable like
below. Then fpm will still fetch and compile it when building your executable,
but users of your library won’t have to.
@@ -677,7 +677,7 @@ the build script:
* `FC` – The Fortran compiler to be used.
* `FFLAGS` – The flags that should be passed to the Fortran compiler.
* `BUILD_DIR` – Where the compiled files should be placed.
-* `INCLUDE_DIRS` – The folders where any dependencies can be found, space seperated.
+* `INCLUDE_DIRS` – The folders where any dependencies can be found, space separated.
It is then the responsibility of the build script to generate the appropriate
include flags.
diff --git a/README.md b/README.md
index 6c6458f..bd45978 100644
--- a/README.md
+++ b/README.md
@@ -63,7 +63,7 @@ with the following contents and initialized as a git repository.
* `fpm.toml` – with your project’s name and some default standard meta-data
* `README.md` – with your project’s name
-* `.gitgnore`
+* `.gitignore`
* `src/project_name.f90` – with a simple hello world subroutine
* `app/main.f90` (if `--with-executable` flag used) – a program that calls the subroutine
* `test/main.f90` (if `--with-test` flag used) – an empty test program
diff --git a/fpm/fpm.toml b/fpm/fpm.toml
index 404e65c..7afc0a0 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 = "893cac0ce374bf07a70ffb9556439c7390e58131"
[[test]]
name = "cli-test"
diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90
index 8bf7a98..5e190c8 100644
--- a/fpm/src/fpm.f90
+++ b/fpm/src/fpm.f90
@@ -84,7 +84,7 @@ recursive subroutine add_libsources_from_package(sources,link_libraries,package_
character(:), allocatable :: dependency_path
do i=1,size(dependency_list)
-
+
if (dependency_list(i)%name .in. package_list) then
cycle
end if
@@ -99,7 +99,7 @@ recursive subroutine add_libsources_from_package(sources,link_libraries,package_
end if
else if (allocated(dependency_list(i)%path)) then
-
+
dependency_path = join_path(package_root,dependency_list(i)%path)
end if
@@ -120,11 +120,11 @@ recursive subroutine add_libsources_from_package(sources,link_libraries,package_
dependency%library%source_dir = "src"
end if
-
+
call add_libsources_from_package(sources,link_libraries,package_list,dependency, &
package_root=dependency_path, &
dev_depends=.false., error=error)
-
+
if (allocated(error)) then
error%message = 'Error while processing sources for dependency package "'//&
new_line('a')//dependency%name//'"'//&
@@ -322,7 +322,7 @@ subroutine cmd_run(settings,test)
exe_source => exe_target%dependencies(1)%ptr%source
if (exe_source%unit_scope == &
- merge(FPM_SCOPE_TEST,FPM_SCOPE_APP,test)) then
+ merge(FPM_SCOPE_TEST,FPM_SCOPE_APP,test)) then
col_width = max(col_width,len(basename(exe_target%output_file))+2)
@@ -336,7 +336,7 @@ subroutine cmd_run(settings,test)
do j=1,size(settings%name)
if (trim(settings%name(j))==exe_source%exe_name) then
-
+
found(j) = .true.
exe_cmd%s = exe_target%output_file
executables = [executables, exe_cmd]
@@ -346,7 +346,7 @@ subroutine cmd_run(settings,test)
end do
end if
-
+
end if
end if
@@ -379,14 +379,14 @@ subroutine cmd_run(settings,test)
do i=1,size(model%targets)
exe_target => model%targets(i)%ptr
-
+
if (exe_target%target_type == FPM_TARGET_EXECUTABLE .and. &
allocated(exe_target%dependencies)) then
exe_source => exe_target%dependencies(1)%ptr%source
if (exe_source%unit_scope == &
- merge(FPM_SCOPE_TEST,FPM_SCOPE_APP,test)) then
+ merge(FPM_SCOPE_TEST,FPM_SCOPE_APP,test)) then
write(stderr,'(A)',advance=(merge("yes","no ",modulo(j,nCol)==0))) &
& [character(len=col_width) :: basename(exe_target%output_file)]
@@ -415,9 +415,13 @@ subroutine cmd_run(settings,test)
if (settings%list) then
write(stderr,*) executables(i)%s
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..50a7d25 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
@@ -53,10 +54,14 @@ character(len=ibug),allocatable :: names(:)
character(len=:), allocatable :: version_text(:)
character(len=:), allocatable :: help_new(:), help_fpm(:), help_run(:), &
- & help_test(:), help_build(:), help_usage(:), &
+ & help_test(:), help_build(:), help_usage(:), help_runner(:), &
& help_text(:), help_install(:), help_help(:), &
& help_list(:), help_list_dash(:), help_list_nodash(:)
+character(len=20),parameter :: manual(*)=[ character(len=20) ::&
+& ' ', 'fpm', 'new', 'build', 'run', &
+& 'test', 'runner', 'list', 'help', 'version' ]
+character(len=:), allocatable :: charbug
contains
subroutine get_command_line_settings(cmd_settings)
class(fpm_cmd_settings), allocatable, intent(out) :: cmd_settings
@@ -97,7 +102,7 @@ contains
select case(trim(cmdarg))
case('run')
- call set_args('--list F --release F --',help_run,version_text)
+ call set_args('--list F --release F --runner " " --',help_run,version_text)
if( size(unnamed) .gt. 1 )then
names=unnamed(2:)
@@ -107,7 +112,7 @@ 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 )
@@ -161,43 +166,44 @@ contains
& backfill=lget('backfill') )
endif
- case('help')
+ case('help','manual')
call set_args(' ',help_help,version_text)
if(size(unnamed).lt.2)then
- unnamed=['help', 'fpm ']
+ if(unnamed(1).eq.'help')then
+ unnamed=[' ', 'fpm']
+ else
+ unnamed=manual
+ endif
+ elseif(unnamed(2).eq.'manual')then
+ unnamed=manual
endif
widest=256
allocate(character(len=widest) :: help_text(0))
do i=2,size(unnamed)
select case(unnamed(i))
+ case(' ' )
+ case('fpm ' )
+ help_text=[character(len=widest) :: help_text, help_fpm]
+ case('new ' )
+ help_text=[character(len=widest) :: help_text, help_new]
case('build ' )
help_text=[character(len=widest) :: help_text, help_build]
case('run ' )
help_text=[character(len=widest) :: help_text, help_run]
- case('help ' )
- help_text=[character(len=widest) :: help_text, help_help]
case('test ' )
help_text=[character(len=widest) :: help_text, help_test]
- case('new ' )
- help_text=[character(len=widest) :: help_text, help_new]
- case('fpm ' )
- help_text=[character(len=widest) :: help_text, help_fpm]
+ case('runner' )
+ help_text=[character(len=widest) :: help_text, help_runner]
case('list ' )
help_text=[character(len=widest) :: help_text, help_list]
- case('version' )
- help_text=[character(len=widest) :: help_text, version_text]
- case('manual ' )
- help_text=[character(len=widest) :: help_text, help_fpm]
- help_text=[character(len=widest) :: help_text, help_new]
- help_text=[character(len=widest) :: help_text, help_build]
- help_text=[character(len=widest) :: help_text, help_run]
- help_text=[character(len=widest) :: help_text, help_test]
+ case('help ' )
help_text=[character(len=widest) :: help_text, help_help]
- help_text=[character(len=widest) :: help_text, help_list]
+ case('version' )
help_text=[character(len=widest) :: help_text, version_text]
case default
help_text=[character(len=widest) :: help_text, &
- & 'ERROR: unknown help topic "'//trim(unnamed(i))//'"']
+ & '<ERROR> unknown help topic "'//trim(unnamed(i))//'"']
+ !!& '<ERROR> unknown help topic "'//trim(unnamed(i)).'not found in:',manual]
end select
enddo
call printhelp(help_text)
@@ -213,7 +219,7 @@ contains
call printhelp(help_list_dash)
endif
case('test')
- call set_args('--list F --release F --',help_test,version_text)
+ call set_args('--list F --release F --runner " " --',help_test,version_text)
if( size(unnamed) .gt. 1 )then
names=unnamed(2:)
@@ -222,8 +228,9 @@ 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
@@ -296,11 +303,75 @@ 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) :: &
'' ]
+ help_runner=[character(len=80) :: &
+ 'NAME ', &
+ ' --runner(1) - a shared option for specifying an application to launch ', &
+ ' executables. ', &
+ ' ', &
+ 'SYNOPSIS ', &
+ ' fpm run|test --runner CMD ... -- SUFFIX_OPTIONS ', &
+ ' ', &
+ 'DESCRIPTION ', &
+ ' The --runner option allows specifying a program to launch ', &
+ ' executables selected via the fpm(1) subcommands "run" and "test". This ', &
+ ' gives easy recourse to utilities such as debuggers and other tools ', &
+ ' that wrap other executables. ', &
+ ' ', &
+ ' These external commands are not part of fpm(1) itself as they vary ', &
+ ' from platform to platform or require independent installation. ', &
+ ' ', &
+ 'OPTION ', &
+ ' --runner ''CMD'' quoted command used to launch the fpm(1) executables. ', &
+ ' Available for both the "run" and "test" subcommands. ', &
+ ' ', &
+ ' -- SUFFIX_OPTIONS additional options to suffix the command CMD and executable ', &
+ ' file names with. ', &
+ 'EXAMPLES ', &
+ ' Use cases for ''fpm run|test --runner "CMD"'' include employing ', &
+ ' the following common GNU/Linux and Unix commands: ', &
+ ' ', &
+ ' INTERROGATE ', &
+ ' + nm - list symbols from object files ', &
+ ' + size - list section sizes and total size. ', &
+ ' + ldd - print shared object dependencies ', &
+ ' + ls - list directory contents ', &
+ ' + stat - display file or file system status ', &
+ ' + file - determine file type ', &
+ ' PERFORMANCE AND DEBUGGING ', &
+ ' + gdb - The GNU Debugger ', &
+ ' + valgrind - a suite of tools for debugging and profiling ', &
+ ' + time - time a simple command or give resource usage ', &
+ ' + timeout - run a command with a time limit ', &
+ ' COPY ', &
+ ' + install - copy files and set attributes ', &
+ ' + tar - an archiving utility ', &
+ ' ALTER ', &
+ ' + rm - remove files or directories ', &
+ ' + chmod - change permissions of a file ', &
+ ' + strip - remove unnecessary information from strippable files ', &
+ ' ', &
+ ' For example ', &
+ ' ', &
+ ' fpm test --runner gdb ', &
+ ' fpm run --runner "tar cvfz $HOME/bundle.tgz" ', &
+ ' fpm run --runner ldd ', &
+ ' fpm run --runner strip ', &
+ ' fpm run --runner ''cp -t /usr/local/bin'' ', &
+ ' ', &
+ ' # options after executable name can be specified after the -- option ', &
+ ' fpm --runner cp run -- /usr/local/bin/ ', &
+ ' # generates commands of the form "cp $FILENAME /usr/local/bin/" ', &
+ ' ', &
+ ' # bash(1) alias example: ', &
+ ' alias fpm-install="ffpm run --release --runner \ ', &
+ ' ''install -vbp -m 0711 -t ~/.local/bin''" ', &
+ ' fpm-install ', &
+ '' ]
help_fpm=[character(len=80) :: &
'NAME ', &
' fpm(1) - A Fortran package manager and build system ', &
@@ -334,10 +405,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 +421,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 ', &
@@ -366,7 +438,10 @@ contains
' fpm run myprogram --release -- -x 10 -y 20 --title "my title" ', &
' ', &
'SEE ALSO ', &
- ' The fpm(1) home page at https://github.com/fortran-lang/fpm ', &
+ ' + The fpm(1) home page is at https://github.com/fortran-lang/fpm ', &
+ ' + Registered fpm(1) packages are at https://fortran-lang.org/packages ', &
+ ' + The fpm(1) TOML file format is described at ', &
+ ' https://github.com/fortran-lang/fpm/blob/master/manifest-reference.md ', &
'']
help_list=[character(len=80) :: &
'NAME ', &
@@ -389,16 +464,13 @@ contains
' ', &
' fpm list ', &
' fpm --list ', &
- ' ', &
- 'SEE ALSO ', &
- ' The fpm(1) home page at https://github.com/fortran-lang/fpm ', &
'' ]
help_run=[character(len=80) :: &
'NAME ', &
' 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 +484,14 @@ 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. ', &
+ ' see "fpm help runner" for further details. ', &
' -- 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,8 +502,8 @@ contains
' # run production version of two applications ', &
' fpm run prg1 prg2 --release ', &
' ', &
- 'SEE ALSO ', &
- ' The fpm(1) home page at https://github.com/fortran-lang/fpm ', &
+ ' # install executables in directory (assuming install(1) exists) ', &
+ ' fpm run --runner ''install -b -m 0711 -p -t /usr/local/bin'' ', &
'' ]
help_build=[character(len=80) :: &
'NAME ', &
@@ -468,9 +542,6 @@ contains
' ', &
' fpm build # build with debug options ', &
' fpm build --release # build with high optimization ', &
- ' ', &
- 'SEE ALSO ', &
- ' The fpm(1) home page at https://github.com/fortran-lang/fpm ', &
'' ]
help_help=[character(len=80) :: &
@@ -479,6 +550,7 @@ contains
' ', &
'SYNOPSIS ', &
' fpm help [fpm] [new] [build] [run] [test] [help] [version] [manual] ', &
+ ' [runner] ', &
' ', &
'DESCRIPTION ', &
' The "fpm help" command is an alternative to the --help parameter ', &
@@ -502,8 +574,6 @@ contains
' fpm help new # display help for "new" subcommand ', &
' fpm help manual # All fpm(1) built-in documentation ', &
' ', &
- 'SEE ALSO ', &
- ' The fpm(1) home page at https://github.com/fortran-lang/fpm ', &
'' ]
help_new=[character(len=80) :: &
'NAME ', &
@@ -578,18 +648,13 @@ contains
' fpm build ', &
' fpm run # run example application program ', &
' fpm test # run example test program ', &
- ' ', &
- 'SEE ALSO ', &
- ' The fpm(1) home page at https://github.com/fortran-lang/fpm ', &
- ' ', &
- ' Registered packages are at https://fortran-lang.org/packages ', &
'' ]
help_test=[character(len=80) :: &
'NAME ', &
' 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 +668,8 @@ 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. ', &
+ ' see "fpm help runner" for further details. ', &
' -- ARGS optional arguments to pass to the test program(s). ', &
' The same arguments are passed to all test names ', &
' specified. ', &
@@ -617,9 +684,6 @@ contains
' fpm test mytest -- -x 10 -y 20 --title "my title line" ', &
' ', &
' fpm test tst1 tst2 --release # production version of two tests ', &
- ' ', &
- 'SEE ALSO ', &
- ' The fpm(1) home page at https://github.com/fortran-lang/fpm ', &
'' ]
help_install=[character(len=80) :: &
' fpm(1) subcommand "install" ', &
diff --git a/manifest-reference.md b/manifest-reference.md
index 63a533f..f1394cb 100644
--- a/manifest-reference.md
+++ b/manifest-reference.md
@@ -131,7 +131,7 @@ copyright = "Copyright 2020 Jane Doe"
## Project description
-The decription provides a short summary on the project.
+The description provides a short summary on the project.
It should be plain text and not using any markup formatting.
*Example:*
@@ -184,7 +184,7 @@ Library targets are exported and useable for other projects.
Defines the exported library target of the project.
A library is generated if the source directory is found in a project.
-The default source directory is ``src`` but can be modifed in the *library* section using the *source-dir* entry.
+The default source directory is ``src`` but can be modified in the *library* section using the *source-dir* entry.
Paths for the source directory are given relative to the project root and use ``/`` as path separator on all platforms.
*Example:*
@@ -199,7 +199,7 @@ source-dir = "lib"
> Supported in Bootstrap fpm only
Projects with custom build scripts can specify those in the *build-script* entry.
-The custom build script will be executeted when the library build step is reached.
+The custom build script will be executed when the library build step is reached.
*Example:*