main Program

Contents

Source Code


Variables

Type AttributesNameInitial
class(fpm_cmd_settings), allocatable:: cmd_settings
type(error_t), allocatable:: error
character(len=:), allocatable:: project_root
character(len=:), allocatable:: pwd_start
character(len=:), allocatable:: pwd_working
character(len=:), allocatable:: working_dir

Functions

function has_manifest(dir)

Arguments

Type IntentOptional AttributesName
character(len=*), intent(in) :: dir

Return Value logical


Subroutines

subroutine get_working_dir(settings, working_dir)

Save access to working directory in settings, in case setting have not been allocated

Arguments

Type IntentOptional AttributesName
class(fpm_cmd_settings), intent(in), optional :: settings
character(len=:), intent(out), allocatable:: working_dir

subroutine handle_error(error)

Arguments

Type IntentOptional AttributesName
type(error_t), intent(in), optional :: error

Source Code

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