fdoc

subroutineread_attribute_statementprivate

subroutine read_attribute_statement(u, line, low)

Read a statement such as public :: x, keeping what it says until the unit is finished.

Arguments

NameTypeIntentAttributesDescription
utype(entity_t)inout

the unit

linecharacter(len=*)in

the statement

lowcharacter(len=*)in

the statement, in lowercase

Calls

Source

Show the code
subroutine read_attribute_statement(u, line, low)
    type(entity_t), intent(inout) :: u      !! the unit
    character(len=*), intent(in) :: line    !! the statement
    character(len=*), intent(in) :: low     !! the statement, in lowercase
    character(len=:), allocatable :: attr, rest, name, dims
    type(string_t), allocatable :: names(:), parts(:)
    integer :: k, at, close

    if (starts_word(low, 'bind') .or. starts_word(low, 'intent')) then
        close = closing_paren(low, index(low, '('))
        attr = remove_blanks(low(:close))
        if (starts_with(attr, 'bind')) attr = replace_commas(attr)
        rest = line(close + 1:)
    else
        at = verify(low, 'abcdefghijklmnopqrstuvwxyz_')
        if (at == 0) at = len(low) + 1
        attr = low(:at - 1)
        rest = line(at:)
    end if
    if (is_procedure(u%kind) .and. (attr == 'data' .or. attr == 'save')) u%more%saved_state = .true.
    if (attr == 'data' .or. attr == 'save' .and. len(strip(rest)) == 0) return
    if (.not. allocated(u%more%pending)) return
    rest = strip(rest)
    if (starts_with(rest, '::')) rest = strip(rest(3:))
    if (attr == 'parameter' .and. len(rest) > 1) rest = strip(rest(2:len(rest) - 1))
    names = top_split(rest, ',')
    do k = 1, size(names)
        name = lowercase(names(k)%s)
        if (attr == 'dimension' .or. attr == 'allocatable' .or. attr == 'pointer') then
            at = index(name, '(')
            if (at > 0) then
                dims = name(at:)
                name = strip(name(:at - 1))
                u%more%pending = [u%more%pending, attribute_t(name, attr//dims)]
                cycle
            end if
        else if (attr == 'parameter') then
            parts = top_split(names(k)%s, '=')
            if (size(parts) < 2) cycle
            name = lowercase(parts(1)%s)
            u%more%parameters = [u%more%parameters, attribute_t(name, parts(2)%s)]
        end if
        u%more%pending = [u%more%pending, attribute_t(name, attr)]
    end do
end subroutine read_attribute_statement

Graphs

Calls

Called by