1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
program main
use, intrinsic :: iso_fortran_env, only : error_unit, output_unit
use fpm_command_line, only: &
fpm_cmd_settings, &
fpm_new_settings, &
fpm_build_settings, &
fpm_run_settings, &
fpm_test_settings, &
fpm_install_settings, &
fpm_update_settings, &
get_command_line_settings
use fpm_error, only: error_t
use fpm_filesystem, only: exists, parent_dir, join_path
use fpm, only: cmd_build, cmd_run
use fpm_cmd_install, only: cmd_install
use fpm_cmd_new, only: cmd_new
use fpm_cmd_update, only : cmd_update
use fpm_os, only: change_directory, get_current_directory
implicit none
class(fpm_cmd_settings), allocatable :: cmd_settings
type(error_t), allocatable :: error
character(len=:), allocatable :: pwd_start, pwd_working, working_dir, project_root
call get_command_line_settings(cmd_settings)
call get_current_directory(pwd_start, error)
call handle_error(error)
call get_working_dir(cmd_settings, working_dir)
if (allocated(working_dir)) then
! Change working directory if requested
if (len_trim(working_dir) > 0) then
call change_directory(working_dir, error)
call handle_error(error)
call get_current_directory(pwd_working, error)
call handle_error(error)
write(output_unit, '(*(a))') "fpm: Entering directory '"//pwd_working//"'"
else
pwd_working = pwd_start
end if
else
pwd_working = pwd_start
end if
if (.not.has_manifest(pwd_working)) then
project_root = pwd_working
do while(.not.has_manifest(project_root))
working_dir = parent_dir(project_root)
if (len(working_dir) == 0) exit
project_root = working_dir
end do
if (has_manifest(project_root)) then
call change_directory(project_root, error)
call handle_error(error)
write(output_unit, '(*(a))') "fpm: Entering directory '"//project_root//"'"
end if
end if
select type(settings=>cmd_settings)
type is (fpm_new_settings)
call cmd_new(settings)
type is (fpm_build_settings)
call cmd_build(settings)
type is (fpm_run_settings)
call cmd_run(settings,test=.false.)
type is (fpm_test_settings)
call cmd_run(settings,test=.true.)
type is (fpm_install_settings)
call cmd_install(settings)
type is (fpm_update_settings)
call cmd_update(settings)
end select
if (allocated(project_root)) then
write(output_unit, '(*(a))') "fpm: Leaving directory '"//project_root//"'"
end if
if (pwd_start /= pwd_working) then
write(output_unit, '(*(a))') "fpm: Leaving directory '"//pwd_working//"'"
end if
contains
function has_manifest(dir)
character(len=*), intent(in) :: dir
logical :: has_manifest
has_manifest = exists(join_path(dir, "fpm.toml"))
end function has_manifest
subroutine handle_error(error)
type(error_t), optional, intent(in) :: error
if (present(error)) then
write(error_unit, '("[Error]", 1x, a)') error%message
stop 1
end if
end subroutine handle_error
!> Save access to working directory in settings, in case setting have not been allocated
subroutine get_working_dir(settings, working_dir)
class(fpm_cmd_settings), optional, intent(in) :: settings
character(len=:), allocatable, intent(out) :: working_dir
if (present(settings)) then
working_dir = settings%working_dir
end if
end subroutine get_working_dir
end program main
|
