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