aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLKedward <laurence.kedward@bristol.ac.uk>2020-11-01 09:16:52 +0000
committerLKedward <laurence.kedward@bristol.ac.uk>2020-11-01 10:37:32 +0000
commit8096ba728f770fb0eb9fcea863d5177bb294770f (patch)
tree8b49bf4032318368e47d5ea6bd451eaf24f6b331
parent436573bc4d110d7a9881d4dd3ae1d56ac99d9144 (diff)
downloadfpm-8096ba728f770fb0eb9fcea863d5177bb294770f.tar.gz
fpm-8096ba728f770fb0eb9fcea863d5177bb294770f.zip
Intermediate: separate out build targets from sources
A new module and type for build targets. List of build targets is generated from the list of sources.
-rw-r--r--fpm/src/fpm.f9028
-rw-r--r--fpm/src/fpm_backend.f90166
-rw-r--r--fpm/src/fpm_model.f9036
-rw-r--r--fpm/src/fpm_sources.f90105
-rw-r--r--fpm/src/fpm_targets.f90220
-rw-r--r--fpm/test/fpm_test/test_module_dependencies.f90315
6 files changed, 549 insertions, 321 deletions
diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90
index 575b654..571eb10 100644
--- a/fpm/src/fpm.f90
+++ b/fpm/src/fpm.f90
@@ -5,12 +5,12 @@ use fpm_command_line, only: fpm_build_settings, fpm_new_settings, &
fpm_run_settings, fpm_install_settings, fpm_test_settings
use fpm_environment, only: run
use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, basename
-use fpm_model, only: srcfile_ptr, srcfile_t, fpm_model_t, &
+use fpm_model, only: fpm_model_t, srcfile_t, build_target_t, &
FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, &
FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST
-use fpm_sources, only: add_executable_sources, add_sources_from_dir, &
- resolve_module_dependencies
+use fpm_sources, only: add_executable_sources, add_sources_from_dir
+use fpm_targets, only: targets_from_sources, resolve_module_dependencies
use fpm_manifest, only : get_package_data, default_executable, &
default_library, package_t, default_test
use fpm_error, only : error_t, fatal_error
@@ -150,6 +150,7 @@ subroutine build_model(model, settings, package, error)
type(error_t), allocatable, intent(out) :: error
integer :: i
+ type(srcfile_t), allocatable :: sources(:)
type(string_t), allocatable :: package_list(:)
model%package_name = package%name
@@ -180,7 +181,7 @@ subroutine build_model(model, settings, package, error)
! Add sources from executable directories
if (is_dir('app') .and. package%build_config%auto_executables) then
- call add_sources_from_dir(model%sources,'app', FPM_SCOPE_APP, &
+ call add_sources_from_dir(sources,'app', FPM_SCOPE_APP, &
with_executables=.true., error=error)
if (allocated(error)) then
@@ -189,7 +190,7 @@ subroutine build_model(model, settings, package, error)
end if
if (is_dir('test') .and. package%build_config%auto_tests) then
- call add_sources_from_dir(model%sources,'test', FPM_SCOPE_TEST, &
+ call add_sources_from_dir(sources,'test', FPM_SCOPE_TEST, &
with_executables=.true., error=error)
if (allocated(error)) then
@@ -198,7 +199,7 @@ subroutine build_model(model, settings, package, error)
end if
if (allocated(package%executable)) then
- call add_executable_sources(model%sources, package%executable, FPM_SCOPE_APP, &
+ call add_executable_sources(sources, package%executable, FPM_SCOPE_APP, &
auto_discover=package%build_config%auto_executables, &
error=error)
@@ -208,7 +209,7 @@ subroutine build_model(model, settings, package, error)
end if
if (allocated(package%test)) then
- call add_executable_sources(model%sources, package%test, FPM_SCOPE_TEST, &
+ call add_executable_sources(sources, package%test, FPM_SCOPE_TEST, &
auto_discover=package%build_config%auto_tests, &
error=error)
@@ -219,20 +220,23 @@ subroutine build_model(model, settings, package, error)
endif
! Add library sources, including local dependencies
- call add_libsources_from_package(model%sources,package_list,package, &
+ call add_libsources_from_package(sources,package_list,package, &
package_root='.',dev_depends=.true.,error=error)
if (allocated(error)) then
return
end if
if(settings%list)then
- do i=1,size(model%sources)
- write(stderr,'(*(g0,1x))')'fpm::build<INFO>:file expected at',model%sources(i)%file_name, &
- & merge('exists ','does not exist',exists(model%sources(i)%file_name) )
+ do i=1,size(sources)
+ write(stderr,'(*(g0,1x))')'fpm::build<INFO>:file expected at',sources(i)%file_name, &
+ & merge('exists ','does not exist',exists(sources(i)%file_name) )
enddo
stop
else
- call resolve_module_dependencies(model%sources,error)
+
+ call targets_from_sources(model%targets,sources,model%package_name)
+
+ call resolve_module_dependencies(model%targets,error)
endif
end subroutine build_model
diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90
index d7005bf..2706b79 100644
--- a/fpm/src/fpm_backend.f90
+++ b/fpm/src/fpm_backend.f90
@@ -7,7 +7,7 @@ use fpm_filesystem, only: basename, dirname, join_path, exists, mkdir
use fpm_model, only: fpm_model_t, srcfile_t, FPM_UNIT_MODULE, &
FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, &
FPM_UNIT_CSOURCE, FPM_UNIT_PROGRAM, &
- FPM_SCOPE_TEST
+ FPM_SCOPE_TEST, build_target_t
use fpm_strings, only: split
@@ -22,137 +22,107 @@ contains
subroutine build_package(model)
type(fpm_model_t), intent(inout) :: model
- integer :: i
- character(:), allocatable :: base, linking, subdir
+ ! integer :: i
+ ! character(:), allocatable :: base, linking, subdir
- if (.not.exists(model%output_directory)) then
- call mkdir(model%output_directory)
- end if
- if (.not.exists(join_path(model%output_directory,model%package_name))) then
- call mkdir(join_path(model%output_directory,model%package_name))
- end if
+ ! if (.not.exists(model%output_directory)) then
+ ! call mkdir(model%output_directory)
+ ! end if
+ ! if (.not.exists(join_path(model%output_directory,model%package_name))) then
+ ! call mkdir(join_path(model%output_directory,model%package_name))
+ ! end if
- linking = ""
- do i=1,size(model%sources)
+ ! linking = ""
+ ! do i=1,size(model%targets)
- if (model%sources(i)%unit_type == FPM_UNIT_MODULE .or. &
- model%sources(i)%unit_type == FPM_UNIT_SUBMODULE .or. &
- model%sources(i)%unit_type == FPM_UNIT_SUBPROGRAM .or. &
- model%sources(i)%unit_type == FPM_UNIT_CSOURCE) then
+ ! ! if (model%sources(i)%unit_type == FPM_UNIT_MODULE .or. &
+ ! ! model%sources(i)%unit_type == FPM_UNIT_SUBMODULE .or. &
+ ! ! model%sources(i)%unit_type == FPM_UNIT_SUBPROGRAM .or. &
+ ! ! model%sources(i)%unit_type == FPM_UNIT_CSOURCE) then
- call build_source(model,model%sources(i),linking)
+ ! call build_source(model,model%sources(i),linking)
- end if
+ ! ! end if
- end do
+ ! end do
- if (any([(model%sources(i)%unit_type == FPM_UNIT_PROGRAM,i=1,size(model%sources))])) then
- if (.not.exists(join_path(model%output_directory,'test'))) then
- call mkdir(join_path(model%output_directory,'test'))
- end if
- if (.not.exists(join_path(model%output_directory,'app'))) then
- call mkdir(join_path(model%output_directory,'app'))
- end if
- end if
+ ! if (any([(model%sources(i)%unit_type == FPM_UNIT_PROGRAM,i=1,size(model%sources))])) then
+ ! if (.not.exists(join_path(model%output_directory,'test'))) then
+ ! call mkdir(join_path(model%output_directory,'test'))
+ ! end if
+ ! if (.not.exists(join_path(model%output_directory,'app'))) then
+ ! call mkdir(join_path(model%output_directory,'app'))
+ ! end if
+ ! end if
- do i=1,size(model%sources)
+ ! do i=1,size(model%sources)
- if (model%sources(i)%unit_type == FPM_UNIT_PROGRAM) then
+ ! if (model%sources(i)%unit_type == FPM_UNIT_PROGRAM) then
- base = basename(model%sources(i)%file_name,suffix=.false.)
+ ! base = basename(model%sources(i)%file_name,suffix=.false.)
- if (model%sources(i)%unit_scope == FPM_SCOPE_TEST) then
- subdir = 'test'
- else
- subdir = 'app'
- end if
+ ! if (model%sources(i)%unit_scope == FPM_SCOPE_TEST) then
+ ! subdir = 'test'
+ ! else
+ ! subdir = 'app'
+ ! end if
- call run("gfortran -c " // model%sources(i)%file_name // ' '//model%fortran_compile_flags &
- // " -o " // join_path(model%output_directory,subdir,base) // ".o")
+ ! call run("gfortran -c " // model%sources(i)%file_name // ' '//model%fortran_compile_flags &
+ ! // " -o " // join_path(model%output_directory,subdir,base) // ".o")
- call run("gfortran " // join_path(model%output_directory, subdir, base) // ".o "// &
- linking //" " //model%link_flags // " -o " // &
- join_path(model%output_directory,subdir,model%sources(i)%exe_name) )
+ ! call run("gfortran " // join_path(model%output_directory, subdir, base) // ".o "// &
+ ! linking //" " //model%link_flags // " -o " // &
+ ! join_path(model%output_directory,subdir,model%sources(i)%exe_name) )
- end if
+ ! end if
- end do
+ ! end do
end subroutine build_package
-recursive subroutine build_source(model,source_file,linking)
+recursive subroutine build_target(model,target,linking)
! Compile Fortran source, called recursively on it dependents
!
type(fpm_model_t), intent(in) :: model
- type(srcfile_t), intent(inout) :: source_file
+ type(build_target_t), intent(inout) :: target
character(:), allocatable, intent(inout) :: linking
- integer :: i
- character(:), allocatable :: object_file
+ ! integer :: i
+ ! character(:), allocatable :: object_file
- if (source_file%built) then
- return
- end if
+ ! if (source_file%built) then
+ ! return
+ ! end if
- if (source_file%touched) then
- write(*,*) '(!) Circular dependency found with: ',source_file%file_name
- stop
- else
- source_file%touched = .true.
- end if
+ ! if (source_file%touched) then
+ ! write(*,*) '(!) Circular dependency found with: ',source_file%file_name
+ ! stop
+ ! else
+ ! source_file%touched = .true.
+ ! end if
- do i=1,size(source_file%file_dependencies)
+ ! do i=1,size(source_file%file_dependencies)
- if (associated(source_file%file_dependencies(i)%ptr)) then
- call build_source(model,source_file%file_dependencies(i)%ptr,linking)
- end if
+ ! if (associated(source_file%file_dependencies(i)%ptr)) then
+ ! call build_source(model,source_file%file_dependencies(i)%ptr,linking)
+ ! end if
- end do
+ ! end do
- object_file = get_object_name(model,source_file%file_name)
+ ! object_file = get_object_name(model,source_file%file_name)
- if (.not.exists(dirname(object_file))) then
- call mkdir(dirname(object_file))
- end if
+ ! if (.not.exists(dirname(object_file))) then
+ ! call mkdir(dirname(object_file))
+ ! end if
- call run("gfortran -c " // source_file%file_name // model%fortran_compile_flags &
- // " -o " // object_file)
- linking = linking // " " // object_file
+ ! call run("gfortran -c " // source_file%file_name // model%fortran_compile_flags &
+ ! // " -o " // object_file)
+ ! linking = linking // " " // object_file
- source_file%built = .true.
+ ! source_file%built = .true.
-end subroutine build_source
-
-
-function get_object_name(model,source_file_name) result(object_file)
- ! Generate object target path from source name and model params
- !
- ! src/test.f90 -> <output-dir>/<package-name>/test.o
- ! src/subdir/test.f90 -> <output-dir>/<package-name>/subdir_test.o
- !
- type(fpm_model_t), intent(in) :: model
- character(*), intent(in) :: source_file_name
- character(:), allocatable :: object_file
-
- integer :: i
- character(1) :: filesep
-
- select case(get_os_type())
- case (OS_WINDOWS)
- filesep = '\'
- case default
- filesep = '/'
- end select
-
- ! Exclude first directory level from path
- object_file = source_file_name(index(source_file_name,filesep)+1:)
-
- ! Construct full target path
- object_file = join_path(model%output_directory, model%package_name, &
- object_file//'.o')
-
-end function get_object_name
+end subroutine build_target
end module fpm_backend
diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90
index 36086df..44b7d39 100644
--- a/fpm/src/fpm_model.f90
+++ b/fpm/src/fpm_model.f90
@@ -4,12 +4,14 @@ use fpm_strings, only: string_t
implicit none
private
-public :: srcfile_ptr, srcfile_t, fpm_model_t
+public :: fpm_model_t, srcfile_t, build_target_t, build_target_ptr
public :: FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, &
FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, &
FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, &
- FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST
+ FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST, &
+ FPM_TARGET_UNKNOWN, FPM_TARGET_EXECUTABLE, FPM_TARGET_ARCHIVE, &
+ FPM_TARGET_OBJECT
integer, parameter :: FPM_UNIT_UNKNOWN = -1
integer, parameter :: FPM_UNIT_PROGRAM = 1
@@ -25,10 +27,10 @@ integer, parameter :: FPM_SCOPE_DEP = 2
integer, parameter :: FPM_SCOPE_APP = 3
integer, parameter :: FPM_SCOPE_TEST = 4
-type srcfile_ptr
- ! For constructing arrays of src_file pointers
- type(srcfile_t), pointer :: ptr => null()
-end type srcfile_ptr
+integer, parameter :: FPM_TARGET_UNKNOWN = -1
+integer, parameter :: FPM_TARGET_EXECUTABLE = 1
+integer, parameter :: FPM_TARGET_ARCHIVE = 2
+integer, parameter :: FPM_TARGET_OBJECT = 3
type srcfile_t
! Type for encapsulating a source file
@@ -49,17 +51,31 @@ type srcfile_t
! Modules USEd by this source file (lowerstring)
type(string_t), allocatable :: include_dependencies(:)
! Files INCLUDEd by this source file
- type(srcfile_ptr), allocatable :: file_dependencies(:)
- ! Resolved source file dependencies
+end type srcfile_t
+
+type build_target_ptr
+ ! For constructing arrays of build_target_t pointers
+ type(build_target_t), pointer :: ptr => null()
+end type build_target_ptr
+
+type build_target_t
+ character(:), allocatable :: output_file
+ ! File path of build target object relative to cwd
+ type(srcfile_t), allocatable :: source
+ ! Primary source for this build target
+ type(build_target_ptr), allocatable :: dependencies(:)
+ ! Resolved build dependencies
+ integer :: target_type = FPM_TARGET_UNKNOWN
logical :: built = .false.
logical :: touched = .false.
-end type srcfile_t
+
+end type build_target_t
type :: fpm_model_t
character(:), allocatable :: package_name
! Name of package
- type(srcfile_t), allocatable :: sources(:)
+ type(build_target_ptr), allocatable :: targets(:)
! Array of sources with module-dependencies resolved
character(:), allocatable :: fortran_compiler
! Command line name to invoke fortran compiler
diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90
index 6ad8815..35b769b 100644
--- a/fpm/src/fpm_sources.f90
+++ b/fpm/src/fpm_sources.f90
@@ -1,7 +1,6 @@
module fpm_sources
use fpm_error, only: error_t, fatal_error
-use fpm_model, only: srcfile_ptr, srcfile_t, &
- FPM_UNIT_PROGRAM, &
+use fpm_model, only: srcfile_t, FPM_UNIT_PROGRAM, &
FPM_SCOPE_LIB, FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST
use fpm_filesystem, only: basename, canon_path, dirname, join_path, list_files
@@ -11,7 +10,7 @@ use fpm_source_parsing, only: parse_source
implicit none
private
-public :: add_sources_from_dir, add_executable_sources, resolve_module_dependencies
+public :: add_sources_from_dir, add_executable_sources
contains
@@ -171,104 +170,4 @@ subroutine get_executable_source_dirs(exe_dirs,executables)
end subroutine get_executable_source_dirs
-subroutine resolve_module_dependencies(sources,error)
- ! After enumerating all source files: resolve file dependencies
- ! by searching on module names
- !
- type(srcfile_t), intent(inout), target :: sources(:)
- type(error_t), allocatable, intent(out) :: error
-
- type(srcfile_ptr) :: dep
-
- integer :: n_depend, i, pass, j
-
- do i=1,size(sources)
-
- do pass=1,2
-
- n_depend = 0
-
- do j=1,size(sources(i)%modules_used)
-
- if (sources(i)%modules_used(j)%s .in. sources(i)%modules_provided) then
- ! Dependency satisfied in same file, skip
- cycle
- end if
-
- if (sources(i)%unit_scope == FPM_SCOPE_APP .OR. &
- sources(i)%unit_scope == FPM_SCOPE_TEST ) then
- dep%ptr => &
- find_module_dependency(sources,sources(i)%modules_used(j)%s, &
- include_dir = dirname(sources(i)%file_name))
- else
- dep%ptr => &
- find_module_dependency(sources,sources(i)%modules_used(j)%s)
- end if
-
- if (.not.associated(dep%ptr)) then
- call fatal_error(error, &
- 'Unable to find source for module dependency: "' // &
- sources(i)%modules_used(j)%s // &
- '" used by "'//sources(i)%file_name//'"')
- return
- end if
-
- n_depend = n_depend + 1
-
- if (pass == 2) then
- sources(i)%file_dependencies(n_depend) = dep
- end if
-
- end do
-
- if (pass == 1) then
- allocate(sources(i)%file_dependencies(n_depend))
- end if
-
- end do
-
- end do
-
-end subroutine resolve_module_dependencies
-
-function find_module_dependency(sources,module_name,include_dir) result(src_ptr)
- ! Find a module dependency in the library or a dependency library
- !
- ! 'include_dir' specifies an allowable non-library search directory
- ! (Used for executable dependencies)
- !
- type(srcfile_t), intent(in), target :: sources(:)
- character(*), intent(in) :: module_name
- character(*), intent(in), optional :: include_dir
- type(srcfile_t), pointer :: src_ptr
-
- integer :: k, l
-
- src_ptr => NULL()
-
- do k=1,size(sources)
-
- do l=1,size(sources(k)%modules_provided)
-
- if (module_name == sources(k)%modules_provided(l)%s) then
- select case(sources(k)%unit_scope)
- case (FPM_SCOPE_LIB, FPM_SCOPE_DEP)
- src_ptr => sources(k)
- exit
- case default
- if (present(include_dir)) then
- if (dirname(sources(k)%file_name) == include_dir) then
- src_ptr => sources(k)
- exit
- end if
- end if
- end select
- end if
-
- end do
-
- end do
-
-end function find_module_dependency
-
end module fpm_sources
diff --git a/fpm/src/fpm_targets.f90 b/fpm/src/fpm_targets.f90
new file mode 100644
index 0000000..dfdc9af
--- /dev/null
+++ b/fpm/src/fpm_targets.f90
@@ -0,0 +1,220 @@
+module fpm_targets
+use fpm_error, only: error_t, fatal_error
+use fpm_model!, only: srcfile_t, build_target_t, FPM_UNIT_PROGRAM, &
+ ! FPM_TARGET_EXECUTABLE, FPM_TARGET_ARCHIVE, FPM_TARGET_OBJECT
+use fpm_environment, only: get_os_type, OS_WINDOWS
+use fpm_filesystem, only: dirname, join_path
+use fpm_strings, only: operator(.in.)
+implicit none
+
+contains
+
+subroutine targets_from_sources(targets,sources,package_name)
+ type(build_target_ptr), allocatable, intent(out), target :: targets(:)
+ type(srcfile_t), intent(in) :: sources(:)
+ character(*), intent(in) :: package_name
+
+ integer :: i
+ type(build_target_t), pointer :: dep
+ logical :: with_lib
+
+ with_lib = any([(sources(i)%unit_scope == FPM_SCOPE_LIB,i=1,size(sources))])
+
+ if (with_lib) call add_target(targets,type = FPM_TARGET_ARCHIVE,&
+ output_file = package_name//'.a')
+
+ do i=1,size(sources)
+
+ select case (sources(i)%unit_type)
+ case (FPM_UNIT_MODULE,FPM_UNIT_SUBMODULE,FPM_UNIT_SUBPROGRAM,FPM_UNIT_CSOURCE)
+
+ call add_target(targets,source = sources(i), &
+ type = FPM_TARGET_OBJECT,&
+ output_file = get_object_name(sources(i)%file_name))
+
+ if (with_lib .and. sources(i)%unit_scope == FPM_SCOPE_LIB) then
+ ! Archive depends on object
+ call add_dependency(targets(1)%ptr, targets(size(targets))%ptr)
+ end if
+
+ case (FPM_UNIT_PROGRAM)
+
+ call add_target(targets,type = FPM_TARGET_OBJECT,&
+ output_file = get_object_name(sources(i)%file_name), &
+ source = sources(i) &
+ )
+
+ call add_target(targets,type = FPM_TARGET_EXECUTABLE,&
+ output_file = join_path('app',sources(i)%exe_name))
+
+
+ ! Executable depends on object
+ call add_dependency(targets(size(targets))%ptr, targets(size(targets)-1)%ptr)
+
+ if (with_lib) then
+ ! Executable depends on library
+ call add_dependency(targets(size(targets))%ptr, targets(1)%ptr)
+ end if
+
+ end select
+
+ end do
+
+end subroutine targets_from_sources
+
+
+subroutine add_target(targets,type,output_file,source)
+ type(build_target_ptr), allocatable, intent(inout) :: targets(:)
+ integer, intent(in) :: type
+ character(*), intent(in) :: output_file
+ type(srcfile_t), intent(in), optional :: source
+
+ type(build_target_ptr), allocatable :: temp(:)
+ type(build_target_t), pointer :: new_target
+
+ allocate(new_target)
+ new_target%target_type = type
+ new_target%output_file = output_file
+ if (present(source)) new_target%source = source
+ allocate(new_target%dependencies(0))
+
+ if (.not.allocated(targets)) allocate(targets(0))
+ targets = [targets, build_target_ptr(new_target)]
+
+end subroutine add_target
+
+
+subroutine add_dependency(target, dependency)
+ type(build_target_t), intent(inout) :: target
+ type(build_target_t) , intent(in), target :: dependency
+
+ type(build_target_ptr) :: depend
+
+ depend%ptr => dependency
+
+ ! if (.not.allocated(target%dependencies)) then
+ ! allocate(target%dependencies(0))
+ ! end if
+
+ target%dependencies = [target%dependencies, depend]
+ ! target%dependencies(size(target%dependencies))%ptr => dependency
+
+end subroutine add_dependency
+
+
+function get_object_name(source_file_name) result(object_file)
+ ! Generate object target path from source name and model params
+ !
+ ! src/test.f90 -> <output-dir>/<package-name>/test.o
+ ! src/subdir/test.f90 -> <output-dir>/<package-name>/subdir_test.o
+ !
+ character(*), intent(in) :: source_file_name
+ character(:), allocatable :: object_file
+
+ integer :: i
+ character(1) :: filesep
+
+ select case(get_os_type())
+ case (OS_WINDOWS)
+ filesep = '\'
+ case default
+ filesep = '/'
+ end select
+
+ ! Exclude first directory level from path
+ object_file = source_file_name(index(source_file_name,filesep)+1:)//'.o'
+
+end function get_object_name
+
+
+subroutine resolve_module_dependencies(targets,error)
+ ! After enumerating all source files: resolve file dependencies
+ ! by searching on module names
+ !
+ type(build_target_ptr), intent(inout), target :: targets(:)
+ type(error_t), allocatable, intent(out) :: error
+
+ type(build_target_ptr) :: dep
+
+ integer :: i, j
+
+ do i=1,size(targets)
+
+ if (.not.allocated(targets(i)%ptr%source)) cycle
+
+ do j=1,size(targets(i)%ptr%source%modules_used)
+
+ if (targets(i)%ptr%source%modules_used(j)%s .in. targets(i)%ptr%source%modules_provided) then
+ ! Dependency satisfied in same file, skip
+ cycle
+ end if
+
+ if (targets(i)%ptr%source%unit_scope == FPM_SCOPE_APP .OR. &
+ targets(i)%ptr%source%unit_scope == FPM_SCOPE_TEST ) then
+ dep%ptr => &
+ find_module_dependency(targets,targets(i)%ptr%source%modules_used(j)%s, &
+ include_dir = dirname(targets(i)%ptr%source%file_name))
+ else
+ dep%ptr => &
+ find_module_dependency(targets,targets(i)%ptr%source%modules_used(j)%s)
+ end if
+
+ if (.not.associated(dep%ptr)) then
+ call fatal_error(error, &
+ 'Unable to find source for module dependency: "' // &
+ targets(i)%ptr%source%modules_used(j)%s // &
+ '" used by "'//targets(i)%ptr%source%file_name//'"')
+ return
+ end if
+
+ call add_dependency(targets(i)%ptr, dep%ptr)
+
+ end do
+
+ end do
+
+end subroutine resolve_module_dependencies
+
+function find_module_dependency(targets,module_name,include_dir) result(target_ptr)
+ ! Find a module dependency in the library or a dependency library
+ !
+ ! 'include_dir' specifies an allowable non-library search directory
+ ! (Used for executable dependencies)
+ !
+ type(build_target_ptr), intent(in), target :: targets(:)
+ character(*), intent(in) :: module_name
+ character(*), intent(in), optional :: include_dir
+ type(build_target_t), pointer :: target_ptr
+
+ integer :: k, l
+
+ target_ptr => NULL()
+
+ do k=1,size(targets)
+
+ if (.not.allocated(targets(k)%ptr%source)) cycle
+
+ do l=1,size(targets(k)%ptr%source%modules_provided)
+
+ if (module_name == targets(k)%ptr%source%modules_provided(l)%s) then
+ select case(targets(k)%ptr%source%unit_scope)
+ case (FPM_SCOPE_LIB, FPM_SCOPE_DEP)
+ target_ptr => targets(k)%ptr
+ exit
+ case default
+ if (present(include_dir)) then
+ if (dirname(targets(k)%ptr%source%file_name) == include_dir) then
+ target_ptr => targets(k)%ptr
+ exit
+ end if
+ end if
+ end select
+ end if
+
+ end do
+
+ end do
+
+end function find_module_dependency
+
+end module fpm_targets \ No newline at end of file
diff --git a/fpm/test/fpm_test/test_module_dependencies.f90 b/fpm/test/fpm_test/test_module_dependencies.f90
index 481dfb3..1292a39 100644
--- a/fpm/test/fpm_test/test_module_dependencies.f90
+++ b/fpm/test/fpm_test/test_module_dependencies.f90
@@ -1,12 +1,13 @@
!> Define tests for the `fpm_sources` module (module dependency checking)
module test_module_dependencies
use testsuite, only : new_unittest, unittest_t, error_t, test_failed
- use fpm_sources, only: resolve_module_dependencies
- use fpm_model, only: srcfile_t, srcfile_ptr, &
+ use fpm_targets, only: targets_from_sources, resolve_module_dependencies
+ use fpm_model, only: srcfile_t, build_target_t, build_target_ptr, &
FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, &
FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, &
FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, &
- FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST
+ FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST, &
+ FPM_TARGET_EXECUTABLE, FPM_TARGET_OBJECT, FPM_TARGET_ARCHIVE
use fpm_strings, only: string_t
implicit none
private
@@ -14,7 +15,7 @@ module test_module_dependencies
public :: collect_module_dependencies
interface operator(.in.)
- module procedure srcfile_in
+ module procedure target_in
end interface
contains
@@ -51,91 +52,123 @@ contains
type(error_t), allocatable, intent(out) :: error
type(srcfile_t) :: sources(2)
+ type(build_target_ptr), allocatable :: targets(:)
- sources(1) = new_test_module(file_name="src/my_mod_1.f90", &
+ sources(1) = new_test_source(FPM_UNIT_MODULE,file_name="src/my_mod_1.f90", &
scope = FPM_SCOPE_LIB, &
provides=[string_t('my_mod_1')])
- sources(2) = new_test_module(file_name="src/my_mod_2.f90", &
+ sources(2) = new_test_source(FPM_UNIT_MODULE,file_name="src/my_mod_2.f90", &
scope = FPM_SCOPE_LIB, &
provides=[string_t('my_mod_2')], &
uses=[string_t('my_mod_1')])
- call resolve_module_dependencies(sources,error)
+ call targets_from_sources(targets,sources,'test_package')
+ call resolve_module_dependencies(targets,error)
if (allocated(error)) then
return
end if
- if (size(sources(1)%file_dependencies)>0) then
- call test_failed(error,'Incorrect number of file_dependencies - expecting zero')
+ if (size(targets) /= 3) then
+ call test_failed(error,'Incorrect number of targets - expecting three')
return
end if
- if (size(sources(2)%file_dependencies) /= 1) then
- call test_failed(error,'Incorrect number of file_dependencies - expecting one')
- return
- end if
+ call check_target(targets(1)%ptr,type=FPM_TARGET_ARCHIVE,n_depends=2, &
+ deps = [targets(2),targets(3)],error=error)
+
+ if (allocated(error)) return
- if (.not.(sources(1) .in. sources(2)%file_dependencies)) then
- call test_failed(error,'Missing file in file_dependencies')
- return
- end if
+
+ call check_target(targets(2)%ptr,type=FPM_TARGET_OBJECT,n_depends=0, &
+ source=sources(1),error=error)
+
+ if (allocated(error)) return
+
+
+ call check_target(targets(3)%ptr,type=FPM_TARGET_OBJECT,n_depends=1, &
+ deps=[targets(2)],source=sources(2),error=error)
+
+ if (allocated(error)) return
end subroutine test_library_module_use
- !> Check program using a library module
+ !> Check a program using a library module
+ !> Each program generates two targets: object file and executable
+ !>
subroutine test_program_module_use(error)
!> Error handling
type(error_t), allocatable, intent(out) :: error
+ call test_scope(FPM_SCOPE_APP,error)
+ if (allocated(error)) return
+
+ call test_scope(FPM_SCOPE_TEST,error)
+ if (allocated(error)) return
+
+ contains
+
+ subroutine test_scope(exe_scope,error)
+ integer, intent(in) :: exe_scope
+ type(error_t), allocatable, intent(out) :: error
+
integer :: i
type(srcfile_t) :: sources(3)
+ type(build_target_ptr), allocatable :: targets(:)
+ character(:), allocatable :: scope_str
+
+ scope_str = merge('FPM_SCOPE_APP ','FPM_SCOPE_TEST',exe_scope==FPM_SCOPE_APP)//' - '
- sources(1) = new_test_module(file_name="src/my_mod_1.f90", &
+ sources(1) = new_test_source(FPM_UNIT_MODULE,file_name="src/my_mod_1.f90", &
scope = FPM_SCOPE_LIB, &
provides=[string_t('my_mod_1')])
- sources(2) = new_test_program(file_name="app/my_program.f90", &
- scope=FPM_SCOPE_APP, &
+ sources(2) = new_test_source(FPM_UNIT_PROGRAM,file_name="app/my_program.f90", &
+ scope=exe_scope, &
uses=[string_t('my_mod_1')])
- sources(3) = new_test_program(file_name="test/my_test.f90", &
- scope=FPM_SCOPE_TEST, &
- uses=[string_t('my_mod_1')])
-
- call resolve_module_dependencies(sources,error)
+ call targets_from_sources(targets,sources,'')
+ call resolve_module_dependencies(targets,error)
if (allocated(error)) then
return
end if
- if (size(sources(1)%file_dependencies)>0) then
- call test_failed(error,'Incorrect number of file_dependencies - expecting zero')
+ if (size(targets) /= 4) then
+ call test_failed(error,scope_str//'Incorrect number of targets - expecting three')
return
end if
- do i=2,3
+ call check_target(targets(1)%ptr,type=FPM_TARGET_ARCHIVE,n_depends=1, &
+ deps=[targets(2)],error=error)
+
+ if (allocated(error)) return
- if (size(sources(i)%file_dependencies) /= 1) then
- call test_failed(error,'Incorrect number of file_dependencies - expecting one')
- return
- end if
+ call check_target(targets(2)%ptr,type=FPM_TARGET_OBJECT,n_depends=0, &
+ source=sources(1),error=error)
- if (.not.(sources(1) .in. sources(i)%file_dependencies)) then
- call test_failed(error,'Missing file in file_dependencies')
- return
- end if
+ if (allocated(error)) return
+
+ call check_target(targets(3)%ptr,type=FPM_TARGET_OBJECT,n_depends=1, &
+ deps=[targets(2)],source=sources(2),error=error)
+
+ if (allocated(error)) return
+
+ call check_target(targets(4)%ptr,type=FPM_TARGET_EXECUTABLE,n_depends=2, &
+ deps=[targets(1),targets(3)],error=error)
+
+ if (allocated(error)) return
+
+ end subroutine test_scope
- end do
-
end subroutine test_program_module_use
!> Check program with module in single source file
- !> (Resulting source object should not include itself as a file dependency)
+ !> (Resulting target should not include itself as a dependency)
subroutine test_program_with_module(error)
!> Error handling
@@ -143,22 +176,35 @@ contains
integer :: i
type(srcfile_t) :: sources(1)
+ type(build_target_ptr), allocatable :: targets(:)
- sources(1) = new_test_module(file_name="app/my_program.f90", &
+ sources(1) = new_test_source(FPM_UNIT_PROGRAM,file_name="app/my_program.f90", &
scope = FPM_SCOPE_APP, &
provides=[string_t('app_mod')], &
uses=[string_t('app_mod')])
- call resolve_module_dependencies(sources,error)
+ call targets_from_sources(targets,sources,'')
+ call resolve_module_dependencies(targets,error)
if (allocated(error)) then
return
end if
- if (size(sources(1)%file_dependencies)>0) then
- call test_failed(error,'Incorrect number of file_dependencies - expecting zero')
+ if (size(targets) /= 2) then
+ write(*,*) size(targets)
+ call test_failed(error,'Incorrect number of targets - expecting two')
return
end if
+
+ call check_target(targets(1)%ptr,type=FPM_TARGET_OBJECT,n_depends=0, &
+ source=sources(1),error=error)
+
+ if (allocated(error)) return
+
+ call check_target(targets(2)%ptr,type=FPM_TARGET_EXECUTABLE,n_depends=1, &
+ deps=[targets(1)],error=error)
+
+ if (allocated(error)) return
end subroutine test_program_with_module
@@ -169,37 +215,61 @@ contains
!> Error handling
type(error_t), allocatable, intent(out) :: error
+ call test_scope(FPM_SCOPE_APP,error)
+ if (allocated(error)) return
+
+ call test_scope(FPM_SCOPE_TEST,error)
+ if (allocated(error)) return
+
+ contains
+
+ subroutine test_scope(exe_scope,error)
+ integer, intent(in) :: exe_scope
+ type(error_t), allocatable, intent(out) :: error
+
type(srcfile_t) :: sources(2)
+ type(build_target_ptr), allocatable :: targets(:)
+ character(:), allocatable :: scope_str
- sources(1) = new_test_module(file_name="app/app_mod.f90", &
- scope = FPM_SCOPE_APP, &
+ scope_str = merge('FPM_SCOPE_APP ','FPM_SCOPE_TEST',exe_scope==FPM_SCOPE_APP)//' - '
+
+ sources(1) = new_test_source(FPM_UNIT_MODULE,file_name="app/app_mod.f90", &
+ scope = exe_scope, &
provides=[string_t('app_mod')])
- sources(2) = new_test_program(file_name="app/my_program.f90", &
- scope=FPM_SCOPE_APP, &
+ sources(2) = new_test_source(FPM_UNIT_PROGRAM,file_name="app/my_program.f90", &
+ scope=exe_scope, &
uses=[string_t('app_mod')])
- call resolve_module_dependencies(sources,error)
+ call targets_from_sources(targets,sources,'')
+ call resolve_module_dependencies(targets,error)
if (allocated(error)) then
return
end if
- if (size(sources(1)%file_dependencies)>0) then
- call test_failed(error,'Incorrect number of file_dependencies - expecting zero')
+ if (size(targets) /= 3) then
+ call test_failed(error,scope_str//'Incorrect number of targets - expecting three')
return
end if
- if (size(sources(2)%file_dependencies) /= 1) then
- call test_failed(error,'Incorrect number of file_dependencies - expecting one')
- return
- end if
- if (.not.(sources(1) .in. sources(2)%file_dependencies)) then
- call test_failed(error,'Missing file in file_dependencies')
- return
- end if
+ call check_target(targets(1)%ptr,type=FPM_TARGET_OBJECT,n_depends=0, &
+ source=sources(1),error=error)
+
+ if (allocated(error)) return
+
+ call check_target(targets(2)%ptr,type=FPM_TARGET_OBJECT,n_depends=1, &
+ source=sources(2),deps=[targets(1)],error=error)
+ if (allocated(error)) return
+
+ call check_target(targets(3)%ptr,type=FPM_TARGET_EXECUTABLE,n_depends=1, &
+ deps=[targets(2)],error=error)
+
+ if (allocated(error)) return
+
+ end subroutine test_scope
end subroutine test_program_own_module_use
@@ -210,17 +280,19 @@ contains
type(error_t), allocatable, intent(out) :: error
type(srcfile_t) :: sources(2)
+ type(build_target_ptr), allocatable :: targets(:)
- sources(1) = new_test_module(file_name="src/my_mod_1.f90", &
+ sources(1) = new_test_source(FPM_UNIT_MODULE,file_name="src/my_mod_1.f90", &
scope = FPM_SCOPE_LIB, &
provides=[string_t('my_mod_1')])
- sources(2) = new_test_module(file_name="src/my_mod_2.f90", &
+ sources(2) = new_test_source(FPM_UNIT_MODULE,file_name="src/my_mod_2.f90", &
scope = FPM_SCOPE_LIB, &
provides=[string_t('my_mod_2')], &
uses=[string_t('my_mod_3')])
- call resolve_module_dependencies(sources,error)
+ call targets_from_sources(targets,sources,'')
+ call resolve_module_dependencies(targets,error)
end subroutine test_missing_library_use
@@ -232,16 +304,18 @@ contains
type(error_t), allocatable, intent(out) :: error
type(srcfile_t) :: sources(2)
+ type(build_target_ptr), allocatable :: targets(:)
- sources(1) = new_test_module(file_name="src/my_mod_1.f90", &
+ sources(1) = new_test_source(FPM_UNIT_MODULE,file_name="src/my_mod_1.f90", &
scope = FPM_SCOPE_LIB, &
provides=[string_t('my_mod_1')])
- sources(2) = new_test_program(file_name="app/my_program.f90", &
+ sources(2) = new_test_source(FPM_UNIT_PROGRAM,file_name="app/my_program.f90", &
scope=FPM_SCOPE_APP, &
uses=[string_t('my_mod_2')])
- call resolve_module_dependencies(sources,error)
+ call targets_from_sources(targets,sources,'')
+ call resolve_module_dependencies(targets,error)
end subroutine test_missing_program_use
@@ -253,17 +327,19 @@ contains
type(error_t), allocatable, intent(out) :: error
type(srcfile_t) :: sources(2)
+ type(build_target_ptr), allocatable :: targets(:)
- sources(1) = new_test_module(file_name="app/app_mod.f90", &
+ sources(1) = new_test_source(FPM_UNIT_MODULE,file_name="app/app_mod.f90", &
scope = FPM_SCOPE_APP, &
provides=[string_t('app_mod')])
- sources(2) = new_test_module(file_name="src/my_mod.f90", &
+ sources(2) = new_test_source(FPM_UNIT_MODULE,file_name="src/my_mod.f90", &
scope = FPM_SCOPE_LIB, &
provides=[string_t('my_mod')], &
uses=[string_t('app_mod')])
- call resolve_module_dependencies(sources,error)
+ call targets_from_sources(targets,sources,'')
+ call resolve_module_dependencies(targets,error)
end subroutine test_invalid_library_use
@@ -275,22 +351,25 @@ contains
type(error_t), allocatable, intent(out) :: error
type(srcfile_t) :: sources(2)
+ type(build_target_ptr), allocatable :: targets(:)
- sources(1) = new_test_module(file_name="app/subdir/app_mod.f90", &
+ sources(1) = new_test_source(FPM_UNIT_MODULE,file_name="app/subdir/app_mod.f90", &
scope = FPM_SCOPE_APP, &
provides=[string_t('app_mod')])
- sources(2) = new_test_program(file_name="app/my_program.f90", &
+ sources(2) = new_test_source(FPM_UNIT_PROGRAM,file_name="app/my_program.f90", &
scope=FPM_SCOPE_APP, &
uses=[string_t('app_mod')])
- call resolve_module_dependencies(sources,error)
+ call targets_from_sources(targets,sources,'')
+ call resolve_module_dependencies(targets,error)
end subroutine test_invalid_own_module_use
- !> Helper to create a new srcfile_t for a module
- function new_test_module(file_name, scope, uses, provides) result(src)
+ !> Helper to create a new srcfile_t
+ function new_test_source(type,file_name, scope, uses, provides) result(src)
+ integer, intent(in) :: type
character(*), intent(in) :: file_name
integer, intent(in) :: scope
type(string_t), intent(in), optional :: uses(:)
@@ -299,7 +378,7 @@ contains
src%file_name = file_name
src%unit_scope = scope
- src%unit_type = FPM_UNIT_MODULE
+ src%unit_type = type
if (present(provides)) then
src%modules_provided = provides
@@ -315,49 +394,89 @@ contains
allocate(src%include_dependencies(0))
- end function new_test_module
+ end function new_test_source
- !> Helper to create a new srcfile_t for a program
- function new_test_program(file_name, scope, uses) result(src)
- character(*), intent(in) :: file_name
- integer, intent(in) :: scope
- type(string_t), intent(in), optional :: uses(:)
- type(srcfile_t) :: src
+ !> Helper to check an expected output target
+ subroutine check_target(target,type,n_depends,deps,source,error)
+ type(build_target_t), intent(in) :: target
+ integer, intent(in) :: type
+ integer, intent(in) :: n_depends
+ type(srcfile_t), intent(in), optional :: source
+ type(build_target_ptr), intent(in), optional :: deps(:)
+ type(error_t), intent(out), allocatable :: error
- src%file_name = file_name
- src%unit_scope = scope
- src%unit_type = FPM_UNIT_PROGRAM
+ integer :: i
- if (present(uses)) then
- src%modules_used = uses
- else
- allocate(src%modules_used(0))
+ if (target%target_type /= type) then
+ call test_failed(error,'Unexpected target_type for target "'//target%output_file//'"')
+ return
end if
- allocate(src%modules_provided(0))
- allocate(src%include_dependencies(0))
+ if (size(target%dependencies) /= n_depends) then
+ call test_failed(error,'Wrong number of dependencies for target "'//target%output_file//'"')
+ return
+ end if
+
+ if (present(deps)) then
- end function new_test_program
+ do i=1,size(deps)
+ if (.not.(deps(i)%ptr .in. target%dependencies)) then
+ call test_failed(error,'Missing dependency ('//deps(i)%ptr%output_file//&
+ ') for target "'//target%output_file//'"')
+ return
+ end if
+
+ end do
+
+ end if
- !> Helper to check if a srcfile is in a list of srcfile_ptr
- logical function srcfile_in(needle,haystack)
- type(srcfile_t), intent(in), target :: needle
- type(srcfile_ptr), intent(in) :: haystack(:)
+ if (present(source)) then
+
+ if (allocated(target%source)) then
+ if (target%source%file_name /= source%file_name) then
+ call test_failed(error,'Incorrect source ('//target%source%file_name//') for target "'//&
+ target%output_file//'"'//new_line('a')//' expected "'//source%file_name//'"')
+ return
+ end if
+
+ else
+ call test_failed(error,'Expecting source for target "'//target%output_file//'" but none found')
+ return
+ end if
+
+ else
+
+ if (allocated(target%source)) then
+ call test_failed(error,'Found source ('//target%source%file_name//') for target "'//&
+ target%output_file//'" but none expected')
+ return
+ end if
+
+ end if
+
+ end subroutine check_target
+
+
+ !> Helper to check if a build target is in a list of build_target_ptr
+ logical function target_in(needle,haystack)
+ type(build_target_t), intent(in), target :: needle
+ type(build_target_ptr), intent(in) :: haystack(:)
integer :: i
- srcfile_in = .false.
+ target_in = .false.
do i=1,size(haystack)
if (associated(haystack(i)%ptr,needle)) then
- srcfile_in = .true.
+ target_in = .true.
return
end if
end do
- end function srcfile_in
+ end function target_in
+
end module test_module_dependencies