fdoc

subroutineparse_procedure_header

subroutine parse_procedure_header(line, h)

Read a subroutine or function statement.

Arguments

NameTypeIntentAttributesDescription
linecharacter(len=*)in

the statement

htype(procedure_header_t)out

the result

Calls

Source

Show the code
subroutine parse_procedure_header(line, h)
    character(len=*), intent(in) :: line            !! the statement
    type(procedure_header_t), intent(out) :: h      !! the result
    character(len=len(line)) :: low
    character(len=:), allocatable :: prefix
    character(len=*), parameter :: PREFIXES(*) = [character(len=13) :: 'impure', 'pure', 'elemental', 'non_recursive', &
                                                  'recursive', 'module']
    integer :: k, at, open, close, depth, n

    low = lowercase(line)
    allocate (h%attribs(0), h%args(0))
    depth = 0
    at = 0
    do k = 1, len(low)
        if (low(k:k) == '(') depth = depth + 1
        if (low(k:k) == ')') depth = depth - 1
        if (depth /= 0) cycle
        if (word_at(low, k, 'subroutine')) then
            at = k + 10
            exit
        end if
        if (word_at(low, k, 'function')) then
            at = k + 8
            h%is_function = .true.
            exit
        end if
    end do
    if (at == 0) return

    prefix = low(1:at - merge(9, 11, h%is_function))
    do k = 1, size(PREFIXES)
        n = len_trim(PREFIXES(k))
        open = index(prefix, PREFIXES(k) (1:n))
        if (open > 0) then
            call push(h%attribs, PREFIXES(k) (1:n))
            prefix = prefix(:open - 1)//prefix(open + n:)
        end if
    end do
    call original_prefix(line, low, at - merge(8, 10, h%is_function) - 1, h%attribs, prefix)
    h%prefix = remove_blanks(prefix)

    open = at + verify(line(at:)//'x', ' ') - 1
    close = open + verify(low(open:)//' ', 'abcdefghijklmnopqrstuvwxyz0123456789_') - 2
    h%name = line(open:close)
    open = close + verify(line(close + 1:)//'x', ' ')
    close = open - 1
    if (open <= len(line)) then
        if (line(open:open) == '(') then
            close = closing_paren(line, open)
            if (close == 0) return
            if (close > open + 1) then
                if (len(strip(line(open + 1:close - 1))) > 0) h%args = top_split(line(open + 1:close - 1), ',')
            end if
        end if
    end if

    do k = close + 1, len(low)
        if (word_at(low, k, 'result')) then
            open = k + index(low(k:), '(') - 1
            at = closing_paren(low, open)
            if (at > 0) h%result_name = strip(line(open + 1:at - 1))
        else if (word_at(low, k, 'bind')) then
            open = k + index(low(k:), '(') - 1
            at = closing_paren(low, open)
            if (at > 0) h%bind_c = strip(line(open + 1:at - 1))
        end if
    end do
    h%ok = .true.
end subroutine parse_procedure_header

Graphs

Calls

Called by