Construct a new library configuration from a TOML data structure
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(library_config_t), | intent(out) | :: | self |
Instance of the library configuration |
||
type(toml_table), | intent(inout) | :: | table |
Instance of the TOML data structure |
||
type(error_t), | intent(out), | allocatable | :: | error |
Error handling |
subroutine new_library(self, table, error) !> Instance of the library configuration type(library_config_t), intent(out) :: self !> Instance of the TOML data structure type(toml_table), intent(inout) :: table !> Error handling type(error_t), allocatable, intent(out) :: error integer :: stat, i character(len=:), allocatable :: single_type call check(table, error) if (allocated(error)) return if (has_list(table, "source-dir")) then call syntax_error(error, "Manifest key [library.source-dir] does not allow list input") return end if ! library.type can now be either a single value or a list call get_value(table, "source-dir", self%source_dir, "src") call get_value(table, "build-script", self%build_script) call get_list(table, "include-dir", self%include_dir, error) if (allocated(error)) return ! Parse library type - can be single value or array if (has_list(table, "type")) then ! Array of types call get_list(table, "type", self%lib_type, error) if (allocated(error)) return else ! Single type - convert to array for consistency call get_value(table, "type", single_type, "monolithic") self%lib_type = [string_t(single_type)] end if if (.not.allocated(self%lib_type)) then self%lib_type = [string_t("monolithic")] end if ! Validate all types in the array do i = 1, size(self%lib_type) select case(self%lib_type(i)%s) case("shared","static","monolithic") ! OK case default call fatal_error(error,"Value of library.type cannot be '"//self%lib_type(i)%s & //"', choose shared/static/monolithic (default)") return end select end do ! Check that monolithic is not specified together with static or shared if (monolithic(self) .and. (static(self) .or. shared(self))) then call fatal_error(error,"library.type 'monolithic' cannot be specified together with 'static' or 'shared'") return end if ! Set default value of include-dir if not found in manifest if (.not.allocated(self%include_dir)) then self%include_dir = [string_t("include")] end if end subroutine new_library