subroutinebuild_relationsprivate
subroutine build_relations(p, relations)
Build the relations between entities.
Arguments
| Name | Type | Intent | Attributes | Description |
|---|---|---|---|---|
| p | type(project_t) | in | the project | |
| relations | type(adjacency_t) | out | dimension(NUM_RELATIONS) | the relations |
Calls
Source
Show the code
subroutine build_relations(p, relations)
type(project_t), intent(in) :: p !! the project
type(adjacency_t), intent(out) :: relations(NUM_RELATIONS) !! the relations
integer, allocatable :: seen(:)
logical, allocatable :: done(:)
logical :: changed
integer :: r, k, j, target, seen_stamp
allocate (seen(p%list%n))
seen = 0
seen_stamp = 0
do r = 1, NUM_RELATIONS
allocate (relations(r)%out(p%list%n), relations(r)%in(p%list%n), relations(r)%labels(p%list%n))
end do
do k = 1, p%list%n
associate (e => p%list%box(k)%e)
if (e%kind == E_NONE) cycle
if (allocated(e%more%uses)) then
do j = 1, size(e%more%uses)
if (e%more%uses(j)%target > 0) call connect(relations(REL_USES), k, e%more%uses(j)%target)
end do
end if
if (e%kind == E_SUBMODULE) then
if (e%parent_submodule_id > 0) then
call connect(relations(REL_USES), k, e%parent_submodule_id)
else if (e%ancestor_id > 0) then
call connect(relations(REL_USES), k, e%ancestor_id)
end if
end if
if (e%visible .and. e%kind /= E_BOUNDPROC) then
seen_stamp = seen_stamp + 1
call visible_calls(p, k, k, seen, seen_stamp, relations(REL_CALLS))
end if
if (allocated(e%more%modproc_ids)) then
do j = 1, size(e%more%modproc_ids)
if (e%more%modproc_ids(j) == 0) cycle
if (p%list%box(e%more%modproc_ids(j))%e%visible) call connect(relations(REL_CALLS), k, e%more%modproc_ids(j))
end do
end if
if (e%kind == E_INTERFACE) then
do j = 1, size(e%children)
if (p%list%box(e%children(j))%e%visible) call connect(relations(REL_CALLS), k, e%children(j))
end do
end if
if (e%extends_id > 0) call connect(relations(REL_INHERITS), k, e%extends_id)
if (e%kind == E_TYPE .and. e%visible) then
do j = 1, size(e%children)
associate (c => p%list%box(e%children(j))%e)
if (c%kind /= E_VARIABLE .or. c%proto_id == 0) cycle
if (p%list%box(c%proto_id)%e%kind == E_TYPE) then
call connect(relations(REL_INHERITS), k, c%proto_id, c%name)
end if
end associate
end do
end if
if (e%file > 0 .and. allocated(e%more%uses)) then
do j = 1, size(e%more%uses)
target = e%more%uses(j)%target
if (target == 0) cycle
target = p%list%box(target)%e%file
if (target > 0 .and. target /= e%file) call connect(relations(REL_FILES), e%file, target)
end do
end if
end associate
end do
! a generic binding is a node only once something refers to it
allocate (done(p%list%n))
done = .false.
changed = .true.
do while (changed)
changed = .false.
do k = 1, p%list%n
if (done(k) .or. p%list%box(k)%e%kind /= E_BOUNDPROC) cycle
if (.not. allocated(relations(REL_CALLS)%in(k)%ids)) cycle
done(k) = .true.
changed = .true.
seen_stamp = seen_stamp + 1
call visible_calls(p, k, k, seen, seen_stamp, relations(REL_CALLS))
end do
end do
end subroutine build_relations