aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSebastian Ehlert <28669218+awvwgk@users.noreply.github.com>2021-05-27 20:04:51 +0200
committerSebastian Ehlert <28669218+awvwgk@users.noreply.github.com>2021-05-27 20:09:13 +0200
commit3c9e6105c8458f6a59d2edc6fd7f2e79c18de943 (patch)
tree7c6f9a5e47460f7661941e1e866571036a84c1b7
parent6d9004d93460dc15b99051c90d1b58d724b010e6 (diff)
downloadfpm-3c9e6105c8458f6a59d2edc6fd7f2e79c18de943.tar.gz
fpm-3c9e6105c8458f6a59d2edc6fd7f2e79c18de943.zip
Allow fpm to change the working directory
-rwxr-xr-xci/run_tests.sh144
-rw-r--r--src/fpm_command_line.f9042
-rw-r--r--src/fpm_os.F9079
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