diff options
-rw-r--r-- | fpm/src/fpm/error.f90 | 27 | ||||
-rw-r--r-- | fpm/src/fpm_sources.f90 | 155 |
2 files changed, 151 insertions, 31 deletions
diff --git a/fpm/src/fpm/error.f90 b/fpm/src/fpm/error.f90 index aebd7e4..ba47034 100644 --- a/fpm/src/fpm/error.f90 +++ b/fpm/src/fpm/error.f90 @@ -5,6 +5,7 @@ module fpm_error public :: error_t public :: fatal_error, syntax_error, file_not_found_error + public :: file_parse_error !> Data type defining an error @@ -55,4 +56,30 @@ contains end subroutine file_not_found_error + !> Error created when file parsing fails + subroutine file_parse_error(error, file_name, line, message) + + !> Instance of the error data + type(error_t), allocatable, intent(out) :: error + + !> Name of file + character(len=*), intent(in) :: file_name + + !> Line number of parse error + integer, intent(in) :: line + + !> Parse error message + character(len=*), intent(in) :: message + + character(50) :: line_no_string + + write(line_no_string,'(I0)') line + + allocate(error) + error%message = 'Error while parsing file "'//file_name//'" on line '// & + trim(line_no_string)//': '//message + + end subroutine file_parse_error + + end module fpm_error diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index f2418b5..ac483f2 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -1,4 +1,5 @@ module fpm_sources +use fpm_error, only: error_t, file_parse_error use fpm_model, only: srcfile_ptr, srcfile_t, fpm_model_t, & FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, & @@ -9,7 +10,8 @@ use fpm_manifest_executable, only: executable_t implicit none private -public :: add_sources_from_dir, add_executable_sources, resolve_module_dependencies +public :: add_sources_from_dir, add_executable_sources +public :: parse_f_source, parse_c_source, resolve_module_dependencies character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & ['iso_c_binding ', & @@ -26,6 +28,7 @@ subroutine add_sources_from_dir(sources,directory,with_executables) type(srcfile_t), allocatable, intent(inout), target :: sources(:) character(*), intent(in) :: directory logical, intent(in), optional :: with_executables + type(error_t), allocatable :: error integer :: i, j logical, allocatable :: is_source(:), exclude_source(:) @@ -48,12 +51,12 @@ subroutine add_sources_from_dir(sources,directory,with_executables) do i = 1, size(src_file_names) if (str_ends_with(lower(src_file_names(i)%s), ".f90")) then - dir_sources(i) = parse_f_source(src_file_names(i)%s) + dir_sources(i) = parse_f_source(src_file_names(i)%s, error) end if if (str_ends_with(lower(src_file_names(i)%s), ".c") .or. & str_ends_with(lower(src_file_names(i)%s), ".h")) then - dir_sources(i) = parse_c_source(src_file_names(i)%s) + dir_sources(i) = parse_c_source(src_file_names(i)%s,error) end if ! Exclude executables unless specified otherwise @@ -157,16 +160,17 @@ subroutine get_executable_source_dirs(exe_dirs,executables) end subroutine get_executable_source_dirs -function parse_f_source(f_filename) result(f_source) +function parse_f_source(f_filename,error) result(f_source) ! Rudimentary scan of Fortran source file and ! extract program unit name and use/include dependencies ! character(*), intent(in) :: f_filename type(srcfile_t) :: f_source + type(error_t), allocatable, intent(out) :: error + integer :: stat integer :: fh, n_use, n_include, n_mod, i, j, ic, pass type(string_t), allocatable :: file_lines(:) - character(:), allocatable :: line_parts(:) character(:), allocatable :: temp_string, mod_name f_source%file_name = f_filename @@ -199,16 +203,31 @@ function parse_f_source(f_filename) result(f_source) if (index(file_lines(i)%s,'::') > 0) then - call split(file_lines(i)%s,line_parts,delimiters=':') - temp_string = trim(line_parts(2)) - call split(temp_string,line_parts,delimiters=' ,') - mod_name = trim(lower(line_parts(1))) + temp_string = split_n(file_lines(i)%s,delims=':',n=2,stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename,i, & + message='unable to find used module name') + return + end if + + mod_name = split_n(temp_string,delims=' ,',n=1,stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename,i, & + message='unable to find used module name') + return + end if + mod_name = lower(mod_name) else - call split(file_lines(i)%s,line_parts,delimiters=' ,') - mod_name = trim(lower(line_parts(2))) - + mod_name = split_n(file_lines(i)%s,n=2,delims=' ,',stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename,i, & + message='unable to find used module name') + return + end if + mod_name = lower(mod_name) + end if if (.not.validate_name(mod_name)) then @@ -236,8 +255,13 @@ function parse_f_source(f_filename) result(f_source) n_include = n_include + 1 if (pass == 2) then - call split(file_lines(i)%s,line_parts,delimiters="'"//'"') - f_source%include_dependencies(n_include)%s = trim(line_parts(2)) + 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,i, & + message='unable to find include file name') + return + end if end if end if @@ -245,12 +269,24 @@ function parse_f_source(f_filename) result(f_source) ! Extract name of module if is module if (index(adjustl(lower(file_lines(i)%s)),'module ') == 1) then - call split(file_lines(i)%s,line_parts,delimiters=' ') + mod_name = lower(split_n(file_lines(i)%s,n=2,delims=' ',stat=stat)) + if (stat /= 0) then + call file_parse_error(error,f_filename,i, & + message='unable to find module name') + return + end if - mod_name = adjustl(trim(lower(line_parts(2)))) + if (mod_name == 'procedure' .or. & + mod_name == 'subroutine' .or. & + mod_name == 'function') then + ! Ignore these cases + cycle + end if if (.not.validate_name(mod_name)) then - cycle + call file_parse_error(error,f_filename,i, & + message='empty or invalid name for module') + return end if n_mod = n_mod + 1 @@ -266,7 +302,12 @@ function parse_f_source(f_filename) result(f_source) ! Extract name of submodule if is submodule if (index(adjustl(lower(file_lines(i)%s)),'submodule') == 1) then - call split(file_lines(i)%s,line_parts,delimiters=' ()') + temp_string = split_n(file_lines(i)%s,n=2,delims='()',stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename,i, & + message='unable to get submodule ancestry') + return + end if f_source%unit_type = FPM_UNIT_SUBMODULE @@ -274,13 +315,19 @@ function parse_f_source(f_filename) result(f_source) if (pass == 2) then - if (index(line_parts(2),':') > 0) then - - line_parts(2) = line_parts(2)(index(line_parts(2),':')+1:) + if (index(temp_string,':') > 0) then + temp_string = temp_string(index(temp_string,':')+1:) + end if - f_source%modules_used(n_use)%s = adjustl(trim(lower(line_parts(2)))) + f_source%modules_used(n_use)%s = lower(temp_string) + + if (.not.validate_name(temp_string)) then + call file_parse_error(error,f_filename,i, & + message='empty or invalid name for submodule parent') + return + end if end if @@ -317,10 +364,7 @@ function parse_f_source(f_filename) result(f_source) integer :: i - if (trim(lower(name)) == 'procedure' .or. & - trim(lower(name)) == 'subroutine' .or. & - trim(lower(name)) == 'function') then - + if (len_trim(name) < 1) then valid = .false. return end if @@ -353,16 +397,16 @@ function parse_f_source(f_filename) result(f_source) end function parse_f_source -function parse_c_source(c_filename) result(c_source) +function parse_c_source(c_filename,error) result(c_source) ! Rudimentary scan of c source file and ! extract include dependencies ! character(*), intent(in) :: c_filename type(srcfile_t) :: c_source + type(error_t), allocatable, intent(out) :: error - integer :: fh, n_include, i, pass + integer :: fh, n_include, i, pass, stat type(string_t), allocatable :: file_lines(:) - character(:), allocatable :: line_parts(:) c_source%file_name = c_filename @@ -394,8 +438,15 @@ function parse_c_source(c_filename) result(c_source) n_include = n_include + 1 if (pass == 2) then - call split(file_lines(i)%s,line_parts,delimiters='"') - c_source%include_dependencies(n_include)%s = trim(line_parts(2)) + + c_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,c_filename,i, & + message='unable to get c include file') + return + end if + end if end if @@ -411,6 +462,48 @@ function parse_c_source(c_filename) result(c_source) end function parse_c_source +function split_n(string,delims,n,stat) result(substring) + ! Split a string on one or more delimeters + ! and return the nth substring if it exists + ! + ! n=0 will return the last item + ! n=-1 will return the penultimate item etc. + ! + ! stat = 1 on return if the index + ! is not found + ! + character(*), intent(in) :: string + character(*), intent(in) :: delims + integer, intent(in) :: n + integer, intent(out) :: stat + character(:), allocatable :: substring + + integer :: i + character(:), allocatable :: string_parts(:) + + call split(string,string_parts,delims) + + if (n<1) then + i = size(string_parts) + n + if (i < 1) then + stat = 1 + return + end if + else + i = n + end if + + if (i>size(string_parts)) then + stat = 1 + return + end if + + substring = trim(string_parts(i)) + stat = 0 + +end function split_n + + subroutine resolve_module_dependencies(sources) ! After enumerating all source files: resolve file dependencies ! by searching on module names |