diff options
| -rwxr-xr-x | ci/run_tests.bat | 38 | ||||
| -rwxr-xr-x | ci/run_tests.sh | 40 | ||||
| -rw-r--r-- | fpm/src/fpm.f90 | 12 | ||||
| -rw-r--r-- | fpm/src/fpm_command_line.f90 | 154 | ||||
| -rw-r--r-- | fpm/src/fpm_compiler.f90 | 518 | ||||
| -rw-r--r-- | fpm/src/fpm_filesystem.f90 | 115 | ||||
| -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 |
9 files changed, 660 insertions, 361 deletions
diff --git a/ci/run_tests.bat b/ci/run_tests.bat index ae57da6..f5b57c1 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 cd ..\.. diff --git a/ci/run_tests.sh b/ci/run_tests.sh index f1c4dff..bca70cc 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 # Cleanup rm -rf ./*/build diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 68385cd..d0acaf5 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 @@ -62,9 +62,17 @@ 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 diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 72a4000..9d95977 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -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 3335b11..51cda20 100644 --- a/fpm/src/fpm_compiler.f90 +++ b/fpm/src/fpm_compiler.f90 @@ -1,27 +1,6 @@ !># Define compiler command options !! !! This module defines compiler options to use for the debug and release builds. -module fpm_compiler -use fpm_model, only: fpm_model_t -use fpm_filesystem, only: join_path -public add_compile_flag_defaults - -contains -!> Choose compile flags based on cli settings & manifest inputs -subroutine add_compile_flag_defaults(build_name,compiler,model) -character(len=*),intent(in) :: build_name !! select build from {release,debug} -character(len=*),intent(in) :: compiler !! compiler name -type(fpm_model_t), intent(inout) :: model !! model to add compiler options to - -! 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 ! vendor Fortran C Module output Module include OpenMP Free for OSS ! compiler compiler directory directory @@ -46,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& - & -fcheck=bounds& - & -fcheck=array-temps& - & -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_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index f9781ab..6acd383 100644 --- a/fpm/src/fpm_filesystem.f90 +++ b/fpm/src/fpm_filesystem.f90 @@ -80,67 +80,98 @@ end function basename !! !! To be replaced by realpath/_fullname in stdlib_os !! -function canon_path(path) result(canon) - character(*), intent(in) :: path - character(:), allocatable :: canon +!! 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 - - j = j - 1 - cycle - - end if + 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 - ! Ignore repeated separators - if (nixpath(i-1:i) == '//') then +contains - cycle + 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 - end if + integer :: ii, nn + character :: tok, last - ! 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 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 |