diff options
| -rw-r--r-- | fpm/src/fpm.f90 | 36 | ||||
| -rw-r--r-- | fpm/src/fpm/error.f90 | 70 | ||||
| -rw-r--r-- | fpm/src/fpm_sources.f90 | 189 | ||||
| -rw-r--r-- | fpm/test/main.f90 | 9 | ||||
| -rw-r--r-- | fpm/test/test_source_parsing.f90 | 621 |
5 files changed, 886 insertions, 39 deletions
diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 29d663c..b57a713 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -18,12 +18,13 @@ public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test contains -subroutine build_model(model, settings, package) +subroutine build_model(model, settings, package, error) ! Constructs a valid fpm model from command line settings and toml manifest ! type(fpm_model_t), intent(out) :: model type(fpm_build_settings), intent(in) :: settings type(package_t), intent(in) :: package + type(error_t), allocatable, intent(out) :: error model%package_name = package%name @@ -37,14 +38,35 @@ subroutine build_model(model, settings, package) ! Add sources from executable directories if (allocated(package%executable)) then - call add_executable_sources(model%sources, package%executable,is_test=.false.) + + call add_executable_sources(model%sources, package%executable, & + is_test=.false., error=error) + + if (allocated(error)) then + return + end if + end if if (allocated(package%test)) then - call add_executable_sources(model%sources, package%test,is_test=.true.) + + call add_executable_sources(model%sources, package%test, & + is_test=.true., error=error) + + if (allocated(error)) then + return + end if + end if if (allocated(package%library)) then - call add_sources_from_dir(model%sources,package%library%source_dir) + + call add_sources_from_dir(model%sources,package%library%source_dir, & + error=error) + + if (allocated(error)) then + return + end if + end if call resolve_module_dependencies(model%sources) @@ -79,7 +101,11 @@ if (.not.(allocated(package%library) .or. allocated(package%executable))) then error stop 1 end if -call build_model(model, settings, package) +call build_model(model, settings, package, error) +if (allocated(error)) then + print '(a)', error%message + error stop 1 +end if call build_package(model) diff --git a/fpm/src/fpm/error.f90 b/fpm/src/fpm/error.f90 index aebd7e4..e69ff1e 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,73 @@ contains end subroutine file_not_found_error + !> Error created when file parsing fails + subroutine file_parse_error(error, file_name, message, line_num, & + line_string, line_col) + + !> Instance of the error data + type(error_t), allocatable, intent(out) :: error + + !> Name of file + character(len=*), intent(in) :: file_name + + !> Parse error message + character(len=*), intent(in) :: message + + !> Line number of parse error + integer, intent(in), optional :: line_num + + !> Line context string + character(len=*), intent(in), optional :: line_string + + !> Line context column + integer, intent(in), optional :: line_col + + character(50) :: temp_string + + allocate(error) + error%message = 'Parse error: '//message//new_line('a') + + error%message = error%message//file_name + + if (present(line_num)) then + + write(temp_string,'(I0)') line_num + + error%message = error%message//':'//trim(temp_string) + + end if + + if (present(line_col)) then + + if (line_col > 0) then + + write(temp_string,'(I0)') line_col + error%message = error%message//':'//trim(temp_string) + + end if + + end if + + if (present(line_string)) then + + error%message = error%message//new_line('a') + error%message = error%message//' | '//line_string + + if (present(line_col)) then + + if (line_col > 0) then + + error%message = error%message//new_line('a') + error%message = error%message//' | '//repeat(' ',line_col-1)//'^' + + end if + + end if + + end if + + 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..787efff 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 ', & @@ -20,12 +22,13 @@ character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & contains -subroutine add_sources_from_dir(sources,directory,with_executables) +subroutine add_sources_from_dir(sources,directory,with_executables,error) ! Enumerate sources in a directory ! type(srcfile_t), allocatable, intent(inout), target :: sources(:) character(*), intent(in) :: directory logical, intent(in), optional :: with_executables + type(error_t), allocatable, intent(out) :: error integer :: i, j logical, allocatable :: is_source(:), exclude_source(:) @@ -48,12 +51,24 @@ 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) + + if (allocated(error)) then + return + end if + 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) + + if (allocated(error)) then + return + end if + end if ! Exclude executables unless specified otherwise @@ -79,13 +94,14 @@ subroutine add_sources_from_dir(sources,directory,with_executables) end subroutine add_sources_from_dir -subroutine add_executable_sources(sources,executables,is_test) +subroutine add_executable_sources(sources,executables,is_test,error) ! Add sources from executable directories specified in manifest ! Only allow executables that are explicitly specified in manifest ! type(srcfile_t), allocatable, intent(inout), target :: sources(:) class(executable_t), intent(in) :: executables(:) logical, intent(in) :: is_test + type(error_t), allocatable, intent(out) :: error integer :: i, j @@ -96,8 +112,14 @@ subroutine add_executable_sources(sources,executables,is_test) call get_executable_source_dirs(exe_dirs,executables) do i=1,size(exe_dirs) + call add_sources_from_dir(dir_sources,exe_dirs(i)%s, & - with_executables=.true.) + with_executables=.true.,error=error) + + if (allocated(error)) then + return + end if + end do allocate(exclude_source(size(dir_sources))) @@ -157,16 +179,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 +222,34 @@ 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, & + 'unable to find used module name',i, & + file_lines(i)%s,index(file_lines(i)%s,'::')) + 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, & + 'unable to find used module name',i, & + file_lines(i)%s) + 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, & + 'unable to find used module name',i, & + file_lines(i)%s) + return + end if + mod_name = lower(mod_name) + end if if (.not.validate_name(mod_name)) then @@ -236,8 +277,14 @@ 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, & + 'unable to find include file name',i, & + file_lines(i)%s) + return + end if end if end if @@ -245,12 +292,26 @@ 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, & + 'unable to find module name',i, & + file_lines(i)%s) + 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, & + 'empty or invalid name for module',i, & + file_lines(i)%s) + return end if n_mod = n_mod + 1 @@ -266,7 +327,13 @@ 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, & + 'unable to get submodule ancestry',i, & + file_lines(i)%s) + return + end if f_source%unit_type = FPM_UNIT_SUBMODULE @@ -274,13 +341,20 @@ 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, & + 'empty or invalid name for submodule parent',i, & + file_lines(i)%s, index(file_lines(i)%s,temp_string)) + return + end if end if @@ -317,10 +391,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 +424,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 +465,16 @@ 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, & + 'unable to get c include file',i, & + file_lines(i)%s,index(file_lines(i)%s,'"')) + return + end if + end if end if @@ -411,6 +490,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 diff --git a/fpm/test/main.f90 b/fpm/test/main.f90 index 19bcdb6..f9d0941 100644 --- a/fpm/test/main.f90 +++ b/fpm/test/main.f90 @@ -4,6 +4,7 @@ program fpm_testing use testsuite, only : run_testsuite use test_toml, only : collect_toml use test_manifest, only : collect_manifest + use test_source_parsing, only : collect_source_parsing implicit none integer :: stat character(len=*), parameter :: fmt = '("#", *(1x, a))' @@ -24,4 +25,12 @@ program fpm_testing error stop 1 end if + write(error_unit, fmt) "Testing:", "fpm_sources (parsing)" + call run_testsuite(collect_source_parsing, error_unit, stat) + + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "tests failed!" + error stop 1 + end if + end program fpm_testing diff --git a/fpm/test/test_source_parsing.f90 b/fpm/test/test_source_parsing.f90 new file mode 100644 index 0000000..c55a206 --- /dev/null +++ b/fpm/test/test_source_parsing.f90 @@ -0,0 +1,621 @@ +!> Define tests for the `fpm_sources` module (parsing routines) +module test_source_parsing + use testsuite, only : new_unittest, unittest_t, error_t, test_failed + use fpm_filesystem, only: get_temp_filename + use fpm_sources, only: parse_f_source, parse_c_source + use fpm_model, only: srcfile_t, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & + FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE + use fpm_strings, only: operator(.in.) + implicit none + private + + public :: collect_source_parsing + +contains + + + !> Collect all exported unit tests + subroutine collect_source_parsing(testsuite) + + !> Collection of tests + type(unittest_t), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + & new_unittest("modules-used", test_modules_used), & + & new_unittest("intrinsic-modules-used", test_intrinsic_modules_used), & + & new_unittest("include-stmt", test_include_stmt), & + & new_unittest("module", test_module), & + & new_unittest("submodule", test_submodule), & + & new_unittest("submodule-ancestor", test_submodule_ancestor), & + & new_unittest("subprogram", test_subprogram), & + & new_unittest("csource", test_csource), & + & new_unittest("invalid-use-stmt", & + test_invalid_use_stmt, should_fail=.true.), & + & new_unittest("invalid-include-stmt", & + test_invalid_include_stmt, should_fail=.true.), & + & new_unittest("invalid-module", & + test_invalid_module, should_fail=.true.), & + & new_unittest("invalid-submodule", & + test_invalid_submodule, should_fail=.true.) & + ] + + end subroutine collect_source_parsing + + + !> Check parsing of module 'USE' statements + subroutine test_modules_used(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'program test', & + & ' use module_one', & + & ' use :: module_two', & + & ' use module_three, only: a, b, c', & + & ' use :: module_four, only: a => b', & + & '! use module_not_used', & + & ' implicit none', & + & 'end program test' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + if (f_source%unit_type /= FPM_UNIT_PROGRAM) then + call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_PROGRAM') + return + end if + + if (size(f_source%modules_provided) /= 0) then + call test_failed(error,'Unexpected modules_provided - expecting zero') + return + end if + + if (size(f_source%modules_used) /= 4) then + call test_failed(error,'Incorrect number of modules_used - expecting four') + return + end if + + if (.not.('module_one' .in. f_source%modules_used)) then + call test_failed(error,'Missing module in modules_used') + return + end if + + if (.not.('module_two' .in. f_source%modules_used)) then + call test_failed(error,'Missing module in modules_used') + return + end if + + if (.not.('module_three' .in. f_source%modules_used)) then + call test_failed(error,'Missing module in modules_used') + return + end if + + if (.not.('module_four' .in. f_source%modules_used)) then + call test_failed(error,'Missing module in modules_used') + return + end if + + if ('module_not_used' .in. f_source%modules_used) then + call test_failed(error,'Commented module found in modules_used') + return + end if + + end subroutine test_modules_used + + + !> Check that intrinsic modules are properly ignore + subroutine test_intrinsic_modules_used(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'program test', & + & ' use iso_c_binding', & + & ' use iso_fortran_env', & + & ' use ieee_arithmetic', & + & ' use ieee_exceptions', & + & ' use ieee_features', & + & ' implicit none', & + & 'end program test' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + if (size(f_source%modules_provided) /= 0) then + call test_failed(error,'Unexpected modules_provided - expecting zero') + return + end if + + if (size(f_source%modules_used) /= 0) then + call test_failed(error,'Incorrect number of modules_used - expecting zero') + return + end if + + if ('iso_c_binding' .in. f_source%modules_used) then + call test_failed(error,'Intrinsic module found in modules_used') + return + end if + + if ('iso_fortran_env' .in. f_source%modules_used) then + call test_failed(error,'Intrinsic module found in modules_used') + return + end if + + if ('ieee_arithmetic' .in. f_source%modules_used) then + call test_failed(error,'Intrinsic module found in modules_used') + return + end if + + if ('ieee_exceptions' .in. f_source%modules_used) then + call test_failed(error,'Intrinsic module found in modules_used') + return + end if + + if ('ieee_features' .in. f_source%modules_used) then + call test_failed(error,'Intrinsic module found in modules_used') + return + end if + + end subroutine test_intrinsic_modules_used + + + !> Check parsing of include statements + subroutine test_include_stmt(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'program test', & + & ' implicit none', & + & ' include "included_file.f90"', & + & ' contains ', & + & ' include "second_include.f90"', & + & 'end program test' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + if (size(f_source%modules_provided) /= 0) then + call test_failed(error,'Unexpected modules_provided - expecting zero') + return + end if + + if (size(f_source%modules_used) /= 0) then + call test_failed(error,'Incorrect number of modules_used - expecting zero') + return + end if + + if (size(f_source%include_dependencies) /= 2) then + call test_failed(error,'Incorrect number of include_dependencies - expecting two') + return + end if + + if (.not.('included_file.f90' .in. f_source%include_dependencies)) then + call test_failed(error,'Missing include file in include_dependencies') + return + end if + + if (.not.('second_include.f90' .in. f_source%include_dependencies)) then + call test_failed(error,'Missing include file in include_dependencies') + return + end if + + end subroutine test_include_stmt + + + !> Try to parse fortran module + subroutine test_module(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'module my_mod', & + & 'use module_one', & + & 'interface', & + & ' module subroutine f()', & + & 'end interface', & + & 'contains', & + & 'module procedure f()', & + & 'end procedure f', & + & 'end submodule test' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + if (f_source%unit_type /= FPM_UNIT_MODULE) then + call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_MODULE') + return + end if + + if (size(f_source%modules_provided) /= 1) then + call test_failed(error,'Unexpected modules_provided - expecting one') + return + end if + + if (size(f_source%modules_used) /= 1) then + call test_failed(error,'Incorrect number of modules_used - expecting one') + return + end if + + if (.not.('my_mod' .in. f_source%modules_provided)) then + call test_failed(error,'Missing module in modules_provided') + return + end if + + if (.not.('module_one' .in. f_source%modules_used)) then + call test_failed(error,'Missing parent module in modules_used') + return + end if + + end subroutine test_module + + + !> Try to parse fortran submodule for ancestry + subroutine test_submodule(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'submodule (parent) :: child', & + & 'use module_one', & + & 'end submodule test' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + if (f_source%unit_type /= FPM_UNIT_SUBMODULE) then + call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_SUBMODULE') + return + end if + + if (size(f_source%modules_provided) /= 0) then + call test_failed(error,'Unexpected modules_provided - expecting zero') + return + end if + + if (size(f_source%modules_used) /= 2) then + call test_failed(error,'Incorrect number of modules_used - expecting two') + return + end if + + if (.not.('module_one' .in. f_source%modules_used)) then + call test_failed(error,'Missing module in modules_used') + return + end if + + if (.not.('parent' .in. f_source%modules_used)) then + call test_failed(error,'Missing parent module in modules_used') + return + end if + + end subroutine test_submodule + + + !> Try to parse fortran multi-level submodule for ancestry + subroutine test_submodule_ancestor(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'submodule (ancestor:parent) :: child', & + & 'use module_one', & + & 'end submodule test' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + if (f_source%unit_type /= FPM_UNIT_SUBMODULE) then + call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_SUBMODULE') + return + end if + + if (size(f_source%modules_provided) /= 0) then + call test_failed(error,'Unexpected modules_provided - expecting zero') + return + end if + + if (size(f_source%modules_used) /= 2) then + call test_failed(error,'Incorrect number of modules_used - expecting two') + return + end if + + if (.not.('module_one' .in. f_source%modules_used)) then + call test_failed(error,'Missing module in modules_used') + return + end if + + if (.not.('parent' .in. f_source%modules_used)) then + call test_failed(error,'Missing parent module in modules_used') + return + end if + + end subroutine test_submodule_ancestor + + + !> Try to parse standard fortran sub-program (non-module) source + subroutine test_subprogram(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'subroutine my_sub(a)', & + & ' use module_one', & + & ' integer, intent(in) :: a', & + & 'end subroutine my_sub' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + if (f_source%unit_type /= FPM_UNIT_SUBPROGRAM) then + call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_SUBPROGRAM') + return + end if + + if (size(f_source%modules_provided) /= 0) then + call test_failed(error,'Unexpected modules_provided - expecting zero') + return + end if + + if (size(f_source%modules_used) /= 1) then + call test_failed(error,'Incorrect number of modules_used - expecting one') + return + end if + + if (.not.('module_one' .in. f_source%modules_used)) then + call test_failed(error,'Missing module in modules_used') + return + end if + + end subroutine test_subprogram + + + !> Try to parse standard c source for includes + subroutine test_csource(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + temp_file = temp_file//'.c' + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & '#include "proto.h"', & + & 'void c_func(int a) {', & + & ' #include "function_body.c"', & + & ' return', & + & '}' + close(unit) + + f_source = parse_c_source(temp_file,error) + if (allocated(error)) then + return + end if + + if (f_source%unit_type /= FPM_UNIT_CSOURCE) then + call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_CSOURCE') + return + end if + + if (size(f_source%modules_provided) /= 0) then + call test_failed(error,'Unexpected modules_provided - expecting zero') + return + end if + + if (size(f_source%modules_used) /= 0) then + call test_failed(error,'Incorrect number of modules_used - expecting zero') + return + end if + + if (size(f_source%include_dependencies) /= 2) then + call test_failed(error,'Incorrect number of include_dependencies - expecting two') + return + end if + + if (.not.('proto.h' .in. f_source%include_dependencies)) then + call test_failed(error,'Missing file in include_dependencies') + return + end if + + if (.not.('function_body.c' .in. f_source%include_dependencies)) then + call test_failed(error,'Missing file in include_dependencies') + return + end if + + end subroutine test_csource + + + !> Try to parse fortran program with invalid use statement + subroutine test_invalid_use_stmt(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'program test', & + & 'use module_one', & + & 'use :: ', & + & 'end program test' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + end subroutine test_invalid_use_stmt + + + !> Try to parse fortran program with invalid use statement + subroutine test_invalid_include_stmt(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'program test', & + & ' include "', & + & 'end program test' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + end subroutine test_invalid_include_stmt + + + !> Try to parse incorrect fortran module syntax + subroutine test_invalid_module(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'module :: my_mod', & + & 'end module test' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + write(*,*) '"',f_source%modules_used(1)%s,'"' + + end subroutine test_invalid_module + + + !> Try to parse incorrect fortran submodule syntax + subroutine test_invalid_submodule(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'submodule :: child', & + & 'end submodule test' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + write(*,*) '"',f_source%modules_used(1)%s,'"' + + end subroutine test_invalid_submodule + + + +end module test_source_parsing |