aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--fpm/src/fpm/error.f9027
-rw-r--r--fpm/src/fpm_sources.f90155
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