fdoc

subroutineread_bindingprivate

subroutine read_binding(list, unit, line, doc, s)

Read a type-bound procedure or generic statement.

Arguments

NameTypeIntentAttributesDescription
listtype(entity_list_t)inout

the entities

unitintegerin

the type

linecharacter(len=*)in

the statement

doctype(doc_lines_t)in

the statement's documentation

stype(settings_t)in

the settings

Calls

Source

Show the code
subroutine read_binding(list, unit, line, doc, s)
    type(entity_list_t), intent(inout) :: list  !! the entities
    integer, intent(in) :: unit                 !! the type
    character(len=*), intent(in) :: line        !! the statement
    type(doc_lines_t), intent(in) :: doc        !! the statement's documentation
    type(settings_t), intent(in) :: s           !! the settings
    type(string_t), allocatable :: names(:), attributes(:), kept(:), bindings(:)
    character(len=:), allocatable :: rest, proto, permission, low, name
    logical :: generic, deferred
    integer :: k, id, open, close

    low = lowercase(line)
    generic = starts_word(low, 'generic')
    rest = strip(line(merge(8, 10, generic):))
    proto = ''
    if (len(rest) > 0) then
        if (rest(1:1) == '(') then
            close = closing_paren(rest, 1)
            proto = strip(rest(2:close - 1))
            rest = strip(rest(close + 1:))
        end if
    end if
    call split_attributes(rest, attributes, name)
    rest = name
    allocate (kept(0))
    permission = list%box(unit)%e%child_permission
    deferred = .false.
    do k = 1, size(attributes)
        low = lowercase(attributes(k)%s)
        select case (low)
        case ('public', 'private')
            permission = low
        case ('deferred')
            deferred = .true.
        case default
            call push(kept, low)
        end select
    end do

    if (generic) then
        allocate (names(1))
        names(1)%s = rest
    else
        names = top_split(rest, ',')
    end if
    do k = size(names), 1, -1
        id = list%add(E_BOUNDPROC, unit)
        associate (b => list%box(id)%e, text => names(k)%s)
            open = index(text, '=>')
            if (open > 0) then
                b%name = strip(text(:open - 1))
                b%more%bindings = top_split(text(open + 2:), ',')
            else
                b%name = strip(text)
                bindings = [string_t(b%name)]
                call move_alloc(bindings, b%more%bindings)
            end if
            b%generic = generic
            b%deferred = deferred
            b%permission = permission
            b%attribs = kept
            if (len(proto) > 0) b%more%proto_text = proto
            if (allocated(doc%lines)) then
                call set_doc(b, s, doc%lines)
            else
                call set_doc(b, s, [string_t ::])
            end if
        end associate
    end do
end subroutine read_binding

Graphs

Calls

Called by