fdoc

subroutineread_associationsprivate

subroutine read_associations(v, associations, level)

Add the names of an associate statement to associations.

Arguments

NameTypeIntentAttributesDescription
vtype(statement_view_t)in

the statement

associationstype(association_t)inoutallocatabledimension(:)

the names in scope

levelintegerinout

how many associate constructs are open

Source

Show the code
subroutine read_associations(v, associations, level)
    type(statement_view_t), intent(in) :: v     !! the statement
    type(association_t), allocatable, intent(inout) :: associations(:)  !! the names in scope
    integer, intent(inout) :: level             !! how many `associate` constructs are open
    character(len=:), allocatable :: chain
    integer :: j, k, depth, stop_at, head

    level = level + 1
    do j = v%first, v%n - 1
        if (.not. v%is(j + 1, '=>')) cycle
        if (v%kind_of(j) /= TK_NAME) cycle
        depth = v%depth(j)
        stop_at = j + 2
        do while (stop_at < v%n)
            if (v%depth(stop_at + 1) < depth .or. (v%depth(stop_at + 1) == depth .and. v%is(stop_at + 1, ','))) exit
            stop_at = stop_at + 1
        end do
        chain = ''
        do k = j + 2, stop_at
            if (v%depth(k) /= depth) cycle
            if (v%kind_of(k) == TK_NAME) then
                if (len(chain) > 0) chain = chain//'%'
                chain = chain//v%low(v%lo(k):v%hi(k))
            else if (.not. v%is(k, '%') .and. .not. v%is(k, '(') .and. .not. v%is(k, ')')) then
                chain = ''
                exit
            end if
        end do
        if (len(chain) == 0) cycle
        ! what it stands for may itself be an associated name
        head = index(chain//'%', '%') - 1
        do k = size(associations), 1, -1
            if (associations(k)%name == chain(:head)) then
                chain = associations(k)%chain//chain(head + 1:)
                exit
            end if
        end do
        associations = [associations, association_t(v%low(v%lo(j):v%hi(j)), chain, level)]
    end do
end subroutine read_associations

Graphs

Called by