Parsing of free-form fortran source files
The following statements are recognised and parsed:
Module/submodule/program declarationuse statementinclude statement@note Note
Intrinsic modules used by sources are not listed in
the modules_used field of source objects.
@note Note
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 file_lines = read_lines_expanded(f_filename) ! 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