Construct a new package configuration from a TOML data structure
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(package_config_t), | intent(out) | :: | self |
Instance of the package 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 |
subroutine new_package(self, table, root, error)
!> Instance of the package configuration
type(package_config_t), intent(out) :: self
!> Instance of the TOML data structure
type(toml_table), intent(inout) :: table
!> Root directory of the manifest
character(len=*), intent(in), optional :: root
!> Error handling
type(error_t), allocatable, intent(out) :: error
! Backspace (8), tabulator (9), newline (10), formfeed (12) and carriage
! return (13) are invalid in package names
character(len=*), parameter :: invalid_chars = &
achar(8) // achar(9) // achar(10) // achar(12) // achar(13)
type(toml_table), pointer :: child, node
type(toml_array), pointer :: children
character(len=:), allocatable :: version, version_file
integer :: ii, nn, stat, io
call check(table, error)
if (allocated(error)) return
call get_value(table, "name", self%name)
if (.not.allocated(self%name)) then
call syntax_error(error, "Could not retrieve package name")
return
end if
if (bad_name_error(error,'package',self%name))then
return
endif
call get_value(table, "license", self%license)
if (len(self%name) <= 0) then
call syntax_error(error, "Package name must be a non-empty string")
return
end if
ii = scan(self%name, invalid_chars)
if (ii > 0) then
call syntax_error(error, "Package name contains invalid characters")
return
end if
call get_value(table, "build", child, requested=.true., stat=stat)
if (stat /= toml_stat%success) then
call fatal_error(error, "Type mismatch for build entry, must be a table")
return
end if
call new_build_config(self%build, child, self%name, error)
if (allocated(error)) return
call get_value(table, "install", child, requested=.true., stat=stat)
if (stat /= toml_stat%success) then
call fatal_error(error, "Type mismatch for install entry, must be a table")
return
end if
call new_install_config(self%install, child, error)
if (allocated(error)) return
call get_value(table, "fortran", child, requested=.true., stat=stat)
if (stat /= toml_stat%success) then
call fatal_error(error, "Type mismatch for fortran entry, must be a table")
return
end if
call new_fortran_config(self%fortran, child, error)
if (allocated(error)) return
call get_value(table, "version", version, "0")
call new_version(self%version, version, error)
if (allocated(error) .and. present(root)) then
version_file = join_path(root, version)
if (exists(version_file)) then
deallocate(error)
open(file=version_file, newunit=io, iostat=stat)
if (stat == 0) then
call getline(io, version, iostat=stat)
end if
if (stat == 0) then
close(io, iostat=stat)
end if
if (stat == 0) then
call new_version(self%version, version, error)
else
call fatal_error(error, "Reading version number from file '" &
& //version_file//"' failed")
end if
end if
end if
if (allocated(error)) return
call get_value(table, "dependencies", child, requested=.false.)
if (associated(child)) then
call new_dependencies(self%dependency, child, root, self%meta, error)
if (allocated(error)) return
end if
call get_value(table, "dev-dependencies", child, requested=.false.)
if (associated(child)) then
call new_dependencies(self%dev_dependency, child, root, error=error)
if (allocated(error)) return
end if
call get_value(table, "library", child, requested=.false.)
if (associated(child)) then
allocate(self%library)
call new_library(self%library, child, error)
if (allocated(error)) return
end if
call get_value(table, "profiles", child, requested=.false.)
if (associated(child)) then
call new_profiles(self%profiles, child, error)
if (allocated(error)) return
else
self%profiles = get_default_profiles(error)
if (allocated(error)) return
end if
call get_value(table, "executable", children, requested=.false.)
if (associated(children)) then
nn = len(children)
allocate(self%executable(nn))
do ii = 1, nn
call get_value(children, ii, node, stat=stat)
if (stat /= toml_stat%success) then
call fatal_error(error, "Could not retrieve executable from array entry")
exit
end if
call new_executable(self%executable(ii), node, error)
if (allocated(error)) exit
end do
if (allocated(error)) return
call unique_programs(self%executable, error)
if (allocated(error)) return
end if
call get_value(table, "example", children, requested=.false.)
if (associated(children)) then
nn = len(children)
allocate(self%example(nn))
do ii = 1, nn
call get_value(children, ii, node, stat=stat)
if (stat /= toml_stat%success) then
call fatal_error(error, "Could not retrieve example from array entry")
exit
end if
call new_example(self%example(ii), node, error)
if (allocated(error)) exit
end do
if (allocated(error)) return
call unique_programs(self%example, error)
if (allocated(error)) return
if (allocated(self%executable)) then
call unique_programs(self%executable, self%example, error)
if (allocated(error)) return
end if
end if
call get_value(table, "test", children, requested=.false.)
if (associated(children)) then
nn = len(children)
allocate(self%test(nn))
do ii = 1, nn
call get_value(children, ii, node, stat=stat)
if (stat /= toml_stat%success) then
call fatal_error(error, "Could not retrieve test from array entry")
exit
end if
call new_test(self%test(ii), node, error)
if (allocated(error)) exit
end do
if (allocated(error)) return
call unique_programs(self%test, error)
if (allocated(error)) return
end if
call get_value(table, "preprocess", child, requested=.false.)
if (associated(child)) then
call new_preprocessors(self%preprocess, child, error)
if (allocated(error)) return
end if
end subroutine new_package