subroutinelink_implementationprivate
subroutine link_implementation(p, id)
Connect a separate module procedure with its interface, and copy what it does not repeat.
Arguments
| Name | Type | Intent | Attributes | Description |
|---|---|---|---|---|
| p | type(project_t) | inout | the project | |
| id | integer | in | 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