new_dependency Subroutine

public subroutine new_dependency(self, table, root, error)

Construct a new dependency configuration from a TOML data structure

Get optional preprocessor directives

Arguments

Type IntentOptional Attributes Name
type(dependency_config_t), intent(out) :: self

Instance of the dependency configuration

type(toml_table), intent(inout) :: table

Instance of the TOML data structure

character(len=*), intent(in), optional :: root

Root directory of the manifest

type(error_t), intent(out), allocatable :: error

Error handling


Source Code

    subroutine new_dependency(self, table, root, error)

        !> Instance of the dependency configuration
        type(dependency_config_t), intent(out) :: self

        !> Instance of the TOML data structure
        type(toml_table), intent(inout) :: table

        !> Root directory of the manifest
        character(*), intent(in), optional :: root

        !> Error handling
        type(error_t), allocatable, intent(out) :: error

        character(len=:), allocatable :: uri, value, requested_version

        type(toml_table), pointer :: child

        call check(table, error)
        if (allocated(error)) return

        call table%get_key(self%name)
        call get_value(table, "namespace", self%namespace)

        call get_value(table, "v", requested_version)
        if (allocated(requested_version)) then
            if (.not. allocated(self%requested_version)) allocate (self%requested_version)
            call new_version(self%requested_version, requested_version, error)
            if (allocated(error)) return
        end if

        !> Get optional preprocessor directives
        call get_value(table, "preprocess", child, requested=.false.)
        if (associated(child)) then
            call new_preprocessors(self%preprocess, child, error)
            if (allocated(error)) return
        endif

        call get_value(table, "path", uri)
        if (allocated(uri)) then
            if (get_os_type() == OS_WINDOWS) uri = windows_path(uri)
            if (present(root)) uri = join_path(root,uri)  ! Relative to the fpm.toml it’s written in
            call move_alloc(uri, self%path)
            return
        end if

        call get_value(table, "git", uri)
        if (allocated(uri)) then
            call get_value(table, "tag", value)
            if (allocated(value)) then
                self%git = git_target_tag(uri, value)
            end if

            if (.not. allocated(self%git)) then
                call get_value(table, "branch", value)
                if (allocated(value)) then
                    self%git = git_target_branch(uri, value)
                end if
            end if

            if (.not. allocated(self%git)) then
                call get_value(table, "rev", value)
                if (allocated(value)) then
                    self%git = git_target_revision(uri, value)
                end if
            end if

            if (.not. allocated(self%git)) then
                self%git = git_target_default(uri)
            end if
            return
        end if

    end subroutine new_dependency