fdoc

subroutineopen_unitprivate

subroutine open_unit(list, parent, construct, line, item, src, doc, s, id)

Create the entity for the statement opening construct construct, if it has one.

Arguments

NameTypeIntentAttributesDescription
listtype(entity_list_t)inout

the entities

parentintegerin

the entity around it

constructintegerin

one of the C_* constants

linecharacter(len=*)in

the statement

itemintegerin

the statement's item

srctype(source_t)in

the source

doctype(doc_lines_t)in

the statement's documentation

stype(settings_t)in

the settings

idintegerout

the new entity, or 0

Calls

Source

Show the code
subroutine open_unit(list, parent, construct, line, item, src, doc, s, id)
    type(entity_list_t), intent(inout) :: list  !! the entities
    integer, intent(in) :: parent               !! the entity around it
    integer, intent(in) :: construct            !! one of the `C_*` constants
    character(len=*), intent(in) :: line        !! the statement
    integer, intent(in) :: item                 !! the statement's item
    type(source_t), intent(in) :: src           !! the source
    type(doc_lines_t), intent(in) :: doc        !! the statement's documentation
    type(settings_t), intent(in) :: s           !! the settings
    integer, intent(out) :: id                  !! the new entity, or 0
    character(len=len(line)) :: low
    character(len=:), allocatable :: words

    id = 0
    low = lowercase(line)
    select case (construct)
    case (C_MODULE)
        id = list%add(E_MODULE, parent)
        words = strip(line(7:))
        list%box(id)%e%name = words
        list%box(id)%e%permission = 'public'
    case (C_SUBMODULE)
        id = list%add(E_SUBMODULE, parent)
        call read_submodule(list%box(id)%e, line)
        list%box(id)%e%permission = 'private'
    case (C_PROGRAM)
        id = list%add(E_PROGRAM, parent)
        words = strip(line(8:))
        list%box(id)%e%name = words
        list%box(id)%e%permission = 'public'
    case (C_BLOCK_DATA)
        id = list%add(E_BLOCKDATA, parent)
        words = strip(line(index(low, 'data') + 4:))
        list%box(id)%e%name = words
        list%box(id)%e%permission = 'public'
    case (C_SUBROUTINE, C_FUNCTION)
        call open_procedure(list, parent, line, id)
    case (C_PROCEDURE)
        id = list%add(E_MODPROC, parent)
        words = strip(line(index(low, 'procedure') + 9:))
        list%box(id)%e%name = words
        list%box(id)%e%permission = inherited_permission(list, parent)
    case (C_INTERFACE)
        id = list%add(E_INTERFACE, parent)
        associate (e => list%box(id)%e)
            e%abstract = starts_word(low, 'abstract')
            e%permission = inherited_permission(list, parent)
            words = strip(line(index(low, 'interface') + 9:))
            e%name = words
            e%generic = len(words) > 0
            allocate (e%more%modprocs(0))
        end associate
    case (C_TYPE)
        id = list%add(E_TYPE, parent)
        list%box(id)%e%permission = inherited_permission(list, parent)
        list%box(id)%e%child_permission = 'public'
        call read_type_statement(list%box(id)%e, line)
    case (C_ENUM)
        id = list%add(E_ENUM, parent)
        list%box(id)%e%name = ''
        list%box(id)%e%permission = inherited_permission(list, parent)
        list%box(id)%e%child_permission = inherited_permission(list, parent)
    end select
    if (id == 0) return

    associate (e => list%box(id)%e)
        e%line = src%tokens%tok(src%stmts%s(item)%first)%line
        if (.not. allocated(e%child_permission)) e%child_permission = e%permission
        if (.not. allocated(e%attribs)) allocate (e%attribs(0))
        if (.not. allocated(e%more%uses)) allocate (e%more%uses(0))
        allocate (e%more%pending(0), e%more%parameters(0), e%more%public_list(0))
        if (.not. allocated(e%meta)) then
            if (allocated(doc%lines)) then
                call set_doc(e, s, doc%lines)
            else
                call set_doc(e, s, [string_t ::])
            end if
        end if
    end associate
    call inherit_display(list, id, s)
end subroutine open_unit

Graphs

Calls

Called by