From 3f6c74ff3a9f009246634b860a5805be475749e2 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sun, 27 Sep 2020 11:41:36 +0100 Subject: [PATCH 01/17] Update: to enable local path dependencies Adds recursive source discovery for local path dependencies --- fpm/src/fpm.f90 | 107 +++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 96 insertions(+), 11 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 7c99b13f97..7ace32c3e7 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -1,6 +1,5 @@ module fpm - -use fpm_strings, only: string_t, str_ends_with +use fpm_strings, only: string_t, str_ends_with, operator(.in.) use fpm_backend, only: build_package use fpm_command_line, only: fpm_build_settings, fpm_new_settings, & fpm_run_settings, fpm_install_settings, fpm_test_settings @@ -14,7 +13,7 @@ module fpm resolve_module_dependencies use fpm_manifest, only : get_package_data, default_executable, & default_library, package_t -use fpm_error, only : error_t +use fpm_error, only : error_t, fatal_error use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & & stderr=>error_unit @@ -25,6 +24,90 @@ module fpm contains + +recursive subroutine add_libsources_from_package(sources,package_list,package,package_root,error) + ! Discover library sources in a package, recursively including dependencies + ! Only supports local path dependencies currently + ! + type(srcfile_t), allocatable, intent(inout), target :: sources(:) + type(string_t), allocatable, intent(inout) :: package_list(:) + type(package_t), intent(in) :: package + character(*), intent(in) :: package_root + type(error_t), allocatable, intent(out) :: error + + integer :: i + type(string_t) :: dep_name + type(package_t) :: dependency + + ! Add package library sources + if (allocated(package%library)) then + + call add_sources_from_dir(sources, join_path(package_root,package%library%source_dir), & + FPM_SCOPE_LIB, error=error) + + if (allocated(error)) then + return + end if + + end if + + ! Add library sources from dependencies + if (allocated(package%dependency)) then + + do i=1,size(package%dependency) + + if (allocated(package%dependency(i)%git)) then + + call fatal_error(error,'Remote dependencies not implemented') + return + + end if + + if (allocated(package%dependency(i)%path)) then + + call get_package_data(dependency, & + join_path(package%dependency(i)%path,"fpm.toml"), error) + + if (allocated(error)) then + error%message = 'Error while parsing manifest for dependency package at:'//& + new_line('a')//join_path(package%dependency(i)%path,"fpm.toml")//& + new_line('a')//error%message + return + end if + + if (dependency%name .in. package_list) then + cycle + end if + + if (.not.allocated(dependency%library) .and. & + exists(join_path(package_root,package%dependency(i)%path,"src"))) then + allocate(dependency%library) + dependency%library%source_dir = "src" + end if + + + call add_libsources_from_package(sources,package_list,dependency, & + package_root=join_path(package_root,package%dependency(i)%path), error=error) + + if (allocated(error)) then + error%message = 'Error while processing sources for dependency package "'//& + new_line('a')//dependency%name//'"'//& + new_line('a')//error%message + return + end if + + dep_name%s = dependency%name + package_list = [package_list, dep_name] + + end if + + end do + + end if + +end subroutine add_libsources_from_package + + subroutine build_model(model, settings, package, error) ! Constructs a valid fpm model from command line settings and toml manifest ! @@ -33,8 +116,13 @@ subroutine build_model(model, settings, package, error) type(package_t), intent(in) :: package type(error_t), allocatable, intent(out) :: error + type(string_t), allocatable :: package_list(:) + model%package_name = package%name + allocate(package_list(1)) + package_list(1)%s = package%name + ! #TODO: Choose flags and output directory based on cli settings & manifest inputs model%fortran_compiler = 'gfortran' @@ -94,14 +182,11 @@ subroutine build_model(model, settings, package, error) end if - if (allocated(package%library)) then - call add_sources_from_dir(model%sources, package%library%source_dir, & - FPM_SCOPE_LIB, error=error) - - if (allocated(error)) then - return - end if - + ! Add library sources, including local dependencies + call add_libsources_from_package(model%sources,package_list,package, & + package_root='.',error=error) + if (allocated(error)) then + return end if call resolve_module_dependencies(model%sources,error) From d9dc4b4fc47182d60f9e18eda36478b9ca8f75fb Mon Sep 17 00:00:00 2001 From: LKedward Date: Sun, 27 Sep 2020 11:43:10 +0100 Subject: [PATCH 02/17] Enable fpm CI tests for local path dependency demos --- ci/run_tests.bat | 18 ++++++++++++++++++ ci/run_tests.sh | 7 +++++++ test/example_packages/README.md | 4 ++-- 3 files changed, 27 insertions(+), 2 deletions(-) diff --git a/ci/run_tests.bat b/ci/run_tests.bat index ce79618608..9c61d7553e 100755 --- a/ci/run_tests.bat +++ b/ci/run_tests.bat @@ -15,6 +15,7 @@ if errorlevel 1 exit 1 build\gfortran_debug\app\fpm if errorlevel 1 exit 1 + cd ..\test\example_packages\hello_world if errorlevel 1 exit 1 @@ -25,6 +26,23 @@ if errorlevel 1 exit 1 if errorlevel 1 exit 1 +cd ..\hello_fpm +if errorlevel 1 exit 1 + +..\..\..\fpm\build\gfortran_debug\app\fpm build +if errorlevel 1 exit 1 + +.\build\gfortran_debug\app\hello_fpm +if errorlevel 1 exit 1 + + +cd ..\circular_test +if errorlevel 1 exit 1 + +..\..\..\fpm\build\gfortran_debug\app\fpm build +if errorlevel 1 exit 1 + + cd ..\hello_complex if errorlevel 1 exit 1 diff --git a/ci/run_tests.sh b/ci/run_tests.sh index ee46cac839..8c7339f636 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -12,6 +12,13 @@ cd ../test/example_packages/hello_world ../../../fpm/build/gfortran_debug/app/fpm build ./build/gfortran_debug/app/hello_world +cd ../hello_fpm +../../../fpm/build/gfortran_debug/app/fpm build +./build/gfortran_debug/app/hello_fpm + +cd ../circular_test +../../../fpm/build/gfortran_debug/app/fpm build + cd ../hello_complex ../../../fpm/build/gfortran_debug/app/fpm build ./build/gfortran_debug/app/say_Hello diff --git a/test/example_packages/README.md b/test/example_packages/README.md index fd02f0d1dd..95dad31cbc 100644 --- a/test/example_packages/README.md +++ b/test/example_packages/README.md @@ -7,10 +7,10 @@ the features demonstrated in each package and which versions of fpm are supporte | Name | Features | Bootstrap (Haskell) fpm | fpm | |---------------------|---------------------------------------------------------------|:-----------------------:|:---:| | circular_example | Local path dependency; circular dependency | Y | N | -| circular_test | Local path dependency; circular dependency | Y | N | +| circular_test | Local path dependency; circular dependency | Y | Y | | hello_complex | Non-standard directory layout; multiple tests and executables | Y | Y | | hello_complex_2 | Auto-discovery of tests and executables with modules | N | Y | -| hello_fpm | App-only; local path dependency | Y | N | +| hello_fpm | App-only; local path dependency | Y | Y | | hello_world | App-only | Y | Y | | makefile_complex | External build command (makefile); local path dependency | Y | N | | program_with_module | App-only; module+program in single source file | Y | Y | From c6a96464ebed9b8363b3d5571fdc9da5c90fe9ca Mon Sep 17 00:00:00 2001 From: LKedward Date: Sun, 27 Sep 2020 12:12:27 +0100 Subject: [PATCH 03/17] Add: support for local dev-depenencies Currently always built. --- fpm/src/fpm.f90 | 66 +++++++++++++++++++++++++++++++++++-------------- 1 file changed, 47 insertions(+), 19 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 7ace32c3e7..4b2d515f1d 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -17,6 +17,7 @@ module fpm use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & & stderr=>error_unit +use fpm_manifest_dependency, only: dependency_t implicit none private public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test @@ -25,7 +26,8 @@ module fpm contains -recursive subroutine add_libsources_from_package(sources,package_list,package,package_root,error) +recursive subroutine add_libsources_from_package(sources,package_list,package, & + package_root,dev_depends,error) ! Discover library sources in a package, recursively including dependencies ! Only supports local path dependencies currently ! @@ -33,12 +35,9 @@ recursive subroutine add_libsources_from_package(sources,package_list,package,pa type(string_t), allocatable, intent(inout) :: package_list(:) type(package_t), intent(in) :: package character(*), intent(in) :: package_root + logical, intent(in) :: dev_depends type(error_t), allocatable, intent(out) :: error - integer :: i - type(string_t) :: dep_name - type(package_t) :: dependency - ! Add package library sources if (allocated(package%library)) then @@ -54,40 +53,69 @@ recursive subroutine add_libsources_from_package(sources,package_list,package,pa ! Add library sources from dependencies if (allocated(package%dependency)) then - do i=1,size(package%dependency) + call add_local_dependencies(package%dependency) + + if (allocated(error)) then + return + end if + + end if + + ! Add library sources from dev-dependencies + if (dev_depends .and. allocated(package%dev_dependency)) then + + call add_local_dependencies(package%dev_dependency) + + if (allocated(error)) then + return + end if + + end if + + contains + + subroutine add_local_dependencies(dependency_list) + type(dependency_t) :: dependency_list(:) + + integer :: i + type(string_t) :: dep_name + type(package_t) :: dependency + + do i=1,size(dependency_list) - if (allocated(package%dependency(i)%git)) then + if (dependency_list(i)%name .in. package_list) then + cycle + end if + + if (allocated(dependency_list(i)%git)) then call fatal_error(error,'Remote dependencies not implemented') return end if - if (allocated(package%dependency(i)%path)) then + if (allocated(dependency_list(i)%path)) then call get_package_data(dependency, & - join_path(package%dependency(i)%path,"fpm.toml"), error) + join_path(dependency_list(i)%path,"fpm.toml"), error) if (allocated(error)) then error%message = 'Error while parsing manifest for dependency package at:'//& - new_line('a')//join_path(package%dependency(i)%path,"fpm.toml")//& + new_line('a')//join_path(dependency_list(i)%path,"fpm.toml")//& new_line('a')//error%message return end if - if (dependency%name .in. package_list) then - cycle - end if - if (.not.allocated(dependency%library) .and. & - exists(join_path(package_root,package%dependency(i)%path,"src"))) then + exists(join_path(package_root,dependency_list(i)%path,"src"))) then allocate(dependency%library) dependency%library%source_dir = "src" end if call add_libsources_from_package(sources,package_list,dependency, & - package_root=join_path(package_root,package%dependency(i)%path), error=error) + package_root=join_path(package_root,dependency_list(i)%path), & + dev_depends=dev_depends, error=error) if (allocated(error)) then error%message = 'Error while processing sources for dependency package "'//& @@ -96,14 +124,14 @@ recursive subroutine add_libsources_from_package(sources,package_list,package,pa return end if - dep_name%s = dependency%name + dep_name%s = dependency_list(i)%name package_list = [package_list, dep_name] end if end do - end if + end subroutine add_local_dependencies end subroutine add_libsources_from_package @@ -184,7 +212,7 @@ subroutine build_model(model, settings, package, error) ! Add library sources, including local dependencies call add_libsources_from_package(model%sources,package_list,package, & - package_root='.',error=error) + package_root='.',dev_depends=.true.,error=error) if (allocated(error)) then return end if From 6f8a4466edde51653439f03a34e6fab6f2ff2071 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sun, 27 Sep 2020 12:14:04 +0100 Subject: [PATCH 04/17] Add: circular_example demo to fpm CI scripts Now supported with local dev-dependencies --- ci/run_tests.bat | 7 +++++++ ci/run_tests.sh | 3 +++ test/example_packages/README.md | 2 +- 3 files changed, 11 insertions(+), 1 deletion(-) diff --git a/ci/run_tests.bat b/ci/run_tests.bat index 9c61d7553e..745f14ff16 100755 --- a/ci/run_tests.bat +++ b/ci/run_tests.bat @@ -43,6 +43,13 @@ if errorlevel 1 exit 1 if errorlevel 1 exit 1 +cd ..\circular_example +if errorlevel 1 exit 1 + +..\..\..\fpm\build\gfortran_debug\app\fpm build +if errorlevel 1 exit 1 + + cd ..\hello_complex if errorlevel 1 exit 1 diff --git a/ci/run_tests.sh b/ci/run_tests.sh index 8c7339f636..6937c6b58d 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -19,6 +19,9 @@ cd ../hello_fpm cd ../circular_test ../../../fpm/build/gfortran_debug/app/fpm build +cd ../circular_example +../../../fpm/build/gfortran_debug/app/fpm build + cd ../hello_complex ../../../fpm/build/gfortran_debug/app/fpm build ./build/gfortran_debug/app/say_Hello diff --git a/test/example_packages/README.md b/test/example_packages/README.md index 95dad31cbc..ee2a908324 100644 --- a/test/example_packages/README.md +++ b/test/example_packages/README.md @@ -6,7 +6,7 @@ the features demonstrated in each package and which versions of fpm are supporte | Name | Features | Bootstrap (Haskell) fpm | fpm | |---------------------|---------------------------------------------------------------|:-----------------------:|:---:| -| circular_example | Local path dependency; circular dependency | Y | N | +| circular_example | Local path dependency; circular dependency | Y | Y | | circular_test | Local path dependency; circular dependency | Y | Y | | hello_complex | Non-standard directory layout; multiple tests and executables | Y | Y | | hello_complex_2 | Auto-discovery of tests and executables with modules | N | Y | From 72dab19de88c2d31deccad2e6f988fb85e614190 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sun, 27 Sep 2020 12:22:03 +0100 Subject: [PATCH 05/17] Minor fix: to local dependency relative path Local dependency paths are relative to the dependent package not the building package. --- fpm/src/fpm.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 4b2d515f1d..887ba22797 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -69,7 +69,7 @@ recursive subroutine add_libsources_from_package(sources,package_list,package, & if (allocated(error)) then return end if - + end if contains @@ -97,11 +97,11 @@ subroutine add_local_dependencies(dependency_list) if (allocated(dependency_list(i)%path)) then call get_package_data(dependency, & - join_path(dependency_list(i)%path,"fpm.toml"), error) + join_path(package_root,dependency_list(i)%path,"fpm.toml"), error) if (allocated(error)) then error%message = 'Error while parsing manifest for dependency package at:'//& - new_line('a')//join_path(dependency_list(i)%path,"fpm.toml")//& + new_line('a')//join_path(package_root,dependency_list(i)%path,"fpm.toml")//& new_line('a')//error%message return end if From 64a0f72db4080c2ca18e8ba7bbad5825c02ab079 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sun, 27 Sep 2020 13:07:21 +0100 Subject: [PATCH 06/17] Retain source file structure in object files --- fpm/src/fpm_backend.f90 | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index 40460d7a37..d7005bff58 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -3,7 +3,7 @@ module fpm_backend ! Implements the native fpm build backend use fpm_environment, only: run, get_os_type, OS_WINDOWS -use fpm_filesystem, only: basename, join_path, exists, mkdir +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, & @@ -113,6 +113,10 @@ recursive subroutine build_source(model,source_file,linking) object_file = get_object_name(model,source_file%file_name) + 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 @@ -145,13 +149,6 @@ function get_object_name(model,source_file_name) result(object_file) ! Exclude first directory level from path object_file = source_file_name(index(source_file_name,filesep)+1:) - ! Convert remaining directory separators to underscores - i = index(object_file,filesep) - do while(i > 0) - object_file(i:i) = '_' - i = index(object_file,filesep) - end do - ! Construct full target path object_file = join_path(model%output_directory, model%package_name, & object_file//'.o') From 1fb2c203652f2ce5677efda392c24a338889a202 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 3 Oct 2020 12:35:59 +0100 Subject: [PATCH 07/17] Update: hello_complex_2 to expose link bug There's a bug which causes app-local modules to be added twice if auto-discovery is on and the app is specified in the manifest. This causes the module to be compiled and linked twice. Not detected before because the module contained no symbols. This commit adds an integer symbol to an app-local module to test this bug. --- .../hello_complex_2/app/say_hello/app_hello_mod.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/test/example_packages/hello_complex_2/app/say_hello/app_hello_mod.f90 b/test/example_packages/hello_complex_2/app/say_hello/app_hello_mod.f90 index 5c426c8724..c5795cbf90 100644 --- a/test/example_packages/hello_complex_2/app/say_hello/app_hello_mod.f90 +++ b/test/example_packages/hello_complex_2/app/say_hello/app_hello_mod.f90 @@ -1,4 +1,6 @@ module app_hello_mod implicit none +integer :: hello_int = 42 + end module app_hello_mod From 4ef3025845b54b81d3ac5644899f42cb84dd95c8 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 3 Oct 2020 12:42:50 +0100 Subject: [PATCH 08/17] Fix: duplication of app modules --- fpm/src/fpm_sources.f90 | 105 ++++++++++++++++++++++------------------ 1 file changed, 57 insertions(+), 48 deletions(-) diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index f79827642f..dc9f5f99e7 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -6,7 +6,7 @@ module fpm_sources FPM_UNIT_CSOURCE, FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, & FPM_SCOPE_LIB, FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST -use fpm_filesystem, only: basename, canon_path, dirname, read_lines, list_files +use fpm_filesystem, only: basename, canon_path, dirname, join_path, read_lines, list_files use fpm_strings, only: lower, split, str_ends_with, string_t, operator(.in.) use fpm_manifest_executable, only: executable_t implicit none @@ -24,6 +24,33 @@ module fpm_sources contains +function parse_source(source_file_path,error) result(source) + character(*), intent(in) :: source_file_path + type(error_t), allocatable, intent(out) :: error + type(srcfile_t) :: source + + if (str_ends_with(lower(source_file_path), ".f90")) then + + source = parse_f_source(source_file_path, error) + + if (source%unit_type == FPM_UNIT_PROGRAM) then + source%exe_name = basename(source_file_path,suffix=.false.) + end if + + else if (str_ends_with(lower(source_file_path), ".c") .or. & + str_ends_with(lower(source_file_path), ".h")) then + + source = parse_c_source(source_file_path,error) + + end if + + if (allocated(error)) then + return + end if + +end function parse_source + + subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) ! Enumerate sources in a directory ! @@ -33,7 +60,7 @@ subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) logical, intent(in), optional :: with_executables type(error_t), allocatable, intent(out) :: error - integer :: i, j + integer :: i logical, allocatable :: is_source(:), exclude_source(:) type(string_t), allocatable :: file_names(:) type(string_t), allocatable :: src_file_names(:) @@ -63,26 +90,8 @@ subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) 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, 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,error) - - if (allocated(error)) then - return - end if - - end if + dir_sources(i) = parse_source(src_file_names(i)%s,error) + if (allocated(error)) return dir_sources(i)%unit_scope = scope @@ -93,7 +102,6 @@ subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) if (with_executables) then exclude_source(i) = .false. - dir_sources(i)%exe_name = basename(src_file_names(i)%s,suffix=.false.) end if end if @@ -122,49 +130,50 @@ subroutine add_executable_sources(sources,executables,scope,auto_discover,error) integer :: i, j type(string_t), allocatable :: exe_dirs(:) - logical, allocatable :: include_source(:) - type(srcfile_t), allocatable :: dir_sources(:) + type(srcfile_t) :: exe_source 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, & - scope, with_executables=.true.,error=error) + call add_sources_from_dir(sources,exe_dirs(i)%s, & + scope, with_executables=auto_discover,error=error) if (allocated(error)) then return end if end do - allocate(include_source(size(dir_sources))) + exe_loop: do i=1,size(executables) - do i = 1, size(dir_sources) - - ! Include source by default if not a program or if auto_discover is enabled - include_source(i) = (dir_sources(i)%unit_type /= FPM_UNIT_PROGRAM) .or. & - auto_discover - - ! Always include sources specified in fpm.toml - do j=1,size(executables) + ! Check if executable already discovered automatically + ! and apply any overrides + do j=1,size(sources) - if (basename(dir_sources(i)%file_name,suffix=.true.) == executables(j)%main .and.& - canon_path(dirname(dir_sources(i)%file_name)) == & - canon_path(executables(j)%source_dir) ) then + if (basename(sources(j)%file_name,suffix=.true.) == executables(i)%main .and.& + canon_path(dirname(sources(j)%file_name)) == & + canon_path(executables(i)%source_dir) ) then - include_source(i) = .true. - dir_sources(i)%exe_name = executables(j)%name - exit + sources(j)%exe_name = executables(i)%name + cycle exe_loop end if + end do - end do + ! Add if not already discovered (auto_discovery off) + exe_source = parse_source(join_path(executables(i)%source_dir,executables(i)%main),error) + exe_source%exe_name = executables(i)%name + exe_source%unit_scope = scope + + if (allocated(error)) return - if (.not.allocated(sources)) then - sources = pack(dir_sources,include_source) - else - sources = [sources, pack(dir_sources,include_source)] - end if + if (.not.allocated(sources)) then + sources = [exe_source] + else + sources = [sources, exe_source] + end if + + end do exe_loop end subroutine add_executable_sources From 48dd8bcc11e9fc3aaecc3088dd093664a58e40be Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 3 Oct 2020 12:49:30 +0100 Subject: [PATCH 09/17] Update: source parsing test - include statement Demonstrates bug in include statement parsing - currently erroneously parsing all statements that begin with 'include'. --- fpm/test/fpm_test/test_source_parsing.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/fpm/test/fpm_test/test_source_parsing.f90 b/fpm/test/fpm_test/test_source_parsing.f90 index 0b92bef8a9..a8bbc09b7f 100644 --- a/fpm/test/fpm_test/test_source_parsing.f90 +++ b/fpm/test/fpm_test/test_source_parsing.f90 @@ -199,6 +199,8 @@ subroutine test_include_stmt(error) & 'program test', & & ' implicit none', & & ' include "included_file.f90"', & + & ' logical :: include_comments', & + & ' include_comments = .false.', & & ' contains ', & & ' include "second_include.f90"', & & 'end program test' From bdaac5c9739468e207bf5ffd0f7b8471b6d5975d Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 3 Oct 2020 12:55:08 +0100 Subject: [PATCH 10/17] Fix: include statement parsing Include statements must have a single or double quote immediately following 'include' --- fpm/src/fpm_sources.f90 | 29 +++++++++++++---------- fpm/test/fpm_test/test_source_parsing.f90 | 8 +++---- 2 files changed, 21 insertions(+), 16 deletions(-) diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index dc9f5f99e7..e654b03852 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -300,21 +300,26 @@ function parse_f_source(f_filename,error) result(f_source) end if ! Process 'INCLUDE' statements - if (index(adjustl(lower(file_lines(i)%s)),'include') == 1) then - - n_include = n_include + 1 + ic = index(adjustl(lower(file_lines(i)%s)),'include') + if ( ic == 1 ) then + ic = index(lower(file_lines(i)%s),'include') + if (index(adjustl(file_lines(i)%s(ic+7:)),'"') == 1 .or. & + index(adjustl(file_lines(i)%s(ic+7:)),"'") == 1 ) then - if (pass == 2) then - 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 + + n_include = n_include + 1 + + if (pass == 2) then + 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 - end if ! Extract name of module if is module diff --git a/fpm/test/fpm_test/test_source_parsing.f90 b/fpm/test/fpm_test/test_source_parsing.f90 index a8bbc09b7f..d1d3e12ca2 100644 --- a/fpm/test/fpm_test/test_source_parsing.f90 +++ b/fpm/test/fpm_test/test_source_parsing.f90 @@ -198,11 +198,11 @@ subroutine test_include_stmt(error) write(unit, '(a)') & & 'program test', & & ' implicit none', & - & ' include "included_file.f90"', & - & ' logical :: include_comments', & - & ' include_comments = .false.', & + & ' include "included_file.f90"', & + & ' character(*) :: include_comments', & + & ' include_comments = "some comments"', & & ' contains ', & - & ' include "second_include.f90"', & + & ' include"second_include.f90"', & & 'end program test' close(unit) From 22ea5a657049e927c8361cf1d26cbe03227c6c58 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 3 Oct 2020 13:33:14 +0100 Subject: [PATCH 11/17] Add: support for remote git dependencies --- fpm/src/fpm.f90 | 76 ++++++++++++++++++++++++--------------------- fpm/src/fpm/git.f90 | 43 +++++++++++++++++++++++++ 2 files changed, 84 insertions(+), 35 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 1c5275a3ad..55b2baae3c 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -53,7 +53,7 @@ recursive subroutine add_libsources_from_package(sources,package_list,package, & ! Add library sources from dependencies if (allocated(package%dependency)) then - call add_local_dependencies(package%dependency) + call add_dependencies(package%dependency) if (allocated(error)) then return @@ -64,7 +64,7 @@ recursive subroutine add_libsources_from_package(sources,package_list,package, & ! Add library sources from dev-dependencies if (dev_depends .and. allocated(package%dev_dependency)) then - call add_local_dependencies(package%dev_dependency) + call add_dependencies(package%dev_dependency) if (allocated(error)) then return @@ -74,13 +74,15 @@ recursive subroutine add_libsources_from_package(sources,package_list,package, & contains - subroutine add_local_dependencies(dependency_list) + subroutine add_dependencies(dependency_list) type(dependency_t) :: dependency_list(:) integer :: i type(string_t) :: dep_name type(package_t) :: dependency + character(:), allocatable :: dependency_path + do i=1,size(dependency_list) if (dependency_list(i)%name .in. package_list) then @@ -89,49 +91,53 @@ subroutine add_local_dependencies(dependency_list) if (allocated(dependency_list(i)%git)) then - call fatal_error(error,'Remote dependencies not implemented') - return + dependency_path = join_path('build','dependencies',dependency_list(i)%name) - end if - - if (allocated(dependency_list(i)%path)) then + if (.not.exists(join_path(dependency_path,'fpm.toml'))) then + call dependency_list(i)%git%checkout(dependency_path, error) + if (allocated(error)) return + end if - call get_package_data(dependency, & - join_path(package_root,dependency_list(i)%path,"fpm.toml"), error) + else if (allocated(dependency_list(i)%path)) then + + dependency_path = join_path(package_root,dependency_list(i)%path) - if (allocated(error)) then - error%message = 'Error while parsing manifest for dependency package at:'//& - new_line('a')//join_path(package_root,dependency_list(i)%path,"fpm.toml")//& - new_line('a')//error%message - return - end if + end if - if (.not.allocated(dependency%library) .and. & - exists(join_path(package_root,dependency_list(i)%path,"src"))) then - allocate(dependency%library) - dependency%library%source_dir = "src" - end if + call get_package_data(dependency, & + join_path(dependency_path,"fpm.toml"), error) - - call add_libsources_from_package(sources,package_list,dependency, & - package_root=join_path(package_root,dependency_list(i)%path), & - dev_depends=dev_depends, error=error) - - if (allocated(error)) then - error%message = 'Error while processing sources for dependency package "'//& - new_line('a')//dependency%name//'"'//& - new_line('a')//error%message - return - end if + if (allocated(error)) then + error%message = 'Error while parsing manifest for dependency package at:'//& + new_line('a')//join_path(dependency_path,"fpm.toml")//& + new_line('a')//error%message + return + end if - dep_name%s = dependency_list(i)%name - package_list = [package_list, dep_name] + if (.not.allocated(dependency%library) .and. & + exists(join_path(dependency_path,"src"))) then + allocate(dependency%library) + dependency%library%source_dir = "src" + end if + + call add_libsources_from_package(sources,package_list,dependency, & + package_root=dependency_path, & + dev_depends=dev_depends, error=error) + + if (allocated(error)) then + error%message = 'Error while processing sources for dependency package "'//& + new_line('a')//dependency%name//'"'//& + new_line('a')//error%message + return end if + dep_name%s = dependency_list(i)%name + package_list = [package_list, dep_name] + end do - end subroutine add_local_dependencies + end subroutine add_dependencies end subroutine add_libsources_from_package diff --git a/fpm/src/fpm/git.f90 b/fpm/src/fpm/git.f90 index 28ae867d67..f02d06f322 100644 --- a/fpm/src/fpm/git.f90 +++ b/fpm/src/fpm/git.f90 @@ -1,5 +1,6 @@ !> Implementation for interacting with git repositories. module fpm_git + use fpm_error, only: error_t, fatal_error implicit none public :: git_target_t @@ -43,6 +44,9 @@ module fpm_git contains + !> Fetch and checkout in local directory + procedure :: checkout + !> Show information on instance procedure :: info @@ -124,6 +128,45 @@ function git_target_tag(url, tag) result(self) end function git_target_tag + subroutine checkout(self,local_path, error) + + !> Instance of the git target + class(git_target_t), intent(in) :: self + + !> Local path to checkout in + character(*), intent(in) :: local_path + + !> Error + type(error_t), allocatable, intent(out) :: error + + !> Stat for execute_command_line + integer :: stat + + call execute_command_line("git init "//local_path, exitstat=stat) + + if (stat /= 0) then + call fatal_error(error,'Error while initiating git repository for remote dependency') + return + end if + + call execute_command_line("git -C "//local_path//" fetch "//self%url//& + " "//self%object, exitstat=stat) + + if (stat /= 0) then + call fatal_error(error,'Error while fetching git repository for remote dependency') + return + end if + + call execute_command_line("git -C "//local_path//" checkout -qf FETCH_HEAD", exitstat=stat) + + if (stat /= 0) then + call fatal_error(error,'Error while checking out git repository for remote dependency') + return + end if + + end subroutine checkout + + !> Show information on git target subroutine info(self, unit, verbosity) From b6ec6b15ffcd764c6798bb8f76f0b6282dec437d Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 3 Oct 2020 12:42:50 +0100 Subject: [PATCH 12/17] Fix: duplication of app modules --- fpm/src/fpm_sources.f90 | 109 ++++++++++++++++++++++------------------ 1 file changed, 59 insertions(+), 50 deletions(-) diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index f79827642f..1028b81293 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -6,7 +6,7 @@ module fpm_sources FPM_UNIT_CSOURCE, FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, & FPM_SCOPE_LIB, FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST -use fpm_filesystem, only: basename, canon_path, dirname, read_lines, list_files +use fpm_filesystem, only: basename, canon_path, dirname, join_path, read_lines, list_files use fpm_strings, only: lower, split, str_ends_with, string_t, operator(.in.) use fpm_manifest_executable, only: executable_t implicit none @@ -24,6 +24,33 @@ module fpm_sources contains +function parse_source(source_file_path,error) result(source) + character(*), intent(in) :: source_file_path + type(error_t), allocatable, intent(out) :: error + type(srcfile_t) :: source + + if (str_ends_with(lower(source_file_path), ".f90")) then + + source = parse_f_source(source_file_path, error) + + if (source%unit_type == FPM_UNIT_PROGRAM) then + source%exe_name = basename(source_file_path,suffix=.false.) + end if + + else if (str_ends_with(lower(source_file_path), ".c") .or. & + str_ends_with(lower(source_file_path), ".h")) then + + source = parse_c_source(source_file_path,error) + + end if + + if (allocated(error)) then + return + end if + +end function parse_source + + subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) ! Enumerate sources in a directory ! @@ -33,7 +60,7 @@ subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) logical, intent(in), optional :: with_executables type(error_t), allocatable, intent(out) :: error - integer :: i, j + integer :: i logical, allocatable :: is_source(:), exclude_source(:) type(string_t), allocatable :: file_names(:) type(string_t), allocatable :: src_file_names(:) @@ -46,13 +73,13 @@ subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) if (allocated(sources)) then allocate(existing_src_files(size(sources))) do i=1,size(sources) - existing_src_files(i)%s = sources(i)%file_name + existing_src_files(i)%s = canon_path(sources(i)%file_name) end do else allocate(existing_src_files(0)) end if - is_source = [(.not.(file_names(i)%s .in. existing_src_files) .and. & + is_source = [(.not.(canon_path(file_names(i)%s) .in. existing_src_files) .and. & (str_ends_with(lower(file_names(i)%s), ".f90") .or. & str_ends_with(lower(file_names(i)%s), ".c") .or. & str_ends_with(lower(file_names(i)%s), ".h") ),i=1,size(file_names))] @@ -63,26 +90,8 @@ subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) 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, 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,error) - - if (allocated(error)) then - return - end if - - end if + dir_sources(i) = parse_source(src_file_names(i)%s,error) + if (allocated(error)) return dir_sources(i)%unit_scope = scope @@ -93,7 +102,6 @@ subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) if (with_executables) then exclude_source(i) = .false. - dir_sources(i)%exe_name = basename(src_file_names(i)%s,suffix=.false.) end if end if @@ -122,49 +130,50 @@ subroutine add_executable_sources(sources,executables,scope,auto_discover,error) integer :: i, j type(string_t), allocatable :: exe_dirs(:) - logical, allocatable :: include_source(:) - type(srcfile_t), allocatable :: dir_sources(:) + type(srcfile_t) :: exe_source 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, & - scope, with_executables=.true.,error=error) + call add_sources_from_dir(sources,exe_dirs(i)%s, & + scope, with_executables=auto_discover,error=error) if (allocated(error)) then return end if end do - allocate(include_source(size(dir_sources))) + exe_loop: do i=1,size(executables) - do i = 1, size(dir_sources) - - ! Include source by default if not a program or if auto_discover is enabled - include_source(i) = (dir_sources(i)%unit_type /= FPM_UNIT_PROGRAM) .or. & - auto_discover - - ! Always include sources specified in fpm.toml - do j=1,size(executables) + ! Check if executable already discovered automatically + ! and apply any overrides + do j=1,size(sources) - if (basename(dir_sources(i)%file_name,suffix=.true.) == executables(j)%main .and.& - canon_path(dirname(dir_sources(i)%file_name)) == & - canon_path(executables(j)%source_dir) ) then + if (basename(sources(j)%file_name,suffix=.true.) == executables(i)%main .and.& + canon_path(dirname(sources(j)%file_name)) == & + canon_path(executables(i)%source_dir) ) then - include_source(i) = .true. - dir_sources(i)%exe_name = executables(j)%name - exit + sources(j)%exe_name = executables(i)%name + cycle exe_loop end if + end do - end do + ! Add if not already discovered (auto_discovery off) + exe_source = parse_source(join_path(executables(i)%source_dir,executables(i)%main),error) + exe_source%exe_name = executables(i)%name + exe_source%unit_scope = scope + + if (allocated(error)) return - if (.not.allocated(sources)) then - sources = pack(dir_sources,include_source) - else - sources = [sources, pack(dir_sources,include_source)] - end if + if (.not.allocated(sources)) then + sources = [exe_source] + else + sources = [sources, exe_source] + end if + + end do exe_loop end subroutine add_executable_sources From 7ca0ba26405a074103c63f281177f3966bc0a760 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 3 Oct 2020 12:49:30 +0100 Subject: [PATCH 13/17] Update: source parsing test - include statement Demonstrates bug in include statement parsing - currently erroneously parsing all statements that begin with 'include'. --- fpm/test/fpm_test/test_source_parsing.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/fpm/test/fpm_test/test_source_parsing.f90 b/fpm/test/fpm_test/test_source_parsing.f90 index 0b92bef8a9..a8bbc09b7f 100644 --- a/fpm/test/fpm_test/test_source_parsing.f90 +++ b/fpm/test/fpm_test/test_source_parsing.f90 @@ -199,6 +199,8 @@ subroutine test_include_stmt(error) & 'program test', & & ' implicit none', & & ' include "included_file.f90"', & + & ' logical :: include_comments', & + & ' include_comments = .false.', & & ' contains ', & & ' include "second_include.f90"', & & 'end program test' From 10d835afd44adecf6589a2ebc0d20249880bcfc8 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 3 Oct 2020 12:55:08 +0100 Subject: [PATCH 14/17] Fix: include statement parsing Include statements must have a single or double quote immediately following 'include' --- fpm/src/fpm_sources.f90 | 29 +++++++++++++---------- fpm/test/fpm_test/test_source_parsing.f90 | 8 +++---- 2 files changed, 21 insertions(+), 16 deletions(-) diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index 1028b81293..393c799692 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -300,21 +300,26 @@ function parse_f_source(f_filename,error) result(f_source) end if ! Process 'INCLUDE' statements - if (index(adjustl(lower(file_lines(i)%s)),'include') == 1) then - - n_include = n_include + 1 + ic = index(adjustl(lower(file_lines(i)%s)),'include') + if ( ic == 1 ) then + ic = index(lower(file_lines(i)%s),'include') + if (index(adjustl(file_lines(i)%s(ic+7:)),'"') == 1 .or. & + index(adjustl(file_lines(i)%s(ic+7:)),"'") == 1 ) then - if (pass == 2) then - 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 + + n_include = n_include + 1 + + if (pass == 2) then + 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 - end if ! Extract name of module if is module diff --git a/fpm/test/fpm_test/test_source_parsing.f90 b/fpm/test/fpm_test/test_source_parsing.f90 index a8bbc09b7f..d1d3e12ca2 100644 --- a/fpm/test/fpm_test/test_source_parsing.f90 +++ b/fpm/test/fpm_test/test_source_parsing.f90 @@ -198,11 +198,11 @@ subroutine test_include_stmt(error) write(unit, '(a)') & & 'program test', & & ' implicit none', & - & ' include "included_file.f90"', & - & ' logical :: include_comments', & - & ' include_comments = .false.', & + & ' include "included_file.f90"', & + & ' character(*) :: include_comments', & + & ' include_comments = "some comments"', & & ' contains ', & - & ' include "second_include.f90"', & + & ' include"second_include.f90"', & & 'end program test' close(unit) From 9b790fbbb606a7de152615745543b0912efd3f33 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 3 Oct 2020 14:09:54 +0100 Subject: [PATCH 15/17] Update: use default git object = 'HEAD' for checkout --- fpm/src/fpm/git.f90 | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/fpm/src/fpm/git.f90 b/fpm/src/fpm/git.f90 index f02d06f322..187b5514e7 100644 --- a/fpm/src/fpm/git.f90 +++ b/fpm/src/fpm/git.f90 @@ -138,10 +138,19 @@ subroutine checkout(self,local_path, error) !> Error type(error_t), allocatable, intent(out) :: error + + !> git object ref + character(:), allocatable :: object !> Stat for execute_command_line integer :: stat + if (allocated(self%object)) then + object = self%object + else + object = 'HEAD' + end if + call execute_command_line("git init "//local_path, exitstat=stat) if (stat /= 0) then @@ -150,7 +159,7 @@ subroutine checkout(self,local_path, error) end if call execute_command_line("git -C "//local_path//" fetch "//self%url//& - " "//self%object, exitstat=stat) + " "//object, exitstat=stat) if (stat /= 0) then call fatal_error(error,'Error while fetching git repository for remote dependency') From 501be367dbfdd7233d343c3fc156ecfa290a6778 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 4 Oct 2020 09:55:40 +0100 Subject: [PATCH 16/17] Update fpm/src/fpm.f90 Co-authored-by: Milan Curcic --- fpm/src/fpm.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 9d1d86350c..8088225c30 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -75,7 +75,7 @@ recursive subroutine add_libsources_from_package(sources,package_list,package, & contains subroutine add_dependencies(dependency_list) - type(dependency_t) :: dependency_list(:) + type(dependency_t), intent(in) :: dependency_list(:) integer :: i type(string_t) :: dep_name From 24b115eab49e8926f4a46c28d2ad383bc3a22b31 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sun, 4 Oct 2020 10:39:17 +0100 Subject: [PATCH 17/17] Don't pull dev dependencies of dependencies. --- fpm/src/fpm.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 8088225c30..faa3e7e8fc 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -29,7 +29,6 @@ module fpm recursive subroutine add_libsources_from_package(sources,package_list,package, & package_root,dev_depends,error) ! Discover library sources in a package, recursively including dependencies - ! Only supports local path dependencies currently ! type(srcfile_t), allocatable, intent(inout), target :: sources(:) type(string_t), allocatable, intent(inout) :: package_list(:) @@ -123,7 +122,7 @@ subroutine add_dependencies(dependency_list) call add_libsources_from_package(sources,package_list,dependency, & package_root=dependency_path, & - dev_depends=dev_depends, error=error) + dev_depends=.false., error=error) if (allocated(error)) then error%message = 'Error while processing sources for dependency package "'//&