subroutineread_bindingprivate
subroutine read_binding(list, unit, line, doc, s)
Read a type-bound procedure or generic statement.
Arguments
| Name | Type | Intent | Attributes | Description |
|---|---|---|---|---|
| list | type(entity_list_t) | inout | the entities | |
| unit | integer | in | the type | |
| line | character(len=*) | in | the statement | |
| doc | type(doc_lines_t) | in | the statement's documentation | |
| s | type(settings_t) | in | the settings |
Calls
Source
Show the code
subroutine read_binding(list, unit, line, doc, s)
type(entity_list_t), intent(inout) :: list !! the entities
integer, intent(in) :: unit !! the type
character(len=*), intent(in) :: line !! the statement
type(doc_lines_t), intent(in) :: doc !! the statement's documentation
type(settings_t), intent(in) :: s !! the settings
type(string_t), allocatable :: names(:), attributes(:), kept(:), bindings(:)
character(len=:), allocatable :: rest, proto, permission, low, name
logical :: generic, deferred
integer :: k, id, open, close
low = lowercase(line)
generic = starts_word(low, 'generic')
rest = strip(line(merge(8, 10, generic):))
proto = ''
if (len(rest) > 0) then
if (rest(1:1) == '(') then
close = closing_paren(rest, 1)
proto = strip(rest(2:close - 1))
rest = strip(rest(close + 1:))
end if
end if
call split_attributes(rest, attributes, name)
rest = name
allocate (kept(0))
permission = list%box(unit)%e%child_permission
deferred = .false.
do k = 1, size(attributes)
low = lowercase(attributes(k)%s)
select case (low)
case ('public', 'private')
permission = low
case ('deferred')
deferred = .true.
case default
call push(kept, low)
end select
end do
if (generic) then
allocate (names(1))
names(1)%s = rest
else
names = top_split(rest, ',')
end if
do k = size(names), 1, -1
id = list%add(E_BOUNDPROC, unit)
associate (b => list%box(id)%e, text => names(k)%s)
open = index(text, '=>')
if (open > 0) then
b%name = strip(text(:open - 1))
b%more%bindings = top_split(text(open + 2:), ',')
else
b%name = strip(text)
bindings = [string_t(b%name)]
call move_alloc(bindings, b%more%bindings)
end if
b%generic = generic
b%deferred = deferred
b%permission = permission
b%attribs = kept
if (len(proto) > 0) b%more%proto_text = proto
if (allocated(doc%lines)) then
call set_doc(b, s, doc%lines)
else
call set_doc(b, s, [string_t ::])
end if
end associate
end do
end subroutine read_binding