diff options
Diffstat (limited to 'app')
| -rw-r--r-- | app/main.f90 | 77 |
1 files changed, 77 insertions, 0 deletions
diff --git a/app/main.f90 b/app/main.f90 index 7476df6..5600f98 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -1,4 +1,5 @@ program main +use, intrinsic :: iso_fortran_env, only : error_unit, output_unit use fpm_command_line, only: & fpm_cmd_settings, & fpm_new_settings, & @@ -8,17 +9,57 @@ use fpm_command_line, only: & 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) @@ -34,4 +75,40 @@ 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 + + character(len=:), allocatable :: 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 |