aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--bootstrap/src/Fpm.hs14
-rw-r--r--fpm/fpm.toml2
-rw-r--r--fpm/src/fpm.f9036
-rw-r--r--fpm/src/fpm/error.f9070
-rw-r--r--fpm/src/fpm/manifest/dependency.f9010
-rw-r--r--fpm/src/fpm/manifest/executable.f905
-rw-r--r--fpm/src/fpm/manifest/library.f902
-rw-r--r--fpm/src/fpm/manifest/package.f905
-rw-r--r--fpm/src/fpm/manifest/test.f903
-rw-r--r--fpm/src/fpm/toml.f907
-rw-r--r--fpm/src/fpm_sources.f90189
-rw-r--r--fpm/test/main.f909
-rw-r--r--fpm/test/test_manifest.f90505
-rw-r--r--fpm/test/test_source_parsing.f90621
-rw-r--r--fpm/test/testsuite.f9034
15 files changed, 1414 insertions, 98 deletions
diff --git a/bootstrap/src/Fpm.hs b/bootstrap/src/Fpm.hs
index fdd83d9..d9de668 100644
--- a/bootstrap/src/Fpm.hs
+++ b/bootstrap/src/Fpm.hs
@@ -617,19 +617,23 @@ fetchDependency name version = do
undefined
GitVersion versionSpec -> do
system
- ("git clone " ++ gitVersionSpecUrl versionSpec ++ " " ++ clonePath)
+ ("git init " ++ clonePath)
case gitVersionSpecRef versionSpec of
- Just ref -> withCurrentDirectory clonePath $ do
+ Just ref -> do
system
- ( "git checkout "
+ ("git -C " ++ clonePath ++ " fetch " ++ gitVersionSpecUrl versionSpec ++ " "
++ (case ref of
Tag tag -> tag
Branch branch -> branch
Commit commit -> commit
)
)
- return (name, clonePath)
- Nothing -> return (name, clonePath)
+ Nothing -> do
+ system
+ ("git -C " ++ clonePath ++ " fetch " ++ gitVersionSpecUrl versionSpec)
+ system
+ ("git -C " ++ clonePath ++ " checkout -qf FETCH_HEAD")
+ return (name, clonePath)
PathVersion versionSpec -> return (name, pathVersionSpecPath versionSpec)
{-
diff --git a/fpm/fpm.toml b/fpm/fpm.toml
index b39d881..d29994a 100644
--- a/fpm/fpm.toml
+++ b/fpm/fpm.toml
@@ -8,7 +8,7 @@ copyright = "2020 fpm contributors"
[dependencies]
[dependencies.toml-f]
git = "https://github.com/toml-f/toml-f"
-rev = "290ba87671ab593e7bd51599e1d80ea736b3cd36"
+tag = "v0.2"
[[test]]
name = "fpm-test"
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/manifest/dependency.f90 b/fpm/src/fpm/manifest/dependency.f90
index 8a3d879..599d43a 100644
--- a/fpm/src/fpm/manifest/dependency.f90
+++ b/fpm/src/fpm/manifest/dependency.f90
@@ -94,7 +94,7 @@ contains
end if
if (.not.allocated(self%git)) then
- call get_value(table, "revision", obj)
+ call get_value(table, "rev", obj)
if (allocated(obj)) then
self%git = git_target_revision(url, obj)
end if
@@ -120,9 +120,10 @@ contains
character(len=:), allocatable :: name
type(toml_key), allocatable :: list(:)
- logical :: url_present, git_target_present
+ logical :: url_present, git_target_present, has_path
integer :: ikey
+ has_path = .false.
url_present = .false.
git_target_present = .false.
@@ -146,6 +147,7 @@ contains
exit
end if
url_present = .true.
+ has_path = list(ikey)%key == 'path'
case("branch", "rev", "tag")
if (git_target_present) then
@@ -163,7 +165,7 @@ contains
return
end if
- if (.not.url_present .and. git_target_present) then
+ if (has_path .and. git_target_present) then
call syntax_error(error, "Dependency "//name//" uses a local path, therefore no git identifiers are allowed")
end if
@@ -182,7 +184,7 @@ contains
!> Error handling
type(error_t), allocatable, intent(out) :: error
- class(toml_table), pointer :: node
+ type(toml_table), pointer :: node
type(toml_key), allocatable :: list(:)
integer :: idep, stat
diff --git a/fpm/src/fpm/manifest/executable.f90 b/fpm/src/fpm/manifest/executable.f90
index f706001..6675519 100644
--- a/fpm/src/fpm/manifest/executable.f90
+++ b/fpm/src/fpm/manifest/executable.f90
@@ -57,7 +57,7 @@ contains
!> Error handling
type(error_t), allocatable, intent(out) :: error
- class(toml_table), pointer :: child
+ type(toml_table), pointer :: child
call check(table, error)
if (allocated(error)) return
@@ -104,7 +104,7 @@ contains
do ikey = 1, size(list)
select case(list(ikey)%key)
case default
- call syntax_error(error, "Key "//list(ikey)%key//" is not allowed executable entry")
+ call syntax_error(error, "Key "//list(ikey)%key//" is not allowed as executable entry")
exit
case("name")
@@ -115,6 +115,7 @@ contains
end select
end do
+ if (allocated(error)) return
if (.not.name_present) then
call syntax_error(error, "Executable name is not provided, please add a name entry")
diff --git a/fpm/src/fpm/manifest/library.f90 b/fpm/src/fpm/manifest/library.f90
index 40e5e92..7a79a2a 100644
--- a/fpm/src/fpm/manifest/library.f90
+++ b/fpm/src/fpm/manifest/library.f90
@@ -77,7 +77,7 @@ contains
do ikey = 1, size(list)
select case(list(ikey)%key)
case default
- call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in package file")
+ call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in library")
exit
case("source-dir", "build-script")
diff --git a/fpm/src/fpm/manifest/package.f90 b/fpm/src/fpm/manifest/package.f90
index 4c2c14a..dff81e5 100644
--- a/fpm/src/fpm/manifest/package.f90
+++ b/fpm/src/fpm/manifest/package.f90
@@ -85,8 +85,8 @@ contains
!> Error handling
type(error_t), allocatable, intent(out) :: error
- class(toml_table), pointer :: child, node
- class(toml_array), pointer :: children
+ type(toml_table), pointer :: child, node
+ type(toml_array), pointer :: children
integer :: ii, nn, stat
call check(table, error)
@@ -184,6 +184,7 @@ contains
name_present = .true.
case("version", "license", "author", "maintainer", "copyright", &
+ & "description", "keywords", "categories", "homepage", &
& "dependencies", "dev-dependencies", "test", "executable", &
& "library")
continue
diff --git a/fpm/src/fpm/manifest/test.f90 b/fpm/src/fpm/manifest/test.f90
index a6c6f64..de4c847 100644
--- a/fpm/src/fpm/manifest/test.f90
+++ b/fpm/src/fpm/manifest/test.f90
@@ -50,7 +50,7 @@ contains
!> Error handling
type(error_t), allocatable, intent(out) :: error
- class(toml_table), pointer :: child
+ type(toml_table), pointer :: child
call check(table, error)
if (allocated(error)) return
@@ -108,6 +108,7 @@ contains
end select
end do
+ if (allocated(error)) return
if (.not.name_present) then
call syntax_error(error, "Test name is not provided, please add a name entry")
diff --git a/fpm/src/fpm/toml.f90 b/fpm/src/fpm/toml.f90
index 183278d..e2445c4 100644
--- a/fpm/src/fpm/toml.f90
+++ b/fpm/src/fpm/toml.f90
@@ -14,14 +14,13 @@
module fpm_toml
use fpm_error, only : error_t, fatal_error, file_not_found_error
use tomlf, only : toml_table, toml_array, toml_key, toml_stat, get_value, &
- & toml_parse, toml_error
- use tomlf_type, only : new_table, len
+ & set_value, toml_parse, toml_error, new_table, add_table, add_array, len
implicit none
private
public :: read_package_file
- public :: toml_table, toml_array, toml_key, toml_stat, get_value
- public :: new_table, len
+ public :: toml_table, toml_array, toml_key, toml_stat, get_value, set_value
+ public :: new_table, add_table, add_array, len
contains
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_manifest.f90 b/fpm/test/test_manifest.f90
index 223b346..d2dc891 100644
--- a/fpm/test/test_manifest.f90
+++ b/fpm/test/test_manifest.f90
@@ -1,6 +1,7 @@
!> Define tests for the `fpm_manifest` modules
module test_manifest
- use testsuite, only : new_unittest, unittest_t, error_t, test_failed
+ use testsuite, only : new_unittest, unittest_t, error_t, test_failed, &
+ & check_string
use fpm_manifest
implicit none
private
@@ -23,11 +24,30 @@ contains
& new_unittest("default-library", test_default_library), &
& new_unittest("default-executable", test_default_executable), &
& new_unittest("dependency-empty", test_dependency_empty, should_fail=.true.), &
+ & new_unittest("dependency-pathtag", test_dependency_pathtag, should_fail=.true.), &
+ & new_unittest("dependency-gitpath", test_dependency_gitpath, should_fail=.true.), &
+ & new_unittest("dependency-nourl", test_dependency_nourl, should_fail=.true.), &
+ & new_unittest("dependency-gitconflict", test_dependency_gitconflict, should_fail=.true.), &
+ & new_unittest("dependency-wrongkey", test_dependency_wrongkey, should_fail=.true.), &
& new_unittest("dependencies-empty", test_dependencies_empty), &
+ & new_unittest("dependencies-typeerror", test_dependencies_typeerror, should_fail=.true.), &
& new_unittest("executable-empty", test_executable_empty, should_fail=.true.), &
+ & new_unittest("executable-typeerror", test_executable_typeerror, should_fail=.true.), &
+ & new_unittest("executable-noname", test_executable_noname, should_fail=.true.), &
+ & new_unittest("executable-wrongkey", test_executable_wrongkey, should_fail=.true.), &
& new_unittest("library-empty", test_library_empty), &
+ & new_unittest("library-wrongkey", test_library_wrongkey, should_fail=.true.), &
+ & new_unittest("package-simple", test_package_simple), &
& new_unittest("package-empty", test_package_empty, should_fail=.true.), &
- & new_unittest("test-empty", test_test_empty, should_fail=.true.)]
+ & new_unittest("package-typeerror", test_package_typeerror, should_fail=.true.), &
+ & new_unittest("package-noname", test_package_noname, should_fail=.true.), &
+ & new_unittest("package-wrongexe", test_package_wrongexe, should_fail=.true.), &
+ & new_unittest("package-wrongtest", test_package_wrongtest, should_fail=.true.), &
+ & new_unittest("test-simple", test_test_simple), &
+ & new_unittest("test-empty", test_test_empty, should_fail=.true.), &
+ & new_unittest("test-typeerror", test_test_typeerror, should_fail=.true.), &
+ & new_unittest("test-noname", test_test_noname, should_fail=.true.), &
+ & new_unittest("test-wrongkey", test_test_wrongkey, should_fail=.true.)]
end subroutine collect_manifest
@@ -143,16 +163,9 @@ contains
allocate(package%library)
call default_library(package%library)
- if (.not.allocated(package%library%source_dir)) then
- call test_failed(error, "Default library source-dir is not set")
- return
- end if
-
- if (package%library%source_dir /= "src") then
- call test_failed(error, "Default library source-dir is "// &
- & package%library%source_dir//" but should be src")
- return
- end if
+ call check_string(error, package%library%source_dir, "src", &
+ & "Default library source-dir")
+ if (allocated(error)) return
end subroutine test_default_library
@@ -169,22 +182,13 @@ contains
allocate(package%executable(1))
call default_executable(package%executable(1), name)
- if (.not.allocated(package%executable(1)%source_dir)) then
- call test_failed(error, "Default executable source-dir is not set")
- return
- end if
-
- if (package%executable(1)%source_dir /= "app") then
- call test_failed(error, "Default executable source-dir is "// &
- & package%executable(1)%source_dir//" but should be app")
- return
- end if
+ call check_string(error, package%executable(1)%source_dir, "app", &
+ & "Default executable source-dir")
+ if (allocated(error)) return
- if (package%executable(1)%name /= name) then
- call test_failed(error, "Default executable name is "// &
- & package%executable(1)%name//" but should be "//name)
- return
- end if
+ call check_string(error, package%executable(1)%name, name, &
+ & "Default executable name")
+ if (allocated(error)) return
end subroutine test_default_executable
@@ -208,6 +212,115 @@ contains
end subroutine test_dependency_empty
+ !> Try to create a dependency with conflicting entries
+ subroutine test_dependency_pathtag(error)
+ use fpm_manifest_dependency
+ use fpm_toml, only : new_table, toml_table, set_value
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(toml_table) :: table
+ integer :: stat
+ type(dependency_t) :: dependency
+
+ call new_table(table)
+ table%key = 'example'
+ call set_value(table, 'path', '"package"', stat)
+ call set_value(table, 'tag', '"v20.1"', stat)
+
+ call new_dependency(dependency, table, error)
+
+ end subroutine test_dependency_pathtag
+
+
+ !> Try to create a dependency with conflicting entries
+ subroutine test_dependency_nourl(error)
+ use fpm_manifest_dependency
+ use fpm_toml, only : new_table, toml_table, set_value
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(toml_table) :: table
+ integer :: stat
+ type(dependency_t) :: dependency
+
+ call new_table(table)
+ table%key = 'example'
+ call set_value(table, 'tag', '"v20.1"', stat)
+
+ call new_dependency(dependency, table, error)
+
+ end subroutine test_dependency_nourl
+
+
+ !> Try to create a dependency with conflicting entries
+ subroutine test_dependency_gitpath(error)
+ use fpm_manifest_dependency
+ use fpm_toml, only : new_table, toml_table, set_value
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(toml_table) :: table
+ integer :: stat
+ type(dependency_t) :: dependency
+
+ call new_table(table)
+ table%key = 'example'
+ call set_value(table, 'path', '"package"', stat)
+ call set_value(table, 'git', '"https://gitea.com/fortran-lang/pack"', stat)
+
+ call new_dependency(dependency, table, error)
+
+ end subroutine test_dependency_gitpath
+
+
+ !> Try to create a dependency with conflicting entries
+ subroutine test_dependency_gitconflict(error)
+ use fpm_manifest_dependency
+ use fpm_toml, only : new_table, toml_table, set_value
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(toml_table) :: table
+ integer :: stat
+ type(dependency_t) :: dependency
+
+ call new_table(table)
+ table%key = 'example'
+ call set_value(table, 'git', '"https://gitea.com/fortran-lang/pack"', stat)
+ call set_value(table, 'branch', '"latest"', stat)
+ call set_value(table, 'tag', '"v20.1"', stat)
+
+ call new_dependency(dependency, table, error)
+
+ end subroutine test_dependency_gitconflict
+
+
+ !> Try to create a dependency with conflicting entries
+ subroutine test_dependency_wrongkey(error)
+ use fpm_manifest_dependency
+ use fpm_toml, only : new_table, toml_table, set_value
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(toml_table) :: table
+ integer :: stat
+ type(dependency_t) :: dependency
+
+ call new_table(table)
+ table%key = 'example'
+ call set_value(table, 'not-available', '"anywhere"', stat)
+
+ call new_dependency(dependency, table, error)
+
+ end subroutine test_dependency_wrongkey
+
+
!> Dependency tables can be empty
subroutine test_dependencies_empty(error)
use fpm_manifest_dependency
@@ -231,6 +344,27 @@ contains
end subroutine test_dependencies_empty
+ !> Add a dependency as an array, which is not supported
+ subroutine test_dependencies_typeerror(error)
+ use fpm_manifest_dependency
+ use fpm_toml, only : new_table, add_array, toml_table, toml_array
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(toml_table) :: table
+ type(toml_array), pointer :: children
+ integer :: stat
+ type(dependency_t), allocatable :: dependencies(:)
+
+ call new_table(table)
+ call add_array(table, 'dep1', children, stat)
+
+ call new_dependencies(dependencies, table, error)
+
+ end subroutine test_dependencies_typeerror
+
+
!> Executables cannot be created from empty tables
subroutine test_executable_empty(error)
use fpm_manifest_executable
@@ -249,6 +383,69 @@ contains
end subroutine test_executable_empty
+ !> Pass a wrong TOML type to the name field of the executable
+ subroutine test_executable_typeerror(error)
+ use fpm_manifest_executable
+ use fpm_toml, only : new_table, add_table, toml_table
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(toml_table) :: table
+ type(toml_table), pointer :: child
+ integer :: stat
+ type(executable_t) :: executable
+
+ call new_table(table)
+ call add_table(table, 'name', child, stat)
+
+ call new_executable(executable, table, error)
+
+ end subroutine test_executable_typeerror
+
+
+ !> Pass a TOML table with insufficient entries to the executable constructor
+ subroutine test_executable_noname(error)
+ use fpm_manifest_executable
+ use fpm_toml, only : new_table, add_table, toml_table
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(toml_table) :: table
+ type(toml_table), pointer :: child
+ integer :: stat
+ type(executable_t) :: executable
+
+ call new_table(table)
+ call add_table(table, 'dependencies', child, stat)
+
+ call new_executable(executable, table, error)
+
+ end subroutine test_executable_noname
+
+
+ !> Pass a TOML table with not allowed keys
+ subroutine test_executable_wrongkey(error)
+ use fpm_manifest_executable
+ use fpm_toml, only : new_table, add_table, toml_table
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(toml_table) :: table
+ type(toml_table), pointer :: child
+ integer :: stat
+ type(executable_t) :: executable
+
+ call new_table(table)
+ call add_table(table, 'wrong-field', child, stat)
+
+ call new_executable(executable, table, error)
+
+ end subroutine test_executable_wrongkey
+
+
!> Libraries can be created from empty tables
subroutine test_library_empty(error)
use fpm_manifest_library
@@ -265,20 +462,73 @@ contains
call new_library(library, table, error)
if (allocated(error)) return
- if (.not.allocated(library%source_dir)) then
- call test_failed(error, "Default library source-dir is not set")
- return
- end if
-
- if (library%source_dir /= "src") then
- call test_failed(error, "Default library source-dir is "// &
- & library%source_dir//" but should be src")
- return
- end if
+ call check_string(error, library%source_dir, "src", &
+ & "Default library source-dir")
+ if (allocated(error)) return
end subroutine test_library_empty
+ !> Pass a TOML table with not allowed keys
+ subroutine test_library_wrongkey(error)
+ use fpm_manifest_library
+ use fpm_toml, only : new_table, add_table, toml_table
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(toml_table) :: table
+ type(toml_table), pointer :: child
+ integer :: stat
+ type(library_t) :: library
+
+ call new_table(table)
+ call add_table(table, 'not-allowed', child, stat)
+
+ call new_library(library, table, error)
+
+ end subroutine test_library_wrongkey
+
+
+ !> Packages cannot be created from empty tables
+ subroutine test_package_simple(error)
+ use fpm_manifest_package
+ use fpm_toml, only : new_table, add_table, add_array, set_value, &
+ & toml_table, toml_array
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(toml_table) :: table
+ type(toml_table), pointer :: child, child2
+ type(toml_array), pointer :: children
+ integer :: stat
+ type(package_t) :: package
+
+ call new_table(table)
+ call set_value(table, 'name', '"example"', stat)
+ call set_value(table, 'license', '"MIT"', stat)
+ call add_table(table, 'dev-dependencies', child, stat)
+ call add_table(child, 'pkg1', child2, stat)
+ call set_value(child2, 'git', '"https://github.com/fortran-lang/pkg1"', stat)
+ call add_table(child, 'pkg2', child2)
+ call set_value(child2, 'git', '"https://gitlab.com/fortran-lang/pkg2"', stat)
+ call set_value(child2, 'branch', '"devel"', stat)
+ call add_table(child, 'pkg3', child2)
+ call set_value(child2, 'git', '"https://bitbucket.org/fortran-lang/pkg3"', stat)
+ call set_value(child2, 'rev', '"9fceb02d0ae598e95dc970b74767f19372d61af8"', stat)
+ call add_table(child, 'pkg4', child2)
+ call set_value(child2, 'git', '"https://gitea.com/fortran-lang/pkg4"', stat)
+ call set_value(child2, 'tag', '"v1.8.5-rc3"', stat)
+ call add_array(table, 'test', children, stat)
+ call add_table(children, child, stat)
+ call set_value(child, 'name', '"tester"', stat)
+
+ call new_package(package, table, error)
+
+ end subroutine test_package_simple
+
+
!> Packages cannot be created from empty tables
subroutine test_package_empty(error)
use fpm_manifest_package
@@ -297,6 +547,124 @@ contains
end subroutine test_package_empty
+ !> Create an array in the package name, which should cause an error
+ subroutine test_package_typeerror(error)
+ use fpm_manifest_package
+ use fpm_toml, only : new_table, add_array, toml_table, toml_array
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(toml_table) :: table
+ type(toml_array), pointer :: child
+ integer :: stat
+ type(package_t) :: package
+
+ call new_table(table)
+ call add_array(table, "name", child, stat)
+
+ call new_package(package, table, error)
+
+ end subroutine test_package_typeerror
+
+
+ !> Try to create a new package without a name field
+ subroutine test_package_noname(error)
+ use fpm_manifest_package
+ use fpm_toml, only : new_table, add_table, toml_table
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(toml_table) :: table
+ type(toml_table), pointer :: child
+ integer :: stat
+ type(package_t) :: package
+
+ call new_table(table)
+ call add_table(table, "library", child, stat)
+ call add_table(table, "dev-dependencies", child, stat)
+ call add_table(table, "dependencies", child, stat)
+
+ call new_package(package, table, error)
+
+ end subroutine test_package_noname
+
+
+ !> Try to read executables from a mixed type array
+ subroutine test_package_wrongexe(error)
+ use fpm_manifest_package
+ use fpm_toml, only : new_table, set_value, add_array, toml_table, toml_array
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(toml_table) :: table
+ type(toml_array), pointer :: children, children2
+ integer :: stat
+ type(package_t) :: package
+
+ call new_table(table)
+ call set_value(table, 'name', '"example"', stat)
+ call add_array(table, 'executable', children, stat)
+ call add_array(children, children2, stat)
+
+ call new_package(package, table, error)
+
+ end subroutine test_package_wrongexe
+
+
+ !> Try to read tests from a mixed type array
+ subroutine test_package_wrongtest(error)
+ use fpm_manifest_package
+ use fpm_toml, only : new_table, set_value, add_array, toml_table, toml_array
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(toml_table) :: table
+ type(toml_array), pointer :: children, children2
+ integer :: stat
+ type(package_t) :: package
+
+ call new_table(table)
+ call set_value(table, 'name', '"example"', stat)
+ call add_array(table, 'test', children, stat)
+ call add_array(children, children2, stat)
+
+ call new_package(package, table, error)
+
+ end subroutine test_package_wrongtest
+
+
+ !> Tests cannot be created from empty tables
+ subroutine test_test_simple(error)
+ use fpm_manifest_test
+ use fpm_toml, only : new_table, set_value, add_table, toml_table
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(toml_table) :: table
+ type(toml_table), pointer :: child
+ integer :: stat
+ type(test_t) :: test
+
+ call new_table(table)
+ call set_value(table, 'name', '"example"', stat)
+ call set_value(table, 'source-dir', '"tests"', stat)
+ call set_value(table, 'main', '"tester.f90"', stat)
+ call add_table(table, 'dependencies', child, stat)
+
+ call new_test(test, table, error)
+ if (allocated(error)) return
+
+ call check_string(error, test%main, "tester.f90", "Test main")
+ if (allocated(error)) return
+
+ end subroutine test_test_simple
+
+
!> Tests cannot be created from empty tables
subroutine test_test_empty(error)
use fpm_manifest_test
@@ -315,4 +683,67 @@ contains
end subroutine test_test_empty
+ !> Pass a wrong TOML type to the name field of the test
+ subroutine test_test_typeerror(error)
+ use fpm_manifest_test
+ use fpm_toml, only : new_table, add_table, toml_table
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(toml_table) :: table
+ type(toml_table), pointer :: child
+ integer :: stat
+ type(test_t) :: test
+
+ call new_table(table)
+ call add_table(table, 'name', child, stat)
+
+ call new_test(test, table, error)
+
+ end subroutine test_test_typeerror
+
+
+ !> Pass a TOML table with insufficient entries to the test constructor
+ subroutine test_test_noname(error)
+ use fpm_manifest_test
+ use fpm_toml, only : new_table, add_table, toml_table
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(toml_table) :: table
+ type(toml_table), pointer :: child
+ integer :: stat
+ type(test_t) :: test
+
+ call new_table(table)
+ call add_table(table, 'dependencies', child, stat)
+
+ call new_test(test, table, error)
+
+ end subroutine test_test_noname
+
+
+ !> Pass a TOML table with not allowed keys
+ subroutine test_test_wrongkey(error)
+ use fpm_manifest_test
+ use fpm_toml, only : new_table, add_table, toml_table
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ type(toml_table) :: table
+ type(toml_table), pointer :: child
+ integer :: stat
+ type(test_t) :: test
+
+ call new_table(table)
+ call add_table(table, 'not-supported', child, stat)
+
+ call new_test(test, table, error)
+
+ end subroutine test_test_wrongkey
+
+
end module test_manifest
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
diff --git a/fpm/test/testsuite.f90 b/fpm/test/testsuite.f90
index bd0d415..9b69032 100644
--- a/fpm/test/testsuite.f90
+++ b/fpm/test/testsuite.f90
@@ -5,6 +5,7 @@ module testsuite
private
public :: run_testsuite, new_unittest, test_failed
+ public :: check_string
public :: unittest_t, error_t
@@ -73,7 +74,8 @@ contains
call collect(testsuite)
do ii = 1, size(testsuite)
- write(unit, '("#", *(1x, a))') "Starting", testsuite(ii)%name, "..."
+ write(unit, '("#", 3(1x, a), 1x, "(", i0, "/", i0, ")")') &
+ & "Starting", testsuite(ii)%name, "...", ii, size(testsuite)
call testsuite(ii)%test(error)
if (allocated(error) .neqv. testsuite(ii)%should_fail) then
if (testsuite(ii)%should_fail) then
@@ -90,7 +92,7 @@ contains
end if
end if
if (allocated(error)) then
- write(unit, '(a)') error%message
+ write(unit, fmt) "Message:", error%message
end if
end do
@@ -119,4 +121,32 @@ contains
end function new_unittest
+ !> Check a deferred length character variable against a reference value
+ subroutine check_string(error, actual, expected, name)
+
+ !> Error handling
+ type(error_t), allocatable, intent(out) :: error
+
+ !> Actual string value
+ character(len=:), allocatable, intent(in) :: actual
+
+ !> Expected string value
+ character(len=*), intent(in) :: expected
+
+ !> Name of the string to check
+ character(len=*), intent(in) :: name
+
+ if (.not.allocated(actual)) then
+ call test_failed(error, name//" is not set correctly")
+ return
+ end if
+
+ if (actual /= expected) then
+ call test_failed(error, name//" is "//actual// &
+ & " but should be "//expected)
+ end if
+
+ end subroutine check_string
+
+
end module testsuite
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-15 15:25:06 +0000