fdoc

subroutinelink_implementationprivate

subroutine link_implementation(p, id)

Connect a separate module procedure with its interface, and copy what it does not repeat.

Arguments

NameTypeIntentAttributesDescription
ptype(project_t)inout

the project

idintegerin

the procedure

Calls

Source

Show the code
subroutine link_implementation(p, id)
    type(project_t), intent(inout) :: p     !! the project
    integer, intent(in) :: id               !! the procedure
    integer :: found, parent

    if (p%list%box(id)%e%kind /= E_MODPROC .and. .not. p%list%box(id)%e%is_module) return
    if (p%list%box(id)%e%iface /= IFACE_NONE) return
    parent = p%list%box(id)%e%parent
    found = find_symbol(p, parent, lowercase(p%list%box(id)%e%name), 1)
    if (found == id .or. found == 0) then
        found = 0
        if (p%list%box(parent)%e%parent_submodule_id > 0) then
            found = find_symbol(p, p%list%box(parent)%e%parent_submodule_id, lowercase(p%list%box(id)%e%name), 1)
        else if (p%list%box(parent)%e%ancestor_id > 0) then
            found = find_symbol(p, p%list%box(parent)%e%ancestor_id, lowercase(p%list%box(id)%e%name), 1)
        end if
    end if
    if (found == 0 .or. found == id) return
    p%list%box(id)%e%implements = found
    p%list%box(found)%e%implements = id
    if (p%list%box(id)%e%kind /= E_MODPROC) return
    associate (e => p%list%box(id)%e, base => p%list%box(found)%e)
        if (allocated(base%attribs)) e%attribs = base%attribs
        if (allocated(base%more%args)) e%more%args = base%more%args
        if (allocated(base%more%arg_ids)) e%more%arg_ids = base%more%arg_ids
        e%result = base%result
    end associate
end subroutine link_implementation

Graphs

Calls

Called by