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_export_settings, &
fpm_run_settings, &
fpm_test_settings, &
fpm_install_settings, &
fpm_update_settings, &
fpm_clean_settings, &
fpm_publish_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, cmd_clean
use fpm_cmd_install, only: cmd_install
use fpm_cmd_export, only: cmd_export
use fpm_cmd_new, only: cmd_new
use fpm_cmd_update, only : cmd_update
use fpm_cmd_publish, only: cmd_publish
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
select type (settings => cmd_settings)
type is (fpm_new_settings)
class default
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
end select
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_export_settings)
call cmd_export(settings)
type is (fpm_install_settings)
call cmd_install(settings)
type is (fpm_update_settings)
call cmd_update(settings)
type is (fpm_clean_settings)
call cmd_clean(settings)
type is (fpm_publish_settings)
call cmd_publish(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