Construct new dependency array from a TOML data structure
Flag dependencies that should be treated as metapackages Parse all meta- and non-metapackage dependencies
Neither a standard dep nor a metapackage Valid meta dependency
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dependency_config_t), | intent(out), | allocatable | :: | deps(:) |
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(metapackage_config_t), | intent(out), | optional | :: | meta |
(optional) metapackages |
|
type(error_t), | intent(out), | allocatable | :: | error |
Error handling |
subroutine new_dependencies(deps, table, root, meta, error)
!> Instance of the dependency configuration
type(dependency_config_t), allocatable, intent(out) :: deps(:)
!> (optional) metapackages
type(metapackage_config_t), optional, intent(out) :: meta
!> 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
type(toml_table), pointer :: node
type(toml_key), allocatable :: list(:)
type(dependency_config_t), allocatable :: all_deps(:)
type(metapackage_request_t) :: meta_request
logical, allocatable :: is_meta(:)
logical :: metapackages_allowed
integer :: idep, stat, ndep
call table%get_keys(list)
! An empty table is okay
if (size(list) < 1) return
!> Flag dependencies that should be treated as metapackages
metapackages_allowed = present(meta)
allocate(is_meta(size(list)),source=.false.)
allocate(all_deps(size(list)))
!> Parse all meta- and non-metapackage dependencies
do idep = 1, size(list)
! Check if this is a standard dependency node
call get_value(table, list(idep)%key, node, stat=stat)
is_standard_dependency: if (stat /= toml_stat%success) then
! See if it can be a valid metapackage name
call new_meta_request(meta_request, list(idep)%key, table, error=error)
!> Neither a standard dep nor a metapackage
if (allocated(error)) then
call syntax_error(error, "Dependency "//list(idep)%key//" is not a valid metapackage or a table entry")
return
endif
!> Valid meta dependency
is_meta(idep) = .true.
else
! Parse as a standard dependency
is_meta(idep) = .false.
call new_dependency(all_deps(idep), node, root, error)
if (allocated(error)) return
end if is_standard_dependency
end do
! Non-meta dependencies
ndep = count(.not.is_meta)
! Finalize standard dependencies
allocate(deps(ndep))
ndep = 0
do idep = 1, size(list)
if (is_meta(idep)) cycle
ndep = ndep+1
deps(ndep) = all_deps(idep)
end do
! Finalize meta dependencies
if (metapackages_allowed) call new_meta_config(meta,table,is_meta,error)
end subroutine new_dependencies