new_library Subroutine

public subroutine new_library(self, table, error)

Construct a new library configuration from a TOML data structure

Arguments

Type IntentOptional 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


Source Code

    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