Parsing of free-form fortran source files
The following statements are recognised and parsed:
Module/submodule/program declarationuse statementinclude statementIntrinsic modules used by sources are not listed in
the modules_used field of source objects.
Submodules are treated as normal modules which use their
corresponding parent modules.
Statements must not continued onto another line
except for an only: list in the use statement.
This is supported:
use my_module, only: &
my_var, my_function, my_subroutine
This is NOT supported:
use &
my_module
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| character(len=*), | intent(in) | :: | f_filename | |||
| type(error_t), | intent(out), | allocatable | :: | error |
function parse_f_source(f_filename,error) result(f_source)
character(*), intent(in) :: f_filename
type(srcfile_t) :: f_source
type(error_t), allocatable, intent(out) :: error
logical :: inside_module, inside_interface, using, intrinsic_module
integer :: stat
integer :: fh, n_use, n_include, n_mod, n_parent, i, j, ic, pass
type(string_t), allocatable :: file_lines(:), file_lines_lower(:)
character(:), allocatable :: temp_string, mod_name, string_parts(:)
if (.not. exists(f_filename)) then
call file_not_found_error(error, f_filename)
return
end if
f_source%file_name = f_filename
open(newunit=fh,file=f_filename,status='old')
file_lines = read_lines_expanded(fh)
close(fh)
! for efficiency in parsing make a lowercase left-adjusted copy of the file
! Need a copy because INCLUDE (and #include) file arguments are case-sensitive
file_lines_lower=file_lines
do i=1,size(file_lines_lower)
file_lines_lower(i)%s=adjustl(lower(file_lines_lower(i)%s))
enddo
! fnv_1a can only be applied to non-zero-length arrays
if (len_trim(file_lines_lower) > 0) f_source%digest = fnv_1a(file_lines)
do pass = 1,2
n_use = 0
n_include = 0
n_mod = 0
n_parent = 0
inside_module = .false.
inside_interface = .false.
file_loop: do i=1,size(file_lines_lower)
! Skip comment lines and preprocessor directives
if (index(file_lines_lower(i)%s,'!') == 1 .or. &
index(file_lines_lower(i)%s,'#') == 1 .or. &
len_trim(file_lines_lower(i)%s) < 1) then
cycle
end if
! Detect exported C-API via bind(C)
if (.not.inside_interface .and. &
parse_subsequence(file_lines_lower(i)%s,'bind','(','c')) then
do j=i,1,-1
if (index(file_lines_lower(j)%s,'function') > 0 .or. &
index(file_lines_lower(j)%s,'subroutine') > 0) then
f_source%unit_type = FPM_UNIT_SUBPROGRAM
exit
end if
if (j>1) then
ic = index(file_lines_lower(j-1)%s,'!')
if (ic < 1) then
ic = len(file_lines_lower(j-1)%s)
end if
temp_string = trim(file_lines_lower(j-1)%s(1:ic))
if (index(temp_string,'&') /= len(temp_string)) then
exit
end if
end if
end do
end if
! Skip lines that are continued: not statements
if (i > 1) then
ic = index(file_lines_lower(i-1)%s,'!')
if (ic < 1) then
ic = len(file_lines_lower(i-1)%s)
end if
temp_string = trim(file_lines_lower(i-1)%s(1:ic))
if (len(temp_string) > 0 .and. index(temp_string,'&') == len(temp_string)) then
cycle
end if
end if
! Detect beginning of interface block
if (index(file_lines_lower(i)%s,'interface') == 1) then
inside_interface = .true.
cycle
end if
! Detect end of interface block
if (parse_sequence(file_lines_lower(i)%s,'end','interface')) then
inside_interface = .false.
cycle
end if
! Process 'USE' statements
call parse_use_statement(f_filename,i,file_lines_lower(i)%s,using,intrinsic_module,mod_name,error)
if (allocated(error)) return
if (using) then
! Not a valid module name?
if (.not.is_fortran_name(mod_name)) cycle
! Valid intrinsic module: not a dependency
if (intrinsic_module) cycle
n_use = n_use + 1
if (pass == 2) f_source%modules_used(n_use)%s = mod_name
cycle
endif
! Process 'INCLUDE' statements
ic = index(file_lines_lower(i)%s,'include')
if ( ic == 1 ) then
ic = index(lower(file_lines(i)%s),'include')
if (index(adjustl(file_lines(i)%s(ic+7:)),'"') == 1 .or. &
index(adjustl(file_lines(i)%s(ic+7:)),"'") == 1 ) then
n_include = n_include + 1
if (pass == 2) then
f_source%include_dependencies(n_include)%s = &
& split_n(file_lines(i)%s,n=2,delims="'"//'"',stat=stat)
if (stat /= 0) then
call file_parse_error(error,f_filename, &
'unable to find include file name',i, &
file_lines(i)%s)
return
end if
end if
cycle
end if
end if
! Extract name of module if is module
if (index(file_lines_lower(i)%s,'module ') == 1) then
! Remove any trailing comments
ic = index(file_lines_lower(i)%s,'!')-1
if (ic < 1) then
ic = len(file_lines_lower(i)%s)
end if
temp_string = trim(file_lines_lower(i)%s(1:ic))
! R1405 module-stmt := "MODULE" module-name
! module-stmt has two space-delimited parts only
! (no line continuations)
call split(temp_string,string_parts,' ')
if (size(string_parts) /= 2) then
cycle
end if
mod_name = trim(adjustl(string_parts(2)))
if (scan(mod_name,'=(&')>0 ) then
! Ignore these cases:
! module <something>&
! module =*
! module (i)
cycle
end if
if (.not.is_fortran_name(mod_name)) then
call file_parse_error(error,f_filename, &
'empty or invalid name for module',i, &
file_lines_lower(i)%s, index(file_lines_lower(i)%s,mod_name))
return
end if
n_mod = n_mod + 1
if (pass == 2) then
f_source%modules_provided(n_mod) = string_t(mod_name)
end if
if (f_source%unit_type == FPM_UNIT_UNKNOWN) then
f_source%unit_type = FPM_UNIT_MODULE
end if
if (.not.inside_module) then
inside_module = .true.
else
! Must have missed an end module statement (can't assume a pure module)
if (f_source%unit_type /= FPM_UNIT_PROGRAM) then
f_source%unit_type = FPM_UNIT_SUBPROGRAM
end if
end if
cycle
end if
! Extract name of submodule if is submodule
if (index(file_lines_lower(i)%s,'submodule') == 1) then
mod_name = split_n(file_lines_lower(i)%s,n=3,delims='()',stat=stat)
if (stat /= 0) then
call file_parse_error(error,f_filename, &
'unable to get submodule name',i, &
file_lines_lower(i)%s)
return
end if
if (.not.is_fortran_name(mod_name)) then
call file_parse_error(error,f_filename, &
'empty or invalid name for submodule',i, &
file_lines_lower(i)%s, index(file_lines_lower(i)%s,mod_name))
return
end if
n_mod = n_mod + 1
temp_string = split_n(file_lines_lower(i)%s,n=2,delims='()',stat=stat)
if (stat /= 0) then
call file_parse_error(error,f_filename, &
'unable to get submodule ancestry',i, &
file_lines_lower(i)%s)
return
end if
if (f_source%unit_type /= FPM_UNIT_PROGRAM) then
f_source%unit_type = FPM_UNIT_SUBMODULE
end if
n_use = n_use + 1
inside_module = .true.
n_parent = n_parent + 1
if (pass == 2) then
if (index(temp_string,':') > 0) then
temp_string = temp_string(index(temp_string,':')+1:)
end if
if (.not.is_fortran_name(temp_string)) then
call file_parse_error(error,f_filename, &
'empty or invalid name for submodule parent',i, &
file_lines_lower(i)%s, index(file_lines_lower(i)%s,temp_string))
return
end if
f_source%modules_used(n_use)%s = temp_string
f_source%parent_modules(n_parent)%s = temp_string
f_source%modules_provided(n_mod)%s = mod_name
end if
cycle
end if
! Detect if contains a program
! (no modules allowed after program def)
if (index(file_lines_lower(i)%s,'program ') == 1) then
temp_string = split_n(file_lines_lower(i)%s,n=2,delims=' ',stat=stat)
if (stat == 0) then
if (scan(temp_string,'=(')>0 ) then
! Ignore:
! program =*
! program (i) =*
cycle
end if
end if
f_source%unit_type = FPM_UNIT_PROGRAM
cycle
end if
! Parse end module statement
! (to check for code outside of modules)
if (parse_sequence(file_lines_lower(i)%s,'end','module') .or. &
parse_sequence(file_lines_lower(i)%s,'end','submodule')) then
inside_module = .false.
cycle
end if
! Any statements not yet parsed are assumed to be other code statements
if (.not.inside_module .and. f_source%unit_type /= FPM_UNIT_PROGRAM) then
f_source%unit_type = FPM_UNIT_SUBPROGRAM
end if
end do file_loop
! If unable to parse end of module statement, then can't assume pure module
! (there could be non-module subprograms present)
if (inside_module .and. f_source%unit_type == FPM_UNIT_MODULE) then
f_source%unit_type = FPM_UNIT_SUBPROGRAM
end if
if (pass == 1) then
allocate(f_source%modules_used(n_use))
allocate(f_source%include_dependencies(n_include))
allocate(f_source%modules_provided(n_mod))
allocate(f_source%parent_modules(n_parent))
end if
end do
end function parse_f_source