new_feature Subroutine

public subroutine new_feature(self, table, root, error, name)

Construct a new feature configuration from a TOML data structure

Arguments

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

Instance of the feature 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

character(len=*), intent(in), optional :: name

Optional name override (if not provided, gets from table key)


Source Code

    subroutine new_feature(self, table, root, error, name)

        !> Instance of the feature configuration
        type(feature_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

        !> Optional name override (if not provided, gets from table key)
        character(len=*), intent(in), optional :: name

        type(toml_table), pointer :: child, node
        type(toml_array), pointer :: children
        character(len=:), allocatable :: compiler_name, os_name
        integer :: ii, nn, stat

        ! Only check schema for pure features (not when called from package)
        if (.not. present(name)) then
            call check(table, error)
            if (allocated(error)) return
        end if

        ! Get feature name from parameter or table key
        if (present(name)) then
            self%name = name
        else
            call table%get_key(self%name)
        end if

        ! Initialize common components
        call init_feature_components(self, table, root=root, error=error)
        if (allocated(error)) return

        ! For features, get platform configuration (optional for packages)
        if (.not. present(name)) then
            call get_value(table, "platform", child, requested=.false., stat=stat)
            if (stat == toml_stat%success .and. associated(child)) then
                call self%platform%load_from_toml(child, error)
                if (allocated(error)) return
            end if
        end if

    end subroutine new_feature