diff options
author | Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> | 2021-05-27 20:04:51 +0200 |
---|---|---|
committer | Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> | 2021-05-27 20:09:13 +0200 |
commit | 3c9e6105c8458f6a59d2edc6fd7f2e79c18de943 (patch) | |
tree | 7c6f9a5e47460f7661941e1e866571036a84c1b7 | |
parent | 6d9004d93460dc15b99051c90d1b58d724b010e6 (diff) | |
download | fpm-3c9e6105c8458f6a59d2edc6fd7f2e79c18de943.tar.gz fpm-3c9e6105c8458f6a59d2edc6fd7f2e79c18de943.zip |
Allow fpm to change the working directory
-rwxr-xr-x | ci/run_tests.sh | 144 | ||||
-rw-r--r-- | src/fpm_command_line.f90 | 42 | ||||
-rw-r--r-- | src/fpm_os.F90 | 79 |
3 files changed, 176 insertions, 89 deletions
diff --git a/ci/run_tests.sh b/ci/run_tests.sh index ffcd9c2..a31fa18 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -13,86 +13,70 @@ fi pushd example_packages/ rm -rf ./*/build -pushd hello_world -"$fpm" build -"$fpm" run --target hello_world -"$fpm" run -popd - -pushd hello_fpm -"$fpm" build -"$fpm" run --target hello_fpm -popd - -pushd circular_test -"$fpm" build -popd - -pushd circular_example -"$fpm" build -popd - -pushd hello_complex -"$fpm" build -"$fpm" test -"$fpm" run --target say_Hello -"$fpm" run --target say_goodbye -"$fpm" test --target greet_test -"$fpm" test --target farewell_test -popd - -pushd hello_complex_2 -"$fpm" build -"$fpm" run --target say_hello_world -"$fpm" run --target say_goodbye -"$fpm" test --target greet_test -"$fpm" test --target farewell_test -popd - -pushd with_examples -"$fpm" build -"$fpm" run --example --target demo-prog -"$fpm" run --target demo-prog -popd - -pushd auto_discovery_off -"$fpm" build -"$fpm" run --target auto_discovery_off -"$fpm" test --target my_test -test ! -x ./build/gfortran_*/app/unused -test ! -x ./build/gfortran_*/test/unused_test -popd - -pushd with_c -"$fpm" build -"$fpm" run --target with_c -popd - -pushd submodules -"$fpm" build -popd - -pushd program_with_module -"$fpm" build -"$fpm" run --target Program_with_module -popd - -pushd link_executable -"$fpm" build -"$fpm" run --target gomp_test -popd - -pushd fortran_includes -"$fpm" build -popd - -pushd c_includes -"$fpm" build -popd - -pushd c_header_only -"$fpm" build -popd +dir=hello_world +"$fpm" -C $dir build +"$fpm" -C $dir run --target hello_world +"$fpm" -C $dir run + +dir=hello_fpm +"$fpm" -C $dir build +"$fpm" -C $dir run --target hello_fpm + +dir=circular_test +"$fpm" -C $dir build + +dir=circular_example +"$fpm" -C $dir build + +dir=hello_complex +"$fpm" -C $dir build +"$fpm" -C $dir test +"$fpm" -C $dir run --target say_Hello +"$fpm" -C $dir run --target say_goodbye +"$fpm" -C $dir test --target greet_test +"$fpm" -C $dir test --target farewell_test + +dir=hello_complex_2 +"$fpm" -C $dir build +"$fpm" -C $dir run --target say_hello_world +"$fpm" -C $dir run --target say_goodbye +"$fpm" -C $dir test --target greet_test +"$fpm" -C $dir test --target farewell_test + +dir=with_examples +"$fpm" -C $dir build +"$fpm" -C $dir run --example --target demo-prog +"$fpm" -C $dir run --target demo-prog + +dir=auto_discovery_off +"$fpm" -C $dir build +"$fpm" -C $dir run --target auto_discovery_off +"$fpm" -C $dir test --target my_test +test ! -x $dir/build/gfortran_*/app/unused +test ! -x $dir/build/gfortran_*/test/unused_test + +dir=with_c +"$fpm" -C $dir build +"$fpm" -C $dir run --target with_c + +"$fpm" -C $dir build + +dir=program_with_module +"$fpm" -C $dir build +"$fpm" -C $dir run --target Program_with_module + +dir=link_executable +"$fpm" -C $dir build +"$fpm" -C $dir run --target gomp_test + +dir=fortran_includes +"$fpm" -C $dir build + +dir=c_includes +"$fpm" -C $dir build + +dir=c_header_only +"$fpm" -C $dir build # Cleanup rm -rf ./*/build diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 2a2ecf5..095a533 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -26,7 +26,9 @@ module fpm_command_line use fpm_environment, only : get_os_type, get_env, & OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD +use fpm_error, only : error_t use M_CLI2, only : set_args, lget, sget, unnamed, remaining, specified +use fpm_os, only : change_directory, get_current_directory 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 @@ -119,6 +121,9 @@ contains integer :: i integer :: widest type(fpm_install_settings), allocatable :: install_settings + character(len=:), allocatable :: pwd_start, working_dir + character(len=:), allocatable :: common_args + type(error_t), allocatable :: error call set_help() ! text for --version switch, @@ -148,12 +153,16 @@ contains if(adjustl(cmdarg(1:1)) .ne. '-')exit enddo + call get_current_directory(pwd_start) + + common_args = '--directory:C " " ' + ! now set subcommand-specific help text and process commandline ! arguments. Then call subcommand routine select case(trim(cmdarg)) case('run') - call set_args('& + call set_args(common_args //'& & --target " " & & --list F & & --all F & @@ -206,7 +215,7 @@ contains & verbose=lget('verbose') ) case('build') - call set_args( '& + call set_args(common_args // '& & --profile " " & & --list F & & --show-model F & @@ -228,7 +237,7 @@ contains & verbose=lget('verbose') ) case('new') - call set_args('& + call set_args(common_args // '& & --src F & & --lib F & & --app F & @@ -298,7 +307,7 @@ contains endif case('help','manual') - call set_args('& + call set_args(common_args // '& & --verbose F & & ',help_help,version_text) if(size(unnamed).lt.2)then @@ -346,7 +355,8 @@ contains call printhelp(help_text) case('install') - call set_args('--profile " " --no-rebuild F --verbose F --prefix " " & + call set_args(common_args // '& + & --profile " " --no-rebuild F --verbose F --prefix " " & & --list F & & --compiler "'//get_env('FPM_COMPILER','gfortran')//'" & & --flag:: " "& @@ -371,7 +381,7 @@ contains call move_alloc(install_settings, cmd_settings) case('list') - call set_args('& + call set_args(common_args // '& & --list F& & --verbose F& &', help_list, version_text) @@ -380,7 +390,7 @@ contains call printhelp(help_list_dash) endif case('test') - call set_args('& + call set_args(common_args // '& & --target " " & & --list F& & --profile " "& @@ -425,7 +435,7 @@ contains & verbose=lget('verbose') ) case('update') - call set_args('--fetch-only F --verbose F --clean F', & + call set_args(common_args // ' --fetch-only F --verbose F --clean F', & help_update, version_text) if( size(unnamed) .gt. 1 )then @@ -441,7 +451,7 @@ contains case default - call set_args('& + call set_args(common_args // '& & --list F& & --verbose F& &', help_fpm, version_text) @@ -462,6 +472,18 @@ contains call printhelp(help_text) end select + + ! Change working directory if requested + working_dir = sget("directory") + if (len_trim(working_dir) > 0) then + call change_directory(working_dir, error) + if (allocated(error)) then + write(stderr, '(*(a, 1x))') "<ERROR>", error%message + stop 1 + end if + write(stdout, '(*(a))') "fpm: Entering directory '"//working_dir//"'" + end if + contains subroutine check_build_vals() @@ -674,6 +696,8 @@ contains ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] [options]', & ' ', & 'SUBCOMMAND OPTIONS ', & + ' -C, --directory PATH', & + ' Change working directory to PATH before running any command', & ' --profile PROF selects the compilation profile for the build.',& ' Currently available profiles are "release" for',& ' high optimization and "debug" for full debug options.',& diff --git a/src/fpm_os.F90 b/src/fpm_os.F90 new file mode 100644 index 0000000..825df58 --- /dev/null +++ b/src/fpm_os.F90 @@ -0,0 +1,79 @@ +module fpm_os + use, intrinsic :: iso_c_binding, only : c_char, c_int, c_null_char + use fpm_error, only : error_t, fatal_error + implicit none + private + public :: change_directory, get_current_directory + +#ifndef _WIN32 + character(len=*), parameter :: pwd_env = "PWD" +#else + character(len=*), parameter :: pwd_env = "CD" +#endif + + interface + function chdir(path) result(stat) & +#ifndef _WIN32 + bind(C, name="chdir") +#else + bind(C, name="_chdir") +#endif + import :: c_char, c_int + character(kind=c_char, len=1), intent(in) :: path(*) + integer(c_int) :: stat + end function chdir + end interface + +contains + + subroutine change_directory(path, error) + character(len=*), intent(in) :: path + type(error_t), allocatable, intent(out) :: error + + character(kind=c_char, len=1), allocatable :: cpath(:) + integer :: stat + + allocate(cpath(len(path)+1)) + call f_c_character(path, cpath, len(path)+1) + + stat = chdir(cpath) + + if (stat /= 0) then + call fatal_error(error, "Failed to change directory to '"//path//"'") + end if + end subroutine change_directory + + subroutine f_c_character(rhs, lhs, len) + character(kind=c_char), intent(out) :: lhs(*) + character(len=*), intent(in) :: rhs + integer, intent(in) :: len + integer :: length + length = min(len-1, len_trim(rhs)) + + lhs(1:length) = transfer(rhs(1:length), lhs(1:length)) + lhs(length+1:length+1) = c_null_char + + end subroutine f_c_character + + subroutine get_current_directory(path) + character(len=:), allocatable, intent(out) :: path + + integer :: length, stat + + call get_environment_variable(pwd_env, length=length, status=stat) + if (stat /= 0) return + + allocate(character(len=length) :: path, stat=stat) + if (stat /= 0) return + + if (length > 0) then + call get_environment_variable(pwd_env, path, status=stat) + if (stat /= 0) then + deallocate(path) + return + end if + end if + + end subroutine get_current_directory + +end module fpm_os |