Construct a new metapackage request from the dependencies table
Set name The toml table is not checked here because it already passed the “new_dependencies” check
Set list of entries that are allowed to be metapackages
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(metapackage_request_t), | intent(out) | :: | self | |||
character(len=*), | intent(in) | :: | key |
The package name |
||
type(toml_table), | intent(inout) | :: | table |
Instance of the TOML data structure |
||
logical, | intent(in), | optional | :: | meta_allowed(:) |
List of keys allowed to be metapackages |
|
type(error_t), | intent(out), | allocatable | :: | error |
Error handling |
subroutine new_meta_request(self, key, table, meta_allowed, error)
type(metapackage_request_t), intent(out) :: self
!> The package name
character(len=*), intent(in) :: key
!> Instance of the TOML data structure
type(toml_table), intent(inout) :: table
!> List of keys allowed to be metapackages
logical, intent(in), optional :: meta_allowed(:)
!> Error handling
type(error_t), allocatable, intent(out) :: error
integer :: stat,i
character(len=:), allocatable :: value
logical, allocatable :: allow_meta(:)
type(toml_key), allocatable :: keys(:)
call request_destroy(self)
!> Set name
self%name = key
if (.not.is_meta_package(key)) then
call fatal_error(error,"Error reading fpm.toml: <"//key//"> is not a valid metapackage name")
return
end if
!> The toml table is not checked here because it already passed
!> the "new_dependencies" check
call table%get_keys(keys)
!> Set list of entries that are allowed to be metapackages
if (present(meta_allowed)) then
if (size(meta_allowed)/=size(keys)) then
call fatal_error(error,"Internal error: list of metapackage-enable entries does not match table size")
return
end if
allow_meta = meta_allowed
else
allocate(allow_meta(size(keys)),source=.true.)
endif
do i=1,size(keys)
! Skip standard dependencies
if (.not.allow_meta(i)) cycle
if (keys(i)%key==key) then
call get_value(table, key, value)
if (.not. allocated(value)) then
call syntax_error(error, "Could not retrieve version string for metapackage key <"//key//">. Check syntax")
return
else
call request_parse(self, value, error)
return
endif
end if
end do
! Key is not present, metapackage not requested
return
end subroutine new_meta_request