new_build_config Subroutine

public subroutine new_build_config(self, table, package_name, error)

Construct a new build configuration from a TOML data structure

Module naming: fist, attempt boolean value first

Value found, but not a boolean. Attempt to read a prefix string

Arguments

Type IntentOptional Attributes Name
type(build_config_t), intent(out) :: self

Instance of the build configuration

type(toml_table), intent(inout) :: table

Instance of the TOML data structure

character(len=*), intent(in) :: package_name

Package name

type(error_t), intent(out), allocatable :: error

Error handling


Source Code

    subroutine new_build_config(self, table, package_name, error)

        !> Instance of the build configuration
        type(build_config_t), intent(out) :: self

        !> Instance of the TOML data structure
        type(toml_table), intent(inout) :: table

        !> Package name
        character(len=*), intent(in) :: package_name

        !> Error handling
        type(error_t), allocatable, intent(out) :: error

        integer :: stat

        call check(table, package_name, error)
        if (allocated(error)) return

        call get_value(table, "auto-executables", self%auto_executables, .true., stat=stat)

        if (stat /= toml_stat%success) then
            call fatal_error(error,"Error while reading value for 'auto-executables' in fpm.toml, expecting logical")
            return
        end if

        call get_value(table, "auto-tests", self%auto_tests, .true., stat=stat)

        if (stat /= toml_stat%success) then
            call fatal_error(error,"Error while reading value for 'auto-tests' in fpm.toml, expecting logical")
            return
        end if

        call get_value(table, "auto-examples", self%auto_examples, .true., stat=stat)

        if (stat /= toml_stat%success) then
            call fatal_error(error,"Error while reading value for 'auto-examples' in fpm.toml, expecting logical")
            return
        end if

        !> Module naming: fist, attempt boolean value first
        call get_value(table, "module-naming", self%module_naming, .false., stat=stat)

        if (stat == toml_stat%success) then

            ! Boolean value found. Set no custom prefix. This also falls back to key not provided
            if (allocated(self%module_prefix%s)) deallocate(self%module_prefix%s)

        else

            !> Value found, but not a boolean. Attempt to read a prefix string
            call get_value(table, "module-naming", self%module_prefix%s)

            if (.not.allocated(self%module_prefix%s)) then
               call syntax_error(error,"Could not read value for 'module-naming' in fpm.toml, expecting logical or a string")
               return
            end if

            if (.not.is_valid_module_prefix(self%module_prefix)) then
               call syntax_error(error,"Invalid custom module name prefix for in fpm.toml: <"//self%module_prefix%s// &
                            ">, expecting a valid alphanumeric string")
               return
            end if

            ! Set module naming to ON
            self%module_naming = .true.

        end if

        call get_list(table, "link", self%link, error)
        if (allocated(error)) return

        call get_list(table, "external-modules", self%external_modules, error)
        if (allocated(error)) return

    end subroutine new_build_config