fdoc

subroutineopen_procedureprivate

subroutine open_procedure(list, parent, line, id)

Create the entity for a subroutine or function statement.

Arguments

NameTypeIntentAttributesDescription
listtype(entity_list_t)inout

the entities

parentintegerin

the entity around it

linecharacter(len=*)in

the statement

idintegerout

the new entity, or 0

Calls

Source

Show the code
subroutine open_procedure(list, parent, line, id)
    type(entity_list_t), intent(inout) :: list  !! the entities
    integer, intent(in) :: parent               !! the entity around it
    character(len=*), intent(in) :: line        !! the statement
    integer, intent(out) :: id                  !! the new entity, or 0
    type(procedure_header_t) :: h
    type(parsed_type_t) :: t
    integer :: var

    call parse_procedure_header(line, h)
    id = 0
    if (.not. h%ok) return
    id = list%add(merge(E_FUNCTION, E_SUBROUTINE, h%is_function), parent)
    associate (e => list%box(id)%e)
        e%name = h%name
        e%permission = inherited_permission(list, parent)
        call move_alloc(h%attribs, e%attribs)
        call move_alloc(h%args, e%more%args)
        allocate (e%more%arg_ids(size(e%more%args)))
        e%more%arg_ids = 0
        e%is_module = contains_string(e%attribs, 'module')
        if (allocated(h%bind_c)) e%more%bind_c = h%bind_c
        if (h%is_function) then
            e%more%result_name = h%name
            if (allocated(h%result_name)) e%more%result_name = h%result_name
        end if
    end associate
    if (.not. h%is_function) return
    call parse_type(h%prefix, t)
    if (.not. t%ok) return
    var = list%add(E_VARIABLE, id)
    associate (v => list%box(var)%e)
        v%name = list%box(id)%e%more%result_name
        v%var_role = VAR_RESULT
        v%permission = 'public'
        allocate (v%attribs(0), v%doc(0), v%meta(0))
        call set_type(v, t)
    end associate
    list%box(id)%e%result = var
end subroutine open_procedure

Graphs

Calls

Called by