Skip to content

Commit 3c9e610

Browse files
awvwgkawvwgk
committed
Allow fpm to change the working directory
1 parent 6d9004d commit 3c9e610

File tree

3 files changed

+176
-89
lines changed

3 files changed

+176
-89
lines changed

‎ci/run_tests.sh

Lines changed: 64 additions & 80 deletions
Original file line numberDiff line numberDiff line change
@@ -13,86 +13,70 @@ fi
1313
pushd example_packages/
1414
rm -rf ./*/build
1515

16-
pushd hello_world
17-
"$fpm" build
18-
"$fpm" run --target hello_world
19-
"$fpm" run
20-
popd
21-
22-
pushd hello_fpm
23-
"$fpm" build
24-
"$fpm" run --target hello_fpm
25-
popd
26-
27-
pushd circular_test
28-
"$fpm" build
29-
popd
30-
31-
pushd circular_example
32-
"$fpm" build
33-
popd
34-
35-
pushd hello_complex
36-
"$fpm" build
37-
"$fpm" test
38-
"$fpm" run --target say_Hello
39-
"$fpm" run --target say_goodbye
40-
"$fpm" test --target greet_test
41-
"$fpm" test --target farewell_test
42-
popd
43-
44-
pushd hello_complex_2
45-
"$fpm" build
46-
"$fpm" run --target say_hello_world
47-
"$fpm" run --target say_goodbye
48-
"$fpm" test --target greet_test
49-
"$fpm" test --target farewell_test
50-
popd
51-
52-
pushd with_examples
53-
"$fpm" build
54-
"$fpm" run --example --target demo-prog
55-
"$fpm" run --target demo-prog
56-
popd
57-
58-
pushd auto_discovery_off
59-
"$fpm" build
60-
"$fpm" run --target auto_discovery_off
61-
"$fpm" test --target my_test
62-
test ! -x ./build/gfortran_*/app/unused
63-
test ! -x ./build/gfortran_*/test/unused_test
64-
popd
65-
66-
pushd with_c
67-
"$fpm" build
68-
"$fpm" run --target with_c
69-
popd
70-
71-
pushd submodules
72-
"$fpm" build
73-
popd
74-
75-
pushd program_with_module
76-
"$fpm" build
77-
"$fpm" run --target Program_with_module
78-
popd
79-
80-
pushd link_executable
81-
"$fpm" build
82-
"$fpm" run --target gomp_test
83-
popd
84-
85-
pushd fortran_includes
86-
"$fpm" build
87-
popd
88-
89-
pushd c_includes
90-
"$fpm" build
91-
popd
92-
93-
pushd c_header_only
94-
"$fpm" build
95-
popd
16+
dir=hello_world
17+
"$fpm" -C $dir build
18+
"$fpm" -C $dir run --target hello_world
19+
"$fpm" -C $dir run
20+
21+
dir=hello_fpm
22+
"$fpm" -C $dir build
23+
"$fpm" -C $dir run --target hello_fpm
24+
25+
dir=circular_test
26+
"$fpm" -C $dir build
27+
28+
dir=circular_example
29+
"$fpm" -C $dir build
30+
31+
dir=hello_complex
32+
"$fpm" -C $dir build
33+
"$fpm" -C $dir test
34+
"$fpm" -C $dir run --target say_Hello
35+
"$fpm" -C $dir run --target say_goodbye
36+
"$fpm" -C $dir test --target greet_test
37+
"$fpm" -C $dir test --target farewell_test
38+
39+
dir=hello_complex_2
40+
"$fpm" -C $dir build
41+
"$fpm" -C $dir run --target say_hello_world
42+
"$fpm" -C $dir run --target say_goodbye
43+
"$fpm" -C $dir test --target greet_test
44+
"$fpm" -C $dir test --target farewell_test
45+
46+
dir=with_examples
47+
"$fpm" -C $dir build
48+
"$fpm" -C $dir run --example --target demo-prog
49+
"$fpm" -C $dir run --target demo-prog
50+
51+
dir=auto_discovery_off
52+
"$fpm" -C $dir build
53+
"$fpm" -C $dir run --target auto_discovery_off
54+
"$fpm" -C $dir test --target my_test
55+
test ! -x $dir/build/gfortran_*/app/unused
56+
test ! -x $dir/build/gfortran_*/test/unused_test
57+
58+
dir=with_c
59+
"$fpm" -C $dir build
60+
"$fpm" -C $dir run --target with_c
61+
62+
"$fpm" -C $dir build
63+
64+
dir=program_with_module
65+
"$fpm" -C $dir build
66+
"$fpm" -C $dir run --target Program_with_module
67+
68+
dir=link_executable
69+
"$fpm" -C $dir build
70+
"$fpm" -C $dir run --target gomp_test
71+
72+
dir=fortran_includes
73+
"$fpm" -C $dir build
74+
75+
dir=c_includes
76+
"$fpm" -C $dir build
77+
78+
dir=c_header_only
79+
"$fpm" -C $dir build
9680

9781
# Cleanup
9882
rm -rf ./*/build

‎src/fpm_command_line.f90

Lines changed: 33 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,9 @@ module fpm_command_line
2626
use fpm_environment, only : get_os_type, get_env, &
2727
OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, &
2828
OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD
29+
use fpm_error, only : error_t
2930
use M_CLI2, only : set_args, lget, sget, unnamed, remaining, specified
31+
use fpm_os, only : change_directory, get_current_directory
3032
use fpm_strings, only : lower, split, fnv_1a
3133
use fpm_filesystem, only : basename, canon_path, to_fortran_name
3234
use fpm_compiler, only : get_default_compile_flags
@@ -119,6 +121,9 @@ subroutine get_command_line_settings(cmd_settings)
119121
integer :: i
120122
integer :: widest
121123
type(fpm_install_settings), allocatable :: install_settings
124+
character(len=:), allocatable :: pwd_start, working_dir
125+
character(len=:), allocatable :: common_args
126+
type(error_t), allocatable :: error
122127

123128
call set_help()
124129
! text for --version switch,
@@ -148,12 +153,16 @@ subroutine get_command_line_settings(cmd_settings)
148153
if(adjustl(cmdarg(1:1)) .ne. '-')exit
149154
enddo
150155

156+
call get_current_directory(pwd_start)
157+
158+
common_args = '--directory:C " " '
159+
151160
! now set subcommand-specific help text and process commandline
152161
! arguments. Then call subcommand routine
153162
select case(trim(cmdarg))
154163

155164
case('run')
156-
call set_args('&
165+
call set_args(common_args //'&
157166
& --target " " &
158167
& --list F &
159168
& --all F &
@@ -206,7 +215,7 @@ subroutine get_command_line_settings(cmd_settings)
206215
& verbose=lget('verbose') )
207216

208217
case('build')
209-
call set_args( '&
218+
call set_args(common_args // '&
210219
& --profile " " &
211220
& --list F &
212221
& --show-model F &
@@ -228,7 +237,7 @@ subroutine get_command_line_settings(cmd_settings)
228237
& verbose=lget('verbose') )
229238

230239
case('new')
231-
call set_args('&
240+
call set_args(common_args // '&
232241
& --src F &
233242
& --lib F &
234243
& --app F &
@@ -298,7 +307,7 @@ subroutine get_command_line_settings(cmd_settings)
298307
endif
299308

300309
case('help','manual')
301-
call set_args('&
310+
call set_args(common_args // '&
302311
& --verbose F &
303312
& ',help_help,version_text)
304313
if(size(unnamed).lt.2)then
@@ -346,7 +355,8 @@ subroutine get_command_line_settings(cmd_settings)
346355
call printhelp(help_text)
347356

348357
case('install')
349-
call set_args('--profile " " --no-rebuild F --verbose F --prefix " " &
358+
call set_args(common_args // '&
359+
& --profile " " --no-rebuild F --verbose F --prefix " " &
350360
& --list F &
351361
& --compiler "'//get_env('FPM_COMPILER','gfortran')//'" &
352362
& --flag:: " "&
@@ -371,7 +381,7 @@ subroutine get_command_line_settings(cmd_settings)
371381
call move_alloc(install_settings, cmd_settings)
372382

373383
case('list')
374-
call set_args('&
384+
call set_args(common_args // '&
375385
& --list F&
376386
& --verbose F&
377387
&', help_list, version_text)
@@ -380,7 +390,7 @@ subroutine get_command_line_settings(cmd_settings)
380390
call printhelp(help_list_dash)
381391
endif
382392
case('test')
383-
call set_args('&
393+
call set_args(common_args // '&
384394
& --target " " &
385395
& --list F&
386396
& --profile " "&
@@ -425,7 +435,7 @@ subroutine get_command_line_settings(cmd_settings)
425435
& verbose=lget('verbose') )
426436

427437
case('update')
428-
call set_args('--fetch-only F --verbose F --clean F', &
438+
call set_args(common_args // ' --fetch-only F --verbose F --clean F', &
429439
help_update, version_text)
430440

431441
if( size(unnamed) .gt. 1 )then
@@ -441,7 +451,7 @@ subroutine get_command_line_settings(cmd_settings)
441451

442452
case default
443453

444-
call set_args('&
454+
call set_args(common_args // '&
445455
& --list F&
446456
& --verbose F&
447457
&', help_fpm, version_text)
@@ -462,6 +472,18 @@ subroutine get_command_line_settings(cmd_settings)
462472
call printhelp(help_text)
463473

464474
end select
475+
476+
! Change working directory if requested
477+
working_dir = sget("directory")
478+
if (len_trim(working_dir) > 0) then
479+
call change_directory(working_dir, error)
480+
if (allocated(error)) then
481+
write(stderr, '(*(a, 1x))') "<ERROR>", error%message
482+
stop 1
483+
end if
484+
write(stdout, '(*(a))') "fpm: Entering directory '"//working_dir//"'"
485+
end if
486+
465487
contains
466488

467489
subroutine check_build_vals()
@@ -674,6 +696,8 @@ subroutine set_help()
674696
' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] [options]', &
675697
' ', &
676698
'SUBCOMMAND OPTIONS ', &
699+
' -C, --directory PATH', &
700+
' Change working directory to PATH before running any command', &
677701
' --profile PROF selects the compilation profile for the build.',&
678702
' Currently available profiles are "release" for',&
679703
' high optimization and "debug" for full debug options.',&

‎src/fpm_os.F90

Lines changed: 79 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,79 @@
1+
module fpm_os
2+
use, intrinsic :: iso_c_binding, only : c_char, c_int, c_null_char
3+
use fpm_error, only : error_t, fatal_error
4+
implicit none
5+
private
6+
public :: change_directory, get_current_directory
7+
8+
#ifndef _WIN32
9+
character(len=*), parameter :: pwd_env = "PWD"
10+
#else
11+
character(len=*), parameter :: pwd_env = "CD"
12+
#endif
13+
14+
interface
15+
function chdir(path) result(stat) &
16+
#ifndef _WIN32
17+
bind(C, name="chdir")
18+
#else
19+
bind(C, name="_chdir")
20+
#endif
21+
import :: c_char, c_int
22+
character(kind=c_char, len=1), intent(in) :: path(*)
23+
integer(c_int) :: stat
24+
end function chdir
25+
end interface
26+
27+
contains
28+
29+
subroutine change_directory(path, error)
30+
character(len=*), intent(in) :: path
31+
type(error_t), allocatable, intent(out) :: error
32+
33+
character(kind=c_char, len=1), allocatable :: cpath(:)
34+
integer :: stat
35+
36+
allocate(cpath(len(path)+1))
37+
call f_c_character(path, cpath, len(path)+1)
38+
39+
stat = chdir(cpath)
40+
41+
if (stat /= 0) then
42+
call fatal_error(error, "Failed to change directory to '"//path//"'")
43+
end if
44+
end subroutine change_directory
45+
46+
subroutine f_c_character(rhs, lhs, len)
47+
character(kind=c_char), intent(out) :: lhs(*)
48+
character(len=*), intent(in) :: rhs
49+
integer, intent(in) :: len
50+
integer :: length
51+
length = min(len-1, len_trim(rhs))
52+
53+
lhs(1:length) = transfer(rhs(1:length), lhs(1:length))
54+
lhs(length+1:length+1) = c_null_char
55+
56+
end subroutine f_c_character
57+
58+
subroutine get_current_directory(path)
59+
character(len=:), allocatable, intent(out) :: path
60+
61+
integer :: length, stat
62+
63+
call get_environment_variable(pwd_env, length=length, status=stat)
64+
if (stat /= 0) return
65+
66+
allocate(character(len=length) :: path, stat=stat)
67+
if (stat /= 0) return
68+
69+
if (length > 0) then
70+
call get_environment_variable(pwd_env, path, status=stat)
71+
if (stat /= 0) then
72+
deallocate(path)
73+
return
74+
end if
75+
end if
76+
77+
end subroutine get_current_directory
78+
79+
end module fpm_os

0 commit comments

Comments
 (0)