diff options
| -rw-r--r-- | README.md | 66 | ||||
| -rwxr-xr-x | ci/run_tests.bat | 38 | ||||
| -rwxr-xr-x | ci/run_tests.sh | 40 | ||||
| -rw-r--r-- | example_packages/link_executable/fpm.toml | 1 | ||||
| -rw-r--r-- | fpm/src/fpm.f90 | 15 | ||||
| -rw-r--r-- | fpm/src/fpm_command_line.f90 | 156 | ||||
| -rw-r--r-- | fpm/src/fpm_compiler.f90 | 520 | ||||
| -rw-r--r-- | fpm/src/fpm_environment.f90 | 17 | ||||
| -rw-r--r-- | fpm/src/fpm_filesystem.f90 | 191 | ||||
| -rw-r--r-- | fpm/src/fpm_sources.f90 | 2 | ||||
| -rw-r--r-- | fpm/src/fpm_strings.f90 | 207 | ||||
| -rw-r--r-- | fpm/test/cli_test/cli_test.f90 | 36 | ||||
| -rw-r--r-- | fpm/test/fpm_test/main.f90 | 2 | ||||
| -rw-r--r-- | fpm/test/fpm_test/test_filesystem.f90 | 106 |
14 files changed, 891 insertions, 506 deletions
@@ -1,30 +1,63 @@ # Fortran Package Manager -This is the repository of the Fortran Package Manager (*fpm*). If you are -looking for *fpm – packaging made simple* instead, see -[jordansissel/fpm](https://github.com/jordansissel/fpm). - -Fortran Package Manager is an early prototype. You can use it to build and -package your Fortran projects, as well as to include supported Fortran -dependency projects. As a prototype, changes to *fpm*’s behavior and inputs may -occur as development continues. Please follow the -[issues](https://github.com/fortran-lang/fpm/issues) to contribute and/or stay -up to date with the development. As the prototype matures and we enter -production, we will do our best to stay backwards compatible. - -To report a bug report or suggest a feature, please read our -[contributor guidelines](CONTRIBUTING.md). +Fortran Package Manager (fpm) is a package manager and build system for Fortran. +Its key goal is to improve the user experience of Fortran programmers. +It does so by making it easier to build your Fortran program or library, run the +executables, tests, and examples, and distribute it as a dependency to other +Fortran projects. +Fpm's user interface is modeled after [Rust's Cargo](https://crates.io/), +so if you're familiar with that tool, you will feel at home with fpm. +Fpm's long term vision is to nurture and grow the ecosystem of modern Fortran +applications and libraries. + +Fpm is an early prototype and is evolving rapidly. +You can use it to build and package your Fortran projects, as well as to use +existing fpm packages as dependencies. +Fpm's behavior and user interface may change as it evolves, however as fpm +matures and we enter production, we will aim to stay backwards compatible. +Please follow the [issues](https://github.com/fortran-lang/fpm/issues) to +contribute and/or stay up to date with the development. +Before opening a bug report or a feature suggestion, please read our +[Contributor Guide](CONTRIBUTING.md). + +Fortran Package Manager is not to be confused with +[Jordan Sissel's fpm](https://github.com/jordansissel/fpm), a more general, +non-Fortran related package manager. ## Getting started -### Binary download +### Setting up fpm + +#### Binary download `x86-64` binaries are available [to download](https://github.com/fortran-lang/fpm/releases) for Windows, MacOS and Linux. __Note:__ On Linux and MacOS, you will need to enable executable permission before you can use the binary. _e.g._ `$ chmod u+x fpm-v0.1.0-linux-x86_64` -__Github actions:__ to setup *fpm* within Github actions for automated testing, you can use the [fortran-lang/setup-fpm](https://github.com/marketplace/actions/setup-fpm) action. +#### Conda + +Fpm is available on conda-forge, to add conda-forge to your channels use: + +``` +conda config --add channels conda-forge +``` + +Fpm can be installed with: + +``` +conda create -n fpm fpm +conda activate fpm +``` + +The conda package manager can be installed from [miniforge](https://github.com/conda-forge/miniforge/releases) +or from [miniconda](https://docs.conda.io/en/latest/miniconda.html). + +#### Github Actions + +To setup *fpm* within Github actions for automated testing, you can use the [fortran-lang/setup-fpm](https://github.com/marketplace/actions/setup-fpm) action. + +#### Bootstraping on other platforms For other platforms and architectures have a look at the [bootstrapping instructions](#bootstrapping-instructions). @@ -94,4 +127,3 @@ with itself and run the tests with: $ cd fpm $ fpm test ``` - diff --git a/ci/run_tests.bat b/ci/run_tests.bat index 811baa4..e010e9f 100755 --- a/ci/run_tests.bat +++ b/ci/run_tests.bat @@ -39,7 +39,7 @@ del /q /f build %fpm_path% build if errorlevel 1 exit 1 -.\build\gfortran_debug\app\hello_world +%fpm_path% run --target hello_world if errorlevel 1 exit 1 %fpm_path% run @@ -53,7 +53,7 @@ del /q /f build %fpm_path% build if errorlevel 1 exit 1 -.\build\gfortran_debug\app\hello_fpm +%fpm_path% run --target hello_fpm if errorlevel 1 exit 1 @@ -83,16 +83,16 @@ if errorlevel 1 exit 1 %fpm_path% test if errorlevel 1 exit 1 -.\build\gfortran_debug\app\say_Hello +%fpm_path% run --target say_Hello if errorlevel 1 exit 1 -.\build\gfortran_debug\app\say_goodbye +%fpm_path% run --target say_goodbye if errorlevel 1 exit 1 -.\build\gfortran_debug\test\greet_test +%fpm_path% test --target greet_test if errorlevel 1 exit 1 -.\build\gfortran_debug\test\farewell_test +%fpm_path% test --target farewell_test if errorlevel 1 exit 1 @@ -103,16 +103,16 @@ del /q /f build %fpm_path% build if errorlevel 1 exit 1 -.\build\gfortran_debug\app\say_hello_world +%fpm_path% run --target say_hello_world if errorlevel 1 exit 1 -.\build\gfortran_debug\app\say_goodbye +%fpm_path% run --target say_goodbye if errorlevel 1 exit 1 -.\build\gfortran_debug\test\greet_test +%fpm_path% test --target greet_test if errorlevel 1 exit 1 -.\build\gfortran_debug\test\farewell_test +%fpm_path% test --target farewell_test cd ..\with_examples @@ -122,10 +122,10 @@ del /q /f build %fpm_path% build if errorlevel 1 exit 1 -.\build\gfortran_debug\example\demo-prog +%fpm_path% run --example --target demo-prog if errorlevel 1 exit 1 -.\build\gfortran_debug\app\demo-prog +%fpm_path% run --target demo-prog if errorlevel 1 exit 1 @@ -136,15 +136,15 @@ del /q /f build %fpm_path% build if errorlevel 1 exit 1 -.\build\gfortran_debug\app\auto_discovery_off +%fpm_path% run --target auto_discovery_off if errorlevel 1 exit 1 -.\build\gfortran_debug\test\my_test +%fpm_path% test --target my_test if errorlevel 1 exit 1 -if exist .\build\gfortran_debug\app\unused exit /B 1 +if exist .\build\gfortran_*\app\unused exit /B 1 -if exist .\build\gfortran_debug\test\unused_test exit /B 1 +if exist .\build\gfortran_*\test\unused_test exit /B 1 cd ..\with_c @@ -154,7 +154,7 @@ del /q /f build %fpm_path% build if errorlevel 1 exit 1 -.\build\gfortran_debug\app\with_c +%fpm_path% run --target with_c if errorlevel 1 exit 1 @@ -173,7 +173,7 @@ del /q /f build %fpm_path% build if errorlevel 1 exit 1 -.\build\gfortran_debug\app\Program_with_module +%fpm_path% run --target Program_with_module if errorlevel 1 exit 1 @@ -184,7 +184,7 @@ del /q /f build %fpm_path% build if errorlevel 1 exit 1 -.\build\gfortran_debug\app\gomp_test +%fpm_path% run --target gomp_test if errorlevel 1 exit 1 diff --git a/ci/run_tests.sh b/ci/run_tests.sh index b1f9a7f..647c57a 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -30,12 +30,12 @@ rm -rf ./*/build cd hello_world "${f_fpm_path}" build -./build/gfortran_debug/app/hello_world +"${f_fpm_path}" run --target hello_world "${f_fpm_path}" run cd ../hello_fpm "${f_fpm_path}" build -./build/gfortran_debug/app/hello_fpm +"${f_fpm_path}" run --target hello_fpm cd ../circular_test "${f_fpm_path}" build @@ -46,48 +46,48 @@ cd ../circular_example cd ../hello_complex "${f_fpm_path}" build "${f_fpm_path}" test -./build/gfortran_debug/app/say_Hello -./build/gfortran_debug/app/say_goodbye -./build/gfortran_debug/test/greet_test -./build/gfortran_debug/test/farewell_test +"${f_fpm_path}" run --target say_Hello +"${f_fpm_path}" run --target say_goodbye +"${f_fpm_path}" test --target greet_test +"${f_fpm_path}" test --target farewell_test cd ../hello_complex_2 "${f_fpm_path}" build -./build/gfortran_debug/app/say_hello_world -./build/gfortran_debug/app/say_goodbye -./build/gfortran_debug/test/greet_test -./build/gfortran_debug/test/farewell_test +"${f_fpm_path}" run --target say_hello_world +"${f_fpm_path}" run --target say_goodbye +"${f_fpm_path}" test --target greet_test +"${f_fpm_path}" test --target farewell_test cd ../with_examples "${f_fpm_path}" build -./build/gfortran_debug/example/demo-prog -./build/gfortran_debug/app/demo-prog +"${f_fpm_path}" run --example --target demo-prog +"${f_fpm_path}" run --target demo-prog cd ../auto_discovery_off "${f_fpm_path}" build -./build/gfortran_debug/app/auto_discovery_off -./build/gfortran_debug/test/my_test -test ! -x ./build/gfortran_debug/app/unused -test ! -x ./build/gfortran_debug/test/unused_test +"${f_fpm_path}" run --target auto_discovery_off +"${f_fpm_path}" test --target my_test +test ! -x ./build/gfortran_*/app/unused +test ! -x ./build/gfortran_*/test/unused_test cd ../with_c "${f_fpm_path}" build -./build/gfortran_debug/app/with_c +"${f_fpm_path}" run --target with_c cd ../submodules "${f_fpm_path}" build cd ../program_with_module "${f_fpm_path}" build -./build/gfortran_debug/app/Program_with_module +"${f_fpm_path}" run --target Program_with_module cd ../link_external "${f_fpm_path}" build -./build/gfortran_debug/app/link_external +"${f_fpm_path}" run --target link_external cd ../link_executable "${f_fpm_path}" build -./build/gfortran_debug/app/gomp_test +"${f_fpm_path}" run --target gomp_test cd ../fortran_includes "${f_fpm_path}" build diff --git a/example_packages/link_executable/fpm.toml b/example_packages/link_executable/fpm.toml index f3545ca..d9e94bb 100644 --- a/example_packages/link_executable/fpm.toml +++ b/example_packages/link_executable/fpm.toml @@ -1,5 +1,4 @@ name = "link_executable" -build.auto-executables = false [[executable]] name = "gomp_test" diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index d9721b2..c2da0bc 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -9,7 +9,7 @@ use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, use fpm_model, only: fpm_model_t, srcfile_t, show_model, & FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, FPM_SCOPE_DEP, & FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST -use fpm_compiler, only: add_compile_flag_defaults +use fpm_compiler, only: get_module_flags, is_unknown_compiler use fpm_sources, only: add_executable_sources, add_sources_from_dir @@ -59,9 +59,20 @@ subroutine build_model(model, settings, package, error) model%fortran_compiler = settings%compiler endif + if (is_unknown_compiler(model%fortran_compiler)) then + write(*, '(*(a:,1x))') & + "<WARN>", "Unknown compiler", model%fortran_compiler, "requested!", & + "Defaults for this compiler might be incorrect" + end if model%output_directory = join_path('build',basename(model%fortran_compiler)//'_'//settings%build_name) - call add_compile_flag_defaults(settings%build_name, basename(model%fortran_compiler), model) + call get_module_flags(model%fortran_compiler, & + & join_path(model%output_directory,model%package_name), & + & model%fortran_compile_flags) + model%fortran_compile_flags = settings%flag // model%fortran_compile_flags + if(settings%verbose)then + write(*,*)'<INFO>COMPILER OPTIONS: ', model%fortran_compile_flags + endif allocate(model%packages(model%deps%ndep)) diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index ac0d595..9d95977 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -15,7 +15,7 @@ !> wanted command line and the expected default values. !> Some of the following points also apply if you add a new option or argument !> to an existing *fpm* subcommand. -!> Add this point you should create a help page for the new command in a simple +!> At this point you should create a help page for the new command in a simple !> catman-like format as well in the ``set_help`` procedure. !> Make sure to register new subcommands in the ``fpm-manual`` command by adding !> them to the manual character array and in the help/manual case as well. @@ -27,8 +27,9 @@ use fpm_environment, only : get_os_type, get_env, & OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & OS_CYGWIN, OS_SOLARIS, OS_FREEBSD use M_CLI2, only : set_args, lget, sget, unnamed, remaining, specified -use fpm_strings, only : lower, split +use fpm_strings, only : lower, split, fnv_1a use fpm_filesystem, only : basename, canon_path, to_fortran_name +use fpm_compiler, only : get_default_compile_flags use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & & stderr=>error_unit @@ -64,7 +65,9 @@ type, extends(fpm_cmd_settings) :: fpm_build_settings logical :: list=.false. logical :: show_model=.false. character(len=:),allocatable :: compiler + character(len=:),allocatable :: profile character(len=:),allocatable :: build_name + character(len=:),allocatable :: flag end type type, extends(fpm_build_settings) :: fpm_run_settings @@ -106,7 +109,7 @@ character(len=20),parameter :: manual(*)=[ character(len=20) ::& & ' ', 'fpm', 'new', 'build', 'run', & & 'test', 'runner', 'install', 'update', 'list', 'help', 'version' ] -character(len=:), allocatable :: val_runner, val_build, val_compiler +character(len=:), allocatable :: val_runner, val_build, val_compiler, val_flag, val_profile contains subroutine get_command_line_settings(cmd_settings) @@ -153,10 +156,11 @@ contains & --target " " & & --list F & & --all F & - & --release F& + & --profile " "& & --example F& & --runner " " & & --compiler "'//get_env('FPM_COMPILER','gfortran')//'" & + & --flag:: " "& & --verbose F& & --',help_run,version_text) @@ -191,7 +195,9 @@ contains cmd_settings=fpm_run_settings(& & args=remaining,& & build_name=val_build,& + & profile=val_profile,& & compiler=val_compiler, & + & flag=val_flag, & & example=lget('example'), & & list=lget('list'),& & name=names,& @@ -200,10 +206,11 @@ contains case('build') call set_args( '& - & --release F & + & --profile " " & & --list F & & --show-model F & & --compiler "'//get_env('FPM_COMPILER','gfortran')//'" & + & --flag:: " "& & --verbose F& & --',help_build,version_text) @@ -212,7 +219,9 @@ contains allocate( fpm_build_settings :: cmd_settings ) cmd_settings=fpm_build_settings( & & build_name=val_build,& + & profile=val_profile,& & compiler=val_compiler, & + & flag=val_flag, & & list=lget('list'),& & show_model=lget('show-model'),& & verbose=lget('verbose') ) @@ -336,9 +345,10 @@ contains call printhelp(help_text) case('install') - call set_args('--release F --no-rebuild F --verbose F --prefix " " & + call set_args('--profile " " --no-rebuild F --verbose F --prefix " " & & --list F & & --compiler "'//get_env('FPM_COMPILER','gfortran')//'" & + & --flag:: " "& & --libdir "lib" --bindir "bin" --includedir "include"', & help_install, version_text) @@ -348,7 +358,9 @@ contains install_settings = fpm_install_settings(& list=lget('list'), & build_name=val_build, & + profile=val_profile,& compiler=val_compiler, & + flag=val_flag, & no_rebuild=lget('no-rebuild'), & verbose=lget('verbose')) call get_char_arg(install_settings%prefix, 'prefix') @@ -370,9 +382,10 @@ contains call set_args('& & --target " " & & --list F& - & --release F& + & --profile " "& & --runner " " & & --compiler "'//get_env('FPM_COMPILER','gfortran')//'" & + & --flag:: " "& & --verbose F& & --',help_test,version_text) @@ -401,7 +414,9 @@ contains cmd_settings=fpm_test_settings(& & args=remaining, & & build_name=val_build, & + & profile=val_profile, & & compiler=val_compiler, & + & flag=val_flag, & & example=.false., & & list=lget('list'), & & name=names, & @@ -449,13 +464,26 @@ contains contains subroutine check_build_vals() + character(len=:), allocatable :: flags val_compiler=sget('compiler') if(val_compiler.eq.'') then val_compiler='gfortran' endif - val_build=trim(merge('release','debug ',lget('release'))) + val_flag = " " // sget('flag') + val_profile = sget('profile') + if (val_flag == '') then + call get_default_compile_flags(val_compiler, val_profile == "release", val_flag) + else + select case(val_profile) + case("release", "debug") + call get_default_compile_flags(val_compiler, val_profile == "release", flags) + val_flag = flags // val_flag + end select + end if + allocate(character(len=16) :: val_build) + write(val_build, '(z16.16)') fnv_1a(val_flag) end subroutine check_build_vals @@ -516,17 +544,17 @@ contains ' '] help_list_dash = [character(len=80) :: & ' ', & - ' build [--compiler COMPILER_NAME] [--release] [--list] ', & + ' build [--compiler COMPILER_NAME] [--profile PROF] [--flag FFLAGS] [--list] ', & ' help [NAME(s)] ', & ' new NAME [[--lib|--src] [--app] [--test] [--example]]| ', & ' [--full|--bare][--backfill] ', & ' update [NAME(s)] [--fetch-only] [--clean] [--verbose] ', & ' list [--list] ', & - ' run [[--target] NAME(s) [--example] [--release] [--all] [--runner "CMD"] ', & - ' [--compiler COMPILER_NAME] [--list] [-- ARGS] ', & - ' test [[--target] NAME(s)] [--release] [--runner "CMD"] [--list] ', & + ' run [[--target] NAME(s) [--example] [--profile PROF] [--flag FFLAGS] [--all] ', & + ' [--runner "CMD"] [--compiler COMPILER_NAME] [--list] [-- ARGS] ', & + ' test [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS] [--runner "CMD"] [--list]', & ' [--compiler COMPILER_NAME] [-- ARGS] ', & - ' install [--release] [--no-rebuild] [--prefix PATH] [options] ', & + ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] [options] ', & ' '] help_usage=[character(len=80) :: & '' ] @@ -592,7 +620,7 @@ contains ' ', & ' # bash(1) alias example: ', & ' alias fpm-install=\ ', & - ' "fpm run --release --runner ''install -vbp -m 0711 -t ~/.local/bin''" ', & + ' "fpm run --profile release --runner ''install -vbp -m 0711 -t ~/.local/bin''" ', & ' fpm-install ', & '' ] help_fpm=[character(len=80) :: & @@ -632,24 +660,29 @@ contains ' ', & ' Their syntax is ', & ' ', & - ' build [--release] [--list] [--compiler COMPILER_NAME] ', & + ' build [--profile PROF] [--flag FFLAGS] [--list] [--compiler COMPILER_NAME]', & ' new NAME [[--lib|--src] [--app] [--test] [--example]]| ', & - ' [--full|--bare][--backfill] ', & + ' [--full|--bare][--backfill] ', & ' update [NAME(s)] [--fetch-only] [--clean] ', & - ' run [[--target] NAME(s)] [--release] [--list] [--example] [--all] ', & - ' [--runner "CMD"] [--compiler COMPILER_NAME] [-- ARGS] ', & - ' test [[--target] NAME(s)] [--release] [--list] ', & + ' run [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS] [--list] [--example]', & + ' [--all] [--runner "CMD"] [--compiler COMPILER_NAME] [-- ARGS] ', & + ' test [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS] [--list] ', & ' [--runner "CMD"] [--compiler COMPILER_NAME] [-- ARGS] ', & ' help [NAME(s)] ', & ' list [--list] ', & - ' install [--release] [--no-rebuild] [--prefix PATH] [options] ', & + ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] [options]', & ' ', & 'SUBCOMMAND OPTIONS ', & - ' --release Builds or runs in release mode (versus debug mode). fpm(1)', & - ' Defaults to using common compiler debug flags and building', & - ' in "build/*_debug/". When this flag is present build ', & - ' output goes into "build/*_release/" and common compiler ', & - ' optimization flags are used. ', & + ' --profile PROF selects the compilation profile for the build.',& + ' Currently available profiles are "release" for',& + ' high optimization and "debug" for full debug options.',& + ' If --flag is not specified the "debug" flags are the',& + ' default. ',& + ' --flag FFLAGS selects compile arguments for the build. These are',& + ' added to the profile options if --profile is specified,',& + ' else these options override the defaults.',& + ' Note object and .mod directory locations are always',& + ' built in.',& ' --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. ', & @@ -671,7 +704,7 @@ contains ' fpm run ', & ' fpm run --example ', & ' fpm new --help ', & - ' fpm run myprogram --release -- -x 10 -y 20 --title "my title" ', & + ' fpm run myprogram --profile release -- -x 10 -y 20 --title "my title"', & ' fpm install --prefix ~/.local ', & ' ', & 'SEE ALSO ', & @@ -708,8 +741,9 @@ contains ' run(1) - the fpm(1) subcommand to run project applications ', & ' ', & 'SYNOPSIS ', & - ' fpm run [[--target] NAME(s)[--release][--compiler COMPILER_NAME] ', & - ' [--runner "CMD"] [--example] [--list] [--all] [-- ARGS] ', & + ' fpm run [[--target] NAME(s) [--profile PROF] [--flag FFLAGS]', & + ' [--compiler COMPILER_NAME] [--runner "CMD"] [--example]', & + ' [--list] [--all] [-- ARGS]', & ' ', & ' fpm run --help|--version ', & ' ', & @@ -733,7 +767,16 @@ contains ' the special characters from shell expansion. ', & ' --all Run all examples or applications. An alias for --target ''*''. ', & ' --example Run example programs instead of applications. ', & - ' --release selects the optimized build instead of the debug build. ', & + ' --profile PROF selects the compilation profile for the build.',& + ' Currently available profiles are "release" for',& + ' high optimization and "debug" for full debug options.',& + ' If --flag is not specified the "debug" flags are the',& + ' default. ',& + ' --flag FFLAGS selects compile arguments for the build. These are',& + ' added to the profile options if --profile is specified,',& + ' else these options override the defaults.',& + ' Note object and .mod directory locations are always',& + ' built in.',& ' --compiler COMPILER_NAME Specify a compiler name. The default is ', & ' "gfortran" unless set by the environment ', & ' variable FPM_COMPILER. ', & @@ -764,7 +807,7 @@ contains ' fpm run myprog -- -x 10 -y 20 --title "my title line" ', & ' ', & ' # run production version of two applications ', & - ' fpm run --target prg1,prg2 --release ', & + ' fpm run --target prg1,prg2 --profile release ', & ' ', & ' # install executables in directory (assuming install(1) exists) ', & ' fpm run --runner ''install -b -m 0711 -p -t /usr/local/bin'' ', & @@ -774,7 +817,7 @@ contains ' build(1) - the fpm(1) subcommand to build a project ', & ' ', & 'SYNOPSIS ', & - ' fpm build [--release][--compiler COMPILER_NAME] [-list] ', & + ' fpm build [--profile PROF] [--flags FFLAGS] [--compiler COMPILER_NAME] [-list]', & ' ', & ' fpm build --help|--version ', & ' ', & @@ -796,8 +839,16 @@ contains ' specified in the "fpm.toml" file. ', & ' ', & 'OPTIONS ', & - ' --release build in build/*_release instead of build/*_debug with ', & - ' high optimization instead of full debug options. ', & + ' --profile PROF selects the compilation profile for the build.',& + ' Currently available profiles are "release" for',& + ' high optimization and "debug" for full debug options.',& + ' If --flag is not specified the "debug" flags are the',& + ' default. ',& + ' --flag FFLAGS selects compile arguments for the build. These are',& + ' added to the profile options if --profile is specified,',& + ' else these options override the defaults.',& + ' Note object and .mod directory locations are always',& + ' built in.',& ' --compiler COMPILER_NAME Specify a compiler name. The default is ', & ' "gfortran" unless set by the environment ', & ' variable FPM_COMPILER. ', & @@ -809,8 +860,8 @@ contains 'EXAMPLES ', & ' Sample commands: ', & ' ', & - ' fpm build # build with debug options ', & - ' fpm build --release # build with high optimization ', & + ' fpm build # build with debug options ', & + ' fpm build --profile release # build with high optimization ', & '' ] help_help=[character(len=80) :: & @@ -954,8 +1005,8 @@ contains ' test(1) - the fpm(1) subcommand to run project tests ', & ' ', & 'SYNOPSIS ', & - ' fpm test [[--target] NAME(s)][--release][--compiler COMPILER_NAME ] ', & - ' [--runner "CMD"] [--list][-- ARGS] ', & + ' fpm test [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS]', & + ' [--compiler COMPILER_NAME ] [--runner "CMD"] [--list][-- ARGS]', & ' ', & ' fpm test --help|--version ', & ' ', & @@ -971,8 +1022,16 @@ contains ' any single character and "*" represents any string. ', & ' Note The glob string normally needs quoted to ', & ' protect the special characters from shell expansion.', & - ' --release selects the optimized build instead of the debug ', & - ' build. ', & + ' --profile PROF selects the compilation profile for the build.',& + ' Currently available profiles are "release" for',& + ' high optimization and "debug" for full debug options.',& + ' If --flag is not specified the "debug" flags are the',& + ' default. ',& + ' --flag FFLAGS selects compile arguments for the build. These are',& + ' added to the profile options if --profile is specified,',& + ' else these options override the defaults.',& + ' Note object and .mod directory locations are always',& + ' built in.',& ' --compiler COMPILER_NAME Specify a compiler name. The default is ', & ' "gfortran" unless set by the environment ', & ' variable FPM_COMPILER. ', & @@ -995,7 +1054,7 @@ contains ' # run a specific test and pass arguments to the command ', & ' fpm test mytest -- -x 10 -y 20 --title "my title line" ', & ' ', & - ' fpm test tst1 tst2 --release # run production version of two tests ', & + ' fpm test tst1 tst2 --profile PROF # run production version of two tests', & '' ] help_update=[character(len=80) :: & 'NAME', & @@ -1021,8 +1080,8 @@ contains ' install(1) - install fpm projects', & '', & 'SYNOPSIS', & - ' fpm install [--release] [--list] [--no-rebuild] [--prefix DIR]', & - ' [--bindir DIR] [--libdir DIR] [--includedir DIR]', & + ' fpm install [--profile PROF] [--flag FFLAGS] [--list] [--no-rebuild]', & + ' [--prefix DIR] [--bindir DIR] [--libdir DIR] [--includedir DIR]', & ' [--verbose]', & '', & 'DESCRIPTION', & @@ -1035,7 +1094,16 @@ contains 'OPTIONS', & ' --list list all installable targets for this project,', & ' but do not install any of them', & - ' --release selects the optimized build instead of the debug build', & + ' --profile PROF selects the compilation profile for the build.',& + ' Currently available profiles are "release" for',& + ' high optimization and "debug" for full debug options.',& + ' If --flag is not specified the "debug" flags are the',& + ' default. ',& + ' --flag FFLAGS selects compile arguments for the build. These are',& + ' added to the profile options if --profile is specified,',& + ' else these options override the defaults.',& + ' Note object and .mod directory locations are always',& + ' built in.',& ' --no-rebuild do not rebuild project before installation', & ' --prefix DIR path to installation directory (requires write access),', & ' the default prefix on Unix systems is $HOME/.local', & @@ -1050,7 +1118,7 @@ contains 'EXAMPLES', & ' 1. Install release version of project:', & '', & - ' fpm install --release', & + ' fpm install --profile release', & '', & ' 2. Install the project without rebuilding the executables:', & '', & diff --git a/fpm/src/fpm_compiler.f90 b/fpm/src/fpm_compiler.f90 index 99aa77d..51cda20 100644 --- a/fpm/src/fpm_compiler.f90 +++ b/fpm/src/fpm_compiler.f90 @@ -1,23 +1,6 @@ -module fpm_compiler -use fpm_model, only: fpm_model_t -use fpm_filesystem, only: join_path -public add_compile_flag_defaults - -contains -subroutine add_compile_flag_defaults(build_name,compiler,model) -! Choose compile flags based on cli settings & manifest inputs -character(len=*),intent(in) :: build_name, compiler - -type(fpm_model_t), intent(inout) :: model -! could just be a function to return a string instead of passing model -! but likely to change other components like matching C compiler - -character(len=:),allocatable :: fflags ! optional flags that might be overridden by user -character(len=:),allocatable :: modpath -character(len=:),allocatable :: mandatory ! flags required for fpm to function properly; - ! ie. add module path and module include directory as appropriate - -! special reserved names "debug" and "release" are for supported compilers with no user-specified compile or load flags +!># Define compiler command options +!! +!! This module defines compiler options to use for the debug and release builds. ! vendor Fortran C Module output Module include OpenMP Free for OSS ! compiler compiler directory directory @@ -42,206 +25,309 @@ character(len=:),allocatable :: mandatory ! flags required for fpm to function p ! G95 ? ? -fmod= -I -fopenmp discontinued ! Open64 ? ? -module -I -mp discontinued ! Unisys ? ? ? ? ? discontinued -character(len=*),parameter :: names(*)=[ character(len=10) :: & -& 'caf', & -& 'gfortran', & -& 'f95', & -& 'nvfortran', & -& 'ifort', & -& 'ifx', & -& 'pgfortran', & -& 'pgf90', & -& 'pgf95', & -& 'flang', & -& 'lfc', & -& 'nagfor', & -& 'crayftn', & -& 'xlf90', & -& 'unknown'] -integer :: i - - modpath=join_path(model%output_directory,model%package_name) - fflags='' - mandatory='' - - select case(build_name//'_'//compiler) - - case('release_caf') - fflags='& - & -O3& - & -Wimplicit-interface& - & -fPIC& - & -fmax-errors=1& - & -funroll-loops& - &' - mandatory=' -J '//modpath//' -I '//modpath - case('debug_caf') - fflags = '& - & -Wall& - & -Wextra& - & -Wimplicit-interface& - & -fPIC -fmax-errors=1& - & -g& - & -fbounds-check& - & -fcheck-array-temporaries& - & -fbacktrace& - &' - mandatory=' -J '//modpath//' -I '//modpath - case('release_gfortran') - fflags='& - & -O3& - & -Wimplicit-interface& - & -fPIC& - & -fmax-errors=1& - & -funroll-loops& - & -fcoarray=single& - &' - mandatory=' -J '//modpath//' -I '//modpath - case('debug_gfortran') - fflags = '& - & -Wall& - & -Wextra& - & -Wimplicit-interface& - & -fPIC -fmax-errors=1& - & -g& - & -fbounds-check& - & -fcheck-array-temporaries& - & -fbacktrace& - & -fcoarray=single& - &' - mandatory=' -J '//modpath//' -I '//modpath - - case('release_f95') - fflags='& - & -O3& - & -Wimplicit-interface& - & -fPIC& - & -fmax-errors=1& - & -ffast-math& - & -funroll-loops& - &' - mandatory=' -J '//modpath//' -I '//modpath - case('debug_f95') - fflags = '& - & -Wall& - & -Wextra& - & -Wimplicit-interface& - & -fPIC -fmax-errors=1& - & -g& - & -fbounds-check& - & -fcheck-array-temporaries& - & -Wno-maybe-uninitialized -Wno-uninitialized& - & -fbacktrace& - &' - mandatory=' -J '//modpath//' -I '//modpath - - case('release_nvfortran') - fflags = '& - & -Mbackslash& - &' - mandatory=' -module '//modpath//' -I '//modpath - case('debug_nvfortran') - fflags = '& - & -Minform=inform& - & -Mbackslash& - & -g& - & -Mbounds& - & -Mchkptr& - & -Mchkstk& - & -traceback& - &' - mandatory=' -module '//modpath//' -I '//modpath - - case('release_ifort') - fflags = '& - & -fp-model precise& - & -pc 64& - & -align all& - & -error-limit 1& - & -reentrancy threaded& - & -nogen-interfaces& - & -assume byterecl& - &' - mandatory=' -module '//modpath//' -I '//modpath - case('debug_ifort') - fflags = '& - & -warn all& - & -check:all:noarg_temp_created& - & -error-limit 1& - & -O0& - & -g& - & -assume byterecl& - & -traceback& - &' - mandatory=' -module '//modpath//' -I '//modpath - case('release_ifx') - fflags = ' ' - mandatory=' -module '//modpath//' -I '//modpath - case('debug_ifx') - fflags = ' ' - mandatory=' -module '//modpath//' -I '//modpath - - case('release_pgfortran','release_pgf90','release_pgf95') ! Portland Group F90/F95 compilers - fflags = ' ' - mandatory=' -module '//modpath//' -I '//modpath - case('debug_pgfortran','debug_pgf90','debug_pgf95') ! Portland Group F90/F95 compilers - fflags = ' ' - mandatory=' -module '//modpath//' -I '//modpath - - case('release_flang') - fflags = ' ' - mandatory=' -module '//modpath//' -I '//modpath - case('debug_flang') - fflags = ' ' - mandatory=' -module '//modpath//' -I '//modpath - - case('release_lfc') - fflags = ' ' - mandatory=' -M '//modpath//' -I '//modpath - case('debug_lfc') - fflags = ' ' - mandatory=' -M '//modpath//' -I '//modpath - - case('release_nagfor') - fflags = ' & - & -O4& - & -coarray=single& - & -PIC& - &' - mandatory=' -mdir '//modpath//' -I '//modpath ! - case('debug_nagfor') - fflags = '& - & -g& - & -C=all& - & -O0& - & -gline& - & -coarray=single& - & -PIC& - &' - mandatory=' -mdir '//modpath//' -I '//modpath ! - case('release_crayftn') - fflags = ' ' - mandatory=' -J '//modpath//' -I '//modpath - case('debug_crayftn') - fflags = ' ' - mandatory=' -J '//modpath//' -I '//modpath - - case('release_xlf90') - fflags = ' ' - mandatory=' -qmoddir '//modpath//' -I '//modpath - case('debug_xlf90') - fflags = ' ' - mandatory=' -qmoddir '//modpath//' -I '//modpath +module fpm_compiler +use fpm_model, only: fpm_model_t +use fpm_filesystem, only: join_path, basename +implicit none +public :: is_unknown_compiler +public :: get_module_flags +public :: get_default_compile_flags +public :: get_debug_compile_flags +public :: get_release_compile_flags + +enum, bind(C) + enumerator :: & + id_unknown, & + id_gcc, & + id_f95, & + id_caf, & + id_intel_classic, & + id_intel_llvm, & + id_pgi, & + id_nvhpc, & + id_nag, & + id_flang, & + id_ibmxl, & + id_cray, & + id_lahey, & + id_lfortran +end enum +integer, parameter :: compiler_enum = kind(id_unknown) + +contains + +subroutine get_default_compile_flags(compiler, release, flags) + character(len=*), intent(in) :: compiler + logical, intent(in) :: release + character(len=:), allocatable, intent(out) :: flags + integer :: id + + id = get_compiler_id(compiler) + if (release) then + call get_release_compile_flags(id, flags) + else + call get_debug_compile_flags(id, flags) + end if + +end subroutine get_default_compile_flags + +subroutine get_release_compile_flags(id, flags) + integer(compiler_enum), intent(in) :: id + character(len=:), allocatable, intent(out) :: flags + + select case(id) + case default + flags = "" + + case(id_caf) + flags='& + & -O3& + & -Wimplicit-interface& + & -fPIC& + & -fmax-errors=1& + & -funroll-loops& + &' + case(id_gcc) + flags='& + & -O3& + & -Wimplicit-interface& + & -fPIC& + & -fmax-errors=1& + & -funroll-loops& + & -fcoarray=single& + &' + case(id_f95) + flags='& + & -O3& + & -Wimplicit-interface& + & -fPIC& + & -fmax-errors=1& + & -ffast-math& + & -funroll-loops& + &' + case(id_nvhpc) + flags = '& + & -Mbackslash& + &' + case(id_intel_classic) + flags = '& + & -fp-model precise& + & -pc 64& + & -align all& + & -error-limit 1& + & -reentrancy threaded& + & -nogen-interfaces& + & -assume byterecl& + &' + case(id_nag) + flags = ' & + & -O4& + & -coarray=single& + & -PIC& + &' + end select +end subroutine get_release_compile_flags + +subroutine get_debug_compile_flags(id, flags) + integer(compiler_enum), intent(in) :: id + character(len=:), allocatable, intent(out) :: flags + + select case(id) + case default + flags = "" + + case(id_caf) + flags = '& + & -Wall& + & -Wextra& + & -Wimplicit-interface& + & -fPIC -fmax-errors=1& + & -g& + & -fcheck=bounds& + & -fcheck=array-temps& + & -fbacktrace& + &' + + case(id_gcc) + flags = '& + & -Wall& + & -Wextra& + & -Wimplicit-interface& + & -fPIC -fmax-errors=1& + & -g& + & -fcheck=bounds& + & -fcheck=array-temps& + & -fbacktrace& + & -fcoarray=single& + &' + + case(id_f95) + flags = '& + & -Wall& + & -Wextra& + & -Wimplicit-interface& + & -fPIC -fmax-errors=1& + & -g& + & -fcheck=bounds& + & -fcheck=array-temps& + & -Wno-maybe-uninitialized -Wno-uninitialized& + & -fbacktrace& + &' + + case(id_nvhpc) + flags = '& + & -Minform=inform& + & -Mbackslash& + & -g& + & -Mbounds& + & -Mchkptr& + & -Mchkstk& + & -traceback& + &' + + case(id_intel_classic) + flags = '& + & -warn all& + & -check:all:noarg_temp_created& + & -error-limit 1& + & -O0& + & -g& + & -assume byterecl& + & -traceback& + &' + case(id_nag) + flags = '& + & -g& + & -C=all& + & -O0& + & -gline& + & -coarray=single& + & -PIC& + &' + end select +end subroutine get_debug_compile_flags + +subroutine get_module_flags(compiler, modpath, flags) + character(len=*), intent(in) :: compiler + character(len=*), intent(in) :: modpath + character(len=:), allocatable, intent(out) :: flags + integer(compiler_enum) :: id + + id = get_compiler_id(compiler) + + select case(id) case default - fflags = ' ' - mandatory=' -module '//modpath//' -I '//modpath - write(*,'(*(a))')'<WARNING> unknown compiler (',compiler,') and build name (',build_name,') combination.' - write(*,'(a,*(T31,6(a:,", "),/))')' known compilers are ',(trim(names(i)),i=1,size(names)-1) + flags=' -module '//modpath//' -I '//modpath + + case(id_caf, id_gcc, id_f95, id_cray) + flags=' -J '//modpath//' -I '//modpath + + case(id_intel_classic, id_intel_llvm, id_nvhpc, id_pgi, id_flang) + flags=' -module '//modpath//' -I '//modpath + + case(id_lahey) + flags=' -M '//modpath//' -I '//modpath + + case(id_nag) + flags=' -mdir '//modpath//' -I '//modpath ! + + case(id_ibmxl) + flags=' -qmoddir '//modpath//' -I '//modpath + end select - model%fortran_compile_flags = fflags//' '//mandatory - -end subroutine add_compile_flag_defaults +end subroutine get_module_flags + +function get_compiler_id(compiler) result(id) + character(len=*), intent(in) :: compiler + integer(kind=compiler_enum) :: id + + if (check_compiler(compiler, "gfortran")) then + id = id_gcc + return + end if + + if (check_compiler(compiler, "f95")) then + id = id_f95 + return + end if + + if (check_compiler(compiler, "caf")) then + id = id_caf + return + end if + + if (check_compiler(compiler, "ifort")) then + id = id_intel_classic + return + end if + + if (check_compiler(compiler, "ifx")) then + id = id_intel_llvm + return + end if + + if (check_compiler(compiler, "nvfortran")) then + id = id_nvhpc + return + end if + + if (check_compiler(compiler, "pgfortran") & + & .or. check_compiler(compiler, "pgf90") & + & .or. check_compiler(compiler, "pgf95")) then + id = id_pgi + return + end if + + if (check_compiler(compiler, "nagfor")) then + id = id_nag + return + end if + + if (check_compiler(compiler, "flang")) then + id = id_flang + return + end if + + if (check_compiler(compiler, "xlf90")) then + id = id_ibmxl + return + end if + + if (check_compiler(compiler, "crayftn")) then + id = id_cray + return + end if + + if (check_compiler(compiler, "lfc")) then + id = id_lahey + return + end if + + if (check_compiler(compiler, "lfort")) then + id = id_lfortran + return + end if + + id = id_unknown + +end function get_compiler_id + +function check_compiler(compiler, expected) result(match) + character(len=*), intent(in) :: compiler + character(len=*), intent(in) :: expected + logical :: match + match = compiler == expected + if (.not. match) then + match = index(basename(compiler), expected) > 0 + end if +end function check_compiler + +function is_unknown_compiler(compiler) result(is_unknown) + character(len=*), intent(in) :: compiler + logical :: is_unknown + is_unknown = get_compiler_id(compiler) == id_unknown +end function is_unknown_compiler end module fpm_compiler diff --git a/fpm/src/fpm_environment.f90 b/fpm/src/fpm_environment.f90 index 929a704..0408ec4 100644 --- a/fpm/src/fpm_environment.f90 +++ b/fpm/src/fpm_environment.f90 @@ -1,3 +1,7 @@ +!> This module contains procedures that interact with the programming environment. +!! +!! * [get_os_type] -- Determine the OS type +!! * [get_env] -- return the value of an environment variable module fpm_environment implicit none private @@ -14,8 +18,8 @@ module fpm_environment integer, parameter, public :: OS_SOLARIS = 5 integer, parameter, public :: OS_FREEBSD = 6 contains + !> Determine the OS type integer function get_os_type() result(r) - !! Determine the OS type !! !! Returns one of OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, OS_CYGWIN, !! OS_SOLARIS, OS_FREEBSD. @@ -106,6 +110,9 @@ contains end if end function get_os_type + !> Compare the output of [[get_os_type]] or the optional + !! passed INTEGER value to the value for OS_WINDOWS + !! and return .TRUE. if they match and .FALSE. otherwise logical function os_is_unix(os) result(unix) integer, intent(in), optional :: os integer :: build_os @@ -117,6 +124,7 @@ contains unix = os /= OS_WINDOWS end function os_is_unix + !> echo command string and pass it to the system for execution subroutine run(cmd,echo) character(len=*), intent(in) :: cmd logical,intent(in),optional :: echo @@ -137,10 +145,15 @@ contains end if end subroutine run + !> get named environment variable value. It it is blank or + !! not set return the optional default value function get_env(NAME,DEFAULT) result(VALUE) implicit none - character(len=*),intent(in) :: NAME + !> name of environment variable to get the value of + character(len=*),intent(in) :: NAME + !> default value to return if the requested value is undefined or blank character(len=*),intent(in),optional :: DEFAULT + !> the returned value character(len=:),allocatable :: VALUE integer :: howbig integer :: stat diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index 5811cd4..6acd383 100644 --- a/fpm/src/fpm_filesystem.f90 +++ b/fpm/src/fpm_filesystem.f90 @@ -1,3 +1,5 @@ +!> This module contains general routines for interacting with the file system +!! module fpm_filesystem use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit use fpm_environment, only: get_os_type, & @@ -15,6 +17,7 @@ use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, contains +!> return value of environment variable subroutine env_variable(var, name) character(len=:), allocatable, intent(out) :: var character(len=*), intent(in) :: name @@ -36,9 +39,9 @@ subroutine env_variable(var, name) end subroutine env_variable +!> Extract filename from path with/without suffix function basename(path,suffix) result (base) - ! Extract filename from path with/without suffix - ! + character(*), intent(In) :: path logical, intent(in), optional :: suffix character(:), allocatable :: base @@ -71,79 +74,109 @@ function basename(path,suffix) result (base) end function basename -function canon_path(path) result(canon) - ! Canonicalize path for comparison - ! Handles path string redundancies - ! Does not test existence of path - ! - ! To be replaced by realpath/_fullname in stdlib_os - ! - character(*), intent(in) :: path - character(:), allocatable :: canon +!> Canonicalize path for comparison +!! * Handles path string redundancies +!! * Does not test existence of path +!! +!! To be replaced by realpath/_fullname in stdlib_os +!! +!! FIXME: Lot's of ugly hacks following here +function canon_path(path) + character(len=*), intent(in) :: path + character(len=:), allocatable :: canon_path + character(len=:), allocatable :: nixpath - integer :: i, j - integer :: iback - character(len(path)) :: nixpath - character(len(path)) :: temp + integer :: ii, istart, iend, stat, nn, last + logical :: is_path, absolute nixpath = unix_path(path) - j = 1 - do i=1,len(nixpath) - - ! Skip back to last directory for '/../' - if (i > 4) then - - if (nixpath(i-3:i) == '/../') then + istart = 0 + nn = 0 + iend = 0 + absolute = nixpath(1:1) == "/" + if (absolute) then + canon_path = "/" + else + canon_path = "" + end if - iback = scan(nixpath(1:i-4),'/',back=.true.) - if (iback > 0) then - j = iback + 1 - cycle + do while(iend < len(nixpath)) + call next(nixpath, istart, iend, is_path) + if (is_path) then + select case(nixpath(istart:iend)) + case(".", "") ! always drop empty paths + case("..") + if (nn > 0) then + last = scan(canon_path(:len(canon_path)-1), "/", back=.true.) + canon_path = canon_path(:last) + nn = nn - 1 + else + if (.not. absolute) then + canon_path = canon_path // nixpath(istart:iend) // "/" + end if end if - - end if - + case default + nn = nn + 1 + canon_path = canon_path // nixpath(istart:iend) // "/" + end select end if + end do - if (i > 1 .and. j > 1) then - - ! Ignore current directory reference - if (nixpath(i-1:i) == './') then + if (len(canon_path) == 0) canon_path = "." + if (len(canon_path) > 1 .and. canon_path(len(canon_path):) == "/") then + canon_path = canon_path(:len(canon_path)-1) + end if - j = j - 1 - cycle +contains - end if + subroutine next(string, istart, iend, is_path) + character(len=*), intent(in) :: string + integer, intent(inout) :: istart + integer, intent(inout) :: iend + logical, intent(inout) :: is_path - ! Ignore repeated separators - if (nixpath(i-1:i) == '//') then + integer :: ii, nn + character :: tok, last - cycle - - end if - - ! Do NOT include trailing slash - if (i == len(nixpath) .and. nixpath(i:i) == '/') then - cycle - end if + nn = len(string) + if (iend >= nn) then + istart = nn + iend = nn + return end if + ii = min(iend + 1, nn) + tok = string(ii:ii) - temp(j:j) = nixpath(i:i) - j = j + 1 + is_path = tok /= '/' - end do + if (.not.is_path) then + is_path = .false. + istart = ii + iend = ii + return + end if - canon = temp(1:j-1) + istart = ii + do ii = min(iend + 1, nn), nn + tok = string(ii:ii) + select case(tok) + case('/') + exit + case default + iend = ii + cycle + end select + end do + end subroutine next end function canon_path +!> Extract dirname from path function dirname(path) result (dir) - ! Extract dirname from path - ! character(*), intent(in) :: path character(:), allocatable :: dir @@ -152,6 +185,7 @@ function dirname(path) result (dir) end function dirname +!> test if a name matches an existing directory path logical function is_dir(dir) character(*), intent(in) :: dir integer :: stat @@ -171,9 +205,9 @@ logical function is_dir(dir) end function is_dir +!> Construct path by joining strings with os file separator function join_path(a1,a2,a3,a4,a5) result(path) - ! Construct path by joining strings with os file separator - ! + character(len=*), intent(in) :: a1, a2 character(len=*), intent(in), optional :: a3, a4, a5 character(len=:), allocatable :: path @@ -209,8 +243,8 @@ function join_path(a1,a2,a3,a4,a5) result(path) end function join_path +!> Determine number or rows in a file given a LUN integer function number_of_rows(s) result(nrows) - ! determine number or rows integer,intent(in)::s integer :: ios character(len=100) :: r @@ -225,6 +259,7 @@ integer function number_of_rows(s) result(nrows) end function number_of_rows +!> read lines into an array of TYPE(STRING_T) variables function read_lines(fh) result(lines) integer, intent(in) :: fh type(string_t), allocatable :: lines(:) @@ -240,6 +275,7 @@ function read_lines(fh) result(lines) end function read_lines +!> Create a directory. Create subdirectories as needed subroutine mkdir(dir) character(len=*), intent(in) :: dir integer :: stat @@ -263,12 +299,12 @@ subroutine mkdir(dir) end subroutine mkdir +!> Get file & directory names in directory `dir`. +!! +!! - File/directory names return are relative to cwd, ie. preprended with `dir` +!! - Includes files starting with `.` except current directory and parent directory +!! recursive subroutine list_files(dir, files, recurse) - ! Get file & directory names in directory `dir`. - ! - ! - File/directory names return are relative to cwd, ie. preprended with `dir` - ! - Includes files starting with `.` except current directory and parent directory - ! character(len=*), intent(in) :: dir type(string_t), allocatable, intent(out) :: files(:) logical, intent(in), optional :: recurse @@ -329,18 +365,19 @@ recursive subroutine list_files(dir, files, recurse) end subroutine list_files +!> test if pathname already exists logical function exists(filename) result(r) character(len=*), intent(in) :: filename inquire(file=filename, exist=r) end function +!> Get a unused temporary filename +!! Calls posix 'tempnam' - not recommended, but +!! we have no security concerns for this application +!! and use here is temporary. +!! Works with MinGW function get_temp_filename() result(tempfile) - ! Get a unused temporary filename - ! Calls posix 'tempnam' - not recommended, but - ! we have no security concerns for this application - ! and use here is temporary. - ! Works with MinGW ! use iso_c_binding, only: c_ptr, C_NULL_PTR, c_f_pointer character(:), allocatable :: tempfile @@ -374,9 +411,9 @@ function get_temp_filename() result(tempfile) end function get_temp_filename +!> Replace file system separators for windows function windows_path(path) result(winpath) - ! Replace file system separators for windows - ! + character(*), intent(in) :: path character(:), allocatable :: winpath @@ -393,9 +430,9 @@ function windows_path(path) result(winpath) end function windows_path +!> Replace file system separators for unix function unix_path(path) result(nixpath) - ! Replace file system separators for unix - ! + character(*), intent(in) :: path character(:), allocatable :: nixpath @@ -412,6 +449,7 @@ function unix_path(path) result(nixpath) end function unix_path +!> read a line of arbitrary length into a CHARACTER variable from the specified LUN subroutine getline(unit, line, iostat, iomsg) !> Formatted IO unit @@ -453,6 +491,7 @@ subroutine getline(unit, line, iostat, iomsg) end subroutine getline +!> delete a file by filename subroutine delete_file(file) character(len=*), intent(in) :: file logical :: exist @@ -464,8 +503,8 @@ subroutine delete_file(file) end if end subroutine delete_file -subroutine warnwrite(fname,data) !> write trimmed character data to a file if it does not exist +subroutine warnwrite(fname,data) character(len=*),intent(in) :: fname character(len=*),intent(in) :: data(:) @@ -478,8 +517,8 @@ character(len=*),intent(in) :: data(:) end subroutine warnwrite +!> procedure to open filename as a sequential "text" file subroutine fileopen(filename,lun,ier) -! procedure to open filename as a sequential "text" file character(len=*),intent(in) :: filename integer,intent(out) :: lun @@ -516,8 +555,8 @@ character(len=256) :: message end subroutine fileopen +!> simple close of a LUN. On error show message and stop (by default) subroutine fileclose(lun,ier) -! simple close of a LUN. On error show message and stop (by default) integer,intent(in) :: lun integer,intent(out),optional :: ier character(len=256) :: message @@ -535,8 +574,8 @@ integer :: ios endif end subroutine fileclose +!> procedure to write filedata to file filename subroutine filewrite(filename,filedata) -! procedure to write filedata to file filename character(len=*),intent(in) :: filename character(len=*),intent(in) :: filedata(:) @@ -560,10 +599,10 @@ character(len=256) :: message end subroutine filewrite +!> Returns string with special characters replaced with an underscore. +!! For now, only a hyphen is treated as a special character, but this can be +!! expanded to other characters if needed. pure function to_fortran_name(string) result(res) - ! Returns string with special characters replaced with an underscore. - ! For now, only a hyphen is treated as a special character, but this can be - ! expanded to other characters if needed. character(*), intent(in) :: string character(len(string)) :: res character, parameter :: SPECIAL_CHARACTERS(*) = ['-'] diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index 3fffa81..c781535 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -161,7 +161,7 @@ subroutine add_executable_sources(sources,executables,scope,auto_discover,error) sources(j)%exe_name = executables(i)%name if (allocated(executables(i)%link)) then - exe_source%link_libraries = executables(i)%link + sources(j)%link_libraries = executables(i)%link end if cycle exe_loop diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90 index 80950de..d62a370 100644 --- a/fpm/src/fpm_strings.f90 +++ b/fpm/src/fpm_strings.f90 @@ -1,3 +1,32 @@ +!> This module defines general procedures for **string operations** for both CHARACTER and +!! TYPE(STRING_T) variables +! +!>## general routines for performing __string operations__ +!! +!!### Types +!! - **TYPE(STRING_T)** define a type to contain strings of variable length +!!### Type Conversions +!! - [[F_STRING]] return Fortran **CHARACTER** variable when given a C-like array of +!! single characters terminated with a C_NULL_CHAR **CHARACTER** +!! - [[STR]] Converts **INTEGER** or** LOGICAL** to **CHARACTER** string +!!### Case +!! - [[LOWER]] Changes a string to lowercase over optional specified column range +!!### Parsing and joining +!! - [[SPLIT]] parse string on delimiter characters and store tokens into an allocatable array +!! - [[STRING_CAT]] Concatenate an array of **type(string_t)** into a single **CHARACTER** variable +!! - [[JOIN]] append an array of **CHARACTER** variables into a single **CHARACTER** variable +!!### Testing +!! - [[STR_ENDS_WITH]] test if a **CHARACTER** string or array ends with a specified suffix +!! - [[STRING_ARRAY_CONTAINS]] Check if array of **TYPE(STRING_T)** matches a particular **CHARACTER** string +!! - **OPERATOR(.IN.)** Check if array of **TYPE(STRING_T)** matches a particular **CHARACTER** string +!! - [[GLOB]] function compares text strings, one of which can have wildcards ('*' or '?'). +!!### Miscellaneous +!! - [[LEN_TRIM]] Determine total trimmed length of **STRING_T** array +!! - [[FNV_1A]] Hash a **CHARACTER(*)** string of default kind or a **TYPE(STRING_T)** array +!! - [[REPLACE]] Returns string with characters in charset replaced with target_char. +!! - [[RESIZE]] increase the size of a **TYPE(STRING_T)** array by N elements +!! + module fpm_strings use iso_fortran_env, only: int64 implicit none @@ -43,6 +72,7 @@ end interface string_t contains +!> test if a CHARACTER string ends with a specified suffix pure logical function str_ends_with_str(s, e) result(r) character(*), intent(in) :: s, e integer :: n1, n2 @@ -55,6 +85,7 @@ pure logical function str_ends_with_str(s, e) result(r) end if end function str_ends_with_str +!> test if a CHARACTER string ends with any of an array of suffixs pure logical function str_ends_with_any(s, e) result(r) character(*), intent(in) :: s character(*), intent(in) :: e(:) @@ -71,6 +102,8 @@ pure logical function str_ends_with_any(s, e) result(r) end function str_ends_with_any +!> return Fortran character variable when given a C-like array of +!! single characters terminated with a C_NULL_CHAR character function f_string(c_string) use iso_c_binding character(len=1), intent(in) :: c_string(:) @@ -132,10 +165,10 @@ pure function fnv_1a_string_t(input, seed) result(hash) end function fnv_1a_string_t + !>Author: John S. Urban + !!License: Public Domain + !! Changes a string to lowercase over optional specified column range elemental pure function lower(str,begin,end) result (string) - ! Changes a string to lowercase over specified range - ! Author: John S. Urban - ! License: Public Domain character(*), intent(In) :: str character(len(str)) :: string @@ -174,9 +207,9 @@ function new_string_t(s) result(string) end function new_string_t +!> Check if array of TYPE(STRING_T) matches a particular CHARACTER string +!! logical function string_array_contains(search_string,array) - ! Check if array of string_t contains a particular string - ! character(*), intent(in) :: search_string type(string_t), intent(in) :: array(:) @@ -188,7 +221,7 @@ logical function string_array_contains(search_string,array) end function string_array_contains !> Concatenate an array of type(string_t) into -!> a single character +!> a single CHARACTER variable function string_cat(strings,delim) result(cat) type(string_t), intent(in) :: strings(:) character(*), intent(in), optional :: delim @@ -229,20 +262,19 @@ pure function string_len_trim(strings) result(n) end function string_len_trim +!>Author: John S. Urban +!!License: Public Domain +!! parse string on delimiter characters and store tokens into an allocatable array subroutine split(input_line,array,delimiters,order,nulls) - ! parse string on delimiter characters and store tokens into an allocatable array" - ! Author: John S. Urban - ! License: Public Domain - - - ! given a line of structure " par1 par2 par3 ... parn " store each par(n) into a separate variable in array. - ! o by default adjacent delimiters in the input string do not create an empty string in the output array - ! o no quoting of delimiters is supported - character(len=*),intent(in) :: input_line ! input string to tokenize - character(len=*),optional,intent(in) :: delimiters ! list of delimiter characters - character(len=*),optional,intent(in) :: order ! order of output array sequential|[reverse|right] - character(len=*),optional,intent(in) :: nulls ! return strings composed of delimiters or not ignore|return|ignoreend - character(len=:),allocatable,intent(out) :: array(:) ! output array of tokens + !! given a line of structure " par1 par2 par3 ... parn " store each par(n) into a separate variable in array. + !! + !! * by default adjacent delimiters in the input string do not create an empty string in the output array + !! * no quoting of delimiters is supported + character(len=*),intent(in) :: input_line !! input string to tokenize + character(len=*),optional,intent(in) :: delimiters !! list of delimiter characters + character(len=*),optional,intent(in) :: order !! order of output array sequential|[reverse|right] + character(len=*),optional,intent(in) :: nulls !! return strings composed of delimiters or not ignore|return|ignoreend + character(len=:),allocatable,intent(out) :: array(:) !! output array of tokens integer :: n ! max number of strings INPUT_LINE could split into if all delimiter integer,allocatable :: ibegin(:) ! positions in input string where tokens start @@ -347,8 +379,8 @@ subroutine split(input_line,array,delimiters,order,nulls) enddo end subroutine split +!> Returns string with characters in charset replaced with target_char. pure function replace(string, charset, target_char) result(res) - ! Returns string with characters in charset replaced with target_char. character(*), intent(in) :: string character, intent(in) :: charset(:), target_char character(len(string)) :: res @@ -361,6 +393,7 @@ pure function replace(string, charset, target_char) result(res) end do end function replace +!> increase the size of a TYPE(STRING_T) array by N elements subroutine resize_string(list, n) !> Instance of the array to be resized type(string_t), allocatable, intent(inout) :: list(:) @@ -396,14 +429,14 @@ subroutine resize_string(list, n) end subroutine resize_string -pure function join(str,sep,trm,left,right,start,end) result (string) -!> -!!##NAME +!>AUTHOR: John S. Urban +!!LICENSE: Public Domain +!!## NAME !! join(3f) - [fpm_strings:EDITING] append CHARACTER variable array into !! a single CHARACTER variable with specified separator !! (LICENSE:PD) !! -!!##SYNOPSIS +!!## SYNOPSIS !! !! pure function join(str,sep,trm,left,right,start,end) result (string) !! @@ -416,13 +449,13 @@ pure function join(str,sep,trm,left,right,start,end) result (string) !! character(len=*),intent(in),optional :: end !! character(len=:),allocatable :: string !! -!!##DESCRIPTION -!! JOIN(3f) appends the elements of a CHARACTER array into a single -!! CHARACTER variable, with elements 1 to N joined from left to right. -!! By default each element is trimmed of trailing spaces and the -!! default separator is a null string. +!!## DESCRIPTION +!! JOIN(3f) appends the elements of a CHARACTER array into a single +!! CHARACTER variable, with elements 1 to N joined from left to right. +!! By default each element is trimmed of trailing spaces and the +!! default separator is a null string. !! -!!##OPTIONS +!!## OPTIONS !! STR(:) array of CHARACTER variables to be joined !! SEP separator string to place between each variable. defaults !! to a null string. @@ -433,50 +466,47 @@ pure function join(str,sep,trm,left,right,start,end) result (string) !! TRM option to trim each element of STR of trailing !! spaces. Defaults to .TRUE. !! -!!##RESULT +!!## RESULT !! STRING CHARACTER variable composed of all of the elements of STR() !! appended together with the optional separator SEP placed !! between the elements. !! -!!##EXAMPLE +!!## EXAMPLE !! !! Sample program: -!! -!! program demo_join -!! use fpm_strings, only: join -!! implicit none -!! character(len=:),allocatable :: s(:) -!! character(len=:),allocatable :: out -!! integer :: i -!! s=[character(len=10) :: 'United',' we',' stand,', & -!! & ' divided',' we fall.'] -!! out=join(s) -!! write(*,'(a)') out -!! write(*,'(a)') join(s,trm=.false.) -!! write(*,'(a)') (join(s,trm=.false.,sep='|'),i=1,3) -!! write(*,'(a)') join(s,sep='<>') -!! write(*,'(a)') join(s,sep=';',left='[',right=']') -!! write(*,'(a)') join(s,left='[',right=']') -!! write(*,'(a)') join(s,left='>>') -!! end program demo_join +!!```fortran +!! program demo_join +!! use fpm_strings, only: join +!! implicit none +!! character(len=:),allocatable :: s(:) +!! character(len=:),allocatable :: out +!! integer :: i +!! s=[character(len=10) :: 'United',' we',' stand,', & +!! & ' divided',' we fall.'] +!! out=join(s) +!! write(*,'(a)') out +!! write(*,'(a)') join(s,trm=.false.) +!! write(*,'(a)') (join(s,trm=.false.,sep='|'),i=1,3) +!! write(*,'(a)') join(s,sep='<>') +!! write(*,'(a)') join(s,sep=';',left='[',right=']') +!! write(*,'(a)') join(s,left='[',right=']') +!! write(*,'(a)') join(s,left='>>') +!! end program demo_join +!!```fortran !! !! Expected output: !! -!! United we stand, divided we fall. -!! United we stand, divided we fall. -!! United | we | stand, | divided | we fall. -!! United | we | stand, | divided | we fall. -!! United | we | stand, | divided | we fall. -!! United<> we<> stand,<> divided<> we fall. -!! [United];[ we];[ stand,];[ divided];[ we fall.] -!! [United][ we][ stand,][ divided][ we fall.] -!! >>United>> we>> stand,>> divided>> we fall. -!! -!!##AUTHOR -!! John S. Urban +!! United we stand, divided we fall. +!! United we stand, divided we fall. +!! United | we | stand, | divided | we fall. +!! United | we | stand, | divided | we fall. +!! United | we | stand, | divided | we fall. +!! United<> we<> stand,<> divided<> we fall. +!! [United];[ we];[ stand,];[ divided];[ we fall.] +!! [United][ we][ stand,][ divided][ we fall.] +!! >>United>> we>> stand,>> divided>> we fall. !! -!!##LICENSE -!! Public Domain +pure function join(str,sep,trm,left,right,start,end) result (string) ! @(#)join(3f): append an array of character variables with specified separator into a single CHARACTER variable @@ -516,29 +546,29 @@ character(len=:),allocatable :: right_local if(present(end))string=string//end end function join -function glob(tame,wild) -!> -!!##NAME +!>##AUTHOR John S. Urban +!!##LICENSE Public Domain +!!## NAME !! glob(3f) - [fpm_strings:COMPARE] compare given string for match to !! pattern which may contain wildcard characters !! (LICENSE:PD) !! -!!##SYNOPSIS +!!## SYNOPSIS !! !! logical function glob(string, pattern ) !! !! character(len=*),intent(in) :: string !! character(len=*),intent(in) :: pattern !! -!!##DESCRIPTION -!! glob(3f) compares given STRING for match to PATTERN which may -!! contain wildcard characters. +!!## DESCRIPTION +!! glob(3f) compares given STRING for match to PATTERN which may +!! contain wildcard characters. !! -!! In this version to get a match the entire string must be described -!! by PATTERN. Trailing whitespace is significant, so trim the input -!! string to have trailing whitespace ignored. +!! In this version to get a match the entire string must be described +!! by PATTERN. Trailing whitespace is significant, so trim the input +!! string to have trailing whitespace ignored. !! -!!##OPTIONS +!!## OPTIONS !! string the input string to test to see if it contains the pattern. !! pattern the following simple globbing options are available !! @@ -550,7 +580,7 @@ function glob(tame,wild) !! o There is no escape character, so matching strings with !! literal question mark and asterisk is problematic. !! -!!##EXAMPLES +!!## EXAMPLES !! !! Example program !! @@ -742,21 +772,18 @@ function glob(tame,wild) !! !! Expected output !! -!!##AUTHOR -!! John S. Urban !! -!!##REFERENCE +!!## REFERENCE !! The article "Matching Wildcards: An Empirical Way to Tame an Algorithm" !! in Dr Dobb's Journal, By Kirk J. Krauss, October 07, 2014 !! -!!##LICENSE -!! Public Domain +function glob(tame,wild) ! @(#)fpm_strings::glob(3f): function compares text strings, one of which can have wildcards ('*' or '?'). -logical :: glob -character(len=*) :: tame ! A string without wildcards -character(len=*) :: wild ! A (potentially) corresponding string with wildcards +logical :: glob !! result of test +character(len=*) :: tame !! A string without wildcards to compare to the globbing expression +character(len=*) :: wild !! A (potentially) corresponding string with wildcards character(len=len(tame)+1) :: tametext character(len=len(wild)+1) :: wildtext character(len=1),parameter :: NULL=char(0) @@ -842,8 +869,8 @@ character(len=:),allocatable :: tbookmark, wbookmark enddo end function glob +!> Returns the length of the string representation of 'i' pure integer function str_int_len(i) result(sz) -! Returns the length of the string representation of 'i' integer, intent(in) :: i integer, parameter :: MAX_STR = 100 character(MAX_STR) :: s @@ -853,15 +880,15 @@ write(s, '(i0)') i sz = len_trim(s) end function +!> Converts integer "i" to string pure function str_int(i) result(s) -! Converts integer "i" to string integer, intent(in) :: i character(len=str_int_len(i)) :: s write(s, '(i0)') i end function +!> Returns the length of the string representation of 'i' pure integer function str_int64_len(i) result(sz) -! Returns the length of the string representation of 'i' integer(int64), intent(in) :: i integer, parameter :: MAX_STR = 100 character(MAX_STR) :: s @@ -871,15 +898,15 @@ write(s, '(i0)') i sz = len_trim(s) end function +!> Converts integer "i" to string pure function str_int64(i) result(s) -! Converts integer "i" to string integer(int64), intent(in) :: i character(len=str_int64_len(i)) :: s write(s, '(i0)') i end function +!> Returns the length of the string representation of 'l' pure integer function str_logical_len(l) result(sz) -! Returns the length of the string representation of 'l' logical, intent(in) :: l if (l) then sz = 6 @@ -888,8 +915,8 @@ else end if end function +!> Converts logical "l" to string pure function str_logical(l) result(s) -! Converts logical "l" to string logical, intent(in) :: l character(len=str_logical_len(l)) :: s if (l) then diff --git a/fpm/test/cli_test/cli_test.f90 b/fpm/test/cli_test/cli_test.f90 index c30d688..d979f1a 100644 --- a/fpm/test/cli_test/cli_test.f90 +++ b/fpm/test/cli_test/cli_test.f90 @@ -28,9 +28,9 @@ integer :: i, ios logical :: w_e,act_w_e ; namelist/act_cli/act_w_e logical :: w_t,act_w_t ; namelist/act_cli/act_w_t -character(len=63) :: build_name,act_build_name ; namelist/act_cli/act_build_name +character(len=63) :: profile,act_profile ; namelist/act_cli/act_profile character(len=:),allocatable :: args,act_args ; namelist/act_cli/act_args -namelist/expected/cmd,cstat,estat,w_e,w_t,name,build_name,args +namelist/expected/cmd,cstat,estat,w_e,w_t,name,profile,args integer :: lun logical,allocatable :: tally(:) logical,allocatable :: subtally(:) @@ -50,19 +50,21 @@ character(len=*),parameter :: tests(*)= [ character(len=256) :: & 'CMD="run", ', & 'CMD="run my_project", NAME="my_project", ', & 'CMD="run proj1 p2 project3", NAME="proj1","p2","project3", ', & -'CMD="run proj1 p2 project3 --release", NAME="proj1","p2","project3",build_name="release",', & -'CMD="run proj1 p2 project3 --release -- arg1 -x ""and a long one""", & - &NAME="proj1","p2","project3",build_name="release",ARGS="""arg1"" -x ""and a long one""", ', & +'CMD="run proj1 p2 project3 --profile debug", NAME="proj1","p2","project3",profile="debug",', & +'CMD="run proj1 p2 project3 --profile release", NAME="proj1","p2","project3",profile="release",', & +'CMD="run proj1 p2 project3 --profile release -- arg1 -x ""and a long one""", & + &NAME="proj1","p2","project3",profile="release",ARGS="""arg1"" -x ""and a long one""", ', & 'CMD="test", ', & 'CMD="test my_project", NAME="my_project", ', & 'CMD="test proj1 p2 project3", NAME="proj1","p2","project3", ', & -'CMD="test proj1 p2 project3 --release", NAME="proj1","p2","project3",build_name="release",', & -'CMD="test proj1 p2 project3 --release -- arg1 -x ""and a long one""", & - &NAME="proj1","p2","project3",build_name="release" ARGS="""arg1"" -x ""and a long one""", ', & +'CMD="test proj1 p2 project3 --profile debug", NAME="proj1","p2","project3",profile="debug",', & +'CMD="test proj1 p2 project3 --profile release", NAME="proj1","p2","project3",profile="release",', & +'CMD="test proj1 p2 project3 --profile release -- arg1 -x ""and a long one""", & + &NAME="proj1","p2","project3",profile="release" ARGS="""arg1"" -x ""and a long one""", ', & -'CMD="build", NAME= build_name="debug",ARGS="",', & -'CMD="build --release", NAME= build_name="release",ARGS="",', & +'CMD="build", NAME= profile="",ARGS="",', & +'CMD="build --profile release", NAME= profile="release",ARGS="",', & ' ' ] character(len=256) :: readme(3) @@ -90,7 +92,7 @@ if(command_argument_count().eq.0)then ! assume if called with no arguments to d endif ! blank out name group EXPECTED name=[(repeat(' ',len(name)),i=1,max_names)] ! the words on the command line sans the subcommand name - build_name="debug" ! --release + profile="" ! --profile PROF w_e=.false. ! --app w_t=.false. ! --test args=repeat(' ',132) ! -- ARGS @@ -107,7 +109,7 @@ if(command_argument_count().eq.0)then ! assume if called with no arguments to d if(estat.eq.0)then open(file='_test_cli',newunit=lun,delim='quote') act_name=[(repeat(' ',len(act_name)),i=1,max_names)] - act_build_name='debug' + act_profile='' act_w_e=.false. act_w_t=.false. act_args=repeat(' ',132) @@ -119,7 +121,7 @@ if(command_argument_count().eq.0)then ! assume if called with no arguments to d ! compare results to expected values subtally=[logical ::] call test_test('NAME',all(act_name.eq.name)) - call test_test('RELEASE',act_build_name.eq.build_name) + call test_test('PROFILE',act_profile.eq.profile) call test_test('WITH_EXPECTED',act_w_e.eqv.w_e) call test_test('WITH_TESTED',act_w_t.eqv.w_t) call test_test('WITH_TEST',act_w_t.eqv.w_t) @@ -204,7 +206,7 @@ allocate (character(len=len(name)) :: act_name(0) ) act_args='' act_w_e=.false. act_w_t=.false. -act_build_name='debug' +act_profile='' select type(settings=>cmd_settings) type is (fpm_new_settings) @@ -212,13 +214,13 @@ type is (fpm_new_settings) act_w_t=settings%with_test act_name=[trim(settings%name)] type is (fpm_build_settings) - act_build_name=settings%build_name + act_profile=settings%profile type is (fpm_run_settings) - act_build_name=settings%build_name + act_profile=settings%profile act_name=settings%name act_args=settings%args type is (fpm_test_settings) - act_build_name=settings%build_name + act_profile=settings%profile act_name=settings%name act_args=settings%args type is (fpm_install_settings) diff --git a/fpm/test/fpm_test/main.f90 b/fpm/test/fpm_test/main.f90 index e1b9d1e..0a65307 100644 --- a/fpm/test/fpm_test/main.f90 +++ b/fpm/test/fpm_test/main.f90 @@ -5,6 +5,7 @@ program fpm_testing & select_suite, run_selected use test_toml, only : collect_toml use test_manifest, only : collect_manifest + use test_filesystem, only : collect_filesystem use test_source_parsing, only : collect_source_parsing use test_module_dependencies, only : collect_module_dependencies use test_package_dependencies, only : collect_package_dependencies @@ -22,6 +23,7 @@ program fpm_testing suite = [ & & new_testsuite("fpm_toml", collect_toml), & & new_testsuite("fpm_manifest", collect_manifest), & + & new_testsuite("fpm_filesystem", collect_filesystem), & & new_testsuite("fpm_source_parsing", collect_source_parsing), & & new_testsuite("fpm_module_dependencies", collect_module_dependencies), & & new_testsuite("fpm_package_dependencies", collect_package_dependencies), & diff --git a/fpm/test/fpm_test/test_filesystem.f90 b/fpm/test/fpm_test/test_filesystem.f90 new file mode 100644 index 0000000..5a7e18a --- /dev/null +++ b/fpm/test/fpm_test/test_filesystem.f90 @@ -0,0 +1,106 @@ +module test_filesystem + use testsuite, only : new_unittest, unittest_t, error_t, test_failed + use fpm_filesystem, only: canon_path + implicit none + private + + public :: collect_filesystem + +contains + + + !> Collect all exported unit tests + subroutine collect_filesystem(testsuite) + + !> Collection of tests + type(unittest_t), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + & new_unittest("canon-path", test_canon_path) & + ] + + end subroutine collect_filesystem + + + subroutine test_canon_path(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + call check_string(error, & + & canon_path("git/project/src/origin"), "git/project/src/origin") + if (allocated(error)) return + + call check_string(error, & + & canon_path("./project/src/origin"), "project/src/origin") + if (allocated(error)) return + + call check_string(error, & + & canon_path("./project/src///origin/"), "project/src/origin") + if (allocated(error)) return + + call check_string(error, & + & canon_path("../project/./src/origin/"), "../project/src/origin") + if (allocated(error)) return + + call check_string(error, & + & canon_path("/project//src/origin/"), "/project/src/origin") + if (allocated(error)) return + + call check_string(error, & + & canon_path("/project/src/../origin/"), "/project/origin") + if (allocated(error)) return + + call check_string(error, & + & canon_path("/project/src/../origin/.."), "/project") + if (allocated(error)) return + + call check_string(error, & + & canon_path("/project/src//../origin/."), "/project/origin") + if (allocated(error)) return + + call check_string(error, & + & canon_path("../project/src/./../origin/."), "../project/origin") + if (allocated(error)) return + + call check_string(error, & + & canon_path("../project/src/../../../origin/."), "../../origin") + if (allocated(error)) return + + call check_string(error, & + & canon_path("/../.."), "/") + if (allocated(error)) return + + call check_string(error, & + & canon_path("././././././/////a/b/.///././////.///c/../../../"), ".") + if (allocated(error)) return + + call check_string(error, & + & canon_path("/./././././/////a/b/.///././////.///c/../../../"), "/") + if (allocated(error)) return + + end subroutine test_canon_path + + + !> Check a character variable against a reference value + subroutine check_string(error, actual, expected) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Actual string value + character(len=*), intent(in) :: actual + + !> Expected string value + character(len=*), intent(in) :: expected + + if (actual /= expected) then + call test_failed(error, & + "Character value missmatch "//& + "expected '"//expected//"' but got '"//actual//"'") + end if + + end subroutine check_string + + +end module test_filesystem |