fdoc

subroutineinheritrecursiveprivate

recursive subroutine inherit(p, id)

Work out what type id inherits, after its parent type.

Arguments

NameTypeIntentAttributesDescription
ptype(project_t)inout

the project

idintegerin

the type

Calls

Source

Show the code
recursive subroutine inherit(p, id)
    type(project_t), intent(inout) :: p     !! the project
    integer, intent(in) :: id               !! the type
    integer, allocatable :: parent_items(:)
    integer :: base, k, item, copy

    if (p%list%box(id)%e%inherit_state /= 0) return
    p%list%box(id)%e%inherit_state = 1
    allocate (p%list%box(id)%e%more%inherited(0))
    if (allocated(p%list%box(id)%e%more%extends)) then
        base = find_symbol(p, p%list%box(id)%e%parent, lowercase(p%list%box(id)%e%more%extends), 3)
        if (base > 0 .and. base /= id) then
            p%list%box(id)%e%extends_id = base
            call inherit(p, base)
            parent_items = [p%list%box(base)%e%more%inherited, p%list%box(base)%e%children]
            do k = 1, size(parent_items)
                item = parent_items(k)
                associate (e => p%list%box(item)%e)
                    select case (e%kind)
                    case (E_VARIABLE)
                        if (e%permission == 'public') call push_int(p%list%box(id)%e%more%inherited, item)
                    case (E_BOUNDPROC)
                        if (e%permission == 'private') cycle
                        if (overrides(p, id, e%name)) cycle
                        if (e%generic) then
                            copy = copy_binding(p, item, id)
                        else
                            call push_int(p%list%box(id)%e%more%inherited, item)
                        end if
                    end select
                end associate
            end do
        end if
    end if
    p%list%box(id)%e%inherit_state = 2
end subroutine inherit

Graphs

Calls

Called by