subroutineopen_procedureprivate
subroutine open_procedure(list, parent, line, id)
Create the entity for a subroutine or function statement.
Arguments
| Name | Type | Intent | Attributes | Description |
|---|---|---|---|---|
| list | type(entity_list_t) | inout | the entities | |
| parent | integer | in | the entity around it | |
| line | character(len=*) | in | the statement | |
| id | integer | out | the new entity, or 0 |
Calls
Source
Show the code
subroutine open_procedure(list, parent, line, id)
type(entity_list_t), intent(inout) :: list !! the entities
integer, intent(in) :: parent !! the entity around it
character(len=*), intent(in) :: line !! the statement
integer, intent(out) :: id !! the new entity, or 0
type(procedure_header_t) :: h
type(parsed_type_t) :: t
integer :: var
call parse_procedure_header(line, h)
id = 0
if (.not. h%ok) return
id = list%add(merge(E_FUNCTION, E_SUBROUTINE, h%is_function), parent)
associate (e => list%box(id)%e)
e%name = h%name
e%permission = inherited_permission(list, parent)
call move_alloc(h%attribs, e%attribs)
call move_alloc(h%args, e%more%args)
allocate (e%more%arg_ids(size(e%more%args)))
e%more%arg_ids = 0
e%is_module = contains_string(e%attribs, 'module')
if (allocated(h%bind_c)) e%more%bind_c = h%bind_c
if (h%is_function) then
e%more%result_name = h%name
if (allocated(h%result_name)) e%more%result_name = h%result_name
end if
end associate
if (.not. h%is_function) return
call parse_type(h%prefix, t)
if (.not. t%ok) return
var = list%add(E_VARIABLE, id)
associate (v => list%box(var)%e)
v%name = list%box(id)%e%more%result_name
v%var_role = VAR_RESULT
v%permission = 'public'
allocate (v%attribs(0), v%doc(0), v%meta(0))
call set_type(v, t)
end associate
list%box(id)%e%result = var
end subroutine open_procedure